1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999, 2000, 2001
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
27 /* This makes the fields of a Display accessible, in Xlib header files. */
29 #define XLIB_ILLEGAL_ACCESS
36 #include "intervals.h"
37 #include "dispextern.h"
39 #include "blockinput.h"
45 #include "termhooks.h"
51 #include <sys/types.h>
55 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
56 #include "bitmaps/gray.xbm"
58 #include <X11/bitmaps/gray>
61 #include "[.bitmaps]gray.xbm"
65 #include <X11/Shell.h>
68 #include <X11/Xaw/Paned.h>
69 #include <X11/Xaw/Label.h>
70 #endif /* USE_MOTIF */
73 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
82 #include "../lwlib/lwlib.h"
86 #include <Xm/DialogS.h>
87 #include <Xm/FileSB.h>
90 /* Do the EDITRES protocol if running X11R5
91 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
93 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
95 extern void _XEditResCheckMessages ();
96 #endif /* R5 + Athena */
98 /* Unique id counter for widgets created by the Lucid Widget Library. */
100 extern LWLIB_ID widget_id_tick
;
103 /* This is part of a kludge--see lwlib/xlwmenu.c. */
104 extern XFontStruct
*xlwmenu_default_font
;
107 extern void free_frame_menubar ();
108 extern double atof ();
112 /* LessTif/Motif version info. */
114 static Lisp_Object Vmotif_version_string
;
116 #endif /* USE_MOTIF */
118 #endif /* USE_X_TOOLKIT */
121 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
123 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
126 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
127 it, and including `bitmaps/gray' more than once is a problem when
128 config.h defines `static' as an empty replacement string. */
130 int gray_bitmap_width
= gray_width
;
131 int gray_bitmap_height
= gray_height
;
132 char *gray_bitmap_bits
= gray_bits
;
134 /* The name we're using in resource queries. Most often "emacs". */
136 Lisp_Object Vx_resource_name
;
138 /* The application class we're using in resource queries.
141 Lisp_Object Vx_resource_class
;
143 /* Non-zero means we're allowed to display an hourglass cursor. */
145 int display_hourglass_p
;
147 /* The background and shape of the mouse pointer, and shape when not
148 over text or in the modeline. */
150 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
151 Lisp_Object Vx_hourglass_pointer_shape
;
153 /* The shape when over mouse-sensitive text. */
155 Lisp_Object Vx_sensitive_text_pointer_shape
;
157 /* If non-nil, the pointer shape to indicate that windows can be
158 dragged horizontally. */
160 Lisp_Object Vx_window_horizontal_drag_shape
;
162 /* Color of chars displayed in cursor box. */
164 Lisp_Object Vx_cursor_fore_pixel
;
166 /* Nonzero if using X. */
170 /* Non nil if no window manager is in use. */
172 Lisp_Object Vx_no_window_manager
;
174 /* Search path for bitmap files. */
176 Lisp_Object Vx_bitmap_file_path
;
178 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
180 Lisp_Object Vx_pixel_size_width_font_regexp
;
182 Lisp_Object Qauto_raise
;
183 Lisp_Object Qauto_lower
;
185 Lisp_Object Qborder_color
;
186 Lisp_Object Qborder_width
;
188 Lisp_Object Qcursor_color
;
189 Lisp_Object Qcursor_type
;
190 Lisp_Object Qgeometry
;
191 Lisp_Object Qicon_left
;
192 Lisp_Object Qicon_top
;
193 Lisp_Object Qicon_type
;
194 Lisp_Object Qicon_name
;
195 Lisp_Object Qinternal_border_width
;
198 Lisp_Object Qmouse_color
;
200 Lisp_Object Qouter_window_id
;
201 Lisp_Object Qparent_id
;
202 Lisp_Object Qscroll_bar_width
;
203 Lisp_Object Qsuppress_icon
;
204 extern Lisp_Object Qtop
;
205 Lisp_Object Qundefined_color
;
206 Lisp_Object Qvertical_scroll_bars
;
207 Lisp_Object Qvisibility
;
208 Lisp_Object Qwindow_id
;
209 Lisp_Object Qx_frame_parameter
;
210 Lisp_Object Qx_resource_name
;
211 Lisp_Object Quser_position
;
212 Lisp_Object Quser_size
;
213 extern Lisp_Object Qdisplay
;
214 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
215 Lisp_Object Qscreen_gamma
, Qline_spacing
, Qcenter
;
216 Lisp_Object Qcompound_text
, Qcancel_timer
;
217 Lisp_Object Qwait_for_wm
;
219 /* The below are defined in frame.c. */
221 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
222 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
223 extern Lisp_Object Qtool_bar_lines
;
225 extern Lisp_Object Vwindow_system_version
;
227 Lisp_Object Qface_set_after_frame_default
;
230 int image_cache_refcount
, dpyinfo_refcount
;
235 /* Error if we are not connected to X. */
241 error ("X windows are not in use or not initialized");
244 /* Nonzero if we can use mouse menus.
245 You should not call this unless HAVE_MENUS is defined. */
253 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
254 and checking validity for X. */
257 check_x_frame (frame
)
263 frame
= selected_frame
;
264 CHECK_LIVE_FRAME (frame
, 0);
267 error ("Non-X frame used");
271 /* Let the user specify an X display with a frame.
272 nil stands for the selected frame--or, if that is not an X frame,
273 the first X display on the list. */
275 static struct x_display_info
*
276 check_x_display_info (frame
)
279 struct x_display_info
*dpyinfo
= NULL
;
283 struct frame
*sf
= XFRAME (selected_frame
);
285 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
286 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
287 else if (x_display_list
!= 0)
288 dpyinfo
= x_display_list
;
290 error ("X windows are not in use or not initialized");
292 else if (STRINGP (frame
))
293 dpyinfo
= x_display_info_for_name (frame
);
298 CHECK_LIVE_FRAME (frame
, 0);
301 error ("Non-X frame used");
302 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
309 /* Return the Emacs frame-object corresponding to an X window.
310 It could be the frame's main window or an icon window. */
312 /* This function can be called during GC, so use GC_xxx type test macros. */
315 x_window_to_frame (dpyinfo
, wdesc
)
316 struct x_display_info
*dpyinfo
;
319 Lisp_Object tail
, frame
;
322 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
325 if (!GC_FRAMEP (frame
))
328 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
330 if (f
->output_data
.x
->hourglass_window
== wdesc
)
333 if ((f
->output_data
.x
->edit_widget
334 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
335 /* A tooltip frame? */
336 || (!f
->output_data
.x
->edit_widget
337 && FRAME_X_WINDOW (f
) == wdesc
)
338 || f
->output_data
.x
->icon_desc
== wdesc
)
340 #else /* not USE_X_TOOLKIT */
341 if (FRAME_X_WINDOW (f
) == wdesc
342 || f
->output_data
.x
->icon_desc
== wdesc
)
344 #endif /* not USE_X_TOOLKIT */
350 /* Like x_window_to_frame but also compares the window with the widget's
354 x_any_window_to_frame (dpyinfo
, wdesc
)
355 struct x_display_info
*dpyinfo
;
358 Lisp_Object tail
, frame
;
359 struct frame
*f
, *found
;
363 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
366 if (!GC_FRAMEP (frame
))
370 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
372 /* This frame matches if the window is any of its widgets. */
373 x
= f
->output_data
.x
;
374 if (x
->hourglass_window
== wdesc
)
378 if (wdesc
== XtWindow (x
->widget
)
379 || wdesc
== XtWindow (x
->column_widget
)
380 || wdesc
== XtWindow (x
->edit_widget
))
382 /* Match if the window is this frame's menubar. */
383 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
386 else if (FRAME_X_WINDOW (f
) == wdesc
)
387 /* A tooltip frame. */
395 /* Likewise, but exclude the menu bar widget. */
398 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
399 struct x_display_info
*dpyinfo
;
402 Lisp_Object tail
, frame
;
406 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
409 if (!GC_FRAMEP (frame
))
412 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
414 x
= f
->output_data
.x
;
415 /* This frame matches if the window is any of its widgets. */
416 if (x
->hourglass_window
== wdesc
)
420 if (wdesc
== XtWindow (x
->widget
)
421 || wdesc
== XtWindow (x
->column_widget
)
422 || wdesc
== XtWindow (x
->edit_widget
))
425 else if (FRAME_X_WINDOW (f
) == wdesc
)
426 /* A tooltip frame. */
432 /* Likewise, but consider only the menu bar widget. */
435 x_menubar_window_to_frame (dpyinfo
, wdesc
)
436 struct x_display_info
*dpyinfo
;
439 Lisp_Object tail
, frame
;
443 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
446 if (!GC_FRAMEP (frame
))
449 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
451 x
= f
->output_data
.x
;
452 /* Match if the window is this frame's menubar. */
453 if (x
->menubar_widget
454 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
460 /* Return the frame whose principal (outermost) window is WDESC.
461 If WDESC is some other (smaller) window, we return 0. */
464 x_top_window_to_frame (dpyinfo
, wdesc
)
465 struct x_display_info
*dpyinfo
;
468 Lisp_Object tail
, frame
;
472 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
475 if (!GC_FRAMEP (frame
))
478 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
480 x
= f
->output_data
.x
;
484 /* This frame matches if the window is its topmost widget. */
485 if (wdesc
== XtWindow (x
->widget
))
487 #if 0 /* I don't know why it did this,
488 but it seems logically wrong,
489 and it causes trouble for MapNotify events. */
490 /* Match if the window is this frame's menubar. */
491 if (x
->menubar_widget
492 && wdesc
== XtWindow (x
->menubar_widget
))
496 else if (FRAME_X_WINDOW (f
) == wdesc
)
502 #endif /* USE_X_TOOLKIT */
506 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
507 id, which is just an int that this section returns. Bitmaps are
508 reference counted so they can be shared among frames.
510 Bitmap indices are guaranteed to be > 0, so a negative number can
511 be used to indicate no bitmap.
513 If you use x_create_bitmap_from_data, then you must keep track of
514 the bitmaps yourself. That is, creating a bitmap from the same
515 data more than once will not be caught. */
518 /* Functions to access the contents of a bitmap, given an id. */
521 x_bitmap_height (f
, id
)
525 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
529 x_bitmap_width (f
, id
)
533 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
537 x_bitmap_pixmap (f
, id
)
541 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
545 /* Allocate a new bitmap record. Returns index of new record. */
548 x_allocate_bitmap_record (f
)
551 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
554 if (dpyinfo
->bitmaps
== NULL
)
556 dpyinfo
->bitmaps_size
= 10;
558 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
559 dpyinfo
->bitmaps_last
= 1;
563 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
564 return ++dpyinfo
->bitmaps_last
;
566 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
567 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
570 dpyinfo
->bitmaps_size
*= 2;
572 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
573 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
574 return ++dpyinfo
->bitmaps_last
;
577 /* Add one reference to the reference count of the bitmap with id ID. */
580 x_reference_bitmap (f
, id
)
584 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
587 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
590 x_create_bitmap_from_data (f
, bits
, width
, height
)
593 unsigned int width
, height
;
595 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
599 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
600 bits
, width
, height
);
605 id
= x_allocate_bitmap_record (f
);
606 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
607 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
608 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
609 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
610 dpyinfo
->bitmaps
[id
- 1].height
= height
;
611 dpyinfo
->bitmaps
[id
- 1].width
= width
;
616 /* Create bitmap from file FILE for frame F. */
619 x_create_bitmap_from_file (f
, file
)
623 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
624 unsigned int width
, height
;
626 int xhot
, yhot
, result
, id
;
631 /* Look for an existing bitmap with the same name. */
632 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
634 if (dpyinfo
->bitmaps
[id
].refcount
635 && dpyinfo
->bitmaps
[id
].file
636 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
638 ++dpyinfo
->bitmaps
[id
].refcount
;
643 /* Search bitmap-file-path for the file, if appropriate. */
644 fd
= openp (Vx_bitmap_file_path
, file
, Qnil
, &found
, 0);
649 filename
= (char *) XSTRING (found
)->data
;
651 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
652 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
653 if (result
!= BitmapSuccess
)
656 id
= x_allocate_bitmap_record (f
);
657 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
658 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
659 dpyinfo
->bitmaps
[id
- 1].file
660 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
661 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
662 dpyinfo
->bitmaps
[id
- 1].height
= height
;
663 dpyinfo
->bitmaps
[id
- 1].width
= width
;
664 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
669 /* Remove reference to bitmap with id number ID. */
672 x_destroy_bitmap (f
, id
)
676 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
680 --dpyinfo
->bitmaps
[id
- 1].refcount
;
681 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
684 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
685 if (dpyinfo
->bitmaps
[id
- 1].file
)
687 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
688 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
695 /* Free all the bitmaps for the display specified by DPYINFO. */
698 x_destroy_all_bitmaps (dpyinfo
)
699 struct x_display_info
*dpyinfo
;
702 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
703 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
705 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
706 if (dpyinfo
->bitmaps
[i
].file
)
707 xfree (dpyinfo
->bitmaps
[i
].file
);
709 dpyinfo
->bitmaps_last
= 0;
712 /* Connect the frame-parameter names for X frames
713 to the ways of passing the parameter values to the window system.
715 The name of a parameter, as a Lisp symbol,
716 has an `x-frame-parameter' property which is an integer in Lisp
717 that is an index in this table. */
719 struct x_frame_parm_table
722 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
725 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
726 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
727 static void x_change_window_heights
P_ ((Lisp_Object
, int));
728 static void x_disable_image
P_ ((struct frame
*, struct image
*));
729 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
730 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
731 static void x_set_wait_for_wm
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
732 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
733 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
734 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
735 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
736 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
737 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
738 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
739 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
740 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
741 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
743 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
744 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
745 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
746 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
748 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
750 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
756 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
758 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
763 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
764 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
766 static void init_color_table
P_ ((void));
767 static void free_color_table
P_ ((void));
768 static unsigned long *colors_in_color_table
P_ ((int *n
));
769 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
770 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
774 static struct x_frame_parm_table x_frame_parms
[] =
776 "auto-raise", x_set_autoraise
,
777 "auto-lower", x_set_autolower
,
778 "background-color", x_set_background_color
,
779 "border-color", x_set_border_color
,
780 "border-width", x_set_border_width
,
781 "cursor-color", x_set_cursor_color
,
782 "cursor-type", x_set_cursor_type
,
784 "foreground-color", x_set_foreground_color
,
785 "icon-name", x_set_icon_name
,
786 "icon-type", x_set_icon_type
,
787 "internal-border-width", x_set_internal_border_width
,
788 "menu-bar-lines", x_set_menu_bar_lines
,
789 "mouse-color", x_set_mouse_color
,
790 "name", x_explicitly_set_name
,
791 "scroll-bar-width", x_set_scroll_bar_width
,
792 "title", x_set_title
,
793 "unsplittable", x_set_unsplittable
,
794 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
795 "visibility", x_set_visibility
,
796 "tool-bar-lines", x_set_tool_bar_lines
,
797 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
798 "scroll-bar-background", x_set_scroll_bar_background
,
799 "screen-gamma", x_set_screen_gamma
,
800 "line-spacing", x_set_line_spacing
,
801 "wait-for-wm", x_set_wait_for_wm
804 /* Attach the `x-frame-parameter' properties to
805 the Lisp symbol names of parameters relevant to X. */
808 init_x_parm_symbols ()
812 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
813 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
817 /* Change the parameters of frame F as specified by ALIST.
818 If a parameter is not specially recognized, do nothing special;
819 otherwise call the `x_set_...' function for that parameter.
820 Except for certain geometry properties, always call store_frame_param
821 to store the new value in the parameter alist. */
824 x_set_frame_parameters (f
, alist
)
830 /* If both of these parameters are present, it's more efficient to
831 set them both at once. So we wait until we've looked at the
832 entire list before we set them. */
836 Lisp_Object left
, top
;
838 /* Same with these. */
839 Lisp_Object icon_left
, icon_top
;
841 /* Record in these vectors all the parms specified. */
845 int left_no_change
= 0, top_no_change
= 0;
846 int icon_left_no_change
= 0, icon_top_no_change
= 0;
848 struct gcpro gcpro1
, gcpro2
;
851 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
854 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
855 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
857 /* Extract parm names and values into those vectors. */
860 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
865 parms
[i
] = Fcar (elt
);
866 values
[i
] = Fcdr (elt
);
869 /* TAIL and ALIST are not used again below here. */
872 GCPRO2 (*parms
, *values
);
876 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
877 because their values appear in VALUES and strings are not valid. */
878 top
= left
= Qunbound
;
879 icon_left
= icon_top
= Qunbound
;
881 /* Provide default values for HEIGHT and WIDTH. */
882 if (FRAME_NEW_WIDTH (f
))
883 width
= FRAME_NEW_WIDTH (f
);
885 width
= FRAME_WIDTH (f
);
887 if (FRAME_NEW_HEIGHT (f
))
888 height
= FRAME_NEW_HEIGHT (f
);
890 height
= FRAME_HEIGHT (f
);
892 /* Process foreground_color and background_color before anything else.
893 They are independent of other properties, but other properties (e.g.,
894 cursor_color) are dependent upon them. */
895 for (p
= 0; p
< i
; p
++)
897 Lisp_Object prop
, val
;
901 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
903 register Lisp_Object param_index
, old_value
;
905 param_index
= Fget (prop
, Qx_frame_parameter
);
906 old_value
= get_frame_param (f
, prop
);
907 store_frame_param (f
, prop
, val
);
908 if (NATNUMP (param_index
)
909 && (XFASTINT (param_index
)
910 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
911 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
915 /* Now process them in reverse of specified order. */
916 for (i
--; i
>= 0; i
--)
918 Lisp_Object prop
, val
;
923 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
924 width
= XFASTINT (val
);
925 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
926 height
= XFASTINT (val
);
927 else if (EQ (prop
, Qtop
))
929 else if (EQ (prop
, Qleft
))
931 else if (EQ (prop
, Qicon_top
))
933 else if (EQ (prop
, Qicon_left
))
935 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
936 /* Processed above. */
940 register Lisp_Object param_index
, old_value
;
942 param_index
= Fget (prop
, Qx_frame_parameter
);
943 old_value
= get_frame_param (f
, prop
);
944 store_frame_param (f
, prop
, val
);
945 if (NATNUMP (param_index
)
946 && (XFASTINT (param_index
)
947 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
948 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
952 /* Don't die if just one of these was set. */
953 if (EQ (left
, Qunbound
))
956 if (f
->output_data
.x
->left_pos
< 0)
957 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
959 XSETINT (left
, f
->output_data
.x
->left_pos
);
961 if (EQ (top
, Qunbound
))
964 if (f
->output_data
.x
->top_pos
< 0)
965 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
967 XSETINT (top
, f
->output_data
.x
->top_pos
);
970 /* If one of the icon positions was not set, preserve or default it. */
971 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
973 icon_left_no_change
= 1;
974 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
975 if (NILP (icon_left
))
976 XSETINT (icon_left
, 0);
978 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
980 icon_top_no_change
= 1;
981 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
983 XSETINT (icon_top
, 0);
986 /* Don't set these parameters unless they've been explicitly
987 specified. The window might be mapped or resized while we're in
988 this function, and we don't want to override that unless the lisp
989 code has asked for it.
991 Don't set these parameters unless they actually differ from the
992 window's current parameters; the window may not actually exist
997 check_frame_size (f
, &height
, &width
);
999 XSETFRAME (frame
, f
);
1001 if (width
!= FRAME_WIDTH (f
)
1002 || height
!= FRAME_HEIGHT (f
)
1003 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1004 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1006 if ((!NILP (left
) || !NILP (top
))
1007 && ! (left_no_change
&& top_no_change
)
1008 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1009 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1014 /* Record the signs. */
1015 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1016 if (EQ (left
, Qminus
))
1017 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1018 else if (INTEGERP (left
))
1020 leftpos
= XINT (left
);
1022 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1024 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1025 && CONSP (XCDR (left
))
1026 && INTEGERP (XCAR (XCDR (left
))))
1028 leftpos
= - XINT (XCAR (XCDR (left
)));
1029 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1031 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1032 && CONSP (XCDR (left
))
1033 && INTEGERP (XCAR (XCDR (left
))))
1035 leftpos
= XINT (XCAR (XCDR (left
)));
1038 if (EQ (top
, Qminus
))
1039 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1040 else if (INTEGERP (top
))
1042 toppos
= XINT (top
);
1044 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1046 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1047 && CONSP (XCDR (top
))
1048 && INTEGERP (XCAR (XCDR (top
))))
1050 toppos
= - XINT (XCAR (XCDR (top
)));
1051 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1053 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1054 && CONSP (XCDR (top
))
1055 && INTEGERP (XCAR (XCDR (top
))))
1057 toppos
= XINT (XCAR (XCDR (top
)));
1061 /* Store the numeric value of the position. */
1062 f
->output_data
.x
->top_pos
= toppos
;
1063 f
->output_data
.x
->left_pos
= leftpos
;
1065 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1067 /* Actually set that position, and convert to absolute. */
1068 x_set_offset (f
, leftpos
, toppos
, -1);
1071 if ((!NILP (icon_left
) || !NILP (icon_top
))
1072 && ! (icon_left_no_change
&& icon_top_no_change
))
1073 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1079 /* Store the screen positions of frame F into XPTR and YPTR.
1080 These are the positions of the containing window manager window,
1081 not Emacs's own window. */
1084 x_real_positions (f
, xptr
, yptr
)
1091 /* This is pretty gross, but seems to be the easiest way out of
1092 the problem that arises when restarting window-managers. */
1094 #ifdef USE_X_TOOLKIT
1095 Window outer
= (f
->output_data
.x
->widget
1096 ? XtWindow (f
->output_data
.x
->widget
)
1097 : FRAME_X_WINDOW (f
));
1099 Window outer
= f
->output_data
.x
->window_desc
;
1101 Window tmp_root_window
;
1102 Window
*tmp_children
;
1103 unsigned int tmp_nchildren
;
1107 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1108 Window outer_window
;
1110 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1111 &f
->output_data
.x
->parent_desc
,
1112 &tmp_children
, &tmp_nchildren
);
1113 XFree ((char *) tmp_children
);
1117 /* Find the position of the outside upper-left corner of
1118 the inner window, with respect to the outer window. */
1119 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1120 outer_window
= f
->output_data
.x
->parent_desc
;
1122 outer_window
= outer
;
1124 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1126 /* From-window, to-window. */
1128 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1130 /* From-position, to-position. */
1131 0, 0, &win_x
, &win_y
,
1136 /* It is possible for the window returned by the XQueryNotify
1137 to become invalid by the time we call XTranslateCoordinates.
1138 That can happen when you restart some window managers.
1139 If so, we get an error in XTranslateCoordinates.
1140 Detect that and try the whole thing over. */
1141 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1143 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1147 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1154 /* Insert a description of internally-recorded parameters of frame X
1155 into the parameter alist *ALISTPTR that is to be given to the user.
1156 Only parameters that are specific to the X window system
1157 and whose values are not correctly recorded in the frame's
1158 param_alist need to be considered here. */
1161 x_report_frame_params (f
, alistptr
)
1163 Lisp_Object
*alistptr
;
1168 /* Represent negative positions (off the top or left screen edge)
1169 in a way that Fmodify_frame_parameters will understand correctly. */
1170 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1171 if (f
->output_data
.x
->left_pos
>= 0)
1172 store_in_alist (alistptr
, Qleft
, tem
);
1174 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1176 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1177 if (f
->output_data
.x
->top_pos
>= 0)
1178 store_in_alist (alistptr
, Qtop
, tem
);
1180 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1182 store_in_alist (alistptr
, Qborder_width
,
1183 make_number (f
->output_data
.x
->border_width
));
1184 store_in_alist (alistptr
, Qinternal_border_width
,
1185 make_number (f
->output_data
.x
->internal_border_width
));
1186 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1187 store_in_alist (alistptr
, Qwindow_id
,
1188 build_string (buf
));
1189 #ifdef USE_X_TOOLKIT
1190 /* Tooltip frame may not have this widget. */
1191 if (f
->output_data
.x
->widget
)
1193 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1194 store_in_alist (alistptr
, Qouter_window_id
,
1195 build_string (buf
));
1196 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1197 FRAME_SAMPLE_VISIBILITY (f
);
1198 store_in_alist (alistptr
, Qvisibility
,
1199 (FRAME_VISIBLE_P (f
) ? Qt
1200 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1201 store_in_alist (alistptr
, Qdisplay
,
1202 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1204 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1207 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1208 store_in_alist (alistptr
, Qparent_id
, tem
);
1213 /* Gamma-correct COLOR on frame F. */
1216 gamma_correct (f
, color
)
1222 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1223 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1224 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1229 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1230 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1231 allocate the color. Value is zero if COLOR_NAME is invalid, or
1232 no color could be allocated. */
1235 x_defined_color (f
, color_name
, color
, alloc_p
)
1242 Display
*dpy
= FRAME_X_DISPLAY (f
);
1243 Colormap cmap
= FRAME_X_COLORMAP (f
);
1246 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1247 if (success_p
&& alloc_p
)
1248 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1255 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1256 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1257 Signal an error if color can't be allocated. */
1260 x_decode_color (f
, color_name
, mono_color
)
1262 Lisp_Object color_name
;
1267 CHECK_STRING (color_name
, 0);
1269 #if 0 /* Don't do this. It's wrong when we're not using the default
1270 colormap, it makes freeing difficult, and it's probably not
1271 an important optimization. */
1272 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1273 return BLACK_PIX_DEFAULT (f
);
1274 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1275 return WHITE_PIX_DEFAULT (f
);
1278 /* Return MONO_COLOR for monochrome frames. */
1279 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1282 /* x_defined_color is responsible for coping with failures
1283 by looking for a near-miss. */
1284 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1287 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1288 Fcons (color_name
, Qnil
)));
1294 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1295 the previous value of that parameter, NEW_VALUE is the new value. */
1298 x_set_line_spacing (f
, new_value
, old_value
)
1300 Lisp_Object new_value
, old_value
;
1302 if (NILP (new_value
))
1303 f
->extra_line_spacing
= 0;
1304 else if (NATNUMP (new_value
))
1305 f
->extra_line_spacing
= XFASTINT (new_value
);
1307 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1308 Fcons (new_value
, Qnil
)));
1309 if (FRAME_VISIBLE_P (f
))
1314 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1315 the previous value of that parameter, NEW_VALUE is the new value.
1316 See also the comment of wait_for_wm in struct x_output. */
1319 x_set_wait_for_wm (f
, new_value
, old_value
)
1321 Lisp_Object new_value
, old_value
;
1323 f
->output_data
.x
->wait_for_wm
= !NILP (new_value
);
1327 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1328 the previous value of that parameter, NEW_VALUE is the new
1332 x_set_screen_gamma (f
, new_value
, old_value
)
1334 Lisp_Object new_value
, old_value
;
1336 if (NILP (new_value
))
1338 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1339 /* The value 0.4545 is the normal viewing gamma. */
1340 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1342 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1343 Fcons (new_value
, Qnil
)));
1345 clear_face_cache (0);
1349 /* Functions called only from `x_set_frame_param'
1350 to set individual parameters.
1352 If FRAME_X_WINDOW (f) is 0,
1353 the frame is being created and its X-window does not exist yet.
1354 In that case, just record the parameter's new value
1355 in the standard place; do not attempt to change the window. */
1358 x_set_foreground_color (f
, arg
, oldval
)
1360 Lisp_Object arg
, oldval
;
1362 struct x_output
*x
= f
->output_data
.x
;
1363 unsigned long fg
, old_fg
;
1365 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1366 old_fg
= x
->foreground_pixel
;
1367 x
->foreground_pixel
= fg
;
1369 if (FRAME_X_WINDOW (f
) != 0)
1371 Display
*dpy
= FRAME_X_DISPLAY (f
);
1374 XSetForeground (dpy
, x
->normal_gc
, fg
);
1375 XSetBackground (dpy
, x
->reverse_gc
, fg
);
1377 if (x
->cursor_pixel
== old_fg
)
1379 unload_color (f
, x
->cursor_pixel
);
1380 x
->cursor_pixel
= x_copy_color (f
, fg
);
1381 XSetBackground (dpy
, x
->cursor_gc
, x
->cursor_pixel
);
1386 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1388 if (FRAME_VISIBLE_P (f
))
1392 unload_color (f
, old_fg
);
1396 x_set_background_color (f
, arg
, oldval
)
1398 Lisp_Object arg
, oldval
;
1400 struct x_output
*x
= f
->output_data
.x
;
1403 bg
= x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1404 unload_color (f
, x
->background_pixel
);
1405 x
->background_pixel
= bg
;
1407 if (FRAME_X_WINDOW (f
) != 0)
1409 Display
*dpy
= FRAME_X_DISPLAY (f
);
1412 XSetBackground (dpy
, x
->normal_gc
, bg
);
1413 XSetForeground (dpy
, x
->reverse_gc
, bg
);
1414 XSetWindowBackground (dpy
, FRAME_X_WINDOW (f
), bg
);
1415 XSetForeground (dpy
, x
->cursor_gc
, bg
);
1417 #ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1418 toolkit scroll bars. */
1421 for (bar
= FRAME_SCROLL_BARS (f
);
1423 bar
= XSCROLL_BAR (bar
)->next
)
1425 Window window
= SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
));
1426 XSetWindowBackground (dpy
, window
, bg
);
1429 #endif /* USE_TOOLKIT_SCROLL_BARS */
1432 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1434 if (FRAME_VISIBLE_P (f
))
1440 x_set_mouse_color (f
, arg
, oldval
)
1442 Lisp_Object arg
, oldval
;
1444 struct x_output
*x
= f
->output_data
.x
;
1445 Display
*dpy
= FRAME_X_DISPLAY (f
);
1446 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1447 Cursor hourglass_cursor
, horizontal_drag_cursor
;
1449 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1450 unsigned long mask_color
= x
->background_pixel
;
1452 /* Don't let pointers be invisible. */
1453 if (mask_color
== pixel
)
1455 x_free_colors (f
, &pixel
, 1);
1456 pixel
= x_copy_color (f
, x
->foreground_pixel
);
1459 unload_color (f
, x
->mouse_pixel
);
1460 x
->mouse_pixel
= pixel
;
1464 /* It's not okay to crash if the user selects a screwy cursor. */
1465 count
= x_catch_errors (dpy
);
1467 if (!NILP (Vx_pointer_shape
))
1469 CHECK_NUMBER (Vx_pointer_shape
, 0);
1470 cursor
= XCreateFontCursor (dpy
, XINT (Vx_pointer_shape
));
1473 cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1474 x_check_errors (dpy
, "bad text pointer cursor: %s");
1476 if (!NILP (Vx_nontext_pointer_shape
))
1478 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1480 = XCreateFontCursor (dpy
, XINT (Vx_nontext_pointer_shape
));
1483 nontext_cursor
= XCreateFontCursor (dpy
, XC_left_ptr
);
1484 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1486 if (!NILP (Vx_hourglass_pointer_shape
))
1488 CHECK_NUMBER (Vx_hourglass_pointer_shape
, 0);
1490 = XCreateFontCursor (dpy
, XINT (Vx_hourglass_pointer_shape
));
1493 hourglass_cursor
= XCreateFontCursor (dpy
, XC_watch
);
1494 x_check_errors (dpy
, "bad hourglass pointer cursor: %s");
1496 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1497 if (!NILP (Vx_mode_pointer_shape
))
1499 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1500 mode_cursor
= XCreateFontCursor (dpy
, XINT (Vx_mode_pointer_shape
));
1503 mode_cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1504 x_check_errors (dpy
, "bad modeline pointer cursor: %s");
1506 if (!NILP (Vx_sensitive_text_pointer_shape
))
1508 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1510 = XCreateFontCursor (dpy
, XINT (Vx_sensitive_text_pointer_shape
));
1513 cross_cursor
= XCreateFontCursor (dpy
, XC_crosshair
);
1515 if (!NILP (Vx_window_horizontal_drag_shape
))
1517 CHECK_NUMBER (Vx_window_horizontal_drag_shape
, 0);
1518 horizontal_drag_cursor
1519 = XCreateFontCursor (dpy
, XINT (Vx_window_horizontal_drag_shape
));
1522 horizontal_drag_cursor
1523 = XCreateFontCursor (dpy
, XC_sb_h_double_arrow
);
1525 /* Check and report errors with the above calls. */
1526 x_check_errors (dpy
, "can't set cursor shape: %s");
1527 x_uncatch_errors (dpy
, count
);
1530 XColor fore_color
, back_color
;
1532 fore_color
.pixel
= x
->mouse_pixel
;
1533 x_query_color (f
, &fore_color
);
1534 back_color
.pixel
= mask_color
;
1535 x_query_color (f
, &back_color
);
1537 XRecolorCursor (dpy
, cursor
, &fore_color
, &back_color
);
1538 XRecolorCursor (dpy
, nontext_cursor
, &fore_color
, &back_color
);
1539 XRecolorCursor (dpy
, mode_cursor
, &fore_color
, &back_color
);
1540 XRecolorCursor (dpy
, cross_cursor
, &fore_color
, &back_color
);
1541 XRecolorCursor (dpy
, hourglass_cursor
, &fore_color
, &back_color
);
1542 XRecolorCursor (dpy
, horizontal_drag_cursor
, &fore_color
, &back_color
);
1545 if (FRAME_X_WINDOW (f
) != 0)
1546 XDefineCursor (dpy
, FRAME_X_WINDOW (f
), cursor
);
1548 if (cursor
!= x
->text_cursor
1549 && x
->text_cursor
!= 0)
1550 XFreeCursor (dpy
, x
->text_cursor
);
1551 x
->text_cursor
= cursor
;
1553 if (nontext_cursor
!= x
->nontext_cursor
1554 && x
->nontext_cursor
!= 0)
1555 XFreeCursor (dpy
, x
->nontext_cursor
);
1556 x
->nontext_cursor
= nontext_cursor
;
1558 if (hourglass_cursor
!= x
->hourglass_cursor
1559 && x
->hourglass_cursor
!= 0)
1560 XFreeCursor (dpy
, x
->hourglass_cursor
);
1561 x
->hourglass_cursor
= hourglass_cursor
;
1563 if (mode_cursor
!= x
->modeline_cursor
1564 && x
->modeline_cursor
!= 0)
1565 XFreeCursor (dpy
, f
->output_data
.x
->modeline_cursor
);
1566 x
->modeline_cursor
= mode_cursor
;
1568 if (cross_cursor
!= x
->cross_cursor
1569 && x
->cross_cursor
!= 0)
1570 XFreeCursor (dpy
, x
->cross_cursor
);
1571 x
->cross_cursor
= cross_cursor
;
1573 if (horizontal_drag_cursor
!= x
->horizontal_drag_cursor
1574 && x
->horizontal_drag_cursor
!= 0)
1575 XFreeCursor (dpy
, x
->horizontal_drag_cursor
);
1576 x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1581 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1585 x_set_cursor_color (f
, arg
, oldval
)
1587 Lisp_Object arg
, oldval
;
1589 unsigned long fore_pixel
, pixel
;
1590 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1591 struct x_output
*x
= f
->output_data
.x
;
1593 if (!NILP (Vx_cursor_fore_pixel
))
1595 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1596 WHITE_PIX_DEFAULT (f
));
1597 fore_pixel_allocated_p
= 1;
1600 fore_pixel
= x
->background_pixel
;
1602 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1603 pixel_allocated_p
= 1;
1605 /* Make sure that the cursor color differs from the background color. */
1606 if (pixel
== x
->background_pixel
)
1608 if (pixel_allocated_p
)
1610 x_free_colors (f
, &pixel
, 1);
1611 pixel_allocated_p
= 0;
1614 pixel
= x
->mouse_pixel
;
1615 if (pixel
== fore_pixel
)
1617 if (fore_pixel_allocated_p
)
1619 x_free_colors (f
, &fore_pixel
, 1);
1620 fore_pixel_allocated_p
= 0;
1622 fore_pixel
= x
->background_pixel
;
1626 unload_color (f
, x
->cursor_foreground_pixel
);
1627 if (!fore_pixel_allocated_p
)
1628 fore_pixel
= x_copy_color (f
, fore_pixel
);
1629 x
->cursor_foreground_pixel
= fore_pixel
;
1631 unload_color (f
, x
->cursor_pixel
);
1632 if (!pixel_allocated_p
)
1633 pixel
= x_copy_color (f
, pixel
);
1634 x
->cursor_pixel
= pixel
;
1636 if (FRAME_X_WINDOW (f
) != 0)
1639 XSetBackground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, x
->cursor_pixel
);
1640 XSetForeground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, fore_pixel
);
1643 if (FRAME_VISIBLE_P (f
))
1645 x_update_cursor (f
, 0);
1646 x_update_cursor (f
, 1);
1650 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1653 /* Set the border-color of frame F to value described by ARG.
1654 ARG can be a string naming a color.
1655 The border-color is used for the border that is drawn by the X server.
1656 Note that this does not fully take effect if done before
1657 F has an x-window; it must be redone when the window is created.
1659 Note: this is done in two routines because of the way X10 works.
1661 Note: under X11, this is normally the province of the window manager,
1662 and so emacs' border colors may be overridden. */
1665 x_set_border_color (f
, arg
, oldval
)
1667 Lisp_Object arg
, oldval
;
1671 CHECK_STRING (arg
, 0);
1672 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1673 x_set_border_pixel (f
, pix
);
1674 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1677 /* Set the border-color of frame F to pixel value PIX.
1678 Note that this does not fully take effect if done before
1679 F has an x-window. */
1682 x_set_border_pixel (f
, pix
)
1686 unload_color (f
, f
->output_data
.x
->border_pixel
);
1687 f
->output_data
.x
->border_pixel
= pix
;
1689 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1692 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1693 (unsigned long)pix
);
1696 if (FRAME_VISIBLE_P (f
))
1702 /* Value is the internal representation of the specified cursor type
1703 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1704 of the bar cursor. */
1706 enum text_cursor_kinds
1707 x_specified_cursor_type (arg
, width
)
1711 enum text_cursor_kinds type
;
1718 else if (CONSP (arg
)
1719 && EQ (XCAR (arg
), Qbar
)
1720 && INTEGERP (XCDR (arg
))
1721 && XINT (XCDR (arg
)) >= 0)
1724 *width
= XINT (XCDR (arg
));
1726 else if (NILP (arg
))
1729 /* Treat anything unknown as "box cursor".
1730 It was bad to signal an error; people have trouble fixing
1731 .Xdefaults with Emacs, when it has something bad in it. */
1732 type
= FILLED_BOX_CURSOR
;
1738 x_set_cursor_type (f
, arg
, oldval
)
1740 Lisp_Object arg
, oldval
;
1744 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1745 f
->output_data
.x
->cursor_width
= width
;
1747 /* Make sure the cursor gets redrawn. This is overkill, but how
1748 often do people change cursor types? */
1749 update_mode_lines
++;
1753 x_set_icon_type (f
, arg
, oldval
)
1755 Lisp_Object arg
, oldval
;
1761 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1764 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1769 result
= x_text_icon (f
,
1770 (char *) XSTRING ((!NILP (f
->icon_name
)
1774 result
= x_bitmap_icon (f
, arg
);
1779 error ("No icon window available");
1782 XFlush (FRAME_X_DISPLAY (f
));
1786 /* Return non-nil if frame F wants a bitmap icon. */
1794 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1802 x_set_icon_name (f
, arg
, oldval
)
1804 Lisp_Object arg
, oldval
;
1810 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1813 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1818 if (f
->output_data
.x
->icon_bitmap
!= 0)
1823 result
= x_text_icon (f
,
1824 (char *) XSTRING ((!NILP (f
->icon_name
)
1833 error ("No icon window available");
1836 XFlush (FRAME_X_DISPLAY (f
));
1841 x_set_font (f
, arg
, oldval
)
1843 Lisp_Object arg
, oldval
;
1846 Lisp_Object fontset_name
;
1848 int old_fontset
= f
->output_data
.x
->fontset
;
1850 CHECK_STRING (arg
, 1);
1852 fontset_name
= Fquery_fontset (arg
, Qnil
);
1855 result
= (STRINGP (fontset_name
)
1856 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1857 : x_new_font (f
, XSTRING (arg
)->data
));
1860 if (EQ (result
, Qnil
))
1861 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1862 else if (EQ (result
, Qt
))
1863 error ("The characters of the given font have varying widths");
1864 else if (STRINGP (result
))
1866 if (STRINGP (fontset_name
))
1868 /* Fontset names are built from ASCII font names, so the
1869 names may be equal despite there was a change. */
1870 if (old_fontset
== f
->output_data
.x
->fontset
)
1873 else if (!NILP (Fequal (result
, oldval
)))
1876 store_frame_param (f
, Qfont
, result
);
1877 recompute_basic_faces (f
);
1882 do_pending_window_change (0);
1884 /* Don't call `face-set-after-frame-default' when faces haven't been
1885 initialized yet. This is the case when called from
1886 Fx_create_frame. In that case, the X widget or window doesn't
1887 exist either, and we can end up in x_report_frame_params with a
1888 null widget which gives a segfault. */
1889 if (FRAME_FACE_CACHE (f
))
1891 XSETFRAME (frame
, f
);
1892 call1 (Qface_set_after_frame_default
, frame
);
1897 x_set_border_width (f
, arg
, oldval
)
1899 Lisp_Object arg
, oldval
;
1901 CHECK_NUMBER (arg
, 0);
1903 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1906 if (FRAME_X_WINDOW (f
) != 0)
1907 error ("Cannot change the border width of a window");
1909 f
->output_data
.x
->border_width
= XINT (arg
);
1913 x_set_internal_border_width (f
, arg
, oldval
)
1915 Lisp_Object arg
, oldval
;
1917 int old
= f
->output_data
.x
->internal_border_width
;
1919 CHECK_NUMBER (arg
, 0);
1920 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1921 if (f
->output_data
.x
->internal_border_width
< 0)
1922 f
->output_data
.x
->internal_border_width
= 0;
1924 #ifdef USE_X_TOOLKIT
1925 if (f
->output_data
.x
->edit_widget
)
1926 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1929 if (f
->output_data
.x
->internal_border_width
== old
)
1932 if (FRAME_X_WINDOW (f
) != 0)
1934 x_set_window_size (f
, 0, f
->width
, f
->height
);
1935 SET_FRAME_GARBAGED (f
);
1936 do_pending_window_change (0);
1941 x_set_visibility (f
, value
, oldval
)
1943 Lisp_Object value
, oldval
;
1946 XSETFRAME (frame
, f
);
1949 Fmake_frame_invisible (frame
, Qt
);
1950 else if (EQ (value
, Qicon
))
1951 Ficonify_frame (frame
);
1953 Fmake_frame_visible (frame
);
1957 /* Change window heights in windows rooted in WINDOW by N lines. */
1960 x_change_window_heights (window
, n
)
1964 struct window
*w
= XWINDOW (window
);
1966 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1967 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1969 if (INTEGERP (w
->orig_top
))
1970 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1971 if (INTEGERP (w
->orig_height
))
1972 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1974 /* Handle just the top child in a vertical split. */
1975 if (!NILP (w
->vchild
))
1976 x_change_window_heights (w
->vchild
, n
);
1978 /* Adjust all children in a horizontal split. */
1979 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1981 w
= XWINDOW (window
);
1982 x_change_window_heights (window
, n
);
1987 x_set_menu_bar_lines (f
, value
, oldval
)
1989 Lisp_Object value
, oldval
;
1992 #ifndef USE_X_TOOLKIT
1993 int olines
= FRAME_MENU_BAR_LINES (f
);
1996 /* Right now, menu bars don't work properly in minibuf-only frames;
1997 most of the commands try to apply themselves to the minibuffer
1998 frame itself, and get an error because you can't switch buffers
1999 in or split the minibuffer window. */
2000 if (FRAME_MINIBUF_ONLY_P (f
))
2003 if (INTEGERP (value
))
2004 nlines
= XINT (value
);
2008 /* Make sure we redisplay all windows in this frame. */
2009 windows_or_buffers_changed
++;
2011 #ifdef USE_X_TOOLKIT
2012 FRAME_MENU_BAR_LINES (f
) = 0;
2015 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2016 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
2017 /* Make sure next redisplay shows the menu bar. */
2018 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2022 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2023 free_frame_menubar (f
);
2024 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2026 f
->output_data
.x
->menubar_widget
= 0;
2028 #else /* not USE_X_TOOLKIT */
2029 FRAME_MENU_BAR_LINES (f
) = nlines
;
2030 x_change_window_heights (f
->root_window
, nlines
- olines
);
2031 #endif /* not USE_X_TOOLKIT */
2036 /* Set the number of lines used for the tool bar of frame F to VALUE.
2037 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2038 is the old number of tool bar lines. This function changes the
2039 height of all windows on frame F to match the new tool bar height.
2040 The frame's height doesn't change. */
2043 x_set_tool_bar_lines (f
, value
, oldval
)
2045 Lisp_Object value
, oldval
;
2047 int delta
, nlines
, root_height
;
2048 Lisp_Object root_window
;
2050 /* Treat tool bars like menu bars. */
2051 if (FRAME_MINIBUF_ONLY_P (f
))
2054 /* Use VALUE only if an integer >= 0. */
2055 if (INTEGERP (value
) && XINT (value
) >= 0)
2056 nlines
= XFASTINT (value
);
2060 /* Make sure we redisplay all windows in this frame. */
2061 ++windows_or_buffers_changed
;
2063 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2065 /* Don't resize the tool-bar to more than we have room for. */
2066 root_window
= FRAME_ROOT_WINDOW (f
);
2067 root_height
= XINT (XWINDOW (root_window
)->height
);
2068 if (root_height
- delta
< 1)
2070 delta
= root_height
- 1;
2071 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2074 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2075 x_change_window_heights (root_window
, delta
);
2078 /* We also have to make sure that the internal border at the top of
2079 the frame, below the menu bar or tool bar, is redrawn when the
2080 tool bar disappears. This is so because the internal border is
2081 below the tool bar if one is displayed, but is below the menu bar
2082 if there isn't a tool bar. The tool bar draws into the area
2083 below the menu bar. */
2084 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2088 clear_current_matrices (f
);
2089 updating_frame
= NULL
;
2092 /* If the tool bar gets smaller, the internal border below it
2093 has to be cleared. It was formerly part of the display
2094 of the larger tool bar, and updating windows won't clear it. */
2097 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2098 int width
= PIXEL_WIDTH (f
);
2099 int y
= nlines
* CANON_Y_UNIT (f
);
2102 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2103 0, y
, width
, height
, False
);
2106 if (WINDOWP (f
->tool_bar_window
))
2107 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2112 /* Set the foreground color for scroll bars on frame F to VALUE.
2113 VALUE should be a string, a color name. If it isn't a string or
2114 isn't a valid color name, do nothing. OLDVAL is the old value of
2115 the frame parameter. */
2118 x_set_scroll_bar_foreground (f
, value
, oldval
)
2120 Lisp_Object value
, oldval
;
2122 unsigned long pixel
;
2124 if (STRINGP (value
))
2125 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2129 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2130 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2132 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2133 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2135 /* Remove all scroll bars because they have wrong colors. */
2136 if (condemn_scroll_bars_hook
)
2137 (*condemn_scroll_bars_hook
) (f
);
2138 if (judge_scroll_bars_hook
)
2139 (*judge_scroll_bars_hook
) (f
);
2141 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2147 /* Set the background color for scroll bars on frame F to VALUE VALUE
2148 should be a string, a color name. If it isn't a string or isn't a
2149 valid color name, do nothing. OLDVAL is the old value of the frame
2153 x_set_scroll_bar_background (f
, value
, oldval
)
2155 Lisp_Object value
, oldval
;
2157 unsigned long pixel
;
2159 if (STRINGP (value
))
2160 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2164 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2165 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2167 #ifdef USE_TOOLKIT_SCROLL_BARS
2168 /* Scrollbar shadow colors. */
2169 if (f
->output_data
.x
->scroll_bar_top_shadow_pixel
!= -1)
2171 unload_color (f
, f
->output_data
.x
->scroll_bar_top_shadow_pixel
);
2172 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
2174 if (f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
!= -1)
2176 unload_color (f
, f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
);
2177 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
2179 #endif /* USE_TOOLKIT_SCROLL_BARS */
2181 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2182 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2184 /* Remove all scroll bars because they have wrong colors. */
2185 if (condemn_scroll_bars_hook
)
2186 (*condemn_scroll_bars_hook
) (f
);
2187 if (judge_scroll_bars_hook
)
2188 (*judge_scroll_bars_hook
) (f
);
2190 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2196 /* Encode Lisp string STRING as a text in a format appropriate for
2197 XICCC (X Inter Client Communication Conventions).
2199 If STRING contains only ASCII characters, do no conversion and
2200 return the string data of STRING. Otherwise, encode the text by
2201 CODING_SYSTEM, and return a newly allocated memory area which
2202 should be freed by `xfree' by a caller.
2204 Store the byte length of resulting text in *TEXT_BYTES.
2206 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2207 which means that the `encoding' of the result can be `STRING'.
2208 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2209 the result should be `COMPOUND_TEXT'. */
2212 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2213 Lisp_Object string
, coding_system
;
2214 int *text_bytes
, *stringp
;
2216 unsigned char *str
= XSTRING (string
)->data
;
2217 int chars
= XSTRING (string
)->size
;
2218 int bytes
= STRING_BYTES (XSTRING (string
));
2222 struct coding_system coding
;
2224 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2225 if (charset_info
== 0)
2227 /* No multibyte character in OBJ. We need not encode it. */
2228 *text_bytes
= bytes
;
2233 setup_coding_system (coding_system
, &coding
);
2234 coding
.src_multibyte
= 1;
2235 coding
.dst_multibyte
= 0;
2236 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2237 if (coding
.type
== coding_type_iso2022
)
2238 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2239 /* We suppress producing escape sequences for composition. */
2240 coding
.composing
= COMPOSITION_DISABLED
;
2241 bufsize
= encoding_buffer_size (&coding
, bytes
);
2242 buf
= (unsigned char *) xmalloc (bufsize
);
2243 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2244 *text_bytes
= coding
.produced
;
2245 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2250 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2253 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2254 name; if NAME is a string, set F's name to NAME and set
2255 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2257 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2258 suggesting a new name, which lisp code should override; if
2259 F->explicit_name is set, ignore the new name; otherwise, set it. */
2262 x_set_name (f
, name
, explicit)
2267 /* Make sure that requests from lisp code override requests from
2268 Emacs redisplay code. */
2271 /* If we're switching from explicit to implicit, we had better
2272 update the mode lines and thereby update the title. */
2273 if (f
->explicit_name
&& NILP (name
))
2274 update_mode_lines
= 1;
2276 f
->explicit_name
= ! NILP (name
);
2278 else if (f
->explicit_name
)
2281 /* If NAME is nil, set the name to the x_id_name. */
2284 /* Check for no change needed in this very common case
2285 before we do any consing. */
2286 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2287 XSTRING (f
->name
)->data
))
2289 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2292 CHECK_STRING (name
, 0);
2294 /* Don't change the name if it's already NAME. */
2295 if (! NILP (Fstring_equal (name
, f
->name
)))
2300 /* For setting the frame title, the title parameter should override
2301 the name parameter. */
2302 if (! NILP (f
->title
))
2305 if (FRAME_X_WINDOW (f
))
2310 XTextProperty text
, icon
;
2312 Lisp_Object coding_system
;
2314 coding_system
= Vlocale_coding_system
;
2315 if (NILP (coding_system
))
2316 coding_system
= Qcompound_text
;
2317 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2318 text
.encoding
= (stringp
? XA_STRING
2319 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2321 text
.nitems
= bytes
;
2323 if (NILP (f
->icon_name
))
2329 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2331 icon
.encoding
= (stringp
? XA_STRING
2332 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2334 icon
.nitems
= bytes
;
2336 #ifdef USE_X_TOOLKIT
2337 XSetWMName (FRAME_X_DISPLAY (f
),
2338 XtWindow (f
->output_data
.x
->widget
), &text
);
2339 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2341 #else /* not USE_X_TOOLKIT */
2342 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2343 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2344 #endif /* not USE_X_TOOLKIT */
2345 if (!NILP (f
->icon_name
)
2346 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2348 if (text
.value
!= XSTRING (name
)->data
)
2351 #else /* not HAVE_X11R4 */
2352 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2353 XSTRING (name
)->data
);
2354 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2355 XSTRING (name
)->data
);
2356 #endif /* not HAVE_X11R4 */
2361 /* This function should be called when the user's lisp code has
2362 specified a name for the frame; the name will override any set by the
2365 x_explicitly_set_name (f
, arg
, oldval
)
2367 Lisp_Object arg
, oldval
;
2369 x_set_name (f
, arg
, 1);
2372 /* This function should be called by Emacs redisplay code to set the
2373 name; names set this way will never override names set by the user's
2376 x_implicitly_set_name (f
, arg
, oldval
)
2378 Lisp_Object arg
, oldval
;
2380 x_set_name (f
, arg
, 0);
2383 /* Change the title of frame F to NAME.
2384 If NAME is nil, use the frame name as the title.
2386 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2387 name; if NAME is a string, set F's name to NAME and set
2388 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2390 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2391 suggesting a new name, which lisp code should override; if
2392 F->explicit_name is set, ignore the new name; otherwise, set it. */
2395 x_set_title (f
, name
, old_name
)
2397 Lisp_Object name
, old_name
;
2399 /* Don't change the title if it's already NAME. */
2400 if (EQ (name
, f
->title
))
2403 update_mode_lines
= 1;
2410 CHECK_STRING (name
, 0);
2412 if (FRAME_X_WINDOW (f
))
2417 XTextProperty text
, icon
;
2419 Lisp_Object coding_system
;
2421 coding_system
= Vlocale_coding_system
;
2422 if (NILP (coding_system
))
2423 coding_system
= Qcompound_text
;
2424 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2425 text
.encoding
= (stringp
? XA_STRING
2426 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2428 text
.nitems
= bytes
;
2430 if (NILP (f
->icon_name
))
2436 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2438 icon
.encoding
= (stringp
? XA_STRING
2439 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2441 icon
.nitems
= bytes
;
2443 #ifdef USE_X_TOOLKIT
2444 XSetWMName (FRAME_X_DISPLAY (f
),
2445 XtWindow (f
->output_data
.x
->widget
), &text
);
2446 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2448 #else /* not USE_X_TOOLKIT */
2449 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2450 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2451 #endif /* not USE_X_TOOLKIT */
2452 if (!NILP (f
->icon_name
)
2453 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2455 if (text
.value
!= XSTRING (name
)->data
)
2458 #else /* not HAVE_X11R4 */
2459 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2460 XSTRING (name
)->data
);
2461 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2462 XSTRING (name
)->data
);
2463 #endif /* not HAVE_X11R4 */
2469 x_set_autoraise (f
, arg
, oldval
)
2471 Lisp_Object arg
, oldval
;
2473 f
->auto_raise
= !EQ (Qnil
, arg
);
2477 x_set_autolower (f
, arg
, oldval
)
2479 Lisp_Object arg
, oldval
;
2481 f
->auto_lower
= !EQ (Qnil
, arg
);
2485 x_set_unsplittable (f
, arg
, oldval
)
2487 Lisp_Object arg
, oldval
;
2489 f
->no_split
= !NILP (arg
);
2493 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2495 Lisp_Object arg
, oldval
;
2497 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2498 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2499 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2500 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2502 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2504 ? vertical_scroll_bar_none
2506 ? vertical_scroll_bar_right
2507 : vertical_scroll_bar_left
);
2509 /* We set this parameter before creating the X window for the
2510 frame, so we can get the geometry right from the start.
2511 However, if the window hasn't been created yet, we shouldn't
2512 call x_set_window_size. */
2513 if (FRAME_X_WINDOW (f
))
2514 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2515 do_pending_window_change (0);
2520 x_set_scroll_bar_width (f
, arg
, oldval
)
2522 Lisp_Object arg
, oldval
;
2524 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2528 #ifdef USE_TOOLKIT_SCROLL_BARS
2529 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2530 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2531 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2532 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2534 /* Make the actual width at least 14 pixels and a multiple of a
2536 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2538 /* Use all of that space (aside from required margins) for the
2540 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2543 if (FRAME_X_WINDOW (f
))
2544 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2545 do_pending_window_change (0);
2547 else if (INTEGERP (arg
) && XINT (arg
) > 0
2548 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2550 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2551 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2553 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2554 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2555 if (FRAME_X_WINDOW (f
))
2556 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2559 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2560 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2561 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2566 /* Subroutines of creating an X frame. */
2568 /* Make sure that Vx_resource_name is set to a reasonable value.
2569 Fix it up, or set it to `emacs' if it is too hopeless. */
2572 validate_x_resource_name ()
2575 /* Number of valid characters in the resource name. */
2577 /* Number of invalid characters in the resource name. */
2582 if (!STRINGP (Vx_resource_class
))
2583 Vx_resource_class
= build_string (EMACS_CLASS
);
2585 if (STRINGP (Vx_resource_name
))
2587 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2590 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2592 /* Only letters, digits, - and _ are valid in resource names.
2593 Count the valid characters and count the invalid ones. */
2594 for (i
= 0; i
< len
; i
++)
2597 if (! ((c
>= 'a' && c
<= 'z')
2598 || (c
>= 'A' && c
<= 'Z')
2599 || (c
>= '0' && c
<= '9')
2600 || c
== '-' || c
== '_'))
2607 /* Not a string => completely invalid. */
2608 bad_count
= 5, good_count
= 0;
2610 /* If name is valid already, return. */
2614 /* If name is entirely invalid, or nearly so, use `emacs'. */
2616 || (good_count
== 1 && bad_count
> 0))
2618 Vx_resource_name
= build_string ("emacs");
2622 /* Name is partly valid. Copy it and replace the invalid characters
2623 with underscores. */
2625 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2627 for (i
= 0; i
< len
; i
++)
2629 int c
= XSTRING (new)->data
[i
];
2630 if (! ((c
>= 'a' && c
<= 'z')
2631 || (c
>= 'A' && c
<= 'Z')
2632 || (c
>= '0' && c
<= '9')
2633 || c
== '-' || c
== '_'))
2634 XSTRING (new)->data
[i
] = '_';
2639 extern char *x_get_string_resource ();
2641 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2642 doc
: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
2643 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
2644 class, where INSTANCE is the name under which Emacs was invoked, or
2645 the name specified by the `-name' or `-rn' command-line arguments.
2647 The optional arguments COMPONENT and SUBCLASS add to the key and the
2648 class, respectively. You must specify both of them or neither.
2649 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
2650 and the class is `Emacs.CLASS.SUBCLASS'. */)
2651 (attribute
, class, component
, subclass
)
2652 Lisp_Object attribute
, class, component
, subclass
;
2654 register char *value
;
2660 CHECK_STRING (attribute
, 0);
2661 CHECK_STRING (class, 0);
2663 if (!NILP (component
))
2664 CHECK_STRING (component
, 1);
2665 if (!NILP (subclass
))
2666 CHECK_STRING (subclass
, 2);
2667 if (NILP (component
) != NILP (subclass
))
2668 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2670 validate_x_resource_name ();
2672 /* Allocate space for the components, the dots which separate them,
2673 and the final '\0'. Make them big enough for the worst case. */
2674 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2675 + (STRINGP (component
)
2676 ? STRING_BYTES (XSTRING (component
)) : 0)
2677 + STRING_BYTES (XSTRING (attribute
))
2680 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2681 + STRING_BYTES (XSTRING (class))
2682 + (STRINGP (subclass
)
2683 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2686 /* Start with emacs.FRAMENAME for the name (the specific one)
2687 and with `Emacs' for the class key (the general one). */
2688 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2689 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2691 strcat (class_key
, ".");
2692 strcat (class_key
, XSTRING (class)->data
);
2694 if (!NILP (component
))
2696 strcat (class_key
, ".");
2697 strcat (class_key
, XSTRING (subclass
)->data
);
2699 strcat (name_key
, ".");
2700 strcat (name_key
, XSTRING (component
)->data
);
2703 strcat (name_key
, ".");
2704 strcat (name_key
, XSTRING (attribute
)->data
);
2706 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2707 name_key
, class_key
);
2709 if (value
!= (char *) 0)
2710 return build_string (value
);
2715 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2718 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2719 struct x_display_info
*dpyinfo
;
2720 Lisp_Object attribute
, class, component
, subclass
;
2722 register char *value
;
2726 CHECK_STRING (attribute
, 0);
2727 CHECK_STRING (class, 0);
2729 if (!NILP (component
))
2730 CHECK_STRING (component
, 1);
2731 if (!NILP (subclass
))
2732 CHECK_STRING (subclass
, 2);
2733 if (NILP (component
) != NILP (subclass
))
2734 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2736 validate_x_resource_name ();
2738 /* Allocate space for the components, the dots which separate them,
2739 and the final '\0'. Make them big enough for the worst case. */
2740 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2741 + (STRINGP (component
)
2742 ? STRING_BYTES (XSTRING (component
)) : 0)
2743 + STRING_BYTES (XSTRING (attribute
))
2746 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2747 + STRING_BYTES (XSTRING (class))
2748 + (STRINGP (subclass
)
2749 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2752 /* Start with emacs.FRAMENAME for the name (the specific one)
2753 and with `Emacs' for the class key (the general one). */
2754 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2755 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2757 strcat (class_key
, ".");
2758 strcat (class_key
, XSTRING (class)->data
);
2760 if (!NILP (component
))
2762 strcat (class_key
, ".");
2763 strcat (class_key
, XSTRING (subclass
)->data
);
2765 strcat (name_key
, ".");
2766 strcat (name_key
, XSTRING (component
)->data
);
2769 strcat (name_key
, ".");
2770 strcat (name_key
, XSTRING (attribute
)->data
);
2772 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2774 if (value
!= (char *) 0)
2775 return build_string (value
);
2780 /* Used when C code wants a resource value. */
2783 x_get_resource_string (attribute
, class)
2784 char *attribute
, *class;
2788 struct frame
*sf
= SELECTED_FRAME ();
2790 /* Allocate space for the components, the dots which separate them,
2791 and the final '\0'. */
2792 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2793 + strlen (attribute
) + 2);
2794 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2795 + strlen (class) + 2);
2797 sprintf (name_key
, "%s.%s",
2798 XSTRING (Vinvocation_name
)->data
,
2800 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2802 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2803 name_key
, class_key
);
2806 /* Types we might convert a resource string into. */
2816 /* Return the value of parameter PARAM.
2818 First search ALIST, then Vdefault_frame_alist, then the X defaults
2819 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2821 Convert the resource to the type specified by desired_type.
2823 If no default is specified, return Qunbound. If you call
2824 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2825 and don't let it get stored in any Lisp-visible variables! */
2828 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2829 struct x_display_info
*dpyinfo
;
2830 Lisp_Object alist
, param
;
2833 enum resource_types type
;
2835 register Lisp_Object tem
;
2837 tem
= Fassq (param
, alist
);
2839 tem
= Fassq (param
, Vdefault_frame_alist
);
2845 tem
= display_x_get_resource (dpyinfo
,
2846 build_string (attribute
),
2847 build_string (class),
2855 case RES_TYPE_NUMBER
:
2856 return make_number (atoi (XSTRING (tem
)->data
));
2858 case RES_TYPE_FLOAT
:
2859 return make_float (atof (XSTRING (tem
)->data
));
2861 case RES_TYPE_BOOLEAN
:
2862 tem
= Fdowncase (tem
);
2863 if (!strcmp (XSTRING (tem
)->data
, "on")
2864 || !strcmp (XSTRING (tem
)->data
, "true"))
2869 case RES_TYPE_STRING
:
2872 case RES_TYPE_SYMBOL
:
2873 /* As a special case, we map the values `true' and `on'
2874 to Qt, and `false' and `off' to Qnil. */
2877 lower
= Fdowncase (tem
);
2878 if (!strcmp (XSTRING (lower
)->data
, "on")
2879 || !strcmp (XSTRING (lower
)->data
, "true"))
2881 else if (!strcmp (XSTRING (lower
)->data
, "off")
2882 || !strcmp (XSTRING (lower
)->data
, "false"))
2885 return Fintern (tem
, Qnil
);
2898 /* Like x_get_arg, but also record the value in f->param_alist. */
2901 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2903 Lisp_Object alist
, param
;
2906 enum resource_types type
;
2910 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2911 attribute
, class, type
);
2913 store_frame_param (f
, param
, value
);
2918 /* Record in frame F the specified or default value according to ALIST
2919 of the parameter named PROP (a Lisp symbol).
2920 If no value is specified for PROP, look for an X default for XPROP
2921 on the frame named NAME.
2922 If that is not found either, use the value DEFLT. */
2925 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2932 enum resource_types type
;
2936 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2937 if (EQ (tem
, Qunbound
))
2939 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2944 /* Record in frame F the specified or default value according to ALIST
2945 of the parameter named PROP (a Lisp symbol). If no value is
2946 specified for PROP, look for an X default for XPROP on the frame
2947 named NAME. If that is not found either, use the value DEFLT. */
2950 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2959 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2962 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2963 if (EQ (tem
, Qunbound
))
2965 #ifdef USE_TOOLKIT_SCROLL_BARS
2967 /* See if an X resource for the scroll bar color has been
2969 tem
= display_x_get_resource (dpyinfo
,
2970 build_string (foreground_p
2974 build_string ("verticalScrollBar"),
2978 /* If nothing has been specified, scroll bars will use a
2979 toolkit-dependent default. Because these defaults are
2980 difficult to get at without actually creating a scroll
2981 bar, use nil to indicate that no color has been
2986 #else /* not USE_TOOLKIT_SCROLL_BARS */
2990 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2993 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2999 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3000 doc
: /* Parse an X-style geometry string STRING.
3001 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3002 The properties returned may include `top', `left', `height', and `width'.
3003 The value of `left' or `top' may be an integer,
3004 or a list (+ N) meaning N pixels relative to top/left corner,
3005 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3010 unsigned int width
, height
;
3013 CHECK_STRING (string
, 0);
3015 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
3016 &x
, &y
, &width
, &height
);
3019 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
3020 error ("Must specify both x and y position, or neither");
3024 if (geometry
& XValue
)
3026 Lisp_Object element
;
3028 if (x
>= 0 && (geometry
& XNegative
))
3029 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3030 else if (x
< 0 && ! (geometry
& XNegative
))
3031 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3033 element
= Fcons (Qleft
, make_number (x
));
3034 result
= Fcons (element
, result
);
3037 if (geometry
& YValue
)
3039 Lisp_Object element
;
3041 if (y
>= 0 && (geometry
& YNegative
))
3042 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3043 else if (y
< 0 && ! (geometry
& YNegative
))
3044 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3046 element
= Fcons (Qtop
, make_number (y
));
3047 result
= Fcons (element
, result
);
3050 if (geometry
& WidthValue
)
3051 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3052 if (geometry
& HeightValue
)
3053 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3058 /* Calculate the desired size and position of this window,
3059 and return the flags saying which aspects were specified.
3061 This function does not make the coordinates positive. */
3063 #define DEFAULT_ROWS 40
3064 #define DEFAULT_COLS 80
3067 x_figure_window_size (f
, parms
)
3071 register Lisp_Object tem0
, tem1
, tem2
;
3072 long window_prompting
= 0;
3073 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3075 /* Default values if we fall through.
3076 Actually, if that happens we should get
3077 window manager prompting. */
3078 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3079 f
->height
= DEFAULT_ROWS
;
3080 /* Window managers expect that if program-specified
3081 positions are not (0,0), they're intentional, not defaults. */
3082 f
->output_data
.x
->top_pos
= 0;
3083 f
->output_data
.x
->left_pos
= 0;
3085 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3086 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3087 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3088 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3090 if (!EQ (tem0
, Qunbound
))
3092 CHECK_NUMBER (tem0
, 0);
3093 f
->height
= XINT (tem0
);
3095 if (!EQ (tem1
, Qunbound
))
3097 CHECK_NUMBER (tem1
, 0);
3098 SET_FRAME_WIDTH (f
, XINT (tem1
));
3100 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3101 window_prompting
|= USSize
;
3103 window_prompting
|= PSize
;
3106 f
->output_data
.x
->vertical_scroll_bar_extra
3107 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3109 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3110 f
->output_data
.x
->flags_areas_extra
3111 = FRAME_FLAGS_AREA_WIDTH (f
);
3112 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3113 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3115 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3116 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3117 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3118 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3120 if (EQ (tem0
, Qminus
))
3122 f
->output_data
.x
->top_pos
= 0;
3123 window_prompting
|= YNegative
;
3125 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3126 && CONSP (XCDR (tem0
))
3127 && INTEGERP (XCAR (XCDR (tem0
))))
3129 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3130 window_prompting
|= YNegative
;
3132 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3133 && CONSP (XCDR (tem0
))
3134 && INTEGERP (XCAR (XCDR (tem0
))))
3136 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3138 else if (EQ (tem0
, Qunbound
))
3139 f
->output_data
.x
->top_pos
= 0;
3142 CHECK_NUMBER (tem0
, 0);
3143 f
->output_data
.x
->top_pos
= XINT (tem0
);
3144 if (f
->output_data
.x
->top_pos
< 0)
3145 window_prompting
|= YNegative
;
3148 if (EQ (tem1
, Qminus
))
3150 f
->output_data
.x
->left_pos
= 0;
3151 window_prompting
|= XNegative
;
3153 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3154 && CONSP (XCDR (tem1
))
3155 && INTEGERP (XCAR (XCDR (tem1
))))
3157 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3158 window_prompting
|= XNegative
;
3160 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3161 && CONSP (XCDR (tem1
))
3162 && INTEGERP (XCAR (XCDR (tem1
))))
3164 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3166 else if (EQ (tem1
, Qunbound
))
3167 f
->output_data
.x
->left_pos
= 0;
3170 CHECK_NUMBER (tem1
, 0);
3171 f
->output_data
.x
->left_pos
= XINT (tem1
);
3172 if (f
->output_data
.x
->left_pos
< 0)
3173 window_prompting
|= XNegative
;
3176 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3177 window_prompting
|= USPosition
;
3179 window_prompting
|= PPosition
;
3182 return window_prompting
;
3185 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3188 XSetWMProtocols (dpy
, w
, protocols
, count
)
3195 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3196 if (prop
== None
) return False
;
3197 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3198 (unsigned char *) protocols
, count
);
3201 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3203 #ifdef USE_X_TOOLKIT
3205 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3206 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3207 already be present because of the toolkit (Motif adds some of them,
3208 for example, but Xt doesn't). */
3211 hack_wm_protocols (f
, widget
)
3215 Display
*dpy
= XtDisplay (widget
);
3216 Window w
= XtWindow (widget
);
3217 int need_delete
= 1;
3223 Atom type
, *atoms
= 0;
3225 unsigned long nitems
= 0;
3226 unsigned long bytes_after
;
3228 if ((XGetWindowProperty (dpy
, w
,
3229 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3230 (long)0, (long)100, False
, XA_ATOM
,
3231 &type
, &format
, &nitems
, &bytes_after
,
3232 (unsigned char **) &atoms
)
3234 && format
== 32 && type
== XA_ATOM
)
3238 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3240 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3242 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3245 if (atoms
) XFree ((char *) atoms
);
3251 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3253 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3255 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3257 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3258 XA_ATOM
, 32, PropModeAppend
,
3259 (unsigned char *) props
, count
);
3267 /* Support routines for XIC (X Input Context). */
3271 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3272 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3275 /* Supported XIM styles, ordered by preferenc. */
3277 static XIMStyle supported_xim_styles
[] =
3279 XIMPreeditPosition
| XIMStatusArea
,
3280 XIMPreeditPosition
| XIMStatusNothing
,
3281 XIMPreeditPosition
| XIMStatusNone
,
3282 XIMPreeditNothing
| XIMStatusArea
,
3283 XIMPreeditNothing
| XIMStatusNothing
,
3284 XIMPreeditNothing
| XIMStatusNone
,
3285 XIMPreeditNone
| XIMStatusArea
,
3286 XIMPreeditNone
| XIMStatusNothing
,
3287 XIMPreeditNone
| XIMStatusNone
,
3292 /* Create an X fontset on frame F with base font name
3296 xic_create_xfontset (f
, base_fontname
)
3298 char *base_fontname
;
3301 char **missing_list
;
3305 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3306 base_fontname
, &missing_list
,
3307 &missing_count
, &def_string
);
3309 XFreeStringList (missing_list
);
3311 /* No need to free def_string. */
3316 /* Value is the best input style, given user preferences USER (already
3317 checked to be supported by Emacs), and styles supported by the
3318 input method XIM. */
3321 best_xim_style (user
, xim
)
3327 for (i
= 0; i
< user
->count_styles
; ++i
)
3328 for (j
= 0; j
< xim
->count_styles
; ++j
)
3329 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3330 return user
->supported_styles
[i
];
3332 /* Return the default style. */
3333 return XIMPreeditNothing
| XIMStatusNothing
;
3336 /* Create XIC for frame F. */
3338 static XIMStyle xic_style
;
3341 create_frame_xic (f
)
3346 XFontSet xfs
= NULL
;
3351 xim
= FRAME_X_XIM (f
);
3356 XVaNestedList preedit_attr
;
3357 XVaNestedList status_attr
;
3358 char *base_fontname
;
3361 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3362 spot
.x
= 0; spot
.y
= 1;
3363 /* Create X fontset. */
3364 fontset
= FRAME_FONTSET (f
);
3366 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3369 /* Determine the base fontname from the ASCII font name of
3371 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3372 char *p
= ascii_font
;
3375 for (i
= 0; *p
; p
++)
3378 /* As the font name doesn't conform to XLFD, we can't
3379 modify it to get a suitable base fontname for the
3381 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3384 int len
= strlen (ascii_font
) + 1;
3387 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3396 base_fontname
= (char *) alloca (len
);
3397 bzero (base_fontname
, len
);
3398 strcpy (base_fontname
, "-*-*-");
3399 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3400 strcat (base_fontname
, "*-*-*-*-*-*-*");
3403 xfs
= xic_create_xfontset (f
, base_fontname
);
3405 /* Determine XIC style. */
3408 XIMStyles supported_list
;
3409 supported_list
.count_styles
= (sizeof supported_xim_styles
3410 / sizeof supported_xim_styles
[0]);
3411 supported_list
.supported_styles
= supported_xim_styles
;
3412 xic_style
= best_xim_style (&supported_list
,
3413 FRAME_X_XIM_STYLES (f
));
3416 preedit_attr
= XVaCreateNestedList (0,
3419 FRAME_FOREGROUND_PIXEL (f
),
3421 FRAME_BACKGROUND_PIXEL (f
),
3422 (xic_style
& XIMPreeditPosition
3427 status_attr
= XVaCreateNestedList (0,
3433 FRAME_FOREGROUND_PIXEL (f
),
3435 FRAME_BACKGROUND_PIXEL (f
),
3438 xic
= XCreateIC (xim
,
3439 XNInputStyle
, xic_style
,
3440 XNClientWindow
, FRAME_X_WINDOW(f
),
3441 XNFocusWindow
, FRAME_X_WINDOW(f
),
3442 XNStatusAttributes
, status_attr
,
3443 XNPreeditAttributes
, preedit_attr
,
3445 XFree (preedit_attr
);
3446 XFree (status_attr
);
3449 FRAME_XIC (f
) = xic
;
3450 FRAME_XIC_STYLE (f
) = xic_style
;
3451 FRAME_XIC_FONTSET (f
) = xfs
;
3455 /* Destroy XIC and free XIC fontset of frame F, if any. */
3461 if (FRAME_XIC (f
) == NULL
)
3464 XDestroyIC (FRAME_XIC (f
));
3465 if (FRAME_XIC_FONTSET (f
))
3466 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3468 FRAME_XIC (f
) = NULL
;
3469 FRAME_XIC_FONTSET (f
) = NULL
;
3473 /* Place preedit area for XIC of window W's frame to specified
3474 pixel position X/Y. X and Y are relative to window W. */
3477 xic_set_preeditarea (w
, x
, y
)
3481 struct frame
*f
= XFRAME (w
->frame
);
3485 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3486 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3487 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3488 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3493 /* Place status area for XIC in bottom right corner of frame F.. */
3496 xic_set_statusarea (f
)
3499 XIC xic
= FRAME_XIC (f
);
3504 /* Negotiate geometry of status area. If input method has existing
3505 status area, use its current size. */
3506 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3507 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3508 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3511 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3512 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3515 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3517 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3518 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3522 area
.width
= needed
->width
;
3523 area
.height
= needed
->height
;
3524 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3525 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3526 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3529 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3530 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3535 /* Set X fontset for XIC of frame F, using base font name
3536 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3539 xic_set_xfontset (f
, base_fontname
)
3541 char *base_fontname
;
3546 xfs
= xic_create_xfontset (f
, base_fontname
);
3548 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3549 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3550 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3551 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3552 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3555 if (FRAME_XIC_FONTSET (f
))
3556 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3557 FRAME_XIC_FONTSET (f
) = xfs
;
3560 #endif /* HAVE_X_I18N */
3564 #ifdef USE_X_TOOLKIT
3566 /* Create and set up the X widget for frame F. */
3569 x_window (f
, window_prompting
, minibuffer_only
)
3571 long window_prompting
;
3572 int minibuffer_only
;
3574 XClassHint class_hints
;
3575 XSetWindowAttributes attributes
;
3576 unsigned long attribute_mask
;
3577 Widget shell_widget
;
3579 Widget frame_widget
;
3585 /* Use the resource name as the top-level widget name
3586 for looking up resources. Make a non-Lisp copy
3587 for the window manager, so GC relocation won't bother it.
3589 Elsewhere we specify the window name for the window manager. */
3592 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3593 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3594 strcpy (f
->namebuf
, str
);
3598 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3599 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3600 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3601 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3602 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3603 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3604 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3605 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3606 applicationShellWidgetClass
,
3607 FRAME_X_DISPLAY (f
), al
, ac
);
3609 f
->output_data
.x
->widget
= shell_widget
;
3610 /* maybe_set_screen_title_format (shell_widget); */
3612 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3613 (widget_value
*) NULL
,
3614 shell_widget
, False
,
3618 (lw_callback
) NULL
);
3621 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3622 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3623 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3624 XtSetValues (pane_widget
, al
, ac
);
3625 f
->output_data
.x
->column_widget
= pane_widget
;
3627 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3628 the emacs screen when changing menubar. This reduces flickering. */
3631 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3632 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3633 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3634 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3635 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3636 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3637 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3638 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3639 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3642 f
->output_data
.x
->edit_widget
= frame_widget
;
3644 XtManageChild (frame_widget
);
3646 /* Do some needed geometry management. */
3649 char *tem
, shell_position
[32];
3652 int extra_borders
= 0;
3654 = (f
->output_data
.x
->menubar_widget
3655 ? (f
->output_data
.x
->menubar_widget
->core
.height
3656 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3659 #if 0 /* Experimentally, we now get the right results
3660 for -geometry -0-0 without this. 24 Aug 96, rms. */
3661 if (FRAME_EXTERNAL_MENU_BAR (f
))
3664 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3665 menubar_size
+= ibw
;
3669 f
->output_data
.x
->menubar_height
= menubar_size
;
3672 /* Motif seems to need this amount added to the sizes
3673 specified for the shell widget. The Athena/Lucid widgets don't.
3674 Both conclusions reached experimentally. -- rms. */
3675 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3676 &extra_borders
, NULL
);
3680 /* Convert our geometry parameters into a geometry string
3682 Note that we do not specify here whether the position
3683 is a user-specified or program-specified one.
3684 We pass that information later, in x_wm_set_size_hints. */
3686 int left
= f
->output_data
.x
->left_pos
;
3687 int xneg
= window_prompting
& XNegative
;
3688 int top
= f
->output_data
.x
->top_pos
;
3689 int yneg
= window_prompting
& YNegative
;
3695 if (window_prompting
& USPosition
)
3696 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3697 PIXEL_WIDTH (f
) + extra_borders
,
3698 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3699 (xneg
? '-' : '+'), left
,
3700 (yneg
? '-' : '+'), top
);
3702 sprintf (shell_position
, "=%dx%d",
3703 PIXEL_WIDTH (f
) + extra_borders
,
3704 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3707 len
= strlen (shell_position
) + 1;
3708 /* We don't free this because we don't know whether
3709 it is safe to free it while the frame exists.
3710 It isn't worth the trouble of arranging to free it
3711 when the frame is deleted. */
3712 tem
= (char *) xmalloc (len
);
3713 strncpy (tem
, shell_position
, len
);
3714 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3715 XtSetValues (shell_widget
, al
, ac
);
3718 XtManageChild (pane_widget
);
3719 XtRealizeWidget (shell_widget
);
3721 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3723 validate_x_resource_name ();
3725 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3726 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3727 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3730 FRAME_XIC (f
) = NULL
;
3732 create_frame_xic (f
);
3736 f
->output_data
.x
->wm_hints
.input
= True
;
3737 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3738 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3739 &f
->output_data
.x
->wm_hints
);
3741 hack_wm_protocols (f
, shell_widget
);
3744 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3747 /* Do a stupid property change to force the server to generate a
3748 PropertyNotify event so that the event_stream server timestamp will
3749 be initialized to something relevant to the time we created the window.
3751 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3752 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3753 XA_ATOM
, 32, PropModeAppend
,
3754 (unsigned char*) NULL
, 0);
3756 /* Make all the standard events reach the Emacs frame. */
3757 attributes
.event_mask
= STANDARD_EVENT_SET
;
3762 /* XIM server might require some X events. */
3763 unsigned long fevent
= NoEventMask
;
3764 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3765 attributes
.event_mask
|= fevent
;
3767 #endif /* HAVE_X_I18N */
3769 attribute_mask
= CWEventMask
;
3770 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3771 attribute_mask
, &attributes
);
3773 XtMapWidget (frame_widget
);
3775 /* x_set_name normally ignores requests to set the name if the
3776 requested name is the same as the current name. This is the one
3777 place where that assumption isn't correct; f->name is set, but
3778 the X server hasn't been told. */
3781 int explicit = f
->explicit_name
;
3783 f
->explicit_name
= 0;
3786 x_set_name (f
, name
, explicit);
3789 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3790 f
->output_data
.x
->text_cursor
);
3794 /* This is a no-op, except under Motif. Make sure main areas are
3795 set to something reasonable, in case we get an error later. */
3796 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3799 #else /* not USE_X_TOOLKIT */
3801 /* Create and set up the X window for frame F. */
3808 XClassHint class_hints
;
3809 XSetWindowAttributes attributes
;
3810 unsigned long attribute_mask
;
3812 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3813 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3814 attributes
.bit_gravity
= StaticGravity
;
3815 attributes
.backing_store
= NotUseful
;
3816 attributes
.save_under
= True
;
3817 attributes
.event_mask
= STANDARD_EVENT_SET
;
3818 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3819 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3824 = XCreateWindow (FRAME_X_DISPLAY (f
),
3825 f
->output_data
.x
->parent_desc
,
3826 f
->output_data
.x
->left_pos
,
3827 f
->output_data
.x
->top_pos
,
3828 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3829 f
->output_data
.x
->border_width
,
3830 CopyFromParent
, /* depth */
3831 InputOutput
, /* class */
3833 attribute_mask
, &attributes
);
3837 create_frame_xic (f
);
3840 /* XIM server might require some X events. */
3841 unsigned long fevent
= NoEventMask
;
3842 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3843 attributes
.event_mask
|= fevent
;
3844 attribute_mask
= CWEventMask
;
3845 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3846 attribute_mask
, &attributes
);
3849 #endif /* HAVE_X_I18N */
3851 validate_x_resource_name ();
3853 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3854 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3855 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3857 /* The menubar is part of the ordinary display;
3858 it does not count in addition to the height of the window. */
3859 f
->output_data
.x
->menubar_height
= 0;
3861 /* This indicates that we use the "Passive Input" input model.
3862 Unless we do this, we don't get the Focus{In,Out} events that we
3863 need to draw the cursor correctly. Accursed bureaucrats.
3864 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3866 f
->output_data
.x
->wm_hints
.input
= True
;
3867 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3868 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3869 &f
->output_data
.x
->wm_hints
);
3870 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3872 /* Request "save yourself" and "delete window" commands from wm. */
3875 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3876 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3877 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3880 /* x_set_name normally ignores requests to set the name if the
3881 requested name is the same as the current name. This is the one
3882 place where that assumption isn't correct; f->name is set, but
3883 the X server hasn't been told. */
3886 int explicit = f
->explicit_name
;
3888 f
->explicit_name
= 0;
3891 x_set_name (f
, name
, explicit);
3894 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3895 f
->output_data
.x
->text_cursor
);
3899 if (FRAME_X_WINDOW (f
) == 0)
3900 error ("Unable to create window");
3903 #endif /* not USE_X_TOOLKIT */
3905 /* Handle the icon stuff for this window. Perhaps later we might
3906 want an x_set_icon_position which can be called interactively as
3914 Lisp_Object icon_x
, icon_y
;
3915 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3917 /* Set the position of the icon. Note that twm groups all
3918 icons in an icon window. */
3919 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3920 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3921 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3923 CHECK_NUMBER (icon_x
, 0);
3924 CHECK_NUMBER (icon_y
, 0);
3926 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3927 error ("Both left and top icon corners of icon must be specified");
3931 if (! EQ (icon_x
, Qunbound
))
3932 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3934 /* Start up iconic or window? */
3935 x_wm_set_window_state
3936 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3941 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3948 /* Make the GCs needed for this window, setting the
3949 background, border and mouse colors; also create the
3950 mouse cursor and the gray border tile. */
3952 static char cursor_bits
[] =
3954 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3955 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3956 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3957 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3964 XGCValues gc_values
;
3968 /* Create the GCs of this frame.
3969 Note that many default values are used. */
3972 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3973 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3974 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3975 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3976 f
->output_data
.x
->normal_gc
3977 = XCreateGC (FRAME_X_DISPLAY (f
),
3979 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
3982 /* Reverse video style. */
3983 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3984 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3985 f
->output_data
.x
->reverse_gc
3986 = XCreateGC (FRAME_X_DISPLAY (f
),
3988 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
3991 /* Cursor has cursor-color background, background-color foreground. */
3992 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3993 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3994 gc_values
.fill_style
= FillOpaqueStippled
;
3996 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3997 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3998 cursor_bits
, 16, 16);
3999 f
->output_data
.x
->cursor_gc
4000 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4001 (GCFont
| GCForeground
| GCBackground
4002 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
4006 f
->output_data
.x
->white_relief
.gc
= 0;
4007 f
->output_data
.x
->black_relief
.gc
= 0;
4009 /* Create the gray border tile used when the pointer is not in
4010 the frame. Since this depends on the frame's pixel values,
4011 this must be done on a per-frame basis. */
4012 f
->output_data
.x
->border_tile
4013 = (XCreatePixmapFromBitmapData
4014 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
4015 gray_bits
, gray_width
, gray_height
,
4016 f
->output_data
.x
->foreground_pixel
,
4017 f
->output_data
.x
->background_pixel
,
4018 DefaultDepth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
))));
4024 /* Free what was was allocated in x_make_gc. */
4030 Display
*dpy
= FRAME_X_DISPLAY (f
);
4034 if (f
->output_data
.x
->normal_gc
)
4036 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
4037 f
->output_data
.x
->normal_gc
= 0;
4040 if (f
->output_data
.x
->reverse_gc
)
4042 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4043 f
->output_data
.x
->reverse_gc
= 0;
4046 if (f
->output_data
.x
->cursor_gc
)
4048 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4049 f
->output_data
.x
->cursor_gc
= 0;
4052 if (f
->output_data
.x
->border_tile
)
4054 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4055 f
->output_data
.x
->border_tile
= 0;
4062 /* Handler for signals raised during x_create_frame and
4063 x_create_top_frame. FRAME is the frame which is partially
4067 unwind_create_frame (frame
)
4070 struct frame
*f
= XFRAME (frame
);
4072 /* If frame is ``official'', nothing to do. */
4073 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4076 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4079 x_free_frame_resources (f
);
4081 /* Check that reference counts are indeed correct. */
4082 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4083 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4091 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4093 doc
: /* Make a new X window, which is called a "frame" in Emacs terms.
4094 Returns an Emacs frame object.
4095 ALIST is an alist of frame parameters.
4096 If the parameters specify that the frame should not have a minibuffer,
4097 and do not specify a specific minibuffer window to use,
4098 then `default-minibuffer-frame' must be a frame whose minibuffer can
4099 be shared by the new frame.
4101 This function is an internal primitive--use `make-frame' instead. */)
4106 Lisp_Object frame
, tem
;
4108 int minibuffer_only
= 0;
4109 long window_prompting
= 0;
4111 int count
= BINDING_STACK_SIZE ();
4112 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4113 Lisp_Object display
;
4114 struct x_display_info
*dpyinfo
= NULL
;
4120 /* Use this general default value to start with
4121 until we know if this frame has a specified name. */
4122 Vx_resource_name
= Vinvocation_name
;
4124 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4125 if (EQ (display
, Qunbound
))
4127 dpyinfo
= check_x_display_info (display
);
4129 kb
= dpyinfo
->kboard
;
4131 kb
= &the_only_kboard
;
4134 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4136 && ! EQ (name
, Qunbound
)
4138 error ("Invalid frame name--not a string or nil");
4141 Vx_resource_name
= name
;
4143 /* See if parent window is specified. */
4144 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4145 if (EQ (parent
, Qunbound
))
4147 if (! NILP (parent
))
4148 CHECK_NUMBER (parent
, 0);
4150 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4151 /* No need to protect DISPLAY because that's not used after passing
4152 it to make_frame_without_minibuffer. */
4154 GCPRO4 (parms
, parent
, name
, frame
);
4155 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4157 if (EQ (tem
, Qnone
) || NILP (tem
))
4158 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4159 else if (EQ (tem
, Qonly
))
4161 f
= make_minibuffer_frame ();
4162 minibuffer_only
= 1;
4164 else if (WINDOWP (tem
))
4165 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4169 XSETFRAME (frame
, f
);
4171 /* Note that X Windows does support scroll bars. */
4172 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4174 f
->output_method
= output_x_window
;
4175 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4176 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4177 f
->output_data
.x
->icon_bitmap
= -1;
4178 f
->output_data
.x
->fontset
= -1;
4179 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4180 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4181 #ifdef USE_TOOLKIT_SCROLL_BARS
4182 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
4183 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
4184 #endif /* USE_TOOLKIT_SCROLL_BARS */
4185 record_unwind_protect (unwind_create_frame
, frame
);
4188 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4190 if (! STRINGP (f
->icon_name
))
4191 f
->icon_name
= Qnil
;
4193 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4195 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4196 dpyinfo_refcount
= dpyinfo
->reference_count
;
4197 #endif /* GLYPH_DEBUG */
4199 FRAME_KBOARD (f
) = kb
;
4202 /* These colors will be set anyway later, but it's important
4203 to get the color reference counts right, so initialize them! */
4206 struct gcpro gcpro1
;
4208 /* Function x_decode_color can signal an error. Make
4209 sure to initialize color slots so that we won't try
4210 to free colors we haven't allocated. */
4211 f
->output_data
.x
->foreground_pixel
= -1;
4212 f
->output_data
.x
->background_pixel
= -1;
4213 f
->output_data
.x
->cursor_pixel
= -1;
4214 f
->output_data
.x
->cursor_foreground_pixel
= -1;
4215 f
->output_data
.x
->border_pixel
= -1;
4216 f
->output_data
.x
->mouse_pixel
= -1;
4218 black
= build_string ("black");
4220 f
->output_data
.x
->foreground_pixel
4221 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4222 f
->output_data
.x
->background_pixel
4223 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4224 f
->output_data
.x
->cursor_pixel
4225 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4226 f
->output_data
.x
->cursor_foreground_pixel
4227 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4228 f
->output_data
.x
->border_pixel
4229 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4230 f
->output_data
.x
->mouse_pixel
4231 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4235 /* Specify the parent under which to make this X window. */
4239 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4240 f
->output_data
.x
->explicit_parent
= 1;
4244 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4245 f
->output_data
.x
->explicit_parent
= 0;
4248 /* Set the name; the functions to which we pass f expect the name to
4250 if (EQ (name
, Qunbound
) || NILP (name
))
4252 f
->name
= build_string (dpyinfo
->x_id_name
);
4253 f
->explicit_name
= 0;
4258 f
->explicit_name
= 1;
4259 /* use the frame's title when getting resources for this frame. */
4260 specbind (Qx_resource_name
, name
);
4263 /* Extract the window parameters from the supplied values
4264 that are needed to determine window geometry. */
4268 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4271 /* First, try whatever font the caller has specified. */
4274 tem
= Fquery_fontset (font
, Qnil
);
4276 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4278 font
= x_new_font (f
, XSTRING (font
)->data
);
4281 /* Try out a font which we hope has bold and italic variations. */
4282 if (!STRINGP (font
))
4283 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4284 if (!STRINGP (font
))
4285 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4286 if (! STRINGP (font
))
4287 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4288 if (! STRINGP (font
))
4289 /* This was formerly the first thing tried, but it finds too many fonts
4290 and takes too long. */
4291 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4292 /* If those didn't work, look for something which will at least work. */
4293 if (! STRINGP (font
))
4294 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4296 if (! STRINGP (font
))
4297 font
= build_string ("fixed");
4299 x_default_parameter (f
, parms
, Qfont
, font
,
4300 "font", "Font", RES_TYPE_STRING
);
4304 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4305 whereby it fails to get any font. */
4306 xlwmenu_default_font
= f
->output_data
.x
->font
;
4309 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4310 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4312 /* This defaults to 2 in order to match xterm. We recognize either
4313 internalBorderWidth or internalBorder (which is what xterm calls
4315 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4319 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4320 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4321 if (! EQ (value
, Qunbound
))
4322 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4325 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4326 "internalBorderWidth", "internalBorderWidth",
4328 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4329 "verticalScrollBars", "ScrollBars",
4332 /* Also do the stuff which must be set before the window exists. */
4333 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4334 "foreground", "Foreground", RES_TYPE_STRING
);
4335 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4336 "background", "Background", RES_TYPE_STRING
);
4337 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4338 "pointerColor", "Foreground", RES_TYPE_STRING
);
4339 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4340 "cursorColor", "Foreground", RES_TYPE_STRING
);
4341 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4342 "borderColor", "BorderColor", RES_TYPE_STRING
);
4343 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4344 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4345 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4346 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4348 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4349 "scrollBarForeground",
4350 "ScrollBarForeground", 1);
4351 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4352 "scrollBarBackground",
4353 "ScrollBarBackground", 0);
4355 /* Init faces before x_default_parameter is called for scroll-bar
4356 parameters because that function calls x_set_scroll_bar_width,
4357 which calls change_frame_size, which calls Fset_window_buffer,
4358 which runs hooks, which call Fvertical_motion. At the end, we
4359 end up in init_iterator with a null face cache, which should not
4361 init_frame_faces (f
);
4363 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4364 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4365 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4366 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4367 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4368 "bufferPredicate", "BufferPredicate",
4370 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4371 "title", "Title", RES_TYPE_STRING
);
4372 x_default_parameter (f
, parms
, Qwait_for_wm
, Qt
,
4373 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN
);
4375 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4377 /* Add the tool-bar height to the initial frame height so that the
4378 user gets a text display area of the size he specified with -g or
4379 via .Xdefaults. Later changes of the tool-bar height don't
4380 change the frame size. This is done so that users can create
4381 tall Emacs frames without having to guess how tall the tool-bar
4383 if (FRAME_TOOL_BAR_LINES (f
))
4385 int margin
, relief
, bar_height
;
4387 relief
= (tool_bar_button_relief
> 0
4388 ? tool_bar_button_relief
4389 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4391 if (INTEGERP (Vtool_bar_button_margin
)
4392 && XINT (Vtool_bar_button_margin
) > 0)
4393 margin
= XFASTINT (Vtool_bar_button_margin
);
4394 else if (CONSP (Vtool_bar_button_margin
)
4395 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4396 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4397 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4401 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4402 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4405 /* Compute the size of the X window. */
4406 window_prompting
= x_figure_window_size (f
, parms
);
4408 if (window_prompting
& XNegative
)
4410 if (window_prompting
& YNegative
)
4411 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4413 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4417 if (window_prompting
& YNegative
)
4418 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4420 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4423 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4425 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4426 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4428 /* Create the X widget or window. */
4429 #ifdef USE_X_TOOLKIT
4430 x_window (f
, window_prompting
, minibuffer_only
);
4438 /* Now consider the frame official. */
4439 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4440 Vframe_list
= Fcons (frame
, Vframe_list
);
4442 /* We need to do this after creating the X window, so that the
4443 icon-creation functions can say whose icon they're describing. */
4444 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4445 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4447 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4448 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4449 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4450 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4451 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4452 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4453 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4454 "scrollBarWidth", "ScrollBarWidth",
4457 /* Dimensions, especially f->height, must be done via change_frame_size.
4458 Change will not be effected unless different from the current
4464 SET_FRAME_WIDTH (f
, 0);
4465 change_frame_size (f
, height
, width
, 1, 0, 0);
4467 /* Set up faces after all frame parameters are known. This call
4468 also merges in face attributes specified for new frames. If we
4469 don't do this, the `menu' face for instance won't have the right
4470 colors, and the menu bar won't appear in the specified colors for
4472 call1 (Qface_set_after_frame_default
, frame
);
4474 #ifdef USE_X_TOOLKIT
4475 /* Create the menu bar. */
4476 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4478 /* If this signals an error, we haven't set size hints for the
4479 frame and we didn't make it visible. */
4480 initialize_frame_menubar (f
);
4482 /* This is a no-op, except under Motif where it arranges the
4483 main window for the widgets on it. */
4484 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4485 f
->output_data
.x
->menubar_widget
,
4486 f
->output_data
.x
->edit_widget
);
4488 #endif /* USE_X_TOOLKIT */
4490 /* Tell the server what size and position, etc, we want, and how
4491 badly we want them. This should be done after we have the menu
4492 bar so that its size can be taken into account. */
4494 x_wm_set_size_hint (f
, window_prompting
, 0);
4497 /* Make the window appear on the frame and enable display, unless
4498 the caller says not to. However, with explicit parent, Emacs
4499 cannot control visibility, so don't try. */
4500 if (! f
->output_data
.x
->explicit_parent
)
4502 Lisp_Object visibility
;
4504 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4506 if (EQ (visibility
, Qunbound
))
4509 if (EQ (visibility
, Qicon
))
4510 x_iconify_frame (f
);
4511 else if (! NILP (visibility
))
4512 x_make_frame_visible (f
);
4514 /* Must have been Qnil. */
4520 /* Make sure windows on this frame appear in calls to next-window
4521 and similar functions. */
4522 Vwindow_list
= Qnil
;
4524 return unbind_to (count
, frame
);
4528 /* FRAME is used only to get a handle on the X display. We don't pass the
4529 display info directly because we're called from frame.c, which doesn't
4530 know about that structure. */
4533 x_get_focus_frame (frame
)
4534 struct frame
*frame
;
4536 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4538 if (! dpyinfo
->x_focus_frame
)
4541 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4546 /* In certain situations, when the window manager follows a
4547 click-to-focus policy, there seems to be no way around calling
4548 XSetInputFocus to give another frame the input focus .
4550 In an ideal world, XSetInputFocus should generally be avoided so
4551 that applications don't interfere with the window manager's focus
4552 policy. But I think it's okay to use when it's clearly done
4553 following a user-command. */
4555 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4556 doc
: /* Set the input focus to FRAME.
4557 FRAME nil means use the selected frame. */)
4561 struct frame
*f
= check_x_frame (frame
);
4562 Display
*dpy
= FRAME_X_DISPLAY (f
);
4566 count
= x_catch_errors (dpy
);
4567 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4568 RevertToParent
, CurrentTime
);
4569 x_uncatch_errors (dpy
, count
);
4576 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4577 doc
: /* Internal function called by `color-defined-p', which see. */)
4579 Lisp_Object color
, frame
;
4582 FRAME_PTR f
= check_x_frame (frame
);
4584 CHECK_STRING (color
, 1);
4586 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4592 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4593 doc
: /* Internal function called by `color-values', which see. */)
4595 Lisp_Object color
, frame
;
4598 FRAME_PTR f
= check_x_frame (frame
);
4600 CHECK_STRING (color
, 1);
4602 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4606 rgb
[0] = make_number (foo
.red
);
4607 rgb
[1] = make_number (foo
.green
);
4608 rgb
[2] = make_number (foo
.blue
);
4609 return Flist (3, rgb
);
4615 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4616 doc
: /* Internal function called by `display-color-p', which see. */)
4618 Lisp_Object display
;
4620 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4622 if (dpyinfo
->n_planes
<= 2)
4625 switch (dpyinfo
->visual
->class)
4638 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4640 doc
: /* Return t if the X display supports shades of gray.
4641 Note that color displays do support shades of gray.
4642 The optional argument DISPLAY specifies which display to ask about.
4643 DISPLAY should be either a frame or a display name (a string).
4644 If omitted or nil, that stands for the selected frame's display. */)
4646 Lisp_Object display
;
4648 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4650 if (dpyinfo
->n_planes
<= 1)
4653 switch (dpyinfo
->visual
->class)
4668 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4670 doc
: /* Returns the width in pixels of the X display DISPLAY.
4671 The optional argument DISPLAY specifies which display to ask about.
4672 DISPLAY should be either a frame or a display name (a string).
4673 If omitted or nil, that stands for the selected frame's display. */)
4675 Lisp_Object display
;
4677 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4679 return make_number (dpyinfo
->width
);
4682 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4683 Sx_display_pixel_height
, 0, 1, 0,
4684 doc
: /* Returns the height in pixels of the X display DISPLAY.
4685 The optional argument DISPLAY specifies which display to ask about.
4686 DISPLAY should be either a frame or a display name (a string).
4687 If omitted or nil, that stands for the selected frame's display. */)
4689 Lisp_Object display
;
4691 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4693 return make_number (dpyinfo
->height
);
4696 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4698 doc
: /* Returns the number of bitplanes of the X display DISPLAY.
4699 The optional argument DISPLAY specifies which display to ask about.
4700 DISPLAY should be either a frame or a display name (a string).
4701 If omitted or nil, that stands for the selected frame's display. */)
4703 Lisp_Object display
;
4705 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4707 return make_number (dpyinfo
->n_planes
);
4710 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4712 doc
: /* Returns the number of color cells of the X display DISPLAY.
4713 The optional argument DISPLAY specifies which display to ask about.
4714 DISPLAY should be either a frame or a display name (a string).
4715 If omitted or nil, that stands for the selected frame's display. */)
4717 Lisp_Object display
;
4719 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4721 return make_number (DisplayCells (dpyinfo
->display
,
4722 XScreenNumberOfScreen (dpyinfo
->screen
)));
4725 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4726 Sx_server_max_request_size
,
4728 doc
: /* Returns the maximum request size of the X server of display DISPLAY.
4729 The optional argument DISPLAY specifies which display to ask about.
4730 DISPLAY should be either a frame or a display name (a string).
4731 If omitted or nil, that stands for the selected frame's display. */)
4733 Lisp_Object display
;
4735 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4737 return make_number (MAXREQUEST (dpyinfo
->display
));
4740 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4741 doc
: /* Returns the vendor ID string of the X server of display DISPLAY.
4742 The optional argument DISPLAY specifies which display to ask about.
4743 DISPLAY should be either a frame or a display name (a string).
4744 If omitted or nil, that stands for the selected frame's display. */)
4746 Lisp_Object display
;
4748 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4749 char *vendor
= ServerVendor (dpyinfo
->display
);
4751 if (! vendor
) vendor
= "";
4752 return build_string (vendor
);
4755 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4756 doc
: /* Returns the version numbers of the X server of display DISPLAY.
4757 The value is a list of three integers: the major and minor
4758 version numbers of the X Protocol in use, and the vendor-specific release
4759 number. See also the function `x-server-vendor'.
4761 The optional argument DISPLAY specifies which display to ask about.
4762 DISPLAY should be either a frame or a display name (a string).
4763 If omitted or nil, that stands for the selected frame's display. */)
4765 Lisp_Object display
;
4767 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4768 Display
*dpy
= dpyinfo
->display
;
4770 return Fcons (make_number (ProtocolVersion (dpy
)),
4771 Fcons (make_number (ProtocolRevision (dpy
)),
4772 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4775 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4776 doc
: /* Return the number of screens on the X server of display DISPLAY.
4777 The optional argument DISPLAY specifies which display to ask about.
4778 DISPLAY should be either a frame or a display name (a string).
4779 If omitted or nil, that stands for the selected frame's display. */)
4781 Lisp_Object display
;
4783 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4785 return make_number (ScreenCount (dpyinfo
->display
));
4788 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4789 doc
: /* Return the height in millimeters of the X display DISPLAY.
4790 The optional argument DISPLAY specifies which display to ask about.
4791 DISPLAY should be either a frame or a display name (a string).
4792 If omitted or nil, that stands for the selected frame's display. */)
4794 Lisp_Object display
;
4796 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4798 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4801 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4802 doc
: /* Return the width in millimeters of the X display DISPLAY.
4803 The optional argument DISPLAY specifies which display to ask about.
4804 DISPLAY should be either a frame or a display name (a string).
4805 If omitted or nil, that stands for the selected frame's display. */)
4807 Lisp_Object display
;
4809 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4811 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4814 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4815 Sx_display_backing_store
, 0, 1, 0,
4816 doc
: /* Returns an indication of whether X display DISPLAY does backing store.
4817 The value may be `always', `when-mapped', or `not-useful'.
4818 The optional argument DISPLAY specifies which display to ask about.
4819 DISPLAY should be either a frame or a display name (a string).
4820 If omitted or nil, that stands for the selected frame's display. */)
4822 Lisp_Object display
;
4824 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4827 switch (DoesBackingStore (dpyinfo
->screen
))
4830 result
= intern ("always");
4834 result
= intern ("when-mapped");
4838 result
= intern ("not-useful");
4842 error ("Strange value for BackingStore parameter of screen");
4849 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4850 Sx_display_visual_class
, 0, 1, 0,
4851 doc
: /* Return the visual class of the X display DISPLAY.
4852 The value is one of the symbols `static-gray', `gray-scale',
4853 `static-color', `pseudo-color', `true-color', or `direct-color'.
4855 The optional argument DISPLAY specifies which display to ask about.
4856 DISPLAY should be either a frame or a display name (a string).
4857 If omitted or nil, that stands for the selected frame's display. */)
4859 Lisp_Object display
;
4861 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4864 switch (dpyinfo
->visual
->class)
4867 result
= intern ("static-gray");
4870 result
= intern ("gray-scale");
4873 result
= intern ("static-color");
4876 result
= intern ("pseudo-color");
4879 result
= intern ("true-color");
4882 result
= intern ("direct-color");
4885 error ("Display has an unknown visual class");
4892 DEFUN ("x-display-save-under", Fx_display_save_under
,
4893 Sx_display_save_under
, 0, 1, 0,
4894 doc
: /* Returns t if the X display DISPLAY supports the save-under feature.
4895 The optional argument DISPLAY specifies which display to ask about.
4896 DISPLAY should be either a frame or a display name (a string).
4897 If omitted or nil, that stands for the selected frame's display. */)
4899 Lisp_Object display
;
4901 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4903 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4911 register struct frame
*f
;
4913 return PIXEL_WIDTH (f
);
4918 register struct frame
*f
;
4920 return PIXEL_HEIGHT (f
);
4925 register struct frame
*f
;
4927 return FONT_WIDTH (f
->output_data
.x
->font
);
4932 register struct frame
*f
;
4934 return f
->output_data
.x
->line_height
;
4939 register struct frame
*f
;
4941 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4946 /************************************************************************
4948 ************************************************************************/
4951 /* Mapping visual names to visuals. */
4953 static struct visual_class
4960 {"StaticGray", StaticGray
},
4961 {"GrayScale", GrayScale
},
4962 {"StaticColor", StaticColor
},
4963 {"PseudoColor", PseudoColor
},
4964 {"TrueColor", TrueColor
},
4965 {"DirectColor", DirectColor
},
4970 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4972 /* Value is the screen number of screen SCR. This is a substitute for
4973 the X function with the same name when that doesn't exist. */
4976 XScreenNumberOfScreen (scr
)
4977 register Screen
*scr
;
4979 Display
*dpy
= scr
->display
;
4982 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4983 if (scr
== dpy
->screens
[i
])
4989 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4992 /* Select the visual that should be used on display DPYINFO. Set
4993 members of DPYINFO appropriately. Called from x_term_init. */
4996 select_visual (dpyinfo
)
4997 struct x_display_info
*dpyinfo
;
4999 Display
*dpy
= dpyinfo
->display
;
5000 Screen
*screen
= dpyinfo
->screen
;
5003 /* See if a visual is specified. */
5004 value
= display_x_get_resource (dpyinfo
,
5005 build_string ("visualClass"),
5006 build_string ("VisualClass"),
5008 if (STRINGP (value
))
5010 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
5011 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
5012 depth, a decimal number. NAME is compared with case ignored. */
5013 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
5018 strcpy (s
, XSTRING (value
)->data
);
5019 dash
= index (s
, '-');
5022 dpyinfo
->n_planes
= atoi (dash
+ 1);
5026 /* We won't find a matching visual with depth 0, so that
5027 an error will be printed below. */
5028 dpyinfo
->n_planes
= 0;
5030 /* Determine the visual class. */
5031 for (i
= 0; visual_classes
[i
].name
; ++i
)
5032 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
5034 class = visual_classes
[i
].class;
5038 /* Look up a matching visual for the specified class. */
5040 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
5041 dpyinfo
->n_planes
, class, &vinfo
))
5042 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
5044 dpyinfo
->visual
= vinfo
.visual
;
5049 XVisualInfo
*vinfo
, vinfo_template
;
5051 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
5054 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
5056 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
5058 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5059 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
5060 &vinfo_template
, &n_visuals
);
5062 fatal ("Can't get proper X visual info");
5064 dpyinfo
->n_planes
= vinfo
->depth
;
5065 XFree ((char *) vinfo
);
5070 /* Return the X display structure for the display named NAME.
5071 Open a new connection if necessary. */
5073 struct x_display_info
*
5074 x_display_info_for_name (name
)
5078 struct x_display_info
*dpyinfo
;
5080 CHECK_STRING (name
, 0);
5082 if (! EQ (Vwindow_system
, intern ("x")))
5083 error ("Not using X Windows");
5085 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5087 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5090 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5095 /* Use this general default value to start with. */
5096 Vx_resource_name
= Vinvocation_name
;
5098 validate_x_resource_name ();
5100 dpyinfo
= x_term_init (name
, (char *)0,
5101 (char *) XSTRING (Vx_resource_name
)->data
);
5104 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5107 XSETFASTINT (Vwindow_system_version
, 11);
5113 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5115 doc
: /* Open a connection to an X server.
5116 DISPLAY is the name of the display to connect to.
5117 Optional second arg XRM-STRING is a string of resources in xrdb format.
5118 If the optional third arg MUST-SUCCEED is non-nil,
5119 terminate Emacs if we can't open the connection. */)
5120 (display
, xrm_string
, must_succeed
)
5121 Lisp_Object display
, xrm_string
, must_succeed
;
5123 unsigned char *xrm_option
;
5124 struct x_display_info
*dpyinfo
;
5126 CHECK_STRING (display
, 0);
5127 if (! NILP (xrm_string
))
5128 CHECK_STRING (xrm_string
, 1);
5130 if (! EQ (Vwindow_system
, intern ("x")))
5131 error ("Not using X Windows");
5133 if (! NILP (xrm_string
))
5134 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5136 xrm_option
= (unsigned char *) 0;
5138 validate_x_resource_name ();
5140 /* This is what opens the connection and sets x_current_display.
5141 This also initializes many symbols, such as those used for input. */
5142 dpyinfo
= x_term_init (display
, xrm_option
,
5143 (char *) XSTRING (Vx_resource_name
)->data
);
5147 if (!NILP (must_succeed
))
5148 fatal ("Cannot connect to X server %s.\n\
5149 Check the DISPLAY environment variable or use `-d'.\n\
5150 Also use the `xhost' program to verify that it is set to permit\n\
5151 connections from your machine.\n",
5152 XSTRING (display
)->data
);
5154 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5159 XSETFASTINT (Vwindow_system_version
, 11);
5163 DEFUN ("x-close-connection", Fx_close_connection
,
5164 Sx_close_connection
, 1, 1, 0,
5165 doc
: /* Close the connection to DISPLAY's X server.
5166 For DISPLAY, specify either a frame or a display name (a string).
5167 If DISPLAY is nil, that stands for the selected frame's display. */)
5169 Lisp_Object display
;
5171 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5174 if (dpyinfo
->reference_count
> 0)
5175 error ("Display still has frames on it");
5178 /* Free the fonts in the font table. */
5179 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5180 if (dpyinfo
->font_table
[i
].name
)
5182 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5183 xfree (dpyinfo
->font_table
[i
].full_name
);
5184 xfree (dpyinfo
->font_table
[i
].name
);
5185 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5188 x_destroy_all_bitmaps (dpyinfo
);
5189 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5191 #ifdef USE_X_TOOLKIT
5192 XtCloseDisplay (dpyinfo
->display
);
5194 XCloseDisplay (dpyinfo
->display
);
5197 x_delete_display (dpyinfo
);
5203 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5204 doc
: /* Return the list of display names that Emacs has connections to. */)
5207 Lisp_Object tail
, result
;
5210 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5211 result
= Fcons (XCAR (XCAR (tail
)), result
);
5216 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5217 doc
: /* If ON is non-nil, report X errors as soon as the erring request is made.
5218 If ON is nil, allow buffering of requests.
5219 Turning on synchronization prohibits the Xlib routines from buffering
5220 requests and seriously degrades performance, but makes debugging much
5222 The optional second argument DISPLAY specifies which display to act on.
5223 DISPLAY should be either a frame or a display name (a string).
5224 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
5226 Lisp_Object display
, on
;
5228 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5230 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5235 /* Wait for responses to all X commands issued so far for frame F. */
5242 XSync (FRAME_X_DISPLAY (f
), False
);
5247 /***********************************************************************
5249 ***********************************************************************/
5251 /* Value is the number of elements of vector VECTOR. */
5253 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5255 /* List of supported image types. Use define_image_type to add new
5256 types. Use lookup_image_type to find a type for a given symbol. */
5258 static struct image_type
*image_types
;
5260 /* The symbol `image' which is the car of the lists used to represent
5263 extern Lisp_Object Qimage
;
5265 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5271 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5272 extern Lisp_Object QCdata
;
5273 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5274 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5275 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5277 /* Other symbols. */
5279 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5281 /* Time in seconds after which images should be removed from the cache
5282 if not displayed. */
5284 Lisp_Object Vimage_cache_eviction_delay
;
5286 /* Function prototypes. */
5288 static void define_image_type
P_ ((struct image_type
*type
));
5289 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5290 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5291 static void x_laplace
P_ ((struct frame
*, struct image
*));
5292 static void x_emboss
P_ ((struct frame
*, struct image
*));
5293 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5297 /* Define a new image type from TYPE. This adds a copy of TYPE to
5298 image_types and adds the symbol *TYPE->type to Vimage_types. */
5301 define_image_type (type
)
5302 struct image_type
*type
;
5304 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5305 The initialized data segment is read-only. */
5306 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5307 bcopy (type
, p
, sizeof *p
);
5308 p
->next
= image_types
;
5310 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5314 /* Look up image type SYMBOL, and return a pointer to its image_type
5315 structure. Value is null if SYMBOL is not a known image type. */
5317 static INLINE
struct image_type
*
5318 lookup_image_type (symbol
)
5321 struct image_type
*type
;
5323 for (type
= image_types
; type
; type
= type
->next
)
5324 if (EQ (symbol
, *type
->type
))
5331 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5332 valid image specification is a list whose car is the symbol
5333 `image', and whose rest is a property list. The property list must
5334 contain a value for key `:type'. That value must be the name of a
5335 supported image type. The rest of the property list depends on the
5339 valid_image_p (object
)
5344 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5348 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
5349 if (EQ (XCAR (tem
), QCtype
))
5352 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
5354 struct image_type
*type
;
5355 type
= lookup_image_type (XCAR (tem
));
5357 valid_p
= type
->valid_p (object
);
5368 /* Log error message with format string FORMAT and argument ARG.
5369 Signaling an error, e.g. when an image cannot be loaded, is not a
5370 good idea because this would interrupt redisplay, and the error
5371 message display would lead to another redisplay. This function
5372 therefore simply displays a message. */
5375 image_error (format
, arg1
, arg2
)
5377 Lisp_Object arg1
, arg2
;
5379 add_to_log (format
, arg1
, arg2
);
5384 /***********************************************************************
5385 Image specifications
5386 ***********************************************************************/
5388 enum image_value_type
5390 IMAGE_DONT_CHECK_VALUE_TYPE
,
5392 IMAGE_STRING_OR_NIL_VALUE
,
5394 IMAGE_POSITIVE_INTEGER_VALUE
,
5395 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5396 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5398 IMAGE_INTEGER_VALUE
,
5399 IMAGE_FUNCTION_VALUE
,
5404 /* Structure used when parsing image specifications. */
5406 struct image_keyword
5408 /* Name of keyword. */
5411 /* The type of value allowed. */
5412 enum image_value_type type
;
5414 /* Non-zero means key must be present. */
5417 /* Used to recognize duplicate keywords in a property list. */
5420 /* The value that was found. */
5425 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5427 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5430 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5431 has the format (image KEYWORD VALUE ...). One of the keyword/
5432 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5433 image_keywords structures of size NKEYWORDS describing other
5434 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5437 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5439 struct image_keyword
*keywords
;
5446 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5449 plist
= XCDR (spec
);
5450 while (CONSP (plist
))
5452 Lisp_Object key
, value
;
5454 /* First element of a pair must be a symbol. */
5456 plist
= XCDR (plist
);
5460 /* There must follow a value. */
5463 value
= XCAR (plist
);
5464 plist
= XCDR (plist
);
5466 /* Find key in KEYWORDS. Error if not found. */
5467 for (i
= 0; i
< nkeywords
; ++i
)
5468 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5474 /* Record that we recognized the keyword. If a keywords
5475 was found more than once, it's an error. */
5476 keywords
[i
].value
= value
;
5477 ++keywords
[i
].count
;
5479 if (keywords
[i
].count
> 1)
5482 /* Check type of value against allowed type. */
5483 switch (keywords
[i
].type
)
5485 case IMAGE_STRING_VALUE
:
5486 if (!STRINGP (value
))
5490 case IMAGE_STRING_OR_NIL_VALUE
:
5491 if (!STRINGP (value
) && !NILP (value
))
5495 case IMAGE_SYMBOL_VALUE
:
5496 if (!SYMBOLP (value
))
5500 case IMAGE_POSITIVE_INTEGER_VALUE
:
5501 if (!INTEGERP (value
) || XINT (value
) <= 0)
5505 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5506 if (INTEGERP (value
) && XINT (value
) >= 0)
5509 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5510 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5514 case IMAGE_ASCENT_VALUE
:
5515 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5517 else if (INTEGERP (value
)
5518 && XINT (value
) >= 0
5519 && XINT (value
) <= 100)
5523 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5524 if (!INTEGERP (value
) || XINT (value
) < 0)
5528 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5531 case IMAGE_FUNCTION_VALUE
:
5532 value
= indirect_function (value
);
5534 || COMPILEDP (value
)
5535 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5539 case IMAGE_NUMBER_VALUE
:
5540 if (!INTEGERP (value
) && !FLOATP (value
))
5544 case IMAGE_INTEGER_VALUE
:
5545 if (!INTEGERP (value
))
5549 case IMAGE_BOOL_VALUE
:
5550 if (!NILP (value
) && !EQ (value
, Qt
))
5559 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5563 /* Check that all mandatory fields are present. */
5564 for (i
= 0; i
< nkeywords
; ++i
)
5565 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5568 return NILP (plist
);
5572 /* Return the value of KEY in image specification SPEC. Value is nil
5573 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5574 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5577 image_spec_value (spec
, key
, found
)
5578 Lisp_Object spec
, key
;
5583 xassert (valid_image_p (spec
));
5585 for (tail
= XCDR (spec
);
5586 CONSP (tail
) && CONSP (XCDR (tail
));
5587 tail
= XCDR (XCDR (tail
)))
5589 if (EQ (XCAR (tail
), key
))
5593 return XCAR (XCDR (tail
));
5603 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5604 doc
: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
5605 PIXELS non-nil means return the size in pixels, otherwise return the
5606 size in canonical character units.
5607 FRAME is the frame on which the image will be displayed. FRAME nil
5608 or omitted means use the selected frame. */)
5609 (spec
, pixels
, frame
)
5610 Lisp_Object spec
, pixels
, frame
;
5615 if (valid_image_p (spec
))
5617 struct frame
*f
= check_x_frame (frame
);
5618 int id
= lookup_image (f
, spec
);
5619 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5620 int width
= img
->width
+ 2 * img
->hmargin
;
5621 int height
= img
->height
+ 2 * img
->vmargin
;
5624 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5625 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5627 size
= Fcons (make_number (width
), make_number (height
));
5630 error ("Invalid image specification");
5636 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5637 doc
: /* Return t if image SPEC has a mask bitmap.
5638 FRAME is the frame on which the image will be displayed. FRAME nil
5639 or omitted means use the selected frame. */)
5641 Lisp_Object spec
, frame
;
5646 if (valid_image_p (spec
))
5648 struct frame
*f
= check_x_frame (frame
);
5649 int id
= lookup_image (f
, spec
);
5650 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5655 error ("Invalid image specification");
5662 /***********************************************************************
5663 Image type independent image structures
5664 ***********************************************************************/
5666 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5667 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5670 /* Allocate and return a new image structure for image specification
5671 SPEC. SPEC has a hash value of HASH. */
5673 static struct image
*
5674 make_image (spec
, hash
)
5678 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5680 xassert (valid_image_p (spec
));
5681 bzero (img
, sizeof *img
);
5682 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5683 xassert (img
->type
!= NULL
);
5685 img
->data
.lisp_val
= Qnil
;
5686 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5692 /* Free image IMG which was used on frame F, including its resources. */
5701 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5703 /* Remove IMG from the hash table of its cache. */
5705 img
->prev
->next
= img
->next
;
5707 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5710 img
->next
->prev
= img
->prev
;
5712 c
->images
[img
->id
] = NULL
;
5714 /* Free resources, then free IMG. */
5715 img
->type
->free (f
, img
);
5721 /* Prepare image IMG for display on frame F. Must be called before
5722 drawing an image. */
5725 prepare_image_for_display (f
, img
)
5731 /* We're about to display IMG, so set its timestamp to `now'. */
5733 img
->timestamp
= EMACS_SECS (t
);
5735 /* If IMG doesn't have a pixmap yet, load it now, using the image
5736 type dependent loader function. */
5737 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5738 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5742 /* Value is the number of pixels for the ascent of image IMG when
5743 drawn in face FACE. */
5746 image_ascent (img
, face
)
5750 int height
= img
->height
+ img
->vmargin
;
5753 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5756 /* This expression is arranged so that if the image can't be
5757 exactly centered, it will be moved slightly up. This is
5758 because a typical font is `top-heavy' (due to the presence
5759 uppercase letters), so the image placement should err towards
5760 being top-heavy too. It also just generally looks better. */
5761 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5763 ascent
= height
/ 2;
5766 ascent
= height
* img
->ascent
/ 100.0;
5773 /***********************************************************************
5774 Helper functions for X image types
5775 ***********************************************************************/
5777 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5779 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5780 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5782 Lisp_Object color_name
,
5783 unsigned long dflt
));
5786 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5787 free the pixmap if any. MASK_P non-zero means clear the mask
5788 pixmap if any. COLORS_P non-zero means free colors allocated for
5789 the image, if any. */
5792 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5795 int pixmap_p
, mask_p
, colors_p
;
5797 if (pixmap_p
&& img
->pixmap
)
5799 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5803 if (mask_p
&& img
->mask
)
5805 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5809 if (colors_p
&& img
->ncolors
)
5811 x_free_colors (f
, img
->colors
, img
->ncolors
);
5812 xfree (img
->colors
);
5818 /* Free X resources of image IMG which is used on frame F. */
5821 x_clear_image (f
, img
)
5826 x_clear_image_1 (f
, img
, 1, 1, 1);
5831 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5832 cannot be allocated, use DFLT. Add a newly allocated color to
5833 IMG->colors, so that it can be freed again. Value is the pixel
5836 static unsigned long
5837 x_alloc_image_color (f
, img
, color_name
, dflt
)
5840 Lisp_Object color_name
;
5844 unsigned long result
;
5846 xassert (STRINGP (color_name
));
5848 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5850 /* This isn't called frequently so we get away with simply
5851 reallocating the color vector to the needed size, here. */
5854 (unsigned long *) xrealloc (img
->colors
,
5855 img
->ncolors
* sizeof *img
->colors
);
5856 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5857 result
= color
.pixel
;
5867 /***********************************************************************
5869 ***********************************************************************/
5871 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5872 static void postprocess_image
P_ ((struct frame
*, struct image
*));
5875 /* Return a new, initialized image cache that is allocated from the
5876 heap. Call free_image_cache to free an image cache. */
5878 struct image_cache
*
5881 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5884 bzero (c
, sizeof *c
);
5886 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5887 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5888 c
->buckets
= (struct image
**) xmalloc (size
);
5889 bzero (c
->buckets
, size
);
5894 /* Free image cache of frame F. Be aware that X frames share images
5898 free_image_cache (f
)
5901 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5906 /* Cache should not be referenced by any frame when freed. */
5907 xassert (c
->refcount
== 0);
5909 for (i
= 0; i
< c
->used
; ++i
)
5910 free_image (f
, c
->images
[i
]);
5914 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5919 /* Clear image cache of frame F. FORCE_P non-zero means free all
5920 images. FORCE_P zero means clear only images that haven't been
5921 displayed for some time. Should be called from time to time to
5922 reduce the number of loaded images. If image-eviction-seconds is
5923 non-nil, this frees images in the cache which weren't displayed for
5924 at least that many seconds. */
5927 clear_image_cache (f
, force_p
)
5931 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5933 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5940 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5942 /* Block input so that we won't be interrupted by a SIGIO
5943 while being in an inconsistent state. */
5946 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5948 struct image
*img
= c
->images
[i
];
5950 && (force_p
|| img
->timestamp
< old
))
5952 free_image (f
, img
);
5957 /* We may be clearing the image cache because, for example,
5958 Emacs was iconified for a longer period of time. In that
5959 case, current matrices may still contain references to
5960 images freed above. So, clear these matrices. */
5963 Lisp_Object tail
, frame
;
5965 FOR_EACH_FRAME (tail
, frame
)
5967 struct frame
*f
= XFRAME (frame
);
5969 && FRAME_X_IMAGE_CACHE (f
) == c
)
5970 clear_current_matrices (f
);
5973 ++windows_or_buffers_changed
;
5981 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5983 doc
: /* Clear the image cache of FRAME.
5984 FRAME nil or omitted means use the selected frame.
5985 FRAME t means clear the image caches of all frames. */)
5993 FOR_EACH_FRAME (tail
, frame
)
5994 if (FRAME_X_P (XFRAME (frame
)))
5995 clear_image_cache (XFRAME (frame
), 1);
5998 clear_image_cache (check_x_frame (frame
), 1);
6004 /* Compute masks and transform image IMG on frame F, as specified
6005 by the image's specification, */
6008 postprocess_image (f
, img
)
6012 /* Manipulation of the image's mask. */
6015 Lisp_Object conversion
, spec
;
6020 /* `:heuristic-mask t'
6022 means build a mask heuristically.
6023 `:heuristic-mask (R G B)'
6024 `:mask (heuristic (R G B))'
6025 means build a mask from color (R G B) in the
6028 means remove a mask, if any. */
6030 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6032 x_build_heuristic_mask (f
, img
, mask
);
6037 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6039 if (EQ (mask
, Qheuristic
))
6040 x_build_heuristic_mask (f
, img
, Qt
);
6041 else if (CONSP (mask
)
6042 && EQ (XCAR (mask
), Qheuristic
))
6044 if (CONSP (XCDR (mask
)))
6045 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6047 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6049 else if (NILP (mask
) && found_p
&& img
->mask
)
6051 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6057 /* Should we apply an image transformation algorithm? */
6058 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6059 if (EQ (conversion
, Qdisabled
))
6060 x_disable_image (f
, img
);
6061 else if (EQ (conversion
, Qlaplace
))
6063 else if (EQ (conversion
, Qemboss
))
6065 else if (CONSP (conversion
)
6066 && EQ (XCAR (conversion
), Qedge_detection
))
6069 tem
= XCDR (conversion
);
6071 x_edge_detection (f
, img
,
6072 Fplist_get (tem
, QCmatrix
),
6073 Fplist_get (tem
, QCcolor_adjustment
));
6079 /* Return the id of image with Lisp specification SPEC on frame F.
6080 SPEC must be a valid Lisp image specification (see valid_image_p). */
6083 lookup_image (f
, spec
)
6087 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6091 struct gcpro gcpro1
;
6094 /* F must be a window-system frame, and SPEC must be a valid image
6096 xassert (FRAME_WINDOW_P (f
));
6097 xassert (valid_image_p (spec
));
6101 /* Look up SPEC in the hash table of the image cache. */
6102 hash
= sxhash (spec
, 0);
6103 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6105 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6106 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6109 /* If not found, create a new image and cache it. */
6112 extern Lisp_Object Qpostscript
;
6115 img
= make_image (spec
, hash
);
6116 cache_image (f
, img
);
6117 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6119 /* If we can't load the image, and we don't have a width and
6120 height, use some arbitrary width and height so that we can
6121 draw a rectangle for it. */
6122 if (img
->load_failed_p
)
6126 value
= image_spec_value (spec
, QCwidth
, NULL
);
6127 img
->width
= (INTEGERP (value
)
6128 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6129 value
= image_spec_value (spec
, QCheight
, NULL
);
6130 img
->height
= (INTEGERP (value
)
6131 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6135 /* Handle image type independent image attributes
6136 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
6137 Lisp_Object ascent
, margin
, relief
;
6139 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6140 if (INTEGERP (ascent
))
6141 img
->ascent
= XFASTINT (ascent
);
6142 else if (EQ (ascent
, Qcenter
))
6143 img
->ascent
= CENTERED_IMAGE_ASCENT
;
6145 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6146 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6147 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
6148 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
6149 && INTEGERP (XCDR (margin
)))
6151 if (XINT (XCAR (margin
)) > 0)
6152 img
->hmargin
= XFASTINT (XCAR (margin
));
6153 if (XINT (XCDR (margin
)) > 0)
6154 img
->vmargin
= XFASTINT (XCDR (margin
));
6157 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6158 if (INTEGERP (relief
))
6160 img
->relief
= XINT (relief
);
6161 img
->hmargin
+= abs (img
->relief
);
6162 img
->vmargin
+= abs (img
->relief
);
6165 /* Do image transformations and compute masks, unless we
6166 don't have the image yet. */
6167 if (!EQ (*img
->type
->type
, Qpostscript
))
6168 postprocess_image (f
, img
);
6172 xassert (!interrupt_input_blocked
);
6175 /* We're using IMG, so set its timestamp to `now'. */
6176 EMACS_GET_TIME (now
);
6177 img
->timestamp
= EMACS_SECS (now
);
6181 /* Value is the image id. */
6186 /* Cache image IMG in the image cache of frame F. */
6189 cache_image (f
, img
)
6193 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6196 /* Find a free slot in c->images. */
6197 for (i
= 0; i
< c
->used
; ++i
)
6198 if (c
->images
[i
] == NULL
)
6201 /* If no free slot found, maybe enlarge c->images. */
6202 if (i
== c
->used
&& c
->used
== c
->size
)
6205 c
->images
= (struct image
**) xrealloc (c
->images
,
6206 c
->size
* sizeof *c
->images
);
6209 /* Add IMG to c->images, and assign IMG an id. */
6215 /* Add IMG to the cache's hash table. */
6216 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6217 img
->next
= c
->buckets
[i
];
6219 img
->next
->prev
= img
;
6221 c
->buckets
[i
] = img
;
6225 /* Call FN on every image in the image cache of frame F. Used to mark
6226 Lisp Objects in the image cache. */
6229 forall_images_in_image_cache (f
, fn
)
6231 void (*fn
) P_ ((struct image
*img
));
6233 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6235 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6239 for (i
= 0; i
< c
->used
; ++i
)
6248 /***********************************************************************
6250 ***********************************************************************/
6252 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6253 XImage
**, Pixmap
*));
6254 static void x_destroy_x_image
P_ ((XImage
*));
6255 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6258 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6259 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6260 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6261 via xmalloc. Print error messages via image_error if an error
6262 occurs. Value is non-zero if successful. */
6265 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6267 int width
, height
, depth
;
6271 Display
*display
= FRAME_X_DISPLAY (f
);
6272 Screen
*screen
= FRAME_X_SCREEN (f
);
6273 Window window
= FRAME_X_WINDOW (f
);
6275 xassert (interrupt_input_blocked
);
6278 depth
= DefaultDepthOfScreen (screen
);
6279 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6280 depth
, ZPixmap
, 0, NULL
, width
, height
,
6281 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6284 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6288 /* Allocate image raster. */
6289 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6291 /* Allocate a pixmap of the same size. */
6292 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6293 if (*pixmap
== None
)
6295 x_destroy_x_image (*ximg
);
6297 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6305 /* Destroy XImage XIMG. Free XIMG->data. */
6308 x_destroy_x_image (ximg
)
6311 xassert (interrupt_input_blocked
);
6316 XDestroyImage (ximg
);
6321 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6322 are width and height of both the image and pixmap. */
6325 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6332 xassert (interrupt_input_blocked
);
6333 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6334 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6335 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6340 /***********************************************************************
6342 ***********************************************************************/
6344 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6345 static char *slurp_file
P_ ((char *, int *));
6348 /* Find image file FILE. Look in data-directory, then
6349 x-bitmap-file-path. Value is the full name of the file found, or
6350 nil if not found. */
6353 x_find_image_file (file
)
6356 Lisp_Object file_found
, search_path
;
6357 struct gcpro gcpro1
, gcpro2
;
6361 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6362 GCPRO2 (file_found
, search_path
);
6364 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6365 fd
= openp (search_path
, file
, Qnil
, &file_found
, 0);
6377 /* Read FILE into memory. Value is a pointer to a buffer allocated
6378 with xmalloc holding FILE's contents. Value is null if an error
6379 occurred. *SIZE is set to the size of the file. */
6382 slurp_file (file
, size
)
6390 if (stat (file
, &st
) == 0
6391 && (fp
= fopen (file
, "r")) != NULL
6392 && (buf
= (char *) xmalloc (st
.st_size
),
6393 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6414 /***********************************************************************
6416 ***********************************************************************/
6418 static int xbm_scan
P_ ((char **, char *, char *, int *));
6419 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6420 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6422 static int xbm_image_p
P_ ((Lisp_Object object
));
6423 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6425 static int xbm_file_p
P_ ((Lisp_Object
));
6428 /* Indices of image specification fields in xbm_format, below. */
6430 enum xbm_keyword_index
6448 /* Vector of image_keyword structures describing the format
6449 of valid XBM image specifications. */
6451 static struct image_keyword xbm_format
[XBM_LAST
] =
6453 {":type", IMAGE_SYMBOL_VALUE
, 1},
6454 {":file", IMAGE_STRING_VALUE
, 0},
6455 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6456 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6457 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6458 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
6459 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
6460 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6461 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6462 {":relief", IMAGE_INTEGER_VALUE
, 0},
6463 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6464 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6465 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6468 /* Structure describing the image type XBM. */
6470 static struct image_type xbm_type
=
6479 /* Tokens returned from xbm_scan. */
6488 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6489 A valid specification is a list starting with the symbol `image'
6490 The rest of the list is a property list which must contain an
6493 If the specification specifies a file to load, it must contain
6494 an entry `:file FILENAME' where FILENAME is a string.
6496 If the specification is for a bitmap loaded from memory it must
6497 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6498 WIDTH and HEIGHT are integers > 0. DATA may be:
6500 1. a string large enough to hold the bitmap data, i.e. it must
6501 have a size >= (WIDTH + 7) / 8 * HEIGHT
6503 2. a bool-vector of size >= WIDTH * HEIGHT
6505 3. a vector of strings or bool-vectors, one for each line of the
6508 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6509 may not be specified in this case because they are defined in the
6512 Both the file and data forms may contain the additional entries
6513 `:background COLOR' and `:foreground COLOR'. If not present,
6514 foreground and background of the frame on which the image is
6515 displayed is used. */
6518 xbm_image_p (object
)
6521 struct image_keyword kw
[XBM_LAST
];
6523 bcopy (xbm_format
, kw
, sizeof kw
);
6524 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6527 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6529 if (kw
[XBM_FILE
].count
)
6531 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6534 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6536 /* In-memory XBM file. */
6537 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6545 /* Entries for `:width', `:height' and `:data' must be present. */
6546 if (!kw
[XBM_WIDTH
].count
6547 || !kw
[XBM_HEIGHT
].count
6548 || !kw
[XBM_DATA
].count
)
6551 data
= kw
[XBM_DATA
].value
;
6552 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6553 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6555 /* Check type of data, and width and height against contents of
6561 /* Number of elements of the vector must be >= height. */
6562 if (XVECTOR (data
)->size
< height
)
6565 /* Each string or bool-vector in data must be large enough
6566 for one line of the image. */
6567 for (i
= 0; i
< height
; ++i
)
6569 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6573 if (XSTRING (elt
)->size
6574 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6577 else if (BOOL_VECTOR_P (elt
))
6579 if (XBOOL_VECTOR (elt
)->size
< width
)
6586 else if (STRINGP (data
))
6588 if (XSTRING (data
)->size
6589 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6592 else if (BOOL_VECTOR_P (data
))
6594 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6605 /* Scan a bitmap file. FP is the stream to read from. Value is
6606 either an enumerator from enum xbm_token, or a character for a
6607 single-character token, or 0 at end of file. If scanning an
6608 identifier, store the lexeme of the identifier in SVAL. If
6609 scanning a number, store its value in *IVAL. */
6612 xbm_scan (s
, end
, sval
, ival
)
6621 /* Skip white space. */
6622 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6627 else if (isdigit (c
))
6629 int value
= 0, digit
;
6631 if (c
== '0' && *s
< end
)
6634 if (c
== 'x' || c
== 'X')
6641 else if (c
>= 'a' && c
<= 'f')
6642 digit
= c
- 'a' + 10;
6643 else if (c
>= 'A' && c
<= 'F')
6644 digit
= c
- 'A' + 10;
6647 value
= 16 * value
+ digit
;
6650 else if (isdigit (c
))
6654 && (c
= *(*s
)++, isdigit (c
)))
6655 value
= 8 * value
+ c
- '0';
6662 && (c
= *(*s
)++, isdigit (c
)))
6663 value
= 10 * value
+ c
- '0';
6671 else if (isalpha (c
) || c
== '_')
6675 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6682 else if (c
== '/' && **s
== '*')
6684 /* C-style comment. */
6686 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6699 /* Replacement for XReadBitmapFileData which isn't available under old
6700 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6701 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6702 the image. Return in *DATA the bitmap data allocated with xmalloc.
6703 Value is non-zero if successful. DATA null means just test if
6704 CONTENTS looks like an in-memory XBM file. */
6707 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6708 char *contents
, *end
;
6709 int *width
, *height
;
6710 unsigned char **data
;
6713 char buffer
[BUFSIZ
];
6716 int bytes_per_line
, i
, nbytes
;
6722 LA1 = xbm_scan (&s, end, buffer, &value)
6724 #define expect(TOKEN) \
6725 if (LA1 != (TOKEN)) \
6730 #define expect_ident(IDENT) \
6731 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6736 *width
= *height
= -1;
6739 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6741 /* Parse defines for width, height and hot-spots. */
6745 expect_ident ("define");
6746 expect (XBM_TK_IDENT
);
6748 if (LA1
== XBM_TK_NUMBER
);
6750 char *p
= strrchr (buffer
, '_');
6751 p
= p
? p
+ 1 : buffer
;
6752 if (strcmp (p
, "width") == 0)
6754 else if (strcmp (p
, "height") == 0)
6757 expect (XBM_TK_NUMBER
);
6760 if (*width
< 0 || *height
< 0)
6762 else if (data
== NULL
)
6765 /* Parse bits. Must start with `static'. */
6766 expect_ident ("static");
6767 if (LA1
== XBM_TK_IDENT
)
6769 if (strcmp (buffer
, "unsigned") == 0)
6772 expect_ident ("char");
6774 else if (strcmp (buffer
, "short") == 0)
6778 if (*width
% 16 && *width
% 16 < 9)
6781 else if (strcmp (buffer
, "char") == 0)
6789 expect (XBM_TK_IDENT
);
6795 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6796 nbytes
= bytes_per_line
* *height
;
6797 p
= *data
= (char *) xmalloc (nbytes
);
6801 for (i
= 0; i
< nbytes
; i
+= 2)
6804 expect (XBM_TK_NUMBER
);
6807 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6810 if (LA1
== ',' || LA1
== '}')
6818 for (i
= 0; i
< nbytes
; ++i
)
6821 expect (XBM_TK_NUMBER
);
6825 if (LA1
== ',' || LA1
== '}')
6850 /* Load XBM image IMG which will be displayed on frame F from buffer
6851 CONTENTS. END is the end of the buffer. Value is non-zero if
6855 xbm_load_image (f
, img
, contents
, end
)
6858 char *contents
, *end
;
6861 unsigned char *data
;
6864 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6867 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6868 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6869 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6872 xassert (img
->width
> 0 && img
->height
> 0);
6874 /* Get foreground and background colors, maybe allocate colors. */
6875 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6877 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6879 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6881 background
= x_alloc_image_color (f
, img
, value
, background
);
6884 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6887 img
->width
, img
->height
,
6888 foreground
, background
,
6892 if (img
->pixmap
== None
)
6894 x_clear_image (f
, img
);
6895 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6901 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6907 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6914 return (STRINGP (data
)
6915 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6916 (XSTRING (data
)->data
6917 + STRING_BYTES (XSTRING (data
))),
6922 /* Fill image IMG which is used on frame F with pixmap data. Value is
6923 non-zero if successful. */
6931 Lisp_Object file_name
;
6933 xassert (xbm_image_p (img
->spec
));
6935 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6936 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6937 if (STRINGP (file_name
))
6942 struct gcpro gcpro1
;
6944 file
= x_find_image_file (file_name
);
6946 if (!STRINGP (file
))
6948 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6953 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6954 if (contents
== NULL
)
6956 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6961 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6966 struct image_keyword fmt
[XBM_LAST
];
6969 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6970 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6973 int in_memory_file_p
= 0;
6975 /* See if data looks like an in-memory XBM file. */
6976 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6977 in_memory_file_p
= xbm_file_p (data
);
6979 /* Parse the image specification. */
6980 bcopy (xbm_format
, fmt
, sizeof fmt
);
6981 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6984 /* Get specified width, and height. */
6985 if (!in_memory_file_p
)
6987 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6988 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6989 xassert (img
->width
> 0 && img
->height
> 0);
6992 /* Get foreground and background colors, maybe allocate colors. */
6993 if (fmt
[XBM_FOREGROUND
].count
6994 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
6995 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6997 if (fmt
[XBM_BACKGROUND
].count
6998 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
6999 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
7002 if (in_memory_file_p
)
7003 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
7004 (XSTRING (data
)->data
7005 + STRING_BYTES (XSTRING (data
))));
7012 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
7014 p
= bits
= (char *) alloca (nbytes
* img
->height
);
7015 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
7017 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
7019 bcopy (XSTRING (line
)->data
, p
, nbytes
);
7021 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
7024 else if (STRINGP (data
))
7025 bits
= XSTRING (data
)->data
;
7027 bits
= XBOOL_VECTOR (data
)->data
;
7029 /* Create the pixmap. */
7030 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7032 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7035 img
->width
, img
->height
,
7036 foreground
, background
,
7042 image_error ("Unable to create pixmap for XBM image `%s'",
7044 x_clear_image (f
, img
);
7054 /***********************************************************************
7056 ***********************************************************************/
7060 static int xpm_image_p
P_ ((Lisp_Object object
));
7061 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
7062 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
7064 #include "X11/xpm.h"
7066 /* The symbol `xpm' identifying XPM-format images. */
7070 /* Indices of image specification fields in xpm_format, below. */
7072 enum xpm_keyword_index
7087 /* Vector of image_keyword structures describing the format
7088 of valid XPM image specifications. */
7090 static struct image_keyword xpm_format
[XPM_LAST
] =
7092 {":type", IMAGE_SYMBOL_VALUE
, 1},
7093 {":file", IMAGE_STRING_VALUE
, 0},
7094 {":data", IMAGE_STRING_VALUE
, 0},
7095 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7096 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7097 {":relief", IMAGE_INTEGER_VALUE
, 0},
7098 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7099 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7100 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7101 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7104 /* Structure describing the image type XBM. */
7106 static struct image_type xpm_type
=
7116 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7117 functions for allocating image colors. Our own functions handle
7118 color allocation failures more gracefully than the ones on the XPM
7121 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7122 #define ALLOC_XPM_COLORS
7125 #ifdef ALLOC_XPM_COLORS
7127 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7128 static void xpm_free_color_cache
P_ ((void));
7129 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7130 static int xpm_color_bucket
P_ ((char *));
7131 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7134 /* An entry in a hash table used to cache color definitions of named
7135 colors. This cache is necessary to speed up XPM image loading in
7136 case we do color allocations ourselves. Without it, we would need
7137 a call to XParseColor per pixel in the image. */
7139 struct xpm_cached_color
7141 /* Next in collision chain. */
7142 struct xpm_cached_color
*next
;
7144 /* Color definition (RGB and pixel color). */
7151 /* The hash table used for the color cache, and its bucket vector
7154 #define XPM_COLOR_CACHE_BUCKETS 1001
7155 struct xpm_cached_color
**xpm_color_cache
;
7157 /* Initialize the color cache. */
7160 xpm_init_color_cache (f
, attrs
)
7162 XpmAttributes
*attrs
;
7164 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7165 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7166 memset (xpm_color_cache
, 0, nbytes
);
7167 init_color_table ();
7169 if (attrs
->valuemask
& XpmColorSymbols
)
7174 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7175 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7176 attrs
->colorsymbols
[i
].value
, &color
))
7178 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7180 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7186 /* Free the color cache. */
7189 xpm_free_color_cache ()
7191 struct xpm_cached_color
*p
, *next
;
7194 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7195 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7201 xfree (xpm_color_cache
);
7202 xpm_color_cache
= NULL
;
7203 free_color_table ();
7207 /* Return the bucket index for color named COLOR_NAME in the color
7211 xpm_color_bucket (color_name
)
7217 for (s
= color_name
; *s
; ++s
)
7219 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7223 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7224 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7227 static struct xpm_cached_color
*
7228 xpm_cache_color (f
, color_name
, color
, bucket
)
7235 struct xpm_cached_color
*p
;
7238 bucket
= xpm_color_bucket (color_name
);
7240 nbytes
= sizeof *p
+ strlen (color_name
);
7241 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7242 strcpy (p
->name
, color_name
);
7244 p
->next
= xpm_color_cache
[bucket
];
7245 xpm_color_cache
[bucket
] = p
;
7250 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7251 return the cached definition in *COLOR. Otherwise, make a new
7252 entry in the cache and allocate the color. Value is zero if color
7253 allocation failed. */
7256 xpm_lookup_color (f
, color_name
, color
)
7261 struct xpm_cached_color
*p
;
7262 int h
= xpm_color_bucket (color_name
);
7264 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7265 if (strcmp (p
->name
, color_name
) == 0)
7270 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7273 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7275 p
= xpm_cache_color (f
, color_name
, color
, h
);
7282 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7283 CLOSURE is a pointer to the frame on which we allocate the
7284 color. Return in *COLOR the allocated color. Value is non-zero
7288 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7295 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7299 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7300 is a pointer to the frame on which we allocate the color. Value is
7301 non-zero if successful. */
7304 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7314 #endif /* ALLOC_XPM_COLORS */
7317 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7318 for XPM images. Such a list must consist of conses whose car and
7322 xpm_valid_color_symbols_p (color_symbols
)
7323 Lisp_Object color_symbols
;
7325 while (CONSP (color_symbols
))
7327 Lisp_Object sym
= XCAR (color_symbols
);
7329 || !STRINGP (XCAR (sym
))
7330 || !STRINGP (XCDR (sym
)))
7332 color_symbols
= XCDR (color_symbols
);
7335 return NILP (color_symbols
);
7339 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7342 xpm_image_p (object
)
7345 struct image_keyword fmt
[XPM_LAST
];
7346 bcopy (xpm_format
, fmt
, sizeof fmt
);
7347 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7348 /* Either `:file' or `:data' must be present. */
7349 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7350 /* Either no `:color-symbols' or it's a list of conses
7351 whose car and cdr are strings. */
7352 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7353 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7357 /* Load image IMG which will be displayed on frame F. Value is
7358 non-zero if successful. */
7366 XpmAttributes attrs
;
7367 Lisp_Object specified_file
, color_symbols
;
7369 /* Configure the XPM lib. Use the visual of frame F. Allocate
7370 close colors. Return colors allocated. */
7371 bzero (&attrs
, sizeof attrs
);
7372 attrs
.visual
= FRAME_X_VISUAL (f
);
7373 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7374 attrs
.valuemask
|= XpmVisual
;
7375 attrs
.valuemask
|= XpmColormap
;
7377 #ifdef ALLOC_XPM_COLORS
7378 /* Allocate colors with our own functions which handle
7379 failing color allocation more gracefully. */
7380 attrs
.color_closure
= f
;
7381 attrs
.alloc_color
= xpm_alloc_color
;
7382 attrs
.free_colors
= xpm_free_colors
;
7383 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7384 #else /* not ALLOC_XPM_COLORS */
7385 /* Let the XPM lib allocate colors. */
7386 attrs
.valuemask
|= XpmReturnAllocPixels
;
7387 #ifdef XpmAllocCloseColors
7388 attrs
.alloc_close_colors
= 1;
7389 attrs
.valuemask
|= XpmAllocCloseColors
;
7390 #else /* not XpmAllocCloseColors */
7391 attrs
.closeness
= 600;
7392 attrs
.valuemask
|= XpmCloseness
;
7393 #endif /* not XpmAllocCloseColors */
7394 #endif /* ALLOC_XPM_COLORS */
7396 /* If image specification contains symbolic color definitions, add
7397 these to `attrs'. */
7398 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7399 if (CONSP (color_symbols
))
7402 XpmColorSymbol
*xpm_syms
;
7405 attrs
.valuemask
|= XpmColorSymbols
;
7407 /* Count number of symbols. */
7408 attrs
.numsymbols
= 0;
7409 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7412 /* Allocate an XpmColorSymbol array. */
7413 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7414 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7415 bzero (xpm_syms
, size
);
7416 attrs
.colorsymbols
= xpm_syms
;
7418 /* Fill the color symbol array. */
7419 for (tail
= color_symbols
, i
= 0;
7421 ++i
, tail
= XCDR (tail
))
7423 Lisp_Object name
= XCAR (XCAR (tail
));
7424 Lisp_Object color
= XCDR (XCAR (tail
));
7425 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7426 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7427 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7428 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7432 /* Create a pixmap for the image, either from a file, or from a
7433 string buffer containing data in the same format as an XPM file. */
7434 #ifdef ALLOC_XPM_COLORS
7435 xpm_init_color_cache (f
, &attrs
);
7438 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7439 if (STRINGP (specified_file
))
7441 Lisp_Object file
= x_find_image_file (specified_file
);
7442 if (!STRINGP (file
))
7444 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7448 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7449 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7454 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7455 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7456 XSTRING (buffer
)->data
,
7457 &img
->pixmap
, &img
->mask
,
7461 if (rc
== XpmSuccess
)
7463 #ifdef ALLOC_XPM_COLORS
7464 img
->colors
= colors_in_color_table (&img
->ncolors
);
7465 #else /* not ALLOC_XPM_COLORS */
7468 img
->ncolors
= attrs
.nalloc_pixels
;
7469 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7470 * sizeof *img
->colors
);
7471 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7473 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7474 #ifdef DEBUG_X_COLORS
7475 register_color (img
->colors
[i
]);
7478 #endif /* not ALLOC_XPM_COLORS */
7480 img
->width
= attrs
.width
;
7481 img
->height
= attrs
.height
;
7482 xassert (img
->width
> 0 && img
->height
> 0);
7484 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7485 XpmFreeAttributes (&attrs
);
7492 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7495 case XpmFileInvalid
:
7496 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7500 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7503 case XpmColorFailed
:
7504 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7508 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7513 #ifdef ALLOC_XPM_COLORS
7514 xpm_free_color_cache ();
7516 return rc
== XpmSuccess
;
7519 #endif /* HAVE_XPM != 0 */
7522 /***********************************************************************
7524 ***********************************************************************/
7526 /* An entry in the color table mapping an RGB color to a pixel color. */
7531 unsigned long pixel
;
7533 /* Next in color table collision list. */
7534 struct ct_color
*next
;
7537 /* The bucket vector size to use. Must be prime. */
7541 /* Value is a hash of the RGB color given by R, G, and B. */
7543 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7545 /* The color hash table. */
7547 struct ct_color
**ct_table
;
7549 /* Number of entries in the color table. */
7551 int ct_colors_allocated
;
7553 /* Initialize the color table. */
7558 int size
= CT_SIZE
* sizeof (*ct_table
);
7559 ct_table
= (struct ct_color
**) xmalloc (size
);
7560 bzero (ct_table
, size
);
7561 ct_colors_allocated
= 0;
7565 /* Free memory associated with the color table. */
7571 struct ct_color
*p
, *next
;
7573 for (i
= 0; i
< CT_SIZE
; ++i
)
7574 for (p
= ct_table
[i
]; p
; p
= next
)
7585 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7586 entry for that color already is in the color table, return the
7587 pixel color of that entry. Otherwise, allocate a new color for R,
7588 G, B, and make an entry in the color table. */
7590 static unsigned long
7591 lookup_rgb_color (f
, r
, g
, b
)
7595 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7596 int i
= hash
% CT_SIZE
;
7599 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7600 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7613 cmap
= FRAME_X_COLORMAP (f
);
7614 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7618 ++ct_colors_allocated
;
7620 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7624 p
->pixel
= color
.pixel
;
7625 p
->next
= ct_table
[i
];
7629 return FRAME_FOREGROUND_PIXEL (f
);
7636 /* Look up pixel color PIXEL which is used on frame F in the color
7637 table. If not already present, allocate it. Value is PIXEL. */
7639 static unsigned long
7640 lookup_pixel_color (f
, pixel
)
7642 unsigned long pixel
;
7644 int i
= pixel
% CT_SIZE
;
7647 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7648 if (p
->pixel
== pixel
)
7657 cmap
= FRAME_X_COLORMAP (f
);
7658 color
.pixel
= pixel
;
7659 x_query_color (f
, &color
);
7660 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7664 ++ct_colors_allocated
;
7666 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7671 p
->next
= ct_table
[i
];
7675 return FRAME_FOREGROUND_PIXEL (f
);
7682 /* Value is a vector of all pixel colors contained in the color table,
7683 allocated via xmalloc. Set *N to the number of colors. */
7685 static unsigned long *
7686 colors_in_color_table (n
)
7691 unsigned long *colors
;
7693 if (ct_colors_allocated
== 0)
7700 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7702 *n
= ct_colors_allocated
;
7704 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7705 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7706 colors
[j
++] = p
->pixel
;
7714 /***********************************************************************
7716 ***********************************************************************/
7718 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7719 int, XImage
*, int));
7720 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7721 XColor
*, int, XImage
*, int));
7722 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7723 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7724 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7726 /* Non-zero means draw a cross on images having `:conversion
7729 int cross_disabled_images
;
7731 /* Edge detection matrices for different edge-detection
7734 static int emboss_matrix
[9] = {
7736 2, -1, 0, /* y - 1 */
7738 0, 1, -2 /* y + 1 */
7741 static int laplace_matrix
[9] = {
7743 1, 0, 0, /* y - 1 */
7745 0, 0, -1 /* y + 1 */
7748 /* Value is the intensity of the color whose red/green/blue values
7751 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7754 /* On frame F, return an array of XColor structures describing image
7755 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7756 non-zero means also fill the red/green/blue members of the XColor
7757 structures. Value is a pointer to the array of XColors structures,
7758 allocated with xmalloc; it must be freed by the caller. */
7761 x_to_xcolors (f
, img
, rgb_p
)
7770 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7772 /* Get the X image IMG->pixmap. */
7773 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7774 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7776 /* Fill the `pixel' members of the XColor array. I wished there
7777 were an easy and portable way to circumvent XGetPixel. */
7779 for (y
= 0; y
< img
->height
; ++y
)
7783 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7784 p
->pixel
= XGetPixel (ximg
, x
, y
);
7787 x_query_colors (f
, row
, img
->width
);
7790 XDestroyImage (ximg
);
7795 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7796 RGB members are set. F is the frame on which this all happens.
7797 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7800 x_from_xcolors (f
, img
, colors
)
7810 init_color_table ();
7812 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7815 for (y
= 0; y
< img
->height
; ++y
)
7816 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7818 unsigned long pixel
;
7819 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7820 XPutPixel (oimg
, x
, y
, pixel
);
7824 x_clear_image_1 (f
, img
, 1, 0, 1);
7826 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7827 x_destroy_x_image (oimg
);
7828 img
->pixmap
= pixmap
;
7829 img
->colors
= colors_in_color_table (&img
->ncolors
);
7830 free_color_table ();
7834 /* On frame F, perform edge-detection on image IMG.
7836 MATRIX is a nine-element array specifying the transformation
7837 matrix. See emboss_matrix for an example.
7839 COLOR_ADJUST is a color adjustment added to each pixel of the
7843 x_detect_edges (f
, img
, matrix
, color_adjust
)
7846 int matrix
[9], color_adjust
;
7848 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7852 for (i
= sum
= 0; i
< 9; ++i
)
7853 sum
+= abs (matrix
[i
]);
7855 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7857 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7859 for (y
= 0; y
< img
->height
; ++y
)
7861 p
= COLOR (new, 0, y
);
7862 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7863 p
= COLOR (new, img
->width
- 1, y
);
7864 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7867 for (x
= 1; x
< img
->width
- 1; ++x
)
7869 p
= COLOR (new, x
, 0);
7870 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7871 p
= COLOR (new, x
, img
->height
- 1);
7872 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7875 for (y
= 1; y
< img
->height
- 1; ++y
)
7877 p
= COLOR (new, 1, y
);
7879 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7881 int r
, g
, b
, y1
, x1
;
7884 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7885 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7888 XColor
*t
= COLOR (colors
, x1
, y1
);
7889 r
+= matrix
[i
] * t
->red
;
7890 g
+= matrix
[i
] * t
->green
;
7891 b
+= matrix
[i
] * t
->blue
;
7894 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7895 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7896 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7897 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7902 x_from_xcolors (f
, img
, new);
7908 /* Perform the pre-defined `emboss' edge-detection on image IMG
7916 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7920 /* Perform the pre-defined `laplace' edge-detection on image IMG
7928 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7932 /* Perform edge-detection on image IMG on frame F, with specified
7933 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7935 MATRIX must be either
7937 - a list of at least 9 numbers in row-major form
7938 - a vector of at least 9 numbers
7940 COLOR_ADJUST nil means use a default; otherwise it must be a
7944 x_edge_detection (f
, img
, matrix
, color_adjust
)
7947 Lisp_Object matrix
, color_adjust
;
7955 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7956 ++i
, matrix
= XCDR (matrix
))
7957 trans
[i
] = XFLOATINT (XCAR (matrix
));
7959 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7961 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7962 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7965 if (NILP (color_adjust
))
7966 color_adjust
= make_number (0xffff / 2);
7968 if (i
== 9 && NUMBERP (color_adjust
))
7969 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7973 /* Transform image IMG on frame F so that it looks disabled. */
7976 x_disable_image (f
, img
)
7980 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7982 if (dpyinfo
->n_planes
>= 2)
7984 /* Color (or grayscale). Convert to gray, and equalize. Just
7985 drawing such images with a stipple can look very odd, so
7986 we're using this method instead. */
7987 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7989 const int h
= 15000;
7990 const int l
= 30000;
7992 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7996 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7997 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7998 p
->red
= p
->green
= p
->blue
= i2
;
8001 x_from_xcolors (f
, img
, colors
);
8004 /* Draw a cross over the disabled image, if we must or if we
8006 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
8008 Display
*dpy
= FRAME_X_DISPLAY (f
);
8011 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
8012 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
8013 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
8014 img
->width
- 1, img
->height
- 1);
8015 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
8021 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
8022 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
8023 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
8024 img
->width
- 1, img
->height
- 1);
8025 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
8033 /* Build a mask for image IMG which is used on frame F. FILE is the
8034 name of an image file, for error messages. HOW determines how to
8035 determine the background color of IMG. If it is a list '(R G B)',
8036 with R, G, and B being integers >= 0, take that as the color of the
8037 background. Otherwise, determine the background color of IMG
8038 heuristically. Value is non-zero if successful. */
8041 x_build_heuristic_mask (f
, img
, how
)
8046 Display
*dpy
= FRAME_X_DISPLAY (f
);
8047 XImage
*ximg
, *mask_img
;
8048 int x
, y
, rc
, look_at_corners_p
;
8049 unsigned long bg
= 0;
8053 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8057 /* Create an image and pixmap serving as mask. */
8058 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
8059 &mask_img
, &img
->mask
);
8063 /* Get the X image of IMG->pixmap. */
8064 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
8067 /* Determine the background color of ximg. If HOW is `(R G B)'
8068 take that as color. Otherwise, try to determine the color
8070 look_at_corners_p
= 1;
8078 && NATNUMP (XCAR (how
)))
8080 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
8084 if (i
== 3 && NILP (how
))
8086 char color_name
[30];
8087 XColor exact
, color
;
8090 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
8092 cmap
= FRAME_X_COLORMAP (f
);
8093 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
8096 look_at_corners_p
= 0;
8101 if (look_at_corners_p
)
8103 unsigned long corners
[4];
8106 /* Get the colors at the corners of ximg. */
8107 corners
[0] = XGetPixel (ximg
, 0, 0);
8108 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
8109 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
8110 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
8112 /* Choose the most frequently found color as background. */
8113 for (i
= best_count
= 0; i
< 4; ++i
)
8117 for (j
= n
= 0; j
< 4; ++j
)
8118 if (corners
[i
] == corners
[j
])
8122 bg
= corners
[i
], best_count
= n
;
8126 /* Set all bits in mask_img to 1 whose color in ximg is different
8127 from the background color bg. */
8128 for (y
= 0; y
< img
->height
; ++y
)
8129 for (x
= 0; x
< img
->width
; ++x
)
8130 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8132 /* Put mask_img into img->mask. */
8133 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8134 x_destroy_x_image (mask_img
);
8135 XDestroyImage (ximg
);
8142 /***********************************************************************
8143 PBM (mono, gray, color)
8144 ***********************************************************************/
8146 static int pbm_image_p
P_ ((Lisp_Object object
));
8147 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8148 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8150 /* The symbol `pbm' identifying images of this type. */
8154 /* Indices of image specification fields in gs_format, below. */
8156 enum pbm_keyword_index
8172 /* Vector of image_keyword structures describing the format
8173 of valid user-defined image specifications. */
8175 static struct image_keyword pbm_format
[PBM_LAST
] =
8177 {":type", IMAGE_SYMBOL_VALUE
, 1},
8178 {":file", IMAGE_STRING_VALUE
, 0},
8179 {":data", IMAGE_STRING_VALUE
, 0},
8180 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8181 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8182 {":relief", IMAGE_INTEGER_VALUE
, 0},
8183 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8184 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8185 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8186 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8187 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8190 /* Structure describing the image type `pbm'. */
8192 static struct image_type pbm_type
=
8202 /* Return non-zero if OBJECT is a valid PBM image specification. */
8205 pbm_image_p (object
)
8208 struct image_keyword fmt
[PBM_LAST
];
8210 bcopy (pbm_format
, fmt
, sizeof fmt
);
8212 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8215 /* Must specify either :data or :file. */
8216 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8220 /* Scan a decimal number from *S and return it. Advance *S while
8221 reading the number. END is the end of the string. Value is -1 at
8225 pbm_scan_number (s
, end
)
8226 unsigned char **s
, *end
;
8228 int c
= 0, val
= -1;
8232 /* Skip white-space. */
8233 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8238 /* Skip comment to end of line. */
8239 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8242 else if (isdigit (c
))
8244 /* Read decimal number. */
8246 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8247 val
= 10 * val
+ c
- '0';
8258 /* Load PBM image IMG for use on frame F. */
8266 int width
, height
, max_color_idx
= 0;
8268 Lisp_Object file
, specified_file
;
8269 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8270 struct gcpro gcpro1
;
8271 unsigned char *contents
= NULL
;
8272 unsigned char *end
, *p
;
8275 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8279 if (STRINGP (specified_file
))
8281 file
= x_find_image_file (specified_file
);
8282 if (!STRINGP (file
))
8284 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8289 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8290 if (contents
== NULL
)
8292 image_error ("Error reading `%s'", file
, Qnil
);
8298 end
= contents
+ size
;
8303 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8304 p
= XSTRING (data
)->data
;
8305 end
= p
+ STRING_BYTES (XSTRING (data
));
8308 /* Check magic number. */
8309 if (end
- p
< 2 || *p
++ != 'P')
8311 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8321 raw_p
= 0, type
= PBM_MONO
;
8325 raw_p
= 0, type
= PBM_GRAY
;
8329 raw_p
= 0, type
= PBM_COLOR
;
8333 raw_p
= 1, type
= PBM_MONO
;
8337 raw_p
= 1, type
= PBM_GRAY
;
8341 raw_p
= 1, type
= PBM_COLOR
;
8345 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8349 /* Read width, height, maximum color-component. Characters
8350 starting with `#' up to the end of a line are ignored. */
8351 width
= pbm_scan_number (&p
, end
);
8352 height
= pbm_scan_number (&p
, end
);
8354 if (type
!= PBM_MONO
)
8356 max_color_idx
= pbm_scan_number (&p
, end
);
8357 if (raw_p
&& max_color_idx
> 255)
8358 max_color_idx
= 255;
8363 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8366 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8367 &ximg
, &img
->pixmap
))
8370 /* Initialize the color hash table. */
8371 init_color_table ();
8373 if (type
== PBM_MONO
)
8376 struct image_keyword fmt
[PBM_LAST
];
8377 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8378 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8380 /* Parse the image specification. */
8381 bcopy (pbm_format
, fmt
, sizeof fmt
);
8382 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8384 /* Get foreground and background colors, maybe allocate colors. */
8385 if (fmt
[PBM_FOREGROUND
].count
8386 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
8387 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8388 if (fmt
[PBM_BACKGROUND
].count
8389 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
8390 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8392 for (y
= 0; y
< height
; ++y
)
8393 for (x
= 0; x
< width
; ++x
)
8403 g
= pbm_scan_number (&p
, end
);
8405 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8410 for (y
= 0; y
< height
; ++y
)
8411 for (x
= 0; x
< width
; ++x
)
8415 if (type
== PBM_GRAY
)
8416 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8425 r
= pbm_scan_number (&p
, end
);
8426 g
= pbm_scan_number (&p
, end
);
8427 b
= pbm_scan_number (&p
, end
);
8430 if (r
< 0 || g
< 0 || b
< 0)
8434 XDestroyImage (ximg
);
8435 image_error ("Invalid pixel value in image `%s'",
8440 /* RGB values are now in the range 0..max_color_idx.
8441 Scale this to the range 0..0xffff supported by X. */
8442 r
= (double) r
* 65535 / max_color_idx
;
8443 g
= (double) g
* 65535 / max_color_idx
;
8444 b
= (double) b
* 65535 / max_color_idx
;
8445 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8449 /* Store in IMG->colors the colors allocated for the image, and
8450 free the color table. */
8451 img
->colors
= colors_in_color_table (&img
->ncolors
);
8452 free_color_table ();
8454 /* Put the image into a pixmap. */
8455 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8456 x_destroy_x_image (ximg
);
8459 img
->height
= height
;
8468 /***********************************************************************
8470 ***********************************************************************/
8476 /* Function prototypes. */
8478 static int png_image_p
P_ ((Lisp_Object object
));
8479 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8481 /* The symbol `png' identifying images of this type. */
8485 /* Indices of image specification fields in png_format, below. */
8487 enum png_keyword_index
8501 /* Vector of image_keyword structures describing the format
8502 of valid user-defined image specifications. */
8504 static struct image_keyword png_format
[PNG_LAST
] =
8506 {":type", IMAGE_SYMBOL_VALUE
, 1},
8507 {":data", IMAGE_STRING_VALUE
, 0},
8508 {":file", IMAGE_STRING_VALUE
, 0},
8509 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8510 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8511 {":relief", IMAGE_INTEGER_VALUE
, 0},
8512 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8513 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8514 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8517 /* Structure describing the image type `png'. */
8519 static struct image_type png_type
=
8529 /* Return non-zero if OBJECT is a valid PNG image specification. */
8532 png_image_p (object
)
8535 struct image_keyword fmt
[PNG_LAST
];
8536 bcopy (png_format
, fmt
, sizeof fmt
);
8538 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8541 /* Must specify either the :data or :file keyword. */
8542 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8546 /* Error and warning handlers installed when the PNG library
8550 my_png_error (png_ptr
, msg
)
8551 png_struct
*png_ptr
;
8554 xassert (png_ptr
!= NULL
);
8555 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8556 longjmp (png_ptr
->jmpbuf
, 1);
8561 my_png_warning (png_ptr
, msg
)
8562 png_struct
*png_ptr
;
8565 xassert (png_ptr
!= NULL
);
8566 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8569 /* Memory source for PNG decoding. */
8571 struct png_memory_storage
8573 unsigned char *bytes
; /* The data */
8574 size_t len
; /* How big is it? */
8575 int index
; /* Where are we? */
8579 /* Function set as reader function when reading PNG image from memory.
8580 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8581 bytes from the input to DATA. */
8584 png_read_from_memory (png_ptr
, data
, length
)
8585 png_structp png_ptr
;
8589 struct png_memory_storage
*tbr
8590 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8592 if (length
> tbr
->len
- tbr
->index
)
8593 png_error (png_ptr
, "Read error");
8595 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8596 tbr
->index
= tbr
->index
+ length
;
8599 /* Load PNG image IMG for use on frame F. Value is non-zero if
8607 Lisp_Object file
, specified_file
;
8608 Lisp_Object specified_data
;
8610 XImage
*ximg
, *mask_img
= NULL
;
8611 struct gcpro gcpro1
;
8612 png_struct
*png_ptr
= NULL
;
8613 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8614 FILE *volatile fp
= NULL
;
8616 png_byte
* volatile pixels
= NULL
;
8617 png_byte
** volatile rows
= NULL
;
8618 png_uint_32 width
, height
;
8619 int bit_depth
, color_type
, interlace_type
;
8621 png_uint_32 row_bytes
;
8624 double screen_gamma
, image_gamma
;
8626 struct png_memory_storage tbr
; /* Data to be read */
8628 /* Find out what file to load. */
8629 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8630 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8634 if (NILP (specified_data
))
8636 file
= x_find_image_file (specified_file
);
8637 if (!STRINGP (file
))
8639 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8644 /* Open the image file. */
8645 fp
= fopen (XSTRING (file
)->data
, "rb");
8648 image_error ("Cannot open image file `%s'", file
, Qnil
);
8654 /* Check PNG signature. */
8655 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8656 || !png_check_sig (sig
, sizeof sig
))
8658 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8666 /* Read from memory. */
8667 tbr
.bytes
= XSTRING (specified_data
)->data
;
8668 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8671 /* Check PNG signature. */
8672 if (tbr
.len
< sizeof sig
8673 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8675 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8680 /* Need to skip past the signature. */
8681 tbr
.bytes
+= sizeof (sig
);
8684 /* Initialize read and info structs for PNG lib. */
8685 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8686 my_png_error
, my_png_warning
);
8689 if (fp
) fclose (fp
);
8694 info_ptr
= png_create_info_struct (png_ptr
);
8697 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8698 if (fp
) fclose (fp
);
8703 end_info
= png_create_info_struct (png_ptr
);
8706 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8707 if (fp
) fclose (fp
);
8712 /* Set error jump-back. We come back here when the PNG library
8713 detects an error. */
8714 if (setjmp (png_ptr
->jmpbuf
))
8718 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8721 if (fp
) fclose (fp
);
8726 /* Read image info. */
8727 if (!NILP (specified_data
))
8728 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8730 png_init_io (png_ptr
, fp
);
8732 png_set_sig_bytes (png_ptr
, sizeof sig
);
8733 png_read_info (png_ptr
, info_ptr
);
8734 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8735 &interlace_type
, NULL
, NULL
);
8737 /* If image contains simply transparency data, we prefer to
8738 construct a clipping mask. */
8739 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8744 /* This function is easier to write if we only have to handle
8745 one data format: RGB or RGBA with 8 bits per channel. Let's
8746 transform other formats into that format. */
8748 /* Strip more than 8 bits per channel. */
8749 if (bit_depth
== 16)
8750 png_set_strip_16 (png_ptr
);
8752 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8754 png_set_expand (png_ptr
);
8756 /* Convert grayscale images to RGB. */
8757 if (color_type
== PNG_COLOR_TYPE_GRAY
8758 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8759 png_set_gray_to_rgb (png_ptr
);
8761 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8762 gamma_str
= getenv ("SCREEN_GAMMA");
8763 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8765 /* Tell the PNG lib to handle gamma correction for us. */
8767 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8768 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8769 /* There is a special chunk in the image specifying the gamma. */
8770 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8773 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8774 /* Image contains gamma information. */
8775 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8777 /* Use a default of 0.5 for the image gamma. */
8778 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8780 /* Handle alpha channel by combining the image with a background
8781 color. Do this only if a real alpha channel is supplied. For
8782 simple transparency, we prefer a clipping mask. */
8785 png_color_16
*image_background
;
8787 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8788 /* Image contains a background color with which to
8789 combine the image. */
8790 png_set_background (png_ptr
, image_background
,
8791 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8794 /* Image does not contain a background color with which
8795 to combine the image data via an alpha channel. Use
8796 the frame's background instead. */
8799 png_color_16 frame_background
;
8801 cmap
= FRAME_X_COLORMAP (f
);
8802 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8803 x_query_color (f
, &color
);
8805 bzero (&frame_background
, sizeof frame_background
);
8806 frame_background
.red
= color
.red
;
8807 frame_background
.green
= color
.green
;
8808 frame_background
.blue
= color
.blue
;
8810 png_set_background (png_ptr
, &frame_background
,
8811 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8815 /* Update info structure. */
8816 png_read_update_info (png_ptr
, info_ptr
);
8818 /* Get number of channels. Valid values are 1 for grayscale images
8819 and images with a palette, 2 for grayscale images with transparency
8820 information (alpha channel), 3 for RGB images, and 4 for RGB
8821 images with alpha channel, i.e. RGBA. If conversions above were
8822 sufficient we should only have 3 or 4 channels here. */
8823 channels
= png_get_channels (png_ptr
, info_ptr
);
8824 xassert (channels
== 3 || channels
== 4);
8826 /* Number of bytes needed for one row of the image. */
8827 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8829 /* Allocate memory for the image. */
8830 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8831 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8832 for (i
= 0; i
< height
; ++i
)
8833 rows
[i
] = pixels
+ i
* row_bytes
;
8835 /* Read the entire image. */
8836 png_read_image (png_ptr
, rows
);
8837 png_read_end (png_ptr
, info_ptr
);
8844 /* Create the X image and pixmap. */
8845 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8849 /* Create an image and pixmap serving as mask if the PNG image
8850 contains an alpha channel. */
8853 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8854 &mask_img
, &img
->mask
))
8856 x_destroy_x_image (ximg
);
8857 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8862 /* Fill the X image and mask from PNG data. */
8863 init_color_table ();
8865 for (y
= 0; y
< height
; ++y
)
8867 png_byte
*p
= rows
[y
];
8869 for (x
= 0; x
< width
; ++x
)
8876 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8878 /* An alpha channel, aka mask channel, associates variable
8879 transparency with an image. Where other image formats
8880 support binary transparency---fully transparent or fully
8881 opaque---PNG allows up to 254 levels of partial transparency.
8882 The PNG library implements partial transparency by combining
8883 the image with a specified background color.
8885 I'm not sure how to handle this here nicely: because the
8886 background on which the image is displayed may change, for
8887 real alpha channel support, it would be necessary to create
8888 a new image for each possible background.
8890 What I'm doing now is that a mask is created if we have
8891 boolean transparency information. Otherwise I'm using
8892 the frame's background color to combine the image with. */
8897 XPutPixel (mask_img
, x
, y
, *p
> 0);
8903 /* Remember colors allocated for this image. */
8904 img
->colors
= colors_in_color_table (&img
->ncolors
);
8905 free_color_table ();
8908 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8913 img
->height
= height
;
8915 /* Put the image into the pixmap, then free the X image and its buffer. */
8916 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8917 x_destroy_x_image (ximg
);
8919 /* Same for the mask. */
8922 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8923 x_destroy_x_image (mask_img
);
8930 #endif /* HAVE_PNG != 0 */
8934 /***********************************************************************
8936 ***********************************************************************/
8940 /* Work around a warning about HAVE_STDLIB_H being redefined in
8942 #ifdef HAVE_STDLIB_H
8943 #define HAVE_STDLIB_H_1
8944 #undef HAVE_STDLIB_H
8945 #endif /* HAVE_STLIB_H */
8947 #include <jpeglib.h>
8951 #ifdef HAVE_STLIB_H_1
8952 #define HAVE_STDLIB_H 1
8955 static int jpeg_image_p
P_ ((Lisp_Object object
));
8956 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8958 /* The symbol `jpeg' identifying images of this type. */
8962 /* Indices of image specification fields in gs_format, below. */
8964 enum jpeg_keyword_index
8973 JPEG_HEURISTIC_MASK
,
8978 /* Vector of image_keyword structures describing the format
8979 of valid user-defined image specifications. */
8981 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8983 {":type", IMAGE_SYMBOL_VALUE
, 1},
8984 {":data", IMAGE_STRING_VALUE
, 0},
8985 {":file", IMAGE_STRING_VALUE
, 0},
8986 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8987 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8988 {":relief", IMAGE_INTEGER_VALUE
, 0},
8989 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8990 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8991 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8994 /* Structure describing the image type `jpeg'. */
8996 static struct image_type jpeg_type
=
9006 /* Return non-zero if OBJECT is a valid JPEG image specification. */
9009 jpeg_image_p (object
)
9012 struct image_keyword fmt
[JPEG_LAST
];
9014 bcopy (jpeg_format
, fmt
, sizeof fmt
);
9016 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
9019 /* Must specify either the :data or :file keyword. */
9020 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
9024 struct my_jpeg_error_mgr
9026 struct jpeg_error_mgr pub
;
9027 jmp_buf setjmp_buffer
;
9032 my_error_exit (cinfo
)
9035 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
9036 longjmp (mgr
->setjmp_buffer
, 1);
9040 /* Init source method for JPEG data source manager. Called by
9041 jpeg_read_header() before any data is actually read. See
9042 libjpeg.doc from the JPEG lib distribution. */
9045 our_init_source (cinfo
)
9046 j_decompress_ptr cinfo
;
9051 /* Fill input buffer method for JPEG data source manager. Called
9052 whenever more data is needed. We read the whole image in one step,
9053 so this only adds a fake end of input marker at the end. */
9056 our_fill_input_buffer (cinfo
)
9057 j_decompress_ptr cinfo
;
9059 /* Insert a fake EOI marker. */
9060 struct jpeg_source_mgr
*src
= cinfo
->src
;
9061 static JOCTET buffer
[2];
9063 buffer
[0] = (JOCTET
) 0xFF;
9064 buffer
[1] = (JOCTET
) JPEG_EOI
;
9066 src
->next_input_byte
= buffer
;
9067 src
->bytes_in_buffer
= 2;
9072 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9073 is the JPEG data source manager. */
9076 our_skip_input_data (cinfo
, num_bytes
)
9077 j_decompress_ptr cinfo
;
9080 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9084 if (num_bytes
> src
->bytes_in_buffer
)
9085 ERREXIT (cinfo
, JERR_INPUT_EOF
);
9087 src
->bytes_in_buffer
-= num_bytes
;
9088 src
->next_input_byte
+= num_bytes
;
9093 /* Method to terminate data source. Called by
9094 jpeg_finish_decompress() after all data has been processed. */
9097 our_term_source (cinfo
)
9098 j_decompress_ptr cinfo
;
9103 /* Set up the JPEG lib for reading an image from DATA which contains
9104 LEN bytes. CINFO is the decompression info structure created for
9105 reading the image. */
9108 jpeg_memory_src (cinfo
, data
, len
)
9109 j_decompress_ptr cinfo
;
9113 struct jpeg_source_mgr
*src
;
9115 if (cinfo
->src
== NULL
)
9117 /* First time for this JPEG object? */
9118 cinfo
->src
= (struct jpeg_source_mgr
*)
9119 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9120 sizeof (struct jpeg_source_mgr
));
9121 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9122 src
->next_input_byte
= data
;
9125 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9126 src
->init_source
= our_init_source
;
9127 src
->fill_input_buffer
= our_fill_input_buffer
;
9128 src
->skip_input_data
= our_skip_input_data
;
9129 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9130 src
->term_source
= our_term_source
;
9131 src
->bytes_in_buffer
= len
;
9132 src
->next_input_byte
= data
;
9136 /* Load image IMG for use on frame F. Patterned after example.c
9137 from the JPEG lib. */
9144 struct jpeg_decompress_struct cinfo
;
9145 struct my_jpeg_error_mgr mgr
;
9146 Lisp_Object file
, specified_file
;
9147 Lisp_Object specified_data
;
9148 FILE * volatile fp
= NULL
;
9150 int row_stride
, x
, y
;
9151 XImage
*ximg
= NULL
;
9153 unsigned long *colors
;
9155 struct gcpro gcpro1
;
9157 /* Open the JPEG file. */
9158 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9159 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9163 if (NILP (specified_data
))
9165 file
= x_find_image_file (specified_file
);
9166 if (!STRINGP (file
))
9168 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9173 fp
= fopen (XSTRING (file
)->data
, "r");
9176 image_error ("Cannot open `%s'", file
, Qnil
);
9182 /* Customize libjpeg's error handling to call my_error_exit when an
9183 error is detected. This function will perform a longjmp. */
9184 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9185 mgr
.pub
.error_exit
= my_error_exit
;
9187 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9191 /* Called from my_error_exit. Display a JPEG error. */
9192 char buffer
[JMSG_LENGTH_MAX
];
9193 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9194 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9195 build_string (buffer
));
9198 /* Close the input file and destroy the JPEG object. */
9200 fclose ((FILE *) fp
);
9201 jpeg_destroy_decompress (&cinfo
);
9203 /* If we already have an XImage, free that. */
9204 x_destroy_x_image (ximg
);
9206 /* Free pixmap and colors. */
9207 x_clear_image (f
, img
);
9213 /* Create the JPEG decompression object. Let it read from fp.
9214 Read the JPEG image header. */
9215 jpeg_create_decompress (&cinfo
);
9217 if (NILP (specified_data
))
9218 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9220 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9221 STRING_BYTES (XSTRING (specified_data
)));
9223 jpeg_read_header (&cinfo
, TRUE
);
9225 /* Customize decompression so that color quantization will be used.
9226 Start decompression. */
9227 cinfo
.quantize_colors
= TRUE
;
9228 jpeg_start_decompress (&cinfo
);
9229 width
= img
->width
= cinfo
.output_width
;
9230 height
= img
->height
= cinfo
.output_height
;
9232 /* Create X image and pixmap. */
9233 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9234 longjmp (mgr
.setjmp_buffer
, 2);
9236 /* Allocate colors. When color quantization is used,
9237 cinfo.actual_number_of_colors has been set with the number of
9238 colors generated, and cinfo.colormap is a two-dimensional array
9239 of color indices in the range 0..cinfo.actual_number_of_colors.
9240 No more than 255 colors will be generated. */
9244 if (cinfo
.out_color_components
> 2)
9245 ir
= 0, ig
= 1, ib
= 2;
9246 else if (cinfo
.out_color_components
> 1)
9247 ir
= 0, ig
= 1, ib
= 0;
9249 ir
= 0, ig
= 0, ib
= 0;
9251 /* Use the color table mechanism because it handles colors that
9252 cannot be allocated nicely. Such colors will be replaced with
9253 a default color, and we don't have to care about which colors
9254 can be freed safely, and which can't. */
9255 init_color_table ();
9256 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9259 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9261 /* Multiply RGB values with 255 because X expects RGB values
9262 in the range 0..0xffff. */
9263 int r
= cinfo
.colormap
[ir
][i
] << 8;
9264 int g
= cinfo
.colormap
[ig
][i
] << 8;
9265 int b
= cinfo
.colormap
[ib
][i
] << 8;
9266 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9269 /* Remember those colors actually allocated. */
9270 img
->colors
= colors_in_color_table (&img
->ncolors
);
9271 free_color_table ();
9275 row_stride
= width
* cinfo
.output_components
;
9276 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9278 for (y
= 0; y
< height
; ++y
)
9280 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9281 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9282 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9286 jpeg_finish_decompress (&cinfo
);
9287 jpeg_destroy_decompress (&cinfo
);
9289 fclose ((FILE *) fp
);
9291 /* Put the image into the pixmap. */
9292 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9293 x_destroy_x_image (ximg
);
9298 #endif /* HAVE_JPEG */
9302 /***********************************************************************
9304 ***********************************************************************/
9310 static int tiff_image_p
P_ ((Lisp_Object object
));
9311 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9313 /* The symbol `tiff' identifying images of this type. */
9317 /* Indices of image specification fields in tiff_format, below. */
9319 enum tiff_keyword_index
9328 TIFF_HEURISTIC_MASK
,
9333 /* Vector of image_keyword structures describing the format
9334 of valid user-defined image specifications. */
9336 static struct image_keyword tiff_format
[TIFF_LAST
] =
9338 {":type", IMAGE_SYMBOL_VALUE
, 1},
9339 {":data", IMAGE_STRING_VALUE
, 0},
9340 {":file", IMAGE_STRING_VALUE
, 0},
9341 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9342 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9343 {":relief", IMAGE_INTEGER_VALUE
, 0},
9344 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9345 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9346 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9349 /* Structure describing the image type `tiff'. */
9351 static struct image_type tiff_type
=
9361 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9364 tiff_image_p (object
)
9367 struct image_keyword fmt
[TIFF_LAST
];
9368 bcopy (tiff_format
, fmt
, sizeof fmt
);
9370 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9373 /* Must specify either the :data or :file keyword. */
9374 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9378 /* Reading from a memory buffer for TIFF images Based on the PNG
9379 memory source, but we have to provide a lot of extra functions.
9382 We really only need to implement read and seek, but I am not
9383 convinced that the TIFF library is smart enough not to destroy
9384 itself if we only hand it the function pointers we need to
9389 unsigned char *bytes
;
9397 tiff_read_from_memory (data
, buf
, size
)
9402 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9404 if (size
> src
->len
- src
->index
)
9406 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9413 tiff_write_from_memory (data
, buf
, size
)
9423 tiff_seek_in_memory (data
, off
, whence
)
9428 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9433 case SEEK_SET
: /* Go from beginning of source. */
9437 case SEEK_END
: /* Go from end of source. */
9438 idx
= src
->len
+ off
;
9441 case SEEK_CUR
: /* Go from current position. */
9442 idx
= src
->index
+ off
;
9445 default: /* Invalid `whence'. */
9449 if (idx
> src
->len
|| idx
< 0)
9458 tiff_close_memory (data
)
9467 tiff_mmap_memory (data
, pbase
, psize
)
9472 /* It is already _IN_ memory. */
9478 tiff_unmap_memory (data
, base
, size
)
9483 /* We don't need to do this. */
9488 tiff_size_of_memory (data
)
9491 return ((tiff_memory_source
*) data
)->len
;
9496 tiff_error_handler (title
, format
, ap
)
9497 const char *title
, *format
;
9503 len
= sprintf (buf
, "TIFF error: %s ", title
);
9504 vsprintf (buf
+ len
, format
, ap
);
9505 add_to_log (buf
, Qnil
, Qnil
);
9510 tiff_warning_handler (title
, format
, ap
)
9511 const char *title
, *format
;
9517 len
= sprintf (buf
, "TIFF warning: %s ", title
);
9518 vsprintf (buf
+ len
, format
, ap
);
9519 add_to_log (buf
, Qnil
, Qnil
);
9523 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9531 Lisp_Object file
, specified_file
;
9532 Lisp_Object specified_data
;
9534 int width
, height
, x
, y
;
9538 struct gcpro gcpro1
;
9539 tiff_memory_source memsrc
;
9541 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9542 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9546 TIFFSetErrorHandler (tiff_error_handler
);
9547 TIFFSetWarningHandler (tiff_warning_handler
);
9549 if (NILP (specified_data
))
9551 /* Read from a file */
9552 file
= x_find_image_file (specified_file
);
9553 if (!STRINGP (file
))
9555 image_error ("Cannot find image file `%s'", file
, Qnil
);
9560 /* Try to open the image file. */
9561 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9564 image_error ("Cannot open `%s'", file
, Qnil
);
9571 /* Memory source! */
9572 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9573 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9576 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9577 (TIFFReadWriteProc
) tiff_read_from_memory
,
9578 (TIFFReadWriteProc
) tiff_write_from_memory
,
9579 tiff_seek_in_memory
,
9581 tiff_size_of_memory
,
9587 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9593 /* Get width and height of the image, and allocate a raster buffer
9594 of width x height 32-bit values. */
9595 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9596 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9597 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9599 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9603 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9609 /* Create the X image and pixmap. */
9610 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9617 /* Initialize the color table. */
9618 init_color_table ();
9620 /* Process the pixel raster. Origin is in the lower-left corner. */
9621 for (y
= 0; y
< height
; ++y
)
9623 uint32
*row
= buf
+ y
* width
;
9625 for (x
= 0; x
< width
; ++x
)
9627 uint32 abgr
= row
[x
];
9628 int r
= TIFFGetR (abgr
) << 8;
9629 int g
= TIFFGetG (abgr
) << 8;
9630 int b
= TIFFGetB (abgr
) << 8;
9631 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9635 /* Remember the colors allocated for the image. Free the color table. */
9636 img
->colors
= colors_in_color_table (&img
->ncolors
);
9637 free_color_table ();
9639 /* Put the image into the pixmap, then free the X image and its buffer. */
9640 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9641 x_destroy_x_image (ximg
);
9645 img
->height
= height
;
9651 #endif /* HAVE_TIFF != 0 */
9655 /***********************************************************************
9657 ***********************************************************************/
9661 #include <gif_lib.h>
9663 static int gif_image_p
P_ ((Lisp_Object object
));
9664 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9666 /* The symbol `gif' identifying images of this type. */
9670 /* Indices of image specification fields in gif_format, below. */
9672 enum gif_keyword_index
9687 /* Vector of image_keyword structures describing the format
9688 of valid user-defined image specifications. */
9690 static struct image_keyword gif_format
[GIF_LAST
] =
9692 {":type", IMAGE_SYMBOL_VALUE
, 1},
9693 {":data", IMAGE_STRING_VALUE
, 0},
9694 {":file", IMAGE_STRING_VALUE
, 0},
9695 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9696 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9697 {":relief", IMAGE_INTEGER_VALUE
, 0},
9698 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9699 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9700 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9701 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9704 /* Structure describing the image type `gif'. */
9706 static struct image_type gif_type
=
9716 /* Return non-zero if OBJECT is a valid GIF image specification. */
9719 gif_image_p (object
)
9722 struct image_keyword fmt
[GIF_LAST
];
9723 bcopy (gif_format
, fmt
, sizeof fmt
);
9725 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9728 /* Must specify either the :data or :file keyword. */
9729 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9733 /* Reading a GIF image from memory
9734 Based on the PNG memory stuff to a certain extent. */
9738 unsigned char *bytes
;
9745 /* Make the current memory source available to gif_read_from_memory.
9746 It's done this way because not all versions of libungif support
9747 a UserData field in the GifFileType structure. */
9748 static gif_memory_source
*current_gif_memory_src
;
9751 gif_read_from_memory (file
, buf
, len
)
9756 gif_memory_source
*src
= current_gif_memory_src
;
9758 if (len
> src
->len
- src
->index
)
9761 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9767 /* Load GIF image IMG for use on frame F. Value is non-zero if
9775 Lisp_Object file
, specified_file
;
9776 Lisp_Object specified_data
;
9777 int rc
, width
, height
, x
, y
, i
;
9779 ColorMapObject
*gif_color_map
;
9780 unsigned long pixel_colors
[256];
9782 struct gcpro gcpro1
;
9784 int ino
, image_left
, image_top
, image_width
, image_height
;
9785 gif_memory_source memsrc
;
9786 unsigned char *raster
;
9788 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9789 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9793 if (NILP (specified_data
))
9795 file
= x_find_image_file (specified_file
);
9796 if (!STRINGP (file
))
9798 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9803 /* Open the GIF file. */
9804 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9807 image_error ("Cannot open `%s'", file
, Qnil
);
9814 /* Read from memory! */
9815 current_gif_memory_src
= &memsrc
;
9816 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9817 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9820 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9823 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9829 /* Read entire contents. */
9830 rc
= DGifSlurp (gif
);
9831 if (rc
== GIF_ERROR
)
9833 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9834 DGifCloseFile (gif
);
9839 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9840 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9841 if (ino
>= gif
->ImageCount
)
9843 image_error ("Invalid image number `%s' in image `%s'",
9845 DGifCloseFile (gif
);
9850 width
= img
->width
= gif
->SWidth
;
9851 height
= img
->height
= gif
->SHeight
;
9853 /* Create the X image and pixmap. */
9854 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9856 DGifCloseFile (gif
);
9861 /* Allocate colors. */
9862 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9864 gif_color_map
= gif
->SColorMap
;
9865 init_color_table ();
9866 bzero (pixel_colors
, sizeof pixel_colors
);
9868 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9870 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9871 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9872 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9873 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9876 img
->colors
= colors_in_color_table (&img
->ncolors
);
9877 free_color_table ();
9879 /* Clear the part of the screen image that are not covered by
9880 the image from the GIF file. Full animated GIF support
9881 requires more than can be done here (see the gif89 spec,
9882 disposal methods). Let's simply assume that the part
9883 not covered by a sub-image is in the frame's background color. */
9884 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9885 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9886 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9887 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9889 for (y
= 0; y
< image_top
; ++y
)
9890 for (x
= 0; x
< width
; ++x
)
9891 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9893 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9894 for (x
= 0; x
< width
; ++x
)
9895 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9897 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9899 for (x
= 0; x
< image_left
; ++x
)
9900 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9901 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9902 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9905 /* Read the GIF image into the X image. We use a local variable
9906 `raster' here because RasterBits below is a char *, and invites
9907 problems with bytes >= 0x80. */
9908 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9910 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9912 static int interlace_start
[] = {0, 4, 2, 1};
9913 static int interlace_increment
[] = {8, 8, 4, 2};
9915 int row
= interlace_start
[0];
9919 for (y
= 0; y
< image_height
; y
++)
9921 if (row
>= image_height
)
9923 row
= interlace_start
[++pass
];
9924 while (row
>= image_height
)
9925 row
= interlace_start
[++pass
];
9928 for (x
= 0; x
< image_width
; x
++)
9930 int i
= raster
[(y
* image_width
) + x
];
9931 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9935 row
+= interlace_increment
[pass
];
9940 for (y
= 0; y
< image_height
; ++y
)
9941 for (x
= 0; x
< image_width
; ++x
)
9943 int i
= raster
[y
* image_width
+ x
];
9944 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9948 DGifCloseFile (gif
);
9950 /* Put the image into the pixmap, then free the X image and its buffer. */
9951 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9952 x_destroy_x_image (ximg
);
9958 #endif /* HAVE_GIF != 0 */
9962 /***********************************************************************
9964 ***********************************************************************/
9966 static int gs_image_p
P_ ((Lisp_Object object
));
9967 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9968 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9970 /* The symbol `postscript' identifying images of this type. */
9972 Lisp_Object Qpostscript
;
9974 /* Keyword symbols. */
9976 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9978 /* Indices of image specification fields in gs_format, below. */
9980 enum gs_keyword_index
9997 /* Vector of image_keyword structures describing the format
9998 of valid user-defined image specifications. */
10000 static struct image_keyword gs_format
[GS_LAST
] =
10002 {":type", IMAGE_SYMBOL_VALUE
, 1},
10003 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10004 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10005 {":file", IMAGE_STRING_VALUE
, 1},
10006 {":loader", IMAGE_FUNCTION_VALUE
, 0},
10007 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
10008 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10009 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10010 {":relief", IMAGE_INTEGER_VALUE
, 0},
10011 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10012 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10013 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
10016 /* Structure describing the image type `ghostscript'. */
10018 static struct image_type gs_type
=
10028 /* Free X resources of Ghostscript image IMG which is used on frame F. */
10031 gs_clear_image (f
, img
)
10035 /* IMG->data.ptr_val may contain a recorded colormap. */
10036 xfree (img
->data
.ptr_val
);
10037 x_clear_image (f
, img
);
10041 /* Return non-zero if OBJECT is a valid Ghostscript image
10045 gs_image_p (object
)
10046 Lisp_Object object
;
10048 struct image_keyword fmt
[GS_LAST
];
10052 bcopy (gs_format
, fmt
, sizeof fmt
);
10054 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
10057 /* Bounding box must be a list or vector containing 4 integers. */
10058 tem
= fmt
[GS_BOUNDING_BOX
].value
;
10061 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
10062 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
10067 else if (VECTORP (tem
))
10069 if (XVECTOR (tem
)->size
!= 4)
10071 for (i
= 0; i
< 4; ++i
)
10072 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
10082 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
10091 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
10092 struct gcpro gcpro1
, gcpro2
;
10094 double in_width
, in_height
;
10095 Lisp_Object pixel_colors
= Qnil
;
10097 /* Compute pixel size of pixmap needed from the given size in the
10098 image specification. Sizes in the specification are in pt. 1 pt
10099 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10101 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
10102 in_width
= XFASTINT (pt_width
) / 72.0;
10103 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
10104 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
10105 in_height
= XFASTINT (pt_height
) / 72.0;
10106 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
10108 /* Create the pixmap. */
10109 xassert (img
->pixmap
== None
);
10110 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10111 img
->width
, img
->height
,
10112 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
10116 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
10120 /* Call the loader to fill the pixmap. It returns a process object
10121 if successful. We do not record_unwind_protect here because
10122 other places in redisplay like calling window scroll functions
10123 don't either. Let the Lisp loader use `unwind-protect' instead. */
10124 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
10126 sprintf (buffer
, "%lu %lu",
10127 (unsigned long) FRAME_X_WINDOW (f
),
10128 (unsigned long) img
->pixmap
);
10129 window_and_pixmap_id
= build_string (buffer
);
10131 sprintf (buffer
, "%lu %lu",
10132 FRAME_FOREGROUND_PIXEL (f
),
10133 FRAME_BACKGROUND_PIXEL (f
));
10134 pixel_colors
= build_string (buffer
);
10136 XSETFRAME (frame
, f
);
10137 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
10139 loader
= intern ("gs-load-image");
10141 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10142 make_number (img
->width
),
10143 make_number (img
->height
),
10144 window_and_pixmap_id
,
10147 return PROCESSP (img
->data
.lisp_val
);
10151 /* Kill the Ghostscript process that was started to fill PIXMAP on
10152 frame F. Called from XTread_socket when receiving an event
10153 telling Emacs that Ghostscript has finished drawing. */
10156 x_kill_gs_process (pixmap
, f
)
10160 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10164 /* Find the image containing PIXMAP. */
10165 for (i
= 0; i
< c
->used
; ++i
)
10166 if (c
->images
[i
]->pixmap
== pixmap
)
10169 /* Should someone in between have cleared the image cache, for
10170 instance, give up. */
10174 /* Kill the GS process. We should have found PIXMAP in the image
10175 cache and its image should contain a process object. */
10176 img
= c
->images
[i
];
10177 xassert (PROCESSP (img
->data
.lisp_val
));
10178 Fkill_process (img
->data
.lisp_val
, Qnil
);
10179 img
->data
.lisp_val
= Qnil
;
10181 /* On displays with a mutable colormap, figure out the colors
10182 allocated for the image by looking at the pixels of an XImage for
10184 class = FRAME_X_VISUAL (f
)->class;
10185 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10191 /* Try to get an XImage for img->pixmep. */
10192 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10193 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10198 /* Initialize the color table. */
10199 init_color_table ();
10201 /* For each pixel of the image, look its color up in the
10202 color table. After having done so, the color table will
10203 contain an entry for each color used by the image. */
10204 for (y
= 0; y
< img
->height
; ++y
)
10205 for (x
= 0; x
< img
->width
; ++x
)
10207 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10208 lookup_pixel_color (f
, pixel
);
10211 /* Record colors in the image. Free color table and XImage. */
10212 img
->colors
= colors_in_color_table (&img
->ncolors
);
10213 free_color_table ();
10214 XDestroyImage (ximg
);
10216 #if 0 /* This doesn't seem to be the case. If we free the colors
10217 here, we get a BadAccess later in x_clear_image when
10218 freeing the colors. */
10219 /* We have allocated colors once, but Ghostscript has also
10220 allocated colors on behalf of us. So, to get the
10221 reference counts right, free them once. */
10223 x_free_colors (f
, img
->colors
, img
->ncolors
);
10227 image_error ("Cannot get X image of `%s'; colors will not be freed",
10233 /* Now that we have the pixmap, compute mask and transform the
10234 image if requested. */
10236 postprocess_image (f
, img
);
10242 /***********************************************************************
10244 ***********************************************************************/
10246 DEFUN ("x-change-window-property", Fx_change_window_property
,
10247 Sx_change_window_property
, 2, 3, 0,
10248 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
10249 PROP and VALUE must be strings. FRAME nil or omitted means use the
10250 selected frame. Value is VALUE. */)
10251 (prop
, value
, frame
)
10252 Lisp_Object frame
, prop
, value
;
10254 struct frame
*f
= check_x_frame (frame
);
10257 CHECK_STRING (prop
, 1);
10258 CHECK_STRING (value
, 2);
10261 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10262 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10263 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10264 XSTRING (value
)->data
, XSTRING (value
)->size
);
10266 /* Make sure the property is set when we return. */
10267 XFlush (FRAME_X_DISPLAY (f
));
10274 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10275 Sx_delete_window_property
, 1, 2, 0,
10276 doc
: /* Remove window property PROP from X window of FRAME.
10277 FRAME nil or omitted means use the selected frame. Value is PROP. */)
10279 Lisp_Object prop
, frame
;
10281 struct frame
*f
= check_x_frame (frame
);
10284 CHECK_STRING (prop
, 1);
10286 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10287 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10289 /* Make sure the property is removed when we return. */
10290 XFlush (FRAME_X_DISPLAY (f
));
10297 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10299 doc
: /* Value is the value of window property PROP on FRAME.
10300 If FRAME is nil or omitted, use the selected frame. Value is nil
10301 if FRAME hasn't a property with name PROP or if PROP has no string
10304 Lisp_Object prop
, frame
;
10306 struct frame
*f
= check_x_frame (frame
);
10309 Lisp_Object prop_value
= Qnil
;
10310 char *tmp_data
= NULL
;
10313 unsigned long actual_size
, bytes_remaining
;
10315 CHECK_STRING (prop
, 1);
10317 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10318 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10319 prop_atom
, 0, 0, False
, XA_STRING
,
10320 &actual_type
, &actual_format
, &actual_size
,
10321 &bytes_remaining
, (unsigned char **) &tmp_data
);
10324 int size
= bytes_remaining
;
10329 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10330 prop_atom
, 0, bytes_remaining
,
10332 &actual_type
, &actual_format
,
10333 &actual_size
, &bytes_remaining
,
10334 (unsigned char **) &tmp_data
);
10335 if (rc
== Success
&& tmp_data
)
10336 prop_value
= make_string (tmp_data
, size
);
10347 /***********************************************************************
10349 ***********************************************************************/
10351 /* If non-null, an asynchronous timer that, when it expires, displays
10352 an hourglass cursor on all frames. */
10354 static struct atimer
*hourglass_atimer
;
10356 /* Non-zero means an hourglass cursor is currently shown. */
10358 static int hourglass_shown_p
;
10360 /* Number of seconds to wait before displaying an hourglass cursor. */
10362 static Lisp_Object Vhourglass_delay
;
10364 /* Default number of seconds to wait before displaying an hourglass
10367 #define DEFAULT_HOURGLASS_DELAY 1
10369 /* Function prototypes. */
10371 static void show_hourglass
P_ ((struct atimer
*));
10372 static void hide_hourglass
P_ ((void));
10375 /* Cancel a currently active hourglass timer, and start a new one. */
10381 int secs
, usecs
= 0;
10383 cancel_hourglass ();
10385 if (INTEGERP (Vhourglass_delay
)
10386 && XINT (Vhourglass_delay
) > 0)
10387 secs
= XFASTINT (Vhourglass_delay
);
10388 else if (FLOATP (Vhourglass_delay
)
10389 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10392 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10393 secs
= XFASTINT (tem
);
10394 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10397 secs
= DEFAULT_HOURGLASS_DELAY
;
10399 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10400 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10401 show_hourglass
, NULL
);
10405 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10409 cancel_hourglass ()
10411 if (hourglass_atimer
)
10413 cancel_atimer (hourglass_atimer
);
10414 hourglass_atimer
= NULL
;
10417 if (hourglass_shown_p
)
10422 /* Timer function of hourglass_atimer. TIMER is equal to
10425 Display an hourglass pointer on all frames by mapping the frames'
10426 hourglass_window. Set the hourglass_p flag in the frames'
10427 output_data.x structure to indicate that an hourglass cursor is
10428 shown on the frames. */
10431 show_hourglass (timer
)
10432 struct atimer
*timer
;
10434 /* The timer implementation will cancel this timer automatically
10435 after this function has run. Set hourglass_atimer to null
10436 so that we know the timer doesn't have to be canceled. */
10437 hourglass_atimer
= NULL
;
10439 if (!hourglass_shown_p
)
10441 Lisp_Object rest
, frame
;
10445 FOR_EACH_FRAME (rest
, frame
)
10447 struct frame
*f
= XFRAME (frame
);
10449 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10451 Display
*dpy
= FRAME_X_DISPLAY (f
);
10453 #ifdef USE_X_TOOLKIT
10454 if (f
->output_data
.x
->widget
)
10456 if (FRAME_OUTER_WINDOW (f
))
10459 f
->output_data
.x
->hourglass_p
= 1;
10461 if (!f
->output_data
.x
->hourglass_window
)
10463 unsigned long mask
= CWCursor
;
10464 XSetWindowAttributes attrs
;
10466 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10468 f
->output_data
.x
->hourglass_window
10469 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10470 0, 0, 32000, 32000, 0, 0,
10476 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10482 hourglass_shown_p
= 1;
10488 /* Hide the hourglass pointer on all frames, if it is currently
10494 if (hourglass_shown_p
)
10496 Lisp_Object rest
, frame
;
10499 FOR_EACH_FRAME (rest
, frame
)
10501 struct frame
*f
= XFRAME (frame
);
10504 /* Watch out for newly created frames. */
10505 && f
->output_data
.x
->hourglass_window
)
10507 XUnmapWindow (FRAME_X_DISPLAY (f
),
10508 f
->output_data
.x
->hourglass_window
);
10509 /* Sync here because XTread_socket looks at the
10510 hourglass_p flag that is reset to zero below. */
10511 XSync (FRAME_X_DISPLAY (f
), False
);
10512 f
->output_data
.x
->hourglass_p
= 0;
10516 hourglass_shown_p
= 0;
10523 /***********************************************************************
10525 ***********************************************************************/
10527 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10528 Lisp_Object
, Lisp_Object
));
10529 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10530 Lisp_Object
, int, int, int *, int *));
10532 /* The frame of a currently visible tooltip. */
10534 Lisp_Object tip_frame
;
10536 /* If non-nil, a timer started that hides the last tooltip when it
10539 Lisp_Object tip_timer
;
10542 /* If non-nil, a vector of 3 elements containing the last args
10543 with which x-show-tip was called. See there. */
10545 Lisp_Object last_show_tip_args
;
10547 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
10549 Lisp_Object Vx_max_tooltip_size
;
10553 unwind_create_tip_frame (frame
)
10556 Lisp_Object deleted
;
10558 deleted
= unwind_create_frame (frame
);
10559 if (EQ (deleted
, Qt
))
10569 /* Create a frame for a tooltip on the display described by DPYINFO.
10570 PARMS is a list of frame parameters. TEXT is the string to
10571 display in the tip frame. Value is the frame.
10573 Note that functions called here, esp. x_default_parameter can
10574 signal errors, for instance when a specified color name is
10575 undefined. We have to make sure that we're in a consistent state
10576 when this happens. */
10579 x_create_tip_frame (dpyinfo
, parms
, text
)
10580 struct x_display_info
*dpyinfo
;
10581 Lisp_Object parms
, text
;
10584 Lisp_Object frame
, tem
;
10586 long window_prompting
= 0;
10588 int count
= BINDING_STACK_SIZE ();
10589 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10591 int face_change_count_before
= face_change_count
;
10592 Lisp_Object buffer
;
10593 struct buffer
*old_buffer
;
10597 /* Use this general default value to start with until we know if
10598 this frame has a specified name. */
10599 Vx_resource_name
= Vinvocation_name
;
10601 #ifdef MULTI_KBOARD
10602 kb
= dpyinfo
->kboard
;
10604 kb
= &the_only_kboard
;
10607 /* Get the name of the frame to use for resource lookup. */
10608 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10609 if (!STRINGP (name
)
10610 && !EQ (name
, Qunbound
)
10612 error ("Invalid frame name--not a string or nil");
10613 Vx_resource_name
= name
;
10616 GCPRO3 (parms
, name
, frame
);
10617 f
= make_frame (1);
10618 XSETFRAME (frame
, f
);
10620 buffer
= Fget_buffer_create (build_string (" *tip*"));
10621 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10622 old_buffer
= current_buffer
;
10623 set_buffer_internal_1 (XBUFFER (buffer
));
10624 current_buffer
->truncate_lines
= Qnil
;
10626 Finsert (1, &text
);
10627 set_buffer_internal_1 (old_buffer
);
10629 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10630 record_unwind_protect (unwind_create_tip_frame
, frame
);
10632 /* By setting the output method, we're essentially saying that
10633 the frame is live, as per FRAME_LIVE_P. If we get a signal
10634 from this point on, x_destroy_window might screw up reference
10636 f
->output_method
= output_x_window
;
10637 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10638 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10639 f
->output_data
.x
->icon_bitmap
= -1;
10640 f
->output_data
.x
->fontset
= -1;
10641 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10642 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10643 #ifdef USE_TOOLKIT_SCROLL_BARS
10644 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
10645 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
10646 #endif /* USE_TOOLKIT_SCROLL_BARS */
10647 f
->icon_name
= Qnil
;
10648 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10650 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10651 dpyinfo_refcount
= dpyinfo
->reference_count
;
10652 #endif /* GLYPH_DEBUG */
10653 #ifdef MULTI_KBOARD
10654 FRAME_KBOARD (f
) = kb
;
10656 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10657 f
->output_data
.x
->explicit_parent
= 0;
10659 /* These colors will be set anyway later, but it's important
10660 to get the color reference counts right, so initialize them! */
10663 struct gcpro gcpro1
;
10665 black
= build_string ("black");
10667 f
->output_data
.x
->foreground_pixel
10668 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10669 f
->output_data
.x
->background_pixel
10670 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10671 f
->output_data
.x
->cursor_pixel
10672 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10673 f
->output_data
.x
->cursor_foreground_pixel
10674 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10675 f
->output_data
.x
->border_pixel
10676 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10677 f
->output_data
.x
->mouse_pixel
10678 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10682 /* Set the name; the functions to which we pass f expect the name to
10684 if (EQ (name
, Qunbound
) || NILP (name
))
10686 f
->name
= build_string (dpyinfo
->x_id_name
);
10687 f
->explicit_name
= 0;
10692 f
->explicit_name
= 1;
10693 /* use the frame's title when getting resources for this frame. */
10694 specbind (Qx_resource_name
, name
);
10697 /* Extract the window parameters from the supplied values that are
10698 needed to determine window geometry. */
10702 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10705 /* First, try whatever font the caller has specified. */
10706 if (STRINGP (font
))
10708 tem
= Fquery_fontset (font
, Qnil
);
10710 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10712 font
= x_new_font (f
, XSTRING (font
)->data
);
10715 /* Try out a font which we hope has bold and italic variations. */
10716 if (!STRINGP (font
))
10717 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10718 if (!STRINGP (font
))
10719 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10720 if (! STRINGP (font
))
10721 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10722 if (! STRINGP (font
))
10723 /* This was formerly the first thing tried, but it finds too many fonts
10724 and takes too long. */
10725 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10726 /* If those didn't work, look for something which will at least work. */
10727 if (! STRINGP (font
))
10728 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10730 if (! STRINGP (font
))
10731 font
= build_string ("fixed");
10733 x_default_parameter (f
, parms
, Qfont
, font
,
10734 "font", "Font", RES_TYPE_STRING
);
10737 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10738 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10740 /* This defaults to 2 in order to match xterm. We recognize either
10741 internalBorderWidth or internalBorder (which is what xterm calls
10743 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10747 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10748 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10749 if (! EQ (value
, Qunbound
))
10750 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10754 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10755 "internalBorderWidth", "internalBorderWidth",
10758 /* Also do the stuff which must be set before the window exists. */
10759 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10760 "foreground", "Foreground", RES_TYPE_STRING
);
10761 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10762 "background", "Background", RES_TYPE_STRING
);
10763 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10764 "pointerColor", "Foreground", RES_TYPE_STRING
);
10765 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10766 "cursorColor", "Foreground", RES_TYPE_STRING
);
10767 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10768 "borderColor", "BorderColor", RES_TYPE_STRING
);
10770 /* Init faces before x_default_parameter is called for scroll-bar
10771 parameters because that function calls x_set_scroll_bar_width,
10772 which calls change_frame_size, which calls Fset_window_buffer,
10773 which runs hooks, which call Fvertical_motion. At the end, we
10774 end up in init_iterator with a null face cache, which should not
10776 init_frame_faces (f
);
10778 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10779 window_prompting
= x_figure_window_size (f
, parms
);
10781 if (window_prompting
& XNegative
)
10783 if (window_prompting
& YNegative
)
10784 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10786 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10790 if (window_prompting
& YNegative
)
10791 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10793 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10796 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10798 XSetWindowAttributes attrs
;
10799 unsigned long mask
;
10802 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10803 if (DoesSaveUnders (dpyinfo
->screen
))
10804 mask
|= CWSaveUnder
;
10806 /* Window managers look at the override-redirect flag to determine
10807 whether or net to give windows a decoration (Xlib spec, chapter
10809 attrs
.override_redirect
= True
;
10810 attrs
.save_under
= True
;
10811 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10812 /* Arrange for getting MapNotify and UnmapNotify events. */
10813 attrs
.event_mask
= StructureNotifyMask
;
10815 = FRAME_X_WINDOW (f
)
10816 = XCreateWindow (FRAME_X_DISPLAY (f
),
10817 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10818 /* x, y, width, height */
10822 CopyFromParent
, InputOutput
, CopyFromParent
,
10829 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10830 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10831 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10832 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10833 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10834 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10836 /* Dimensions, especially f->height, must be done via change_frame_size.
10837 Change will not be effected unless different from the current
10840 height
= f
->height
;
10842 SET_FRAME_WIDTH (f
, 0);
10843 change_frame_size (f
, height
, width
, 1, 0, 0);
10845 /* Set up faces after all frame parameters are known. This call
10846 also merges in face attributes specified for new frames.
10848 Frame parameters may be changed if .Xdefaults contains
10849 specifications for the default font. For example, if there is an
10850 `Emacs.default.attributeBackground: pink', the `background-color'
10851 attribute of the frame get's set, which let's the internal border
10852 of the tooltip frame appear in pink. Prevent this. */
10854 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
10856 /* Set tip_frame here, so that */
10858 call1 (Qface_set_after_frame_default
, frame
);
10860 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
10861 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
10869 /* It is now ok to make the frame official even if we get an error
10870 below. And the frame needs to be on Vframe_list or making it
10871 visible won't work. */
10872 Vframe_list
= Fcons (frame
, Vframe_list
);
10874 /* Now that the frame is official, it counts as a reference to
10876 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10878 /* Setting attributes of faces of the tooltip frame from resources
10879 and similar will increment face_change_count, which leads to the
10880 clearing of all current matrices. Since this isn't necessary
10881 here, avoid it by resetting face_change_count to the value it
10882 had before we created the tip frame. */
10883 face_change_count
= face_change_count_before
;
10885 /* Discard the unwind_protect. */
10886 return unbind_to (count
, frame
);
10890 /* Compute where to display tip frame F. PARMS is the list of frame
10891 parameters for F. DX and DY are specified offsets from the current
10892 location of the mouse. WIDTH and HEIGHT are the width and height
10893 of the tooltip. Return coordinates relative to the root window of
10894 the display in *ROOT_X, and *ROOT_Y. */
10897 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
10899 Lisp_Object parms
, dx
, dy
;
10901 int *root_x
, *root_y
;
10903 Lisp_Object left
, top
;
10905 Window root
, child
;
10908 /* User-specified position? */
10909 left
= Fcdr (Fassq (Qleft
, parms
));
10910 top
= Fcdr (Fassq (Qtop
, parms
));
10912 /* Move the tooltip window where the mouse pointer is. Resize and
10914 if (!INTEGERP (left
) && !INTEGERP (top
))
10917 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10918 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
10922 if (INTEGERP (top
))
10923 *root_y
= XINT (top
);
10924 else if (*root_y
+ XINT (dy
) - height
< 0)
10925 *root_y
-= XINT (dy
);
10929 *root_y
+= XINT (dy
);
10932 if (INTEGERP (left
))
10933 *root_x
= XINT (left
);
10934 else if (*root_x
+ XINT (dx
) + width
> FRAME_X_DISPLAY_INFO (f
)->width
)
10935 *root_x
-= width
+ XINT (dx
);
10937 *root_x
+= XINT (dx
);
10941 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10942 doc
: /* Show STRING in a "tooltip" window on frame FRAME.
10943 A tooltip window is a small X window displaying a string.
10945 FRAME nil or omitted means use the selected frame.
10947 PARMS is an optional list of frame parameters which can be used to
10948 change the tooltip's appearance.
10950 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
10951 means use the default timeout of 5 seconds.
10953 If the list of frame parameters PARAMS contains a `left' parameters,
10954 the tooltip is displayed at that x-position. Otherwise it is
10955 displayed at the mouse position, with offset DX added (default is 5 if
10956 DX isn't specified). Likewise for the y-position; if a `top' frame
10957 parameter is specified, it determines the y-position of the tooltip
10958 window, otherwise it is displayed at the mouse position, with offset
10959 DY added (default is -10).
10961 A tooltip's maximum size is specified by `x-max-tooltip-size'.
10962 Text larger than the specified size is clipped. */)
10963 (string
, frame
, parms
, timeout
, dx
, dy
)
10964 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10968 Lisp_Object buffer
, top
, left
, max_width
, max_height
;
10969 int root_x
, root_y
;
10970 struct buffer
*old_buffer
;
10971 struct text_pos pos
;
10972 int i
, width
, height
;
10973 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10974 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10975 int count
= BINDING_STACK_SIZE ();
10977 specbind (Qinhibit_redisplay
, Qt
);
10979 GCPRO4 (string
, parms
, frame
, timeout
);
10981 CHECK_STRING (string
, 0);
10982 f
= check_x_frame (frame
);
10983 if (NILP (timeout
))
10984 timeout
= make_number (5);
10986 CHECK_NATNUM (timeout
, 2);
10989 dx
= make_number (5);
10991 CHECK_NUMBER (dx
, 5);
10994 dy
= make_number (-10);
10996 CHECK_NUMBER (dy
, 6);
10998 if (NILP (last_show_tip_args
))
10999 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
11001 if (!NILP (tip_frame
))
11003 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
11004 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
11005 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
11007 if (EQ (frame
, last_frame
)
11008 && !NILP (Fequal (last_string
, string
))
11009 && !NILP (Fequal (last_parms
, parms
)))
11011 struct frame
*f
= XFRAME (tip_frame
);
11013 /* Only DX and DY have changed. */
11014 if (!NILP (tip_timer
))
11016 Lisp_Object timer
= tip_timer
;
11018 call1 (Qcancel_timer
, timer
);
11022 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
11023 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
11024 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11031 /* Hide a previous tip, if any. */
11034 ASET (last_show_tip_args
, 0, string
);
11035 ASET (last_show_tip_args
, 1, frame
);
11036 ASET (last_show_tip_args
, 2, parms
);
11038 /* Add default values to frame parameters. */
11039 if (NILP (Fassq (Qname
, parms
)))
11040 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
11041 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11042 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
11043 if (NILP (Fassq (Qborder_width
, parms
)))
11044 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
11045 if (NILP (Fassq (Qborder_color
, parms
)))
11046 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
11047 if (NILP (Fassq (Qbackground_color
, parms
)))
11048 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
11051 /* Create a frame for the tooltip, and record it in the global
11052 variable tip_frame. */
11053 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
, string
);
11054 f
= XFRAME (frame
);
11056 /* Set up the frame's root window. */
11057 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
11058 w
->left
= w
->top
= make_number (0);
11060 if (CONSP (Vx_max_tooltip_size
)
11061 && INTEGERP (XCAR (Vx_max_tooltip_size
))
11062 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
11063 && INTEGERP (XCDR (Vx_max_tooltip_size
))
11064 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
11066 w
->width
= XCAR (Vx_max_tooltip_size
);
11067 w
->height
= XCDR (Vx_max_tooltip_size
);
11071 w
->width
= make_number (80);
11072 w
->height
= make_number (40);
11075 f
->window_width
= XINT (w
->width
);
11077 w
->pseudo_window_p
= 1;
11079 /* Display the tooltip text in a temporary buffer. */
11080 old_buffer
= current_buffer
;
11081 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
11082 current_buffer
->truncate_lines
= Qnil
;
11083 clear_glyph_matrix (w
->desired_matrix
);
11084 clear_glyph_matrix (w
->current_matrix
);
11085 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
11086 try_window (FRAME_ROOT_WINDOW (f
), pos
);
11088 /* Compute width and height of the tooltip. */
11089 width
= height
= 0;
11090 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
11092 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
11093 struct glyph
*last
;
11096 /* Stop at the first empty row at the end. */
11097 if (!row
->enabled_p
|| !row
->displays_text_p
)
11100 /* Let the row go over the full width of the frame. */
11101 row
->full_width_p
= 1;
11103 /* There's a glyph at the end of rows that is used to place
11104 the cursor there. Don't include the width of this glyph. */
11105 if (row
->used
[TEXT_AREA
])
11107 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
11108 row_width
= row
->pixel_width
- last
->pixel_width
;
11111 row_width
= row
->pixel_width
;
11113 height
+= row
->height
;
11114 width
= max (width
, row_width
);
11117 /* Add the frame's internal border to the width and height the X
11118 window should have. */
11119 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11120 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11122 /* Move the tooltip window where the mouse pointer is. Resize and
11124 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
11127 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11128 root_x
, root_y
, width
, height
);
11129 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
11132 /* Draw into the window. */
11133 w
->must_be_updated_p
= 1;
11134 update_single_window (w
, 1);
11136 /* Restore original current buffer. */
11137 set_buffer_internal_1 (old_buffer
);
11138 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
11141 /* Let the tip disappear after timeout seconds. */
11142 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
11143 intern ("x-hide-tip"));
11146 return unbind_to (count
, Qnil
);
11150 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
11151 doc
: /* Hide the current tooltip window, if there is any.
11152 Value is t if tooltip was open, nil otherwise. */)
11156 Lisp_Object deleted
, frame
, timer
;
11157 struct gcpro gcpro1
, gcpro2
;
11159 /* Return quickly if nothing to do. */
11160 if (NILP (tip_timer
) && NILP (tip_frame
))
11165 GCPRO2 (frame
, timer
);
11166 tip_frame
= tip_timer
= deleted
= Qnil
;
11168 count
= BINDING_STACK_SIZE ();
11169 specbind (Qinhibit_redisplay
, Qt
);
11170 specbind (Qinhibit_quit
, Qt
);
11173 call1 (Qcancel_timer
, timer
);
11175 if (FRAMEP (frame
))
11177 Fdelete_frame (frame
, Qnil
);
11181 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11182 redisplay procedure is not called when a tip frame over menu
11183 items is unmapped. Redisplay the menu manually... */
11185 struct frame
*f
= SELECTED_FRAME ();
11186 Widget w
= f
->output_data
.x
->menubar_widget
;
11187 extern void xlwmenu_redisplay
P_ ((Widget
));
11189 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
11193 xlwmenu_redisplay (w
);
11197 #endif /* USE_LUCID */
11201 return unbind_to (count
, deleted
);
11206 /***********************************************************************
11207 File selection dialog
11208 ***********************************************************************/
11212 /* Callback for "OK" and "Cancel" on file selection dialog. */
11215 file_dialog_cb (widget
, client_data
, call_data
)
11217 XtPointer call_data
, client_data
;
11219 int *result
= (int *) client_data
;
11220 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11221 *result
= cb
->reason
;
11225 /* Callback for unmapping a file selection dialog. This is used to
11226 capture the case where a dialog is closed via a window manager's
11227 closer button, for example. Using a XmNdestroyCallback didn't work
11231 file_dialog_unmap_cb (widget
, client_data
, call_data
)
11233 XtPointer call_data
, client_data
;
11235 int *result
= (int *) client_data
;
11236 *result
= XmCR_CANCEL
;
11240 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11241 doc
: /* Read file name, prompting with PROMPT in directory DIR.
11242 Use a file selection dialog.
11243 Select DEFAULT-FILENAME in the dialog's file selection box, if
11244 specified. Don't let the user enter a file name in the file
11245 selection dialog's entry field, if MUSTMATCH is non-nil. */)
11246 (prompt
, dir
, default_filename
, mustmatch
)
11247 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11250 struct frame
*f
= SELECTED_FRAME ();
11251 Lisp_Object file
= Qnil
;
11252 Widget dialog
, text
, list
, help
;
11255 extern XtAppContext Xt_app_con
;
11256 XmString dir_xmstring
, pattern_xmstring
;
11257 int count
= specpdl_ptr
- specpdl
;
11258 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11260 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11261 CHECK_STRING (prompt
, 0);
11262 CHECK_STRING (dir
, 1);
11264 /* Prevent redisplay. */
11265 specbind (Qinhibit_redisplay
, Qt
);
11269 /* Create the dialog with PROMPT as title, using DIR as initial
11270 directory and using "*" as pattern. */
11271 dir
= Fexpand_file_name (dir
, Qnil
);
11272 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11273 pattern_xmstring
= XmStringCreateLocalized ("*");
11275 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11276 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11277 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11278 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11279 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11280 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11282 XmStringFree (dir_xmstring
);
11283 XmStringFree (pattern_xmstring
);
11285 /* Add callbacks for OK and Cancel. */
11286 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11287 (XtPointer
) &result
);
11288 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11289 (XtPointer
) &result
);
11290 XtAddCallback (dialog
, XmNunmapCallback
, file_dialog_unmap_cb
,
11291 (XtPointer
) &result
);
11293 /* Disable the help button since we can't display help. */
11294 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11295 XtSetSensitive (help
, False
);
11297 /* Mark OK button as default. */
11298 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11299 XmNshowAsDefault
, True
, NULL
);
11301 /* If MUSTMATCH is non-nil, disable the file entry field of the
11302 dialog, so that the user must select a file from the files list
11303 box. We can't remove it because we wouldn't have a way to get at
11304 the result file name, then. */
11305 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11306 if (!NILP (mustmatch
))
11309 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11310 XtSetSensitive (text
, False
);
11311 XtSetSensitive (label
, False
);
11314 /* Manage the dialog, so that list boxes get filled. */
11315 XtManageChild (dialog
);
11317 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11318 must include the path for this to work. */
11319 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11320 if (STRINGP (default_filename
))
11322 XmString default_xmstring
;
11326 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11328 if (!XmListItemExists (list
, default_xmstring
))
11330 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11331 XmListAddItem (list
, default_xmstring
, 0);
11335 item_pos
= XmListItemPos (list
, default_xmstring
);
11336 XmStringFree (default_xmstring
);
11338 /* Select the item and scroll it into view. */
11339 XmListSelectPos (list
, item_pos
, True
);
11340 XmListSetPos (list
, item_pos
);
11343 /* Process events until the user presses Cancel or OK. Block
11344 and unblock input here so that we get a chance of processing
11348 while (result
== 0)
11351 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11356 /* Get the result. */
11357 if (result
== XmCR_OK
)
11362 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11363 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11364 XmStringFree (text
);
11365 file
= build_string (data
);
11372 XtUnmanageChild (dialog
);
11373 XtDestroyWidget (dialog
);
11377 /* Make "Cancel" equivalent to C-g. */
11379 Fsignal (Qquit
, Qnil
);
11381 return unbind_to (count
, file
);
11384 #endif /* USE_MOTIF */
11388 /***********************************************************************
11390 ***********************************************************************/
11392 #ifdef HAVE_XKBGETKEYBOARD
11393 #include <X11/XKBlib.h>
11394 #include <X11/keysym.h>
11397 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11398 Sx_backspace_delete_keys_p
, 0, 1, 0,
11399 doc
: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
11400 FRAME nil means use the selected frame.
11401 Value is t if we know that both keys are present, and are mapped to the
11402 usual X keysyms. */)
11406 #ifdef HAVE_XKBGETKEYBOARD
11408 struct frame
*f
= check_x_frame (frame
);
11409 Display
*dpy
= FRAME_X_DISPLAY (f
);
11410 Lisp_Object have_keys
;
11411 int major
, minor
, op
, event
, error
;
11415 /* Check library version in case we're dynamically linked. */
11416 major
= XkbMajorVersion
;
11417 minor
= XkbMinorVersion
;
11418 if (!XkbLibraryVersion (&major
, &minor
))
11424 /* Check that the server supports XKB. */
11425 major
= XkbMajorVersion
;
11426 minor
= XkbMinorVersion
;
11427 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11434 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11437 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11439 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11441 for (i
= kb
->min_key_code
;
11442 (i
< kb
->max_key_code
11443 && (delete_keycode
== 0 || backspace_keycode
== 0));
11446 /* The XKB symbolic key names can be seen most easily in
11447 the PS file generated by `xkbprint -label name
11449 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11450 delete_keycode
= i
;
11451 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11452 backspace_keycode
= i
;
11455 XkbFreeNames (kb
, 0, True
);
11458 XkbFreeClientMap (kb
, 0, True
);
11461 && backspace_keycode
11462 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11463 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11468 #else /* not HAVE_XKBGETKEYBOARD */
11470 #endif /* not HAVE_XKBGETKEYBOARD */
11475 /***********************************************************************
11477 ***********************************************************************/
11482 /* This is zero if not using X windows. */
11485 /* The section below is built by the lisp expression at the top of the file,
11486 just above where these variables are declared. */
11487 /*&&& init symbols here &&&*/
11488 Qauto_raise
= intern ("auto-raise");
11489 staticpro (&Qauto_raise
);
11490 Qauto_lower
= intern ("auto-lower");
11491 staticpro (&Qauto_lower
);
11492 Qbar
= intern ("bar");
11494 Qborder_color
= intern ("border-color");
11495 staticpro (&Qborder_color
);
11496 Qborder_width
= intern ("border-width");
11497 staticpro (&Qborder_width
);
11498 Qbox
= intern ("box");
11500 Qcursor_color
= intern ("cursor-color");
11501 staticpro (&Qcursor_color
);
11502 Qcursor_type
= intern ("cursor-type");
11503 staticpro (&Qcursor_type
);
11504 Qgeometry
= intern ("geometry");
11505 staticpro (&Qgeometry
);
11506 Qicon_left
= intern ("icon-left");
11507 staticpro (&Qicon_left
);
11508 Qicon_top
= intern ("icon-top");
11509 staticpro (&Qicon_top
);
11510 Qicon_type
= intern ("icon-type");
11511 staticpro (&Qicon_type
);
11512 Qicon_name
= intern ("icon-name");
11513 staticpro (&Qicon_name
);
11514 Qinternal_border_width
= intern ("internal-border-width");
11515 staticpro (&Qinternal_border_width
);
11516 Qleft
= intern ("left");
11517 staticpro (&Qleft
);
11518 Qright
= intern ("right");
11519 staticpro (&Qright
);
11520 Qmouse_color
= intern ("mouse-color");
11521 staticpro (&Qmouse_color
);
11522 Qnone
= intern ("none");
11523 staticpro (&Qnone
);
11524 Qparent_id
= intern ("parent-id");
11525 staticpro (&Qparent_id
);
11526 Qscroll_bar_width
= intern ("scroll-bar-width");
11527 staticpro (&Qscroll_bar_width
);
11528 Qsuppress_icon
= intern ("suppress-icon");
11529 staticpro (&Qsuppress_icon
);
11530 Qundefined_color
= intern ("undefined-color");
11531 staticpro (&Qundefined_color
);
11532 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11533 staticpro (&Qvertical_scroll_bars
);
11534 Qvisibility
= intern ("visibility");
11535 staticpro (&Qvisibility
);
11536 Qwindow_id
= intern ("window-id");
11537 staticpro (&Qwindow_id
);
11538 Qouter_window_id
= intern ("outer-window-id");
11539 staticpro (&Qouter_window_id
);
11540 Qx_frame_parameter
= intern ("x-frame-parameter");
11541 staticpro (&Qx_frame_parameter
);
11542 Qx_resource_name
= intern ("x-resource-name");
11543 staticpro (&Qx_resource_name
);
11544 Quser_position
= intern ("user-position");
11545 staticpro (&Quser_position
);
11546 Quser_size
= intern ("user-size");
11547 staticpro (&Quser_size
);
11548 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11549 staticpro (&Qscroll_bar_foreground
);
11550 Qscroll_bar_background
= intern ("scroll-bar-background");
11551 staticpro (&Qscroll_bar_background
);
11552 Qscreen_gamma
= intern ("screen-gamma");
11553 staticpro (&Qscreen_gamma
);
11554 Qline_spacing
= intern ("line-spacing");
11555 staticpro (&Qline_spacing
);
11556 Qcenter
= intern ("center");
11557 staticpro (&Qcenter
);
11558 Qcompound_text
= intern ("compound-text");
11559 staticpro (&Qcompound_text
);
11560 Qcancel_timer
= intern ("cancel-timer");
11561 staticpro (&Qcancel_timer
);
11562 Qwait_for_wm
= intern ("wait-for-wm");
11563 staticpro (&Qwait_for_wm
);
11564 /* This is the end of symbol initialization. */
11566 /* Text property `display' should be nonsticky by default. */
11567 Vtext_property_default_nonsticky
11568 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11571 Qlaplace
= intern ("laplace");
11572 staticpro (&Qlaplace
);
11573 Qemboss
= intern ("emboss");
11574 staticpro (&Qemboss
);
11575 Qedge_detection
= intern ("edge-detection");
11576 staticpro (&Qedge_detection
);
11577 Qheuristic
= intern ("heuristic");
11578 staticpro (&Qheuristic
);
11579 QCmatrix
= intern (":matrix");
11580 staticpro (&QCmatrix
);
11581 QCcolor_adjustment
= intern (":color-adjustment");
11582 staticpro (&QCcolor_adjustment
);
11583 QCmask
= intern (":mask");
11584 staticpro (&QCmask
);
11586 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11587 staticpro (&Qface_set_after_frame_default
);
11589 Fput (Qundefined_color
, Qerror_conditions
,
11590 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11591 Fput (Qundefined_color
, Qerror_message
,
11592 build_string ("Undefined color"));
11594 init_x_parm_symbols ();
11596 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11597 doc
: /* Non-nil means always draw a cross over disabled images.
11598 Disabled images are those having an `:conversion disabled' property.
11599 A cross is always drawn on black & white displays. */);
11600 cross_disabled_images
= 0;
11602 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11603 doc
: /* List of directories to search for bitmap files for X. */);
11604 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11606 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11607 doc
: /* The shape of the pointer when over text.
11608 Changing the value does not affect existing frames
11609 unless you set the mouse color. */);
11610 Vx_pointer_shape
= Qnil
;
11612 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11613 doc
: /* The name Emacs uses to look up X resources.
11614 `x-get-resource' uses this as the first component of the instance name
11615 when requesting resource values.
11616 Emacs initially sets `x-resource-name' to the name under which Emacs
11617 was invoked, or to the value specified with the `-name' or `-rn'
11618 switches, if present.
11620 It may be useful to bind this variable locally around a call
11621 to `x-get-resource'. See also the variable `x-resource-class'. */);
11622 Vx_resource_name
= Qnil
;
11624 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11625 doc
: /* The class Emacs uses to look up X resources.
11626 `x-get-resource' uses this as the first component of the instance class
11627 when requesting resource values.
11629 Emacs initially sets `x-resource-class' to "Emacs".
11631 Setting this variable permanently is not a reasonable thing to do,
11632 but binding this variable locally around a call to `x-get-resource'
11633 is a reasonable practice. See also the variable `x-resource-name'. */);
11634 Vx_resource_class
= build_string (EMACS_CLASS
);
11636 #if 0 /* This doesn't really do anything. */
11637 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11638 doc
: /* The shape of the pointer when not over text.
11639 This variable takes effect when you create a new frame
11640 or when you set the mouse color. */);
11642 Vx_nontext_pointer_shape
= Qnil
;
11644 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
11645 doc
: /* The shape of the pointer when Emacs is busy.
11646 This variable takes effect when you create a new frame
11647 or when you set the mouse color. */);
11648 Vx_hourglass_pointer_shape
= Qnil
;
11650 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
11651 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
11652 display_hourglass_p
= 1;
11654 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
11655 doc
: /* *Seconds to wait before displaying an hourglass pointer.
11656 Value must be an integer or float. */);
11657 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
11659 #if 0 /* This doesn't really do anything. */
11660 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11661 doc
: /* The shape of the pointer when over the mode line.
11662 This variable takes effect when you create a new frame
11663 or when you set the mouse color. */);
11665 Vx_mode_pointer_shape
= Qnil
;
11667 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11668 &Vx_sensitive_text_pointer_shape
,
11669 doc
: /* The shape of the pointer when over mouse-sensitive text.
11670 This variable takes effect when you create a new frame
11671 or when you set the mouse color. */);
11672 Vx_sensitive_text_pointer_shape
= Qnil
;
11674 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11675 &Vx_window_horizontal_drag_shape
,
11676 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
11677 This variable takes effect when you create a new frame
11678 or when you set the mouse color. */);
11679 Vx_window_horizontal_drag_shape
= Qnil
;
11681 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11682 doc
: /* A string indicating the foreground color of the cursor box. */);
11683 Vx_cursor_fore_pixel
= Qnil
;
11685 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
11686 doc
: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
11687 Text larger than this is clipped. */);
11688 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
11690 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11691 doc
: /* Non-nil if no X window manager is in use.
11692 Emacs doesn't try to figure this out; this is always nil
11693 unless you set it to something else. */);
11694 /* We don't have any way to find this out, so set it to nil
11695 and maybe the user would like to set it to t. */
11696 Vx_no_window_manager
= Qnil
;
11698 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11699 &Vx_pixel_size_width_font_regexp
,
11700 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
11702 Since Emacs gets width of a font matching with this regexp from
11703 PIXEL_SIZE field of the name, font finding mechanism gets faster for
11704 such a font. This is especially effective for such large fonts as
11705 Chinese, Japanese, and Korean. */);
11706 Vx_pixel_size_width_font_regexp
= Qnil
;
11708 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11709 doc
: /* Time after which cached images are removed from the cache.
11710 When an image has not been displayed this many seconds, remove it
11711 from the image cache. Value must be an integer or nil with nil
11712 meaning don't clear the cache. */);
11713 Vimage_cache_eviction_delay
= make_number (30 * 60);
11715 #ifdef USE_X_TOOLKIT
11716 Fprovide (intern ("x-toolkit"), Qnil
);
11718 Fprovide (intern ("motif"), Qnil
);
11720 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string
,
11721 doc
: /* Version info for LessTif/Motif. */);
11722 Vmotif_version_string
= build_string (XmVERSION_STRING
);
11723 #endif /* USE_MOTIF */
11724 #endif /* USE_X_TOOLKIT */
11726 defsubr (&Sx_get_resource
);
11728 /* X window properties. */
11729 defsubr (&Sx_change_window_property
);
11730 defsubr (&Sx_delete_window_property
);
11731 defsubr (&Sx_window_property
);
11733 defsubr (&Sxw_display_color_p
);
11734 defsubr (&Sx_display_grayscale_p
);
11735 defsubr (&Sxw_color_defined_p
);
11736 defsubr (&Sxw_color_values
);
11737 defsubr (&Sx_server_max_request_size
);
11738 defsubr (&Sx_server_vendor
);
11739 defsubr (&Sx_server_version
);
11740 defsubr (&Sx_display_pixel_width
);
11741 defsubr (&Sx_display_pixel_height
);
11742 defsubr (&Sx_display_mm_width
);
11743 defsubr (&Sx_display_mm_height
);
11744 defsubr (&Sx_display_screens
);
11745 defsubr (&Sx_display_planes
);
11746 defsubr (&Sx_display_color_cells
);
11747 defsubr (&Sx_display_visual_class
);
11748 defsubr (&Sx_display_backing_store
);
11749 defsubr (&Sx_display_save_under
);
11750 defsubr (&Sx_parse_geometry
);
11751 defsubr (&Sx_create_frame
);
11752 defsubr (&Sx_open_connection
);
11753 defsubr (&Sx_close_connection
);
11754 defsubr (&Sx_display_list
);
11755 defsubr (&Sx_synchronize
);
11756 defsubr (&Sx_focus_frame
);
11757 defsubr (&Sx_backspace_delete_keys_p
);
11759 /* Setting callback functions for fontset handler. */
11760 get_font_info_func
= x_get_font_info
;
11762 #if 0 /* This function pointer doesn't seem to be used anywhere.
11763 And the pointer assigned has the wrong type, anyway. */
11764 list_fonts_func
= x_list_fonts
;
11767 load_font_func
= x_load_font
;
11768 find_ccl_program_func
= x_find_ccl_program
;
11769 query_font_func
= x_query_font
;
11770 set_frame_fontset_func
= x_set_font
;
11771 check_window_system_func
= check_x
;
11774 Qxbm
= intern ("xbm");
11776 QCtype
= intern (":type");
11777 staticpro (&QCtype
);
11778 QCconversion
= intern (":conversion");
11779 staticpro (&QCconversion
);
11780 QCheuristic_mask
= intern (":heuristic-mask");
11781 staticpro (&QCheuristic_mask
);
11782 QCcolor_symbols
= intern (":color-symbols");
11783 staticpro (&QCcolor_symbols
);
11784 QCascent
= intern (":ascent");
11785 staticpro (&QCascent
);
11786 QCmargin
= intern (":margin");
11787 staticpro (&QCmargin
);
11788 QCrelief
= intern (":relief");
11789 staticpro (&QCrelief
);
11790 Qpostscript
= intern ("postscript");
11791 staticpro (&Qpostscript
);
11792 QCloader
= intern (":loader");
11793 staticpro (&QCloader
);
11794 QCbounding_box
= intern (":bounding-box");
11795 staticpro (&QCbounding_box
);
11796 QCpt_width
= intern (":pt-width");
11797 staticpro (&QCpt_width
);
11798 QCpt_height
= intern (":pt-height");
11799 staticpro (&QCpt_height
);
11800 QCindex
= intern (":index");
11801 staticpro (&QCindex
);
11802 Qpbm
= intern ("pbm");
11806 Qxpm
= intern ("xpm");
11811 Qjpeg
= intern ("jpeg");
11812 staticpro (&Qjpeg
);
11816 Qtiff
= intern ("tiff");
11817 staticpro (&Qtiff
);
11821 Qgif
= intern ("gif");
11826 Qpng
= intern ("png");
11830 defsubr (&Sclear_image_cache
);
11831 defsubr (&Simage_size
);
11832 defsubr (&Simage_mask_p
);
11834 hourglass_atimer
= NULL
;
11835 hourglass_shown_p
= 0;
11837 defsubr (&Sx_show_tip
);
11838 defsubr (&Sx_hide_tip
);
11840 staticpro (&tip_timer
);
11842 staticpro (&tip_frame
);
11844 last_show_tip_args
= Qnil
;
11845 staticpro (&last_show_tip_args
);
11848 defsubr (&Sx_file_dialog
);
11856 image_types
= NULL
;
11857 Vimage_types
= Qnil
;
11859 define_image_type (&xbm_type
);
11860 define_image_type (&gs_type
);
11861 define_image_type (&pbm_type
);
11864 define_image_type (&xpm_type
);
11868 define_image_type (&jpeg_type
);
11872 define_image_type (&tiff_type
);
11876 define_image_type (&gif_type
);
11880 define_image_type (&png_type
);
11884 #endif /* HAVE_X_WINDOWS */