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 */
120 #define min(a,b) ((a) < (b) ? (a) : (b))
121 #define max(a,b) ((a) > (b) ? (a) : (b))
124 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
126 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
129 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
130 it, and including `bitmaps/gray' more than once is a problem when
131 config.h defines `static' as an empty replacement string. */
133 int gray_bitmap_width
= gray_width
;
134 int gray_bitmap_height
= gray_height
;
135 char *gray_bitmap_bits
= gray_bits
;
137 /* The name we're using in resource queries. Most often "emacs". */
139 Lisp_Object Vx_resource_name
;
141 /* The application class we're using in resource queries.
144 Lisp_Object Vx_resource_class
;
146 /* Non-zero means we're allowed to display an hourglass cursor. */
148 int display_hourglass_p
;
150 /* The background and shape of the mouse pointer, and shape when not
151 over text or in the modeline. */
153 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
154 Lisp_Object Vx_hourglass_pointer_shape
;
156 /* The shape when over mouse-sensitive text. */
158 Lisp_Object Vx_sensitive_text_pointer_shape
;
160 /* If non-nil, the pointer shape to indicate that windows can be
161 dragged horizontally. */
163 Lisp_Object Vx_window_horizontal_drag_shape
;
165 /* Color of chars displayed in cursor box. */
167 Lisp_Object Vx_cursor_fore_pixel
;
169 /* Nonzero if using X. */
173 /* Non nil if no window manager is in use. */
175 Lisp_Object Vx_no_window_manager
;
177 /* Search path for bitmap files. */
179 Lisp_Object Vx_bitmap_file_path
;
181 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
183 Lisp_Object Vx_pixel_size_width_font_regexp
;
185 Lisp_Object Qauto_raise
;
186 Lisp_Object Qauto_lower
;
188 Lisp_Object Qborder_color
;
189 Lisp_Object Qborder_width
;
191 Lisp_Object Qcursor_color
;
192 Lisp_Object Qcursor_type
;
193 Lisp_Object Qgeometry
;
194 Lisp_Object Qicon_left
;
195 Lisp_Object Qicon_top
;
196 Lisp_Object Qicon_type
;
197 Lisp_Object Qicon_name
;
198 Lisp_Object Qinternal_border_width
;
201 Lisp_Object Qmouse_color
;
203 Lisp_Object Qouter_window_id
;
204 Lisp_Object Qparent_id
;
205 Lisp_Object Qscroll_bar_width
;
206 Lisp_Object Qsuppress_icon
;
207 extern Lisp_Object Qtop
;
208 Lisp_Object Qundefined_color
;
209 Lisp_Object Qvertical_scroll_bars
;
210 Lisp_Object Qvisibility
;
211 Lisp_Object Qwindow_id
;
212 Lisp_Object Qx_frame_parameter
;
213 Lisp_Object Qx_resource_name
;
214 Lisp_Object Quser_position
;
215 Lisp_Object Quser_size
;
216 extern Lisp_Object Qdisplay
;
217 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
218 Lisp_Object Qscreen_gamma
, Qline_spacing
, Qcenter
;
219 Lisp_Object Qcompound_text
, Qcancel_timer
;
220 Lisp_Object Qwait_for_wm
;
222 /* The below are defined in frame.c. */
224 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
225 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
226 extern Lisp_Object Qtool_bar_lines
;
228 extern Lisp_Object Vwindow_system_version
;
230 Lisp_Object Qface_set_after_frame_default
;
233 int image_cache_refcount
, dpyinfo_refcount
;
238 /* Error if we are not connected to X. */
244 error ("X windows are not in use or not initialized");
247 /* Nonzero if we can use mouse menus.
248 You should not call this unless HAVE_MENUS is defined. */
256 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
257 and checking validity for X. */
260 check_x_frame (frame
)
266 frame
= selected_frame
;
267 CHECK_LIVE_FRAME (frame
, 0);
270 error ("Non-X frame used");
274 /* Let the user specify an X display with a frame.
275 nil stands for the selected frame--or, if that is not an X frame,
276 the first X display on the list. */
278 static struct x_display_info
*
279 check_x_display_info (frame
)
282 struct x_display_info
*dpyinfo
= NULL
;
286 struct frame
*sf
= XFRAME (selected_frame
);
288 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
289 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
290 else if (x_display_list
!= 0)
291 dpyinfo
= x_display_list
;
293 error ("X windows are not in use or not initialized");
295 else if (STRINGP (frame
))
296 dpyinfo
= x_display_info_for_name (frame
);
301 CHECK_LIVE_FRAME (frame
, 0);
304 error ("Non-X frame used");
305 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
312 /* Return the Emacs frame-object corresponding to an X window.
313 It could be the frame's main window or an icon window. */
315 /* This function can be called during GC, so use GC_xxx type test macros. */
318 x_window_to_frame (dpyinfo
, wdesc
)
319 struct x_display_info
*dpyinfo
;
322 Lisp_Object tail
, frame
;
325 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
328 if (!GC_FRAMEP (frame
))
331 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
333 if (f
->output_data
.x
->hourglass_window
== wdesc
)
336 if ((f
->output_data
.x
->edit_widget
337 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
338 /* A tooltip frame? */
339 || (!f
->output_data
.x
->edit_widget
340 && FRAME_X_WINDOW (f
) == wdesc
)
341 || f
->output_data
.x
->icon_desc
== wdesc
)
343 #else /* not USE_X_TOOLKIT */
344 if (FRAME_X_WINDOW (f
) == wdesc
345 || f
->output_data
.x
->icon_desc
== wdesc
)
347 #endif /* not USE_X_TOOLKIT */
353 /* Like x_window_to_frame but also compares the window with the widget's
357 x_any_window_to_frame (dpyinfo
, wdesc
)
358 struct x_display_info
*dpyinfo
;
361 Lisp_Object tail
, frame
;
362 struct frame
*f
, *found
;
366 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
369 if (!GC_FRAMEP (frame
))
373 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
375 /* This frame matches if the window is any of its widgets. */
376 x
= f
->output_data
.x
;
377 if (x
->hourglass_window
== wdesc
)
381 if (wdesc
== XtWindow (x
->widget
)
382 || wdesc
== XtWindow (x
->column_widget
)
383 || wdesc
== XtWindow (x
->edit_widget
))
385 /* Match if the window is this frame's menubar. */
386 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
389 else if (FRAME_X_WINDOW (f
) == wdesc
)
390 /* A tooltip frame. */
398 /* Likewise, but exclude the menu bar widget. */
401 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
402 struct x_display_info
*dpyinfo
;
405 Lisp_Object tail
, frame
;
409 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
412 if (!GC_FRAMEP (frame
))
415 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
417 x
= f
->output_data
.x
;
418 /* This frame matches if the window is any of its widgets. */
419 if (x
->hourglass_window
== wdesc
)
423 if (wdesc
== XtWindow (x
->widget
)
424 || wdesc
== XtWindow (x
->column_widget
)
425 || wdesc
== XtWindow (x
->edit_widget
))
428 else if (FRAME_X_WINDOW (f
) == wdesc
)
429 /* A tooltip frame. */
435 /* Likewise, but consider only the menu bar widget. */
438 x_menubar_window_to_frame (dpyinfo
, wdesc
)
439 struct x_display_info
*dpyinfo
;
442 Lisp_Object tail
, frame
;
446 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
449 if (!GC_FRAMEP (frame
))
452 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
454 x
= f
->output_data
.x
;
455 /* Match if the window is this frame's menubar. */
456 if (x
->menubar_widget
457 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
463 /* Return the frame whose principal (outermost) window is WDESC.
464 If WDESC is some other (smaller) window, we return 0. */
467 x_top_window_to_frame (dpyinfo
, wdesc
)
468 struct x_display_info
*dpyinfo
;
471 Lisp_Object tail
, frame
;
475 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
478 if (!GC_FRAMEP (frame
))
481 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
483 x
= f
->output_data
.x
;
487 /* This frame matches if the window is its topmost widget. */
488 if (wdesc
== XtWindow (x
->widget
))
490 #if 0 /* I don't know why it did this,
491 but it seems logically wrong,
492 and it causes trouble for MapNotify events. */
493 /* Match if the window is this frame's menubar. */
494 if (x
->menubar_widget
495 && wdesc
== XtWindow (x
->menubar_widget
))
499 else if (FRAME_X_WINDOW (f
) == wdesc
)
505 #endif /* USE_X_TOOLKIT */
509 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
510 id, which is just an int that this section returns. Bitmaps are
511 reference counted so they can be shared among frames.
513 Bitmap indices are guaranteed to be > 0, so a negative number can
514 be used to indicate no bitmap.
516 If you use x_create_bitmap_from_data, then you must keep track of
517 the bitmaps yourself. That is, creating a bitmap from the same
518 data more than once will not be caught. */
521 /* Functions to access the contents of a bitmap, given an id. */
524 x_bitmap_height (f
, id
)
528 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
532 x_bitmap_width (f
, id
)
536 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
540 x_bitmap_pixmap (f
, id
)
544 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
548 /* Allocate a new bitmap record. Returns index of new record. */
551 x_allocate_bitmap_record (f
)
554 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
557 if (dpyinfo
->bitmaps
== NULL
)
559 dpyinfo
->bitmaps_size
= 10;
561 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
562 dpyinfo
->bitmaps_last
= 1;
566 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
567 return ++dpyinfo
->bitmaps_last
;
569 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
570 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
573 dpyinfo
->bitmaps_size
*= 2;
575 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
576 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
577 return ++dpyinfo
->bitmaps_last
;
580 /* Add one reference to the reference count of the bitmap with id ID. */
583 x_reference_bitmap (f
, id
)
587 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
590 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
593 x_create_bitmap_from_data (f
, bits
, width
, height
)
596 unsigned int width
, height
;
598 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
602 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
603 bits
, width
, height
);
608 id
= x_allocate_bitmap_record (f
);
609 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
610 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
611 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
612 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
613 dpyinfo
->bitmaps
[id
- 1].height
= height
;
614 dpyinfo
->bitmaps
[id
- 1].width
= width
;
619 /* Create bitmap from file FILE for frame F. */
622 x_create_bitmap_from_file (f
, file
)
626 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
627 unsigned int width
, height
;
629 int xhot
, yhot
, result
, id
;
634 /* Look for an existing bitmap with the same name. */
635 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
637 if (dpyinfo
->bitmaps
[id
].refcount
638 && dpyinfo
->bitmaps
[id
].file
639 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
641 ++dpyinfo
->bitmaps
[id
].refcount
;
646 /* Search bitmap-file-path for the file, if appropriate. */
647 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
652 filename
= (char *) XSTRING (found
)->data
;
654 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
655 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
656 if (result
!= BitmapSuccess
)
659 id
= x_allocate_bitmap_record (f
);
660 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
661 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
662 dpyinfo
->bitmaps
[id
- 1].file
663 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
664 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
665 dpyinfo
->bitmaps
[id
- 1].height
= height
;
666 dpyinfo
->bitmaps
[id
- 1].width
= width
;
667 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
672 /* Remove reference to bitmap with id number ID. */
675 x_destroy_bitmap (f
, id
)
679 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
683 --dpyinfo
->bitmaps
[id
- 1].refcount
;
684 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
687 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
688 if (dpyinfo
->bitmaps
[id
- 1].file
)
690 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
691 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
698 /* Free all the bitmaps for the display specified by DPYINFO. */
701 x_destroy_all_bitmaps (dpyinfo
)
702 struct x_display_info
*dpyinfo
;
705 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
706 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
708 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
709 if (dpyinfo
->bitmaps
[i
].file
)
710 xfree (dpyinfo
->bitmaps
[i
].file
);
712 dpyinfo
->bitmaps_last
= 0;
715 /* Connect the frame-parameter names for X frames
716 to the ways of passing the parameter values to the window system.
718 The name of a parameter, as a Lisp symbol,
719 has an `x-frame-parameter' property which is an integer in Lisp
720 that is an index in this table. */
722 struct x_frame_parm_table
725 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
728 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
729 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
730 static void x_change_window_heights
P_ ((Lisp_Object
, int));
731 static void x_disable_image
P_ ((struct frame
*, struct image
*));
732 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
733 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
734 static void x_set_wait_for_wm
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
735 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
736 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
737 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
738 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
739 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
740 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
741 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
742 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
743 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
744 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
746 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
751 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
755 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
759 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
761 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
766 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
767 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
769 static void init_color_table
P_ ((void));
770 static void free_color_table
P_ ((void));
771 static unsigned long *colors_in_color_table
P_ ((int *n
));
772 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
773 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
777 static struct x_frame_parm_table x_frame_parms
[] =
779 "auto-raise", x_set_autoraise
,
780 "auto-lower", x_set_autolower
,
781 "background-color", x_set_background_color
,
782 "border-color", x_set_border_color
,
783 "border-width", x_set_border_width
,
784 "cursor-color", x_set_cursor_color
,
785 "cursor-type", x_set_cursor_type
,
787 "foreground-color", x_set_foreground_color
,
788 "icon-name", x_set_icon_name
,
789 "icon-type", x_set_icon_type
,
790 "internal-border-width", x_set_internal_border_width
,
791 "menu-bar-lines", x_set_menu_bar_lines
,
792 "mouse-color", x_set_mouse_color
,
793 "name", x_explicitly_set_name
,
794 "scroll-bar-width", x_set_scroll_bar_width
,
795 "title", x_set_title
,
796 "unsplittable", x_set_unsplittable
,
797 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
798 "visibility", x_set_visibility
,
799 "tool-bar-lines", x_set_tool_bar_lines
,
800 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
801 "scroll-bar-background", x_set_scroll_bar_background
,
802 "screen-gamma", x_set_screen_gamma
,
803 "line-spacing", x_set_line_spacing
,
804 "wait-for-wm", x_set_wait_for_wm
807 /* Attach the `x-frame-parameter' properties to
808 the Lisp symbol names of parameters relevant to X. */
811 init_x_parm_symbols ()
815 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
816 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
820 /* Change the parameters of frame F as specified by ALIST.
821 If a parameter is not specially recognized, do nothing special;
822 otherwise call the `x_set_...' function for that parameter.
823 Except for certain geometry properties, always call store_frame_param
824 to store the new value in the parameter alist. */
827 x_set_frame_parameters (f
, alist
)
833 /* If both of these parameters are present, it's more efficient to
834 set them both at once. So we wait until we've looked at the
835 entire list before we set them. */
839 Lisp_Object left
, top
;
841 /* Same with these. */
842 Lisp_Object icon_left
, icon_top
;
844 /* Record in these vectors all the parms specified. */
848 int left_no_change
= 0, top_no_change
= 0;
849 int icon_left_no_change
= 0, icon_top_no_change
= 0;
851 struct gcpro gcpro1
, gcpro2
;
854 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
857 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
858 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
860 /* Extract parm names and values into those vectors. */
863 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
868 parms
[i
] = Fcar (elt
);
869 values
[i
] = Fcdr (elt
);
872 /* TAIL and ALIST are not used again below here. */
875 GCPRO2 (*parms
, *values
);
879 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
880 because their values appear in VALUES and strings are not valid. */
881 top
= left
= Qunbound
;
882 icon_left
= icon_top
= Qunbound
;
884 /* Provide default values for HEIGHT and WIDTH. */
885 if (FRAME_NEW_WIDTH (f
))
886 width
= FRAME_NEW_WIDTH (f
);
888 width
= FRAME_WIDTH (f
);
890 if (FRAME_NEW_HEIGHT (f
))
891 height
= FRAME_NEW_HEIGHT (f
);
893 height
= FRAME_HEIGHT (f
);
895 /* Process foreground_color and background_color before anything else.
896 They are independent of other properties, but other properties (e.g.,
897 cursor_color) are dependent upon them. */
898 for (p
= 0; p
< i
; p
++)
900 Lisp_Object prop
, val
;
904 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
906 register Lisp_Object param_index
, old_value
;
908 param_index
= Fget (prop
, Qx_frame_parameter
);
909 old_value
= get_frame_param (f
, prop
);
910 store_frame_param (f
, prop
, val
);
911 if (NATNUMP (param_index
)
912 && (XFASTINT (param_index
)
913 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
914 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
918 /* Now process them in reverse of specified order. */
919 for (i
--; i
>= 0; i
--)
921 Lisp_Object prop
, val
;
926 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
927 width
= XFASTINT (val
);
928 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
929 height
= XFASTINT (val
);
930 else if (EQ (prop
, Qtop
))
932 else if (EQ (prop
, Qleft
))
934 else if (EQ (prop
, Qicon_top
))
936 else if (EQ (prop
, Qicon_left
))
938 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
939 /* Processed above. */
943 register Lisp_Object param_index
, old_value
;
945 param_index
= Fget (prop
, Qx_frame_parameter
);
946 old_value
= get_frame_param (f
, prop
);
947 store_frame_param (f
, prop
, val
);
948 if (NATNUMP (param_index
)
949 && (XFASTINT (param_index
)
950 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
951 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
955 /* Don't die if just one of these was set. */
956 if (EQ (left
, Qunbound
))
959 if (f
->output_data
.x
->left_pos
< 0)
960 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
962 XSETINT (left
, f
->output_data
.x
->left_pos
);
964 if (EQ (top
, Qunbound
))
967 if (f
->output_data
.x
->top_pos
< 0)
968 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
970 XSETINT (top
, f
->output_data
.x
->top_pos
);
973 /* If one of the icon positions was not set, preserve or default it. */
974 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
976 icon_left_no_change
= 1;
977 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
978 if (NILP (icon_left
))
979 XSETINT (icon_left
, 0);
981 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
983 icon_top_no_change
= 1;
984 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
986 XSETINT (icon_top
, 0);
989 /* Don't set these parameters unless they've been explicitly
990 specified. The window might be mapped or resized while we're in
991 this function, and we don't want to override that unless the lisp
992 code has asked for it.
994 Don't set these parameters unless they actually differ from the
995 window's current parameters; the window may not actually exist
1000 check_frame_size (f
, &height
, &width
);
1002 XSETFRAME (frame
, f
);
1004 if (width
!= FRAME_WIDTH (f
)
1005 || height
!= FRAME_HEIGHT (f
)
1006 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1007 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1009 if ((!NILP (left
) || !NILP (top
))
1010 && ! (left_no_change
&& top_no_change
)
1011 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1012 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1017 /* Record the signs. */
1018 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1019 if (EQ (left
, Qminus
))
1020 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1021 else if (INTEGERP (left
))
1023 leftpos
= XINT (left
);
1025 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1027 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1028 && CONSP (XCDR (left
))
1029 && INTEGERP (XCAR (XCDR (left
))))
1031 leftpos
= - XINT (XCAR (XCDR (left
)));
1032 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1034 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1035 && CONSP (XCDR (left
))
1036 && INTEGERP (XCAR (XCDR (left
))))
1038 leftpos
= XINT (XCAR (XCDR (left
)));
1041 if (EQ (top
, Qminus
))
1042 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1043 else if (INTEGERP (top
))
1045 toppos
= XINT (top
);
1047 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1049 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1050 && CONSP (XCDR (top
))
1051 && INTEGERP (XCAR (XCDR (top
))))
1053 toppos
= - XINT (XCAR (XCDR (top
)));
1054 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1056 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1057 && CONSP (XCDR (top
))
1058 && INTEGERP (XCAR (XCDR (top
))))
1060 toppos
= XINT (XCAR (XCDR (top
)));
1064 /* Store the numeric value of the position. */
1065 f
->output_data
.x
->top_pos
= toppos
;
1066 f
->output_data
.x
->left_pos
= leftpos
;
1068 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1070 /* Actually set that position, and convert to absolute. */
1071 x_set_offset (f
, leftpos
, toppos
, -1);
1074 if ((!NILP (icon_left
) || !NILP (icon_top
))
1075 && ! (icon_left_no_change
&& icon_top_no_change
))
1076 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1082 /* Store the screen positions of frame F into XPTR and YPTR.
1083 These are the positions of the containing window manager window,
1084 not Emacs's own window. */
1087 x_real_positions (f
, xptr
, yptr
)
1094 /* This is pretty gross, but seems to be the easiest way out of
1095 the problem that arises when restarting window-managers. */
1097 #ifdef USE_X_TOOLKIT
1098 Window outer
= (f
->output_data
.x
->widget
1099 ? XtWindow (f
->output_data
.x
->widget
)
1100 : FRAME_X_WINDOW (f
));
1102 Window outer
= f
->output_data
.x
->window_desc
;
1104 Window tmp_root_window
;
1105 Window
*tmp_children
;
1106 unsigned int tmp_nchildren
;
1110 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1111 Window outer_window
;
1113 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1114 &f
->output_data
.x
->parent_desc
,
1115 &tmp_children
, &tmp_nchildren
);
1116 XFree ((char *) tmp_children
);
1120 /* Find the position of the outside upper-left corner of
1121 the inner window, with respect to the outer window. */
1122 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1123 outer_window
= f
->output_data
.x
->parent_desc
;
1125 outer_window
= outer
;
1127 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1129 /* From-window, to-window. */
1131 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1133 /* From-position, to-position. */
1134 0, 0, &win_x
, &win_y
,
1139 /* It is possible for the window returned by the XQueryNotify
1140 to become invalid by the time we call XTranslateCoordinates.
1141 That can happen when you restart some window managers.
1142 If so, we get an error in XTranslateCoordinates.
1143 Detect that and try the whole thing over. */
1144 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1146 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1150 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1157 /* Insert a description of internally-recorded parameters of frame X
1158 into the parameter alist *ALISTPTR that is to be given to the user.
1159 Only parameters that are specific to the X window system
1160 and whose values are not correctly recorded in the frame's
1161 param_alist need to be considered here. */
1164 x_report_frame_params (f
, alistptr
)
1166 Lisp_Object
*alistptr
;
1171 /* Represent negative positions (off the top or left screen edge)
1172 in a way that Fmodify_frame_parameters will understand correctly. */
1173 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1174 if (f
->output_data
.x
->left_pos
>= 0)
1175 store_in_alist (alistptr
, Qleft
, tem
);
1177 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1179 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1180 if (f
->output_data
.x
->top_pos
>= 0)
1181 store_in_alist (alistptr
, Qtop
, tem
);
1183 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1185 store_in_alist (alistptr
, Qborder_width
,
1186 make_number (f
->output_data
.x
->border_width
));
1187 store_in_alist (alistptr
, Qinternal_border_width
,
1188 make_number (f
->output_data
.x
->internal_border_width
));
1189 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1190 store_in_alist (alistptr
, Qwindow_id
,
1191 build_string (buf
));
1192 #ifdef USE_X_TOOLKIT
1193 /* Tooltip frame may not have this widget. */
1194 if (f
->output_data
.x
->widget
)
1196 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1197 store_in_alist (alistptr
, Qouter_window_id
,
1198 build_string (buf
));
1199 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1200 FRAME_SAMPLE_VISIBILITY (f
);
1201 store_in_alist (alistptr
, Qvisibility
,
1202 (FRAME_VISIBLE_P (f
) ? Qt
1203 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1204 store_in_alist (alistptr
, Qdisplay
,
1205 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1207 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1210 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1211 store_in_alist (alistptr
, Qparent_id
, tem
);
1216 /* Gamma-correct COLOR on frame F. */
1219 gamma_correct (f
, color
)
1225 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1226 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1227 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1232 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1233 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1234 allocate the color. Value is zero if COLOR_NAME is invalid, or
1235 no color could be allocated. */
1238 x_defined_color (f
, color_name
, color
, alloc_p
)
1245 Display
*dpy
= FRAME_X_DISPLAY (f
);
1246 Colormap cmap
= FRAME_X_COLORMAP (f
);
1249 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1250 if (success_p
&& alloc_p
)
1251 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1258 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1259 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1260 Signal an error if color can't be allocated. */
1263 x_decode_color (f
, color_name
, mono_color
)
1265 Lisp_Object color_name
;
1270 CHECK_STRING (color_name
, 0);
1272 #if 0 /* Don't do this. It's wrong when we're not using the default
1273 colormap, it makes freeing difficult, and it's probably not
1274 an important optimization. */
1275 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1276 return BLACK_PIX_DEFAULT (f
);
1277 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1278 return WHITE_PIX_DEFAULT (f
);
1281 /* Return MONO_COLOR for monochrome frames. */
1282 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1285 /* x_defined_color is responsible for coping with failures
1286 by looking for a near-miss. */
1287 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1290 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1291 Fcons (color_name
, Qnil
)));
1297 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1298 the previous value of that parameter, NEW_VALUE is the new value. */
1301 x_set_line_spacing (f
, new_value
, old_value
)
1303 Lisp_Object new_value
, old_value
;
1305 if (NILP (new_value
))
1306 f
->extra_line_spacing
= 0;
1307 else if (NATNUMP (new_value
))
1308 f
->extra_line_spacing
= XFASTINT (new_value
);
1310 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1311 Fcons (new_value
, Qnil
)));
1312 if (FRAME_VISIBLE_P (f
))
1317 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1318 the previous value of that parameter, NEW_VALUE is the new value.
1319 See also the comment of wait_for_wm in struct x_output. */
1322 x_set_wait_for_wm (f
, new_value
, old_value
)
1324 Lisp_Object new_value
, old_value
;
1326 f
->output_data
.x
->wait_for_wm
= !NILP (new_value
);
1330 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1331 the previous value of that parameter, NEW_VALUE is the new
1335 x_set_screen_gamma (f
, new_value
, old_value
)
1337 Lisp_Object new_value
, old_value
;
1339 if (NILP (new_value
))
1341 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1342 /* The value 0.4545 is the normal viewing gamma. */
1343 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1345 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1346 Fcons (new_value
, Qnil
)));
1348 clear_face_cache (0);
1352 /* Functions called only from `x_set_frame_param'
1353 to set individual parameters.
1355 If FRAME_X_WINDOW (f) is 0,
1356 the frame is being created and its X-window does not exist yet.
1357 In that case, just record the parameter's new value
1358 in the standard place; do not attempt to change the window. */
1361 x_set_foreground_color (f
, arg
, oldval
)
1363 Lisp_Object arg
, oldval
;
1365 struct x_output
*x
= f
->output_data
.x
;
1366 unsigned long fg
, old_fg
;
1368 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1369 old_fg
= x
->foreground_pixel
;
1370 x
->foreground_pixel
= fg
;
1372 if (FRAME_X_WINDOW (f
) != 0)
1374 Display
*dpy
= FRAME_X_DISPLAY (f
);
1377 XSetForeground (dpy
, x
->normal_gc
, fg
);
1378 XSetBackground (dpy
, x
->reverse_gc
, fg
);
1380 if (x
->cursor_pixel
== old_fg
)
1382 unload_color (f
, x
->cursor_pixel
);
1383 x
->cursor_pixel
= x_copy_color (f
, fg
);
1384 XSetBackground (dpy
, x
->cursor_gc
, x
->cursor_pixel
);
1389 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1391 if (FRAME_VISIBLE_P (f
))
1395 unload_color (f
, old_fg
);
1399 x_set_background_color (f
, arg
, oldval
)
1401 Lisp_Object arg
, oldval
;
1403 struct x_output
*x
= f
->output_data
.x
;
1406 bg
= x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1407 unload_color (f
, x
->background_pixel
);
1408 x
->background_pixel
= bg
;
1410 if (FRAME_X_WINDOW (f
) != 0)
1412 Display
*dpy
= FRAME_X_DISPLAY (f
);
1415 XSetBackground (dpy
, x
->normal_gc
, bg
);
1416 XSetForeground (dpy
, x
->reverse_gc
, bg
);
1417 XSetWindowBackground (dpy
, FRAME_X_WINDOW (f
), bg
);
1418 XSetForeground (dpy
, x
->cursor_gc
, bg
);
1420 #ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1421 toolkit scroll bars. */
1424 for (bar
= FRAME_SCROLL_BARS (f
);
1426 bar
= XSCROLL_BAR (bar
)->next
)
1428 Window window
= SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
));
1429 XSetWindowBackground (dpy
, window
, bg
);
1432 #endif /* USE_TOOLKIT_SCROLL_BARS */
1435 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1437 if (FRAME_VISIBLE_P (f
))
1443 x_set_mouse_color (f
, arg
, oldval
)
1445 Lisp_Object arg
, oldval
;
1447 struct x_output
*x
= f
->output_data
.x
;
1448 Display
*dpy
= FRAME_X_DISPLAY (f
);
1449 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1450 Cursor hourglass_cursor
, horizontal_drag_cursor
;
1452 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1453 unsigned long mask_color
= x
->background_pixel
;
1455 /* Don't let pointers be invisible. */
1456 if (mask_color
== pixel
)
1458 x_free_colors (f
, &pixel
, 1);
1459 pixel
= x_copy_color (f
, x
->foreground_pixel
);
1462 unload_color (f
, x
->mouse_pixel
);
1463 x
->mouse_pixel
= pixel
;
1467 /* It's not okay to crash if the user selects a screwy cursor. */
1468 count
= x_catch_errors (dpy
);
1470 if (!NILP (Vx_pointer_shape
))
1472 CHECK_NUMBER (Vx_pointer_shape
, 0);
1473 cursor
= XCreateFontCursor (dpy
, XINT (Vx_pointer_shape
));
1476 cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1477 x_check_errors (dpy
, "bad text pointer cursor: %s");
1479 if (!NILP (Vx_nontext_pointer_shape
))
1481 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1483 = XCreateFontCursor (dpy
, XINT (Vx_nontext_pointer_shape
));
1486 nontext_cursor
= XCreateFontCursor (dpy
, XC_left_ptr
);
1487 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1489 if (!NILP (Vx_hourglass_pointer_shape
))
1491 CHECK_NUMBER (Vx_hourglass_pointer_shape
, 0);
1493 = XCreateFontCursor (dpy
, XINT (Vx_hourglass_pointer_shape
));
1496 hourglass_cursor
= XCreateFontCursor (dpy
, XC_watch
);
1497 x_check_errors (dpy
, "bad hourglass pointer cursor: %s");
1499 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1500 if (!NILP (Vx_mode_pointer_shape
))
1502 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1503 mode_cursor
= XCreateFontCursor (dpy
, XINT (Vx_mode_pointer_shape
));
1506 mode_cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1507 x_check_errors (dpy
, "bad modeline pointer cursor: %s");
1509 if (!NILP (Vx_sensitive_text_pointer_shape
))
1511 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1513 = XCreateFontCursor (dpy
, XINT (Vx_sensitive_text_pointer_shape
));
1516 cross_cursor
= XCreateFontCursor (dpy
, XC_crosshair
);
1518 if (!NILP (Vx_window_horizontal_drag_shape
))
1520 CHECK_NUMBER (Vx_window_horizontal_drag_shape
, 0);
1521 horizontal_drag_cursor
1522 = XCreateFontCursor (dpy
, XINT (Vx_window_horizontal_drag_shape
));
1525 horizontal_drag_cursor
1526 = XCreateFontCursor (dpy
, XC_sb_h_double_arrow
);
1528 /* Check and report errors with the above calls. */
1529 x_check_errors (dpy
, "can't set cursor shape: %s");
1530 x_uncatch_errors (dpy
, count
);
1533 XColor fore_color
, back_color
;
1535 fore_color
.pixel
= x
->mouse_pixel
;
1536 x_query_color (f
, &fore_color
);
1537 back_color
.pixel
= mask_color
;
1538 x_query_color (f
, &back_color
);
1540 XRecolorCursor (dpy
, cursor
, &fore_color
, &back_color
);
1541 XRecolorCursor (dpy
, nontext_cursor
, &fore_color
, &back_color
);
1542 XRecolorCursor (dpy
, mode_cursor
, &fore_color
, &back_color
);
1543 XRecolorCursor (dpy
, cross_cursor
, &fore_color
, &back_color
);
1544 XRecolorCursor (dpy
, hourglass_cursor
, &fore_color
, &back_color
);
1545 XRecolorCursor (dpy
, horizontal_drag_cursor
, &fore_color
, &back_color
);
1548 if (FRAME_X_WINDOW (f
) != 0)
1549 XDefineCursor (dpy
, FRAME_X_WINDOW (f
), cursor
);
1551 if (cursor
!= x
->text_cursor
1552 && x
->text_cursor
!= 0)
1553 XFreeCursor (dpy
, x
->text_cursor
);
1554 x
->text_cursor
= cursor
;
1556 if (nontext_cursor
!= x
->nontext_cursor
1557 && x
->nontext_cursor
!= 0)
1558 XFreeCursor (dpy
, x
->nontext_cursor
);
1559 x
->nontext_cursor
= nontext_cursor
;
1561 if (hourglass_cursor
!= x
->hourglass_cursor
1562 && x
->hourglass_cursor
!= 0)
1563 XFreeCursor (dpy
, x
->hourglass_cursor
);
1564 x
->hourglass_cursor
= hourglass_cursor
;
1566 if (mode_cursor
!= x
->modeline_cursor
1567 && x
->modeline_cursor
!= 0)
1568 XFreeCursor (dpy
, f
->output_data
.x
->modeline_cursor
);
1569 x
->modeline_cursor
= mode_cursor
;
1571 if (cross_cursor
!= x
->cross_cursor
1572 && x
->cross_cursor
!= 0)
1573 XFreeCursor (dpy
, x
->cross_cursor
);
1574 x
->cross_cursor
= cross_cursor
;
1576 if (horizontal_drag_cursor
!= x
->horizontal_drag_cursor
1577 && x
->horizontal_drag_cursor
!= 0)
1578 XFreeCursor (dpy
, x
->horizontal_drag_cursor
);
1579 x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1584 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1588 x_set_cursor_color (f
, arg
, oldval
)
1590 Lisp_Object arg
, oldval
;
1592 unsigned long fore_pixel
, pixel
;
1593 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1594 struct x_output
*x
= f
->output_data
.x
;
1596 if (!NILP (Vx_cursor_fore_pixel
))
1598 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1599 WHITE_PIX_DEFAULT (f
));
1600 fore_pixel_allocated_p
= 1;
1603 fore_pixel
= x
->background_pixel
;
1605 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1606 pixel_allocated_p
= 1;
1608 /* Make sure that the cursor color differs from the background color. */
1609 if (pixel
== x
->background_pixel
)
1611 if (pixel_allocated_p
)
1613 x_free_colors (f
, &pixel
, 1);
1614 pixel_allocated_p
= 0;
1617 pixel
= x
->mouse_pixel
;
1618 if (pixel
== fore_pixel
)
1620 if (fore_pixel_allocated_p
)
1622 x_free_colors (f
, &fore_pixel
, 1);
1623 fore_pixel_allocated_p
= 0;
1625 fore_pixel
= x
->background_pixel
;
1629 unload_color (f
, x
->cursor_foreground_pixel
);
1630 if (!fore_pixel_allocated_p
)
1631 fore_pixel
= x_copy_color (f
, fore_pixel
);
1632 x
->cursor_foreground_pixel
= fore_pixel
;
1634 unload_color (f
, x
->cursor_pixel
);
1635 if (!pixel_allocated_p
)
1636 pixel
= x_copy_color (f
, pixel
);
1637 x
->cursor_pixel
= pixel
;
1639 if (FRAME_X_WINDOW (f
) != 0)
1642 XSetBackground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, x
->cursor_pixel
);
1643 XSetForeground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, fore_pixel
);
1646 if (FRAME_VISIBLE_P (f
))
1648 x_update_cursor (f
, 0);
1649 x_update_cursor (f
, 1);
1653 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1656 /* Set the border-color of frame F to value described by ARG.
1657 ARG can be a string naming a color.
1658 The border-color is used for the border that is drawn by the X server.
1659 Note that this does not fully take effect if done before
1660 F has an x-window; it must be redone when the window is created.
1662 Note: this is done in two routines because of the way X10 works.
1664 Note: under X11, this is normally the province of the window manager,
1665 and so emacs' border colors may be overridden. */
1668 x_set_border_color (f
, arg
, oldval
)
1670 Lisp_Object arg
, oldval
;
1674 CHECK_STRING (arg
, 0);
1675 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1676 x_set_border_pixel (f
, pix
);
1677 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1680 /* Set the border-color of frame F to pixel value PIX.
1681 Note that this does not fully take effect if done before
1682 F has an x-window. */
1685 x_set_border_pixel (f
, pix
)
1689 unload_color (f
, f
->output_data
.x
->border_pixel
);
1690 f
->output_data
.x
->border_pixel
= pix
;
1692 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1695 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1696 (unsigned long)pix
);
1699 if (FRAME_VISIBLE_P (f
))
1705 /* Value is the internal representation of the specified cursor type
1706 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1707 of the bar cursor. */
1709 enum text_cursor_kinds
1710 x_specified_cursor_type (arg
, width
)
1714 enum text_cursor_kinds type
;
1721 else if (CONSP (arg
)
1722 && EQ (XCAR (arg
), Qbar
)
1723 && INTEGERP (XCDR (arg
))
1724 && XINT (XCDR (arg
)) >= 0)
1727 *width
= XINT (XCDR (arg
));
1729 else if (NILP (arg
))
1732 /* Treat anything unknown as "box cursor".
1733 It was bad to signal an error; people have trouble fixing
1734 .Xdefaults with Emacs, when it has something bad in it. */
1735 type
= FILLED_BOX_CURSOR
;
1741 x_set_cursor_type (f
, arg
, oldval
)
1743 Lisp_Object arg
, oldval
;
1747 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1748 f
->output_data
.x
->cursor_width
= width
;
1750 /* Make sure the cursor gets redrawn. This is overkill, but how
1751 often do people change cursor types? */
1752 update_mode_lines
++;
1756 x_set_icon_type (f
, arg
, oldval
)
1758 Lisp_Object arg
, oldval
;
1764 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1767 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1772 result
= x_text_icon (f
,
1773 (char *) XSTRING ((!NILP (f
->icon_name
)
1777 result
= x_bitmap_icon (f
, arg
);
1782 error ("No icon window available");
1785 XFlush (FRAME_X_DISPLAY (f
));
1789 /* Return non-nil if frame F wants a bitmap icon. */
1797 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1805 x_set_icon_name (f
, arg
, oldval
)
1807 Lisp_Object arg
, oldval
;
1813 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1816 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1821 if (f
->output_data
.x
->icon_bitmap
!= 0)
1826 result
= x_text_icon (f
,
1827 (char *) XSTRING ((!NILP (f
->icon_name
)
1836 error ("No icon window available");
1839 XFlush (FRAME_X_DISPLAY (f
));
1844 x_set_font (f
, arg
, oldval
)
1846 Lisp_Object arg
, oldval
;
1849 Lisp_Object fontset_name
;
1851 int old_fontset
= f
->output_data
.x
->fontset
;
1853 CHECK_STRING (arg
, 1);
1855 fontset_name
= Fquery_fontset (arg
, Qnil
);
1858 result
= (STRINGP (fontset_name
)
1859 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1860 : x_new_font (f
, XSTRING (arg
)->data
));
1863 if (EQ (result
, Qnil
))
1864 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1865 else if (EQ (result
, Qt
))
1866 error ("The characters of the given font have varying widths");
1867 else if (STRINGP (result
))
1869 if (STRINGP (fontset_name
))
1871 /* Fontset names are built from ASCII font names, so the
1872 names may be equal despite there was a change. */
1873 if (old_fontset
== f
->output_data
.x
->fontset
)
1876 else if (!NILP (Fequal (result
, oldval
)))
1879 store_frame_param (f
, Qfont
, result
);
1880 recompute_basic_faces (f
);
1885 do_pending_window_change (0);
1887 /* Don't call `face-set-after-frame-default' when faces haven't been
1888 initialized yet. This is the case when called from
1889 Fx_create_frame. In that case, the X widget or window doesn't
1890 exist either, and we can end up in x_report_frame_params with a
1891 null widget which gives a segfault. */
1892 if (FRAME_FACE_CACHE (f
))
1894 XSETFRAME (frame
, f
);
1895 call1 (Qface_set_after_frame_default
, frame
);
1900 x_set_border_width (f
, arg
, oldval
)
1902 Lisp_Object arg
, oldval
;
1904 CHECK_NUMBER (arg
, 0);
1906 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1909 if (FRAME_X_WINDOW (f
) != 0)
1910 error ("Cannot change the border width of a window");
1912 f
->output_data
.x
->border_width
= XINT (arg
);
1916 x_set_internal_border_width (f
, arg
, oldval
)
1918 Lisp_Object arg
, oldval
;
1920 int old
= f
->output_data
.x
->internal_border_width
;
1922 CHECK_NUMBER (arg
, 0);
1923 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1924 if (f
->output_data
.x
->internal_border_width
< 0)
1925 f
->output_data
.x
->internal_border_width
= 0;
1927 #ifdef USE_X_TOOLKIT
1928 if (f
->output_data
.x
->edit_widget
)
1929 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1932 if (f
->output_data
.x
->internal_border_width
== old
)
1935 if (FRAME_X_WINDOW (f
) != 0)
1937 x_set_window_size (f
, 0, f
->width
, f
->height
);
1938 SET_FRAME_GARBAGED (f
);
1939 do_pending_window_change (0);
1944 x_set_visibility (f
, value
, oldval
)
1946 Lisp_Object value
, oldval
;
1949 XSETFRAME (frame
, f
);
1952 Fmake_frame_invisible (frame
, Qt
);
1953 else if (EQ (value
, Qicon
))
1954 Ficonify_frame (frame
);
1956 Fmake_frame_visible (frame
);
1960 /* Change window heights in windows rooted in WINDOW by N lines. */
1963 x_change_window_heights (window
, n
)
1967 struct window
*w
= XWINDOW (window
);
1969 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1970 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1972 if (INTEGERP (w
->orig_top
))
1973 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1974 if (INTEGERP (w
->orig_height
))
1975 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1977 /* Handle just the top child in a vertical split. */
1978 if (!NILP (w
->vchild
))
1979 x_change_window_heights (w
->vchild
, n
);
1981 /* Adjust all children in a horizontal split. */
1982 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1984 w
= XWINDOW (window
);
1985 x_change_window_heights (window
, n
);
1990 x_set_menu_bar_lines (f
, value
, oldval
)
1992 Lisp_Object value
, oldval
;
1995 #ifndef USE_X_TOOLKIT
1996 int olines
= FRAME_MENU_BAR_LINES (f
);
1999 /* Right now, menu bars don't work properly in minibuf-only frames;
2000 most of the commands try to apply themselves to the minibuffer
2001 frame itself, and get an error because you can't switch buffers
2002 in or split the minibuffer window. */
2003 if (FRAME_MINIBUF_ONLY_P (f
))
2006 if (INTEGERP (value
))
2007 nlines
= XINT (value
);
2011 /* Make sure we redisplay all windows in this frame. */
2012 windows_or_buffers_changed
++;
2014 #ifdef USE_X_TOOLKIT
2015 FRAME_MENU_BAR_LINES (f
) = 0;
2018 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2019 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
2020 /* Make sure next redisplay shows the menu bar. */
2021 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2025 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2026 free_frame_menubar (f
);
2027 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2029 f
->output_data
.x
->menubar_widget
= 0;
2031 #else /* not USE_X_TOOLKIT */
2032 FRAME_MENU_BAR_LINES (f
) = nlines
;
2033 x_change_window_heights (f
->root_window
, nlines
- olines
);
2034 #endif /* not USE_X_TOOLKIT */
2039 /* Set the number of lines used for the tool bar of frame F to VALUE.
2040 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2041 is the old number of tool bar lines. This function changes the
2042 height of all windows on frame F to match the new tool bar height.
2043 The frame's height doesn't change. */
2046 x_set_tool_bar_lines (f
, value
, oldval
)
2048 Lisp_Object value
, oldval
;
2050 int delta
, nlines
, root_height
;
2051 Lisp_Object root_window
;
2053 /* Treat tool bars like menu bars. */
2054 if (FRAME_MINIBUF_ONLY_P (f
))
2057 /* Use VALUE only if an integer >= 0. */
2058 if (INTEGERP (value
) && XINT (value
) >= 0)
2059 nlines
= XFASTINT (value
);
2063 /* Make sure we redisplay all windows in this frame. */
2064 ++windows_or_buffers_changed
;
2066 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2068 /* Don't resize the tool-bar to more than we have room for. */
2069 root_window
= FRAME_ROOT_WINDOW (f
);
2070 root_height
= XINT (XWINDOW (root_window
)->height
);
2071 if (root_height
- delta
< 1)
2073 delta
= root_height
- 1;
2074 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2077 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2078 x_change_window_heights (root_window
, delta
);
2081 /* We also have to make sure that the internal border at the top of
2082 the frame, below the menu bar or tool bar, is redrawn when the
2083 tool bar disappears. This is so because the internal border is
2084 below the tool bar if one is displayed, but is below the menu bar
2085 if there isn't a tool bar. The tool bar draws into the area
2086 below the menu bar. */
2087 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2091 clear_current_matrices (f
);
2092 updating_frame
= NULL
;
2095 /* If the tool bar gets smaller, the internal border below it
2096 has to be cleared. It was formerly part of the display
2097 of the larger tool bar, and updating windows won't clear it. */
2100 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2101 int width
= PIXEL_WIDTH (f
);
2102 int y
= nlines
* CANON_Y_UNIT (f
);
2105 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2106 0, y
, width
, height
, False
);
2109 if (WINDOWP (f
->tool_bar_window
))
2110 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2115 /* Set the foreground color for scroll bars on frame F to VALUE.
2116 VALUE should be a string, a color name. If it isn't a string or
2117 isn't a valid color name, do nothing. OLDVAL is the old value of
2118 the frame parameter. */
2121 x_set_scroll_bar_foreground (f
, value
, oldval
)
2123 Lisp_Object value
, oldval
;
2125 unsigned long pixel
;
2127 if (STRINGP (value
))
2128 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2132 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2133 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2135 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2136 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2138 /* Remove all scroll bars because they have wrong colors. */
2139 if (condemn_scroll_bars_hook
)
2140 (*condemn_scroll_bars_hook
) (f
);
2141 if (judge_scroll_bars_hook
)
2142 (*judge_scroll_bars_hook
) (f
);
2144 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2150 /* Set the background color for scroll bars on frame F to VALUE VALUE
2151 should be a string, a color name. If it isn't a string or isn't a
2152 valid color name, do nothing. OLDVAL is the old value of the frame
2156 x_set_scroll_bar_background (f
, value
, oldval
)
2158 Lisp_Object value
, oldval
;
2160 unsigned long pixel
;
2162 if (STRINGP (value
))
2163 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2167 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2168 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2170 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2171 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2173 /* Remove all scroll bars because they have wrong colors. */
2174 if (condemn_scroll_bars_hook
)
2175 (*condemn_scroll_bars_hook
) (f
);
2176 if (judge_scroll_bars_hook
)
2177 (*judge_scroll_bars_hook
) (f
);
2179 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2185 /* Encode Lisp string STRING as a text in a format appropriate for
2186 XICCC (X Inter Client Communication Conventions).
2188 If STRING contains only ASCII characters, do no conversion and
2189 return the string data of STRING. Otherwise, encode the text by
2190 CODING_SYSTEM, and return a newly allocated memory area which
2191 should be freed by `xfree' by a caller.
2193 Store the byte length of resulting text in *TEXT_BYTES.
2195 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2196 which means that the `encoding' of the result can be `STRING'.
2197 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2198 the result should be `COMPOUND_TEXT'. */
2201 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2202 Lisp_Object string
, coding_system
;
2203 int *text_bytes
, *stringp
;
2205 unsigned char *str
= XSTRING (string
)->data
;
2206 int chars
= XSTRING (string
)->size
;
2207 int bytes
= STRING_BYTES (XSTRING (string
));
2211 struct coding_system coding
;
2213 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2214 if (charset_info
== 0)
2216 /* No multibyte character in OBJ. We need not encode it. */
2217 *text_bytes
= bytes
;
2222 setup_coding_system (coding_system
, &coding
);
2223 coding
.src_multibyte
= 1;
2224 coding
.dst_multibyte
= 0;
2225 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2226 if (coding
.type
== coding_type_iso2022
)
2227 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2228 /* We suppress producing escape sequences for composition. */
2229 coding
.composing
= COMPOSITION_DISABLED
;
2230 bufsize
= encoding_buffer_size (&coding
, bytes
);
2231 buf
= (unsigned char *) xmalloc (bufsize
);
2232 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2233 *text_bytes
= coding
.produced
;
2234 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2239 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2242 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2243 name; if NAME is a string, set F's name to NAME and set
2244 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2246 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2247 suggesting a new name, which lisp code should override; if
2248 F->explicit_name is set, ignore the new name; otherwise, set it. */
2251 x_set_name (f
, name
, explicit)
2256 /* Make sure that requests from lisp code override requests from
2257 Emacs redisplay code. */
2260 /* If we're switching from explicit to implicit, we had better
2261 update the mode lines and thereby update the title. */
2262 if (f
->explicit_name
&& NILP (name
))
2263 update_mode_lines
= 1;
2265 f
->explicit_name
= ! NILP (name
);
2267 else if (f
->explicit_name
)
2270 /* If NAME is nil, set the name to the x_id_name. */
2273 /* Check for no change needed in this very common case
2274 before we do any consing. */
2275 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2276 XSTRING (f
->name
)->data
))
2278 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2281 CHECK_STRING (name
, 0);
2283 /* Don't change the name if it's already NAME. */
2284 if (! NILP (Fstring_equal (name
, f
->name
)))
2289 /* For setting the frame title, the title parameter should override
2290 the name parameter. */
2291 if (! NILP (f
->title
))
2294 if (FRAME_X_WINDOW (f
))
2299 XTextProperty text
, icon
;
2301 Lisp_Object coding_system
;
2303 coding_system
= Vlocale_coding_system
;
2304 if (NILP (coding_system
))
2305 coding_system
= Qcompound_text
;
2306 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2307 text
.encoding
= (stringp
? XA_STRING
2308 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2310 text
.nitems
= bytes
;
2312 if (NILP (f
->icon_name
))
2318 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2320 icon
.encoding
= (stringp
? XA_STRING
2321 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2323 icon
.nitems
= bytes
;
2325 #ifdef USE_X_TOOLKIT
2326 XSetWMName (FRAME_X_DISPLAY (f
),
2327 XtWindow (f
->output_data
.x
->widget
), &text
);
2328 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2330 #else /* not USE_X_TOOLKIT */
2331 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2332 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2333 #endif /* not USE_X_TOOLKIT */
2334 if (!NILP (f
->icon_name
)
2335 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2337 if (text
.value
!= XSTRING (name
)->data
)
2340 #else /* not HAVE_X11R4 */
2341 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2342 XSTRING (name
)->data
);
2343 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2344 XSTRING (name
)->data
);
2345 #endif /* not HAVE_X11R4 */
2350 /* This function should be called when the user's lisp code has
2351 specified a name for the frame; the name will override any set by the
2354 x_explicitly_set_name (f
, arg
, oldval
)
2356 Lisp_Object arg
, oldval
;
2358 x_set_name (f
, arg
, 1);
2361 /* This function should be called by Emacs redisplay code to set the
2362 name; names set this way will never override names set by the user's
2365 x_implicitly_set_name (f
, arg
, oldval
)
2367 Lisp_Object arg
, oldval
;
2369 x_set_name (f
, arg
, 0);
2372 /* Change the title of frame F to NAME.
2373 If NAME is nil, use the frame name as the title.
2375 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2376 name; if NAME is a string, set F's name to NAME and set
2377 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2379 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2380 suggesting a new name, which lisp code should override; if
2381 F->explicit_name is set, ignore the new name; otherwise, set it. */
2384 x_set_title (f
, name
, old_name
)
2386 Lisp_Object name
, old_name
;
2388 /* Don't change the title if it's already NAME. */
2389 if (EQ (name
, f
->title
))
2392 update_mode_lines
= 1;
2399 CHECK_STRING (name
, 0);
2401 if (FRAME_X_WINDOW (f
))
2406 XTextProperty text
, icon
;
2408 Lisp_Object coding_system
;
2410 coding_system
= Vlocale_coding_system
;
2411 if (NILP (coding_system
))
2412 coding_system
= Qcompound_text
;
2413 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2414 text
.encoding
= (stringp
? XA_STRING
2415 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2417 text
.nitems
= bytes
;
2419 if (NILP (f
->icon_name
))
2425 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2427 icon
.encoding
= (stringp
? XA_STRING
2428 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2430 icon
.nitems
= bytes
;
2432 #ifdef USE_X_TOOLKIT
2433 XSetWMName (FRAME_X_DISPLAY (f
),
2434 XtWindow (f
->output_data
.x
->widget
), &text
);
2435 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2437 #else /* not USE_X_TOOLKIT */
2438 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2439 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2440 #endif /* not USE_X_TOOLKIT */
2441 if (!NILP (f
->icon_name
)
2442 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2444 if (text
.value
!= XSTRING (name
)->data
)
2447 #else /* not HAVE_X11R4 */
2448 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2449 XSTRING (name
)->data
);
2450 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2451 XSTRING (name
)->data
);
2452 #endif /* not HAVE_X11R4 */
2458 x_set_autoraise (f
, arg
, oldval
)
2460 Lisp_Object arg
, oldval
;
2462 f
->auto_raise
= !EQ (Qnil
, arg
);
2466 x_set_autolower (f
, arg
, oldval
)
2468 Lisp_Object arg
, oldval
;
2470 f
->auto_lower
= !EQ (Qnil
, arg
);
2474 x_set_unsplittable (f
, arg
, oldval
)
2476 Lisp_Object arg
, oldval
;
2478 f
->no_split
= !NILP (arg
);
2482 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2484 Lisp_Object arg
, oldval
;
2486 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2487 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2488 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2489 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2491 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2493 ? vertical_scroll_bar_none
2495 ? vertical_scroll_bar_right
2496 : vertical_scroll_bar_left
);
2498 /* We set this parameter before creating the X window for the
2499 frame, so we can get the geometry right from the start.
2500 However, if the window hasn't been created yet, we shouldn't
2501 call x_set_window_size. */
2502 if (FRAME_X_WINDOW (f
))
2503 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2504 do_pending_window_change (0);
2509 x_set_scroll_bar_width (f
, arg
, oldval
)
2511 Lisp_Object arg
, oldval
;
2513 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2517 #ifdef USE_TOOLKIT_SCROLL_BARS
2518 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2519 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2520 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2521 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2523 /* Make the actual width at least 14 pixels and a multiple of a
2525 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2527 /* Use all of that space (aside from required margins) for the
2529 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2532 if (FRAME_X_WINDOW (f
))
2533 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2534 do_pending_window_change (0);
2536 else if (INTEGERP (arg
) && XINT (arg
) > 0
2537 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2539 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2540 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2542 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2543 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2544 if (FRAME_X_WINDOW (f
))
2545 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2548 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2549 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2550 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2555 /* Subroutines of creating an X frame. */
2557 /* Make sure that Vx_resource_name is set to a reasonable value.
2558 Fix it up, or set it to `emacs' if it is too hopeless. */
2561 validate_x_resource_name ()
2564 /* Number of valid characters in the resource name. */
2566 /* Number of invalid characters in the resource name. */
2571 if (!STRINGP (Vx_resource_class
))
2572 Vx_resource_class
= build_string (EMACS_CLASS
);
2574 if (STRINGP (Vx_resource_name
))
2576 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2579 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2581 /* Only letters, digits, - and _ are valid in resource names.
2582 Count the valid characters and count the invalid ones. */
2583 for (i
= 0; i
< len
; i
++)
2586 if (! ((c
>= 'a' && c
<= 'z')
2587 || (c
>= 'A' && c
<= 'Z')
2588 || (c
>= '0' && c
<= '9')
2589 || c
== '-' || c
== '_'))
2596 /* Not a string => completely invalid. */
2597 bad_count
= 5, good_count
= 0;
2599 /* If name is valid already, return. */
2603 /* If name is entirely invalid, or nearly so, use `emacs'. */
2605 || (good_count
== 1 && bad_count
> 0))
2607 Vx_resource_name
= build_string ("emacs");
2611 /* Name is partly valid. Copy it and replace the invalid characters
2612 with underscores. */
2614 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2616 for (i
= 0; i
< len
; i
++)
2618 int c
= XSTRING (new)->data
[i
];
2619 if (! ((c
>= 'a' && c
<= 'z')
2620 || (c
>= 'A' && c
<= 'Z')
2621 || (c
>= '0' && c
<= '9')
2622 || c
== '-' || c
== '_'))
2623 XSTRING (new)->data
[i
] = '_';
2628 extern char *x_get_string_resource ();
2630 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2631 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2632 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2633 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2634 the name specified by the `-name' or `-rn' command-line arguments.\n\
2636 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2637 class, respectively. You must specify both of them or neither.\n\
2638 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2639 and the class is `Emacs.CLASS.SUBCLASS'.")
2640 (attribute
, class, component
, subclass
)
2641 Lisp_Object attribute
, class, component
, subclass
;
2643 register char *value
;
2649 CHECK_STRING (attribute
, 0);
2650 CHECK_STRING (class, 0);
2652 if (!NILP (component
))
2653 CHECK_STRING (component
, 1);
2654 if (!NILP (subclass
))
2655 CHECK_STRING (subclass
, 2);
2656 if (NILP (component
) != NILP (subclass
))
2657 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2659 validate_x_resource_name ();
2661 /* Allocate space for the components, the dots which separate them,
2662 and the final '\0'. Make them big enough for the worst case. */
2663 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2664 + (STRINGP (component
)
2665 ? STRING_BYTES (XSTRING (component
)) : 0)
2666 + STRING_BYTES (XSTRING (attribute
))
2669 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2670 + STRING_BYTES (XSTRING (class))
2671 + (STRINGP (subclass
)
2672 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2675 /* Start with emacs.FRAMENAME for the name (the specific one)
2676 and with `Emacs' for the class key (the general one). */
2677 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2678 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2680 strcat (class_key
, ".");
2681 strcat (class_key
, XSTRING (class)->data
);
2683 if (!NILP (component
))
2685 strcat (class_key
, ".");
2686 strcat (class_key
, XSTRING (subclass
)->data
);
2688 strcat (name_key
, ".");
2689 strcat (name_key
, XSTRING (component
)->data
);
2692 strcat (name_key
, ".");
2693 strcat (name_key
, XSTRING (attribute
)->data
);
2695 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2696 name_key
, class_key
);
2698 if (value
!= (char *) 0)
2699 return build_string (value
);
2704 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2707 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2708 struct x_display_info
*dpyinfo
;
2709 Lisp_Object attribute
, class, component
, subclass
;
2711 register char *value
;
2715 CHECK_STRING (attribute
, 0);
2716 CHECK_STRING (class, 0);
2718 if (!NILP (component
))
2719 CHECK_STRING (component
, 1);
2720 if (!NILP (subclass
))
2721 CHECK_STRING (subclass
, 2);
2722 if (NILP (component
) != NILP (subclass
))
2723 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2725 validate_x_resource_name ();
2727 /* Allocate space for the components, the dots which separate them,
2728 and the final '\0'. Make them big enough for the worst case. */
2729 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2730 + (STRINGP (component
)
2731 ? STRING_BYTES (XSTRING (component
)) : 0)
2732 + STRING_BYTES (XSTRING (attribute
))
2735 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2736 + STRING_BYTES (XSTRING (class))
2737 + (STRINGP (subclass
)
2738 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2741 /* Start with emacs.FRAMENAME for the name (the specific one)
2742 and with `Emacs' for the class key (the general one). */
2743 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2744 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2746 strcat (class_key
, ".");
2747 strcat (class_key
, XSTRING (class)->data
);
2749 if (!NILP (component
))
2751 strcat (class_key
, ".");
2752 strcat (class_key
, XSTRING (subclass
)->data
);
2754 strcat (name_key
, ".");
2755 strcat (name_key
, XSTRING (component
)->data
);
2758 strcat (name_key
, ".");
2759 strcat (name_key
, XSTRING (attribute
)->data
);
2761 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2763 if (value
!= (char *) 0)
2764 return build_string (value
);
2769 /* Used when C code wants a resource value. */
2772 x_get_resource_string (attribute
, class)
2773 char *attribute
, *class;
2777 struct frame
*sf
= SELECTED_FRAME ();
2779 /* Allocate space for the components, the dots which separate them,
2780 and the final '\0'. */
2781 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2782 + strlen (attribute
) + 2);
2783 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2784 + strlen (class) + 2);
2786 sprintf (name_key
, "%s.%s",
2787 XSTRING (Vinvocation_name
)->data
,
2789 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2791 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2792 name_key
, class_key
);
2795 /* Types we might convert a resource string into. */
2805 /* Return the value of parameter PARAM.
2807 First search ALIST, then Vdefault_frame_alist, then the X defaults
2808 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2810 Convert the resource to the type specified by desired_type.
2812 If no default is specified, return Qunbound. If you call
2813 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2814 and don't let it get stored in any Lisp-visible variables! */
2817 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2818 struct x_display_info
*dpyinfo
;
2819 Lisp_Object alist
, param
;
2822 enum resource_types type
;
2824 register Lisp_Object tem
;
2826 tem
= Fassq (param
, alist
);
2828 tem
= Fassq (param
, Vdefault_frame_alist
);
2834 tem
= display_x_get_resource (dpyinfo
,
2835 build_string (attribute
),
2836 build_string (class),
2844 case RES_TYPE_NUMBER
:
2845 return make_number (atoi (XSTRING (tem
)->data
));
2847 case RES_TYPE_FLOAT
:
2848 return make_float (atof (XSTRING (tem
)->data
));
2850 case RES_TYPE_BOOLEAN
:
2851 tem
= Fdowncase (tem
);
2852 if (!strcmp (XSTRING (tem
)->data
, "on")
2853 || !strcmp (XSTRING (tem
)->data
, "true"))
2858 case RES_TYPE_STRING
:
2861 case RES_TYPE_SYMBOL
:
2862 /* As a special case, we map the values `true' and `on'
2863 to Qt, and `false' and `off' to Qnil. */
2866 lower
= Fdowncase (tem
);
2867 if (!strcmp (XSTRING (lower
)->data
, "on")
2868 || !strcmp (XSTRING (lower
)->data
, "true"))
2870 else if (!strcmp (XSTRING (lower
)->data
, "off")
2871 || !strcmp (XSTRING (lower
)->data
, "false"))
2874 return Fintern (tem
, Qnil
);
2887 /* Like x_get_arg, but also record the value in f->param_alist. */
2890 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2892 Lisp_Object alist
, param
;
2895 enum resource_types type
;
2899 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2900 attribute
, class, type
);
2902 store_frame_param (f
, param
, value
);
2907 /* Record in frame F the specified or default value according to ALIST
2908 of the parameter named PROP (a Lisp symbol).
2909 If no value is specified for PROP, look for an X default for XPROP
2910 on the frame named NAME.
2911 If that is not found either, use the value DEFLT. */
2914 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2921 enum resource_types type
;
2925 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2926 if (EQ (tem
, Qunbound
))
2928 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2933 /* Record in frame F the specified or default value according to ALIST
2934 of the parameter named PROP (a Lisp symbol). If no value is
2935 specified for PROP, look for an X default for XPROP on the frame
2936 named NAME. If that is not found either, use the value DEFLT. */
2939 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2948 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2951 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2952 if (EQ (tem
, Qunbound
))
2954 #ifdef USE_TOOLKIT_SCROLL_BARS
2956 /* See if an X resource for the scroll bar color has been
2958 tem
= display_x_get_resource (dpyinfo
,
2959 build_string (foreground_p
2963 build_string ("verticalScrollBar"),
2967 /* If nothing has been specified, scroll bars will use a
2968 toolkit-dependent default. Because these defaults are
2969 difficult to get at without actually creating a scroll
2970 bar, use nil to indicate that no color has been
2975 #else /* not USE_TOOLKIT_SCROLL_BARS */
2979 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2982 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2988 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2989 "Parse an X-style geometry string STRING.\n\
2990 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2991 The properties returned may include `top', `left', `height', and `width'.\n\
2992 The value of `left' or `top' may be an integer,\n\
2993 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2994 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2999 unsigned int width
, height
;
3002 CHECK_STRING (string
, 0);
3004 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
3005 &x
, &y
, &width
, &height
);
3008 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
3009 error ("Must specify both x and y position, or neither");
3013 if (geometry
& XValue
)
3015 Lisp_Object element
;
3017 if (x
>= 0 && (geometry
& XNegative
))
3018 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3019 else if (x
< 0 && ! (geometry
& XNegative
))
3020 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3022 element
= Fcons (Qleft
, make_number (x
));
3023 result
= Fcons (element
, result
);
3026 if (geometry
& YValue
)
3028 Lisp_Object element
;
3030 if (y
>= 0 && (geometry
& YNegative
))
3031 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3032 else if (y
< 0 && ! (geometry
& YNegative
))
3033 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3035 element
= Fcons (Qtop
, make_number (y
));
3036 result
= Fcons (element
, result
);
3039 if (geometry
& WidthValue
)
3040 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3041 if (geometry
& HeightValue
)
3042 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3047 /* Calculate the desired size and position of this window,
3048 and return the flags saying which aspects were specified.
3050 This function does not make the coordinates positive. */
3052 #define DEFAULT_ROWS 40
3053 #define DEFAULT_COLS 80
3056 x_figure_window_size (f
, parms
)
3060 register Lisp_Object tem0
, tem1
, tem2
;
3061 long window_prompting
= 0;
3062 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3064 /* Default values if we fall through.
3065 Actually, if that happens we should get
3066 window manager prompting. */
3067 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3068 f
->height
= DEFAULT_ROWS
;
3069 /* Window managers expect that if program-specified
3070 positions are not (0,0), they're intentional, not defaults. */
3071 f
->output_data
.x
->top_pos
= 0;
3072 f
->output_data
.x
->left_pos
= 0;
3074 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3075 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3076 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3077 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3079 if (!EQ (tem0
, Qunbound
))
3081 CHECK_NUMBER (tem0
, 0);
3082 f
->height
= XINT (tem0
);
3084 if (!EQ (tem1
, Qunbound
))
3086 CHECK_NUMBER (tem1
, 0);
3087 SET_FRAME_WIDTH (f
, XINT (tem1
));
3089 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3090 window_prompting
|= USSize
;
3092 window_prompting
|= PSize
;
3095 f
->output_data
.x
->vertical_scroll_bar_extra
3096 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3098 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3099 f
->output_data
.x
->flags_areas_extra
3100 = FRAME_FLAGS_AREA_WIDTH (f
);
3101 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3102 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3104 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3105 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3106 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3107 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3109 if (EQ (tem0
, Qminus
))
3111 f
->output_data
.x
->top_pos
= 0;
3112 window_prompting
|= YNegative
;
3114 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3115 && CONSP (XCDR (tem0
))
3116 && INTEGERP (XCAR (XCDR (tem0
))))
3118 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3119 window_prompting
|= YNegative
;
3121 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3122 && CONSP (XCDR (tem0
))
3123 && INTEGERP (XCAR (XCDR (tem0
))))
3125 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3127 else if (EQ (tem0
, Qunbound
))
3128 f
->output_data
.x
->top_pos
= 0;
3131 CHECK_NUMBER (tem0
, 0);
3132 f
->output_data
.x
->top_pos
= XINT (tem0
);
3133 if (f
->output_data
.x
->top_pos
< 0)
3134 window_prompting
|= YNegative
;
3137 if (EQ (tem1
, Qminus
))
3139 f
->output_data
.x
->left_pos
= 0;
3140 window_prompting
|= XNegative
;
3142 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3143 && CONSP (XCDR (tem1
))
3144 && INTEGERP (XCAR (XCDR (tem1
))))
3146 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3147 window_prompting
|= XNegative
;
3149 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3150 && CONSP (XCDR (tem1
))
3151 && INTEGERP (XCAR (XCDR (tem1
))))
3153 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3155 else if (EQ (tem1
, Qunbound
))
3156 f
->output_data
.x
->left_pos
= 0;
3159 CHECK_NUMBER (tem1
, 0);
3160 f
->output_data
.x
->left_pos
= XINT (tem1
);
3161 if (f
->output_data
.x
->left_pos
< 0)
3162 window_prompting
|= XNegative
;
3165 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3166 window_prompting
|= USPosition
;
3168 window_prompting
|= PPosition
;
3171 return window_prompting
;
3174 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3177 XSetWMProtocols (dpy
, w
, protocols
, count
)
3184 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3185 if (prop
== None
) return False
;
3186 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3187 (unsigned char *) protocols
, count
);
3190 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3192 #ifdef USE_X_TOOLKIT
3194 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3195 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3196 already be present because of the toolkit (Motif adds some of them,
3197 for example, but Xt doesn't). */
3200 hack_wm_protocols (f
, widget
)
3204 Display
*dpy
= XtDisplay (widget
);
3205 Window w
= XtWindow (widget
);
3206 int need_delete
= 1;
3212 Atom type
, *atoms
= 0;
3214 unsigned long nitems
= 0;
3215 unsigned long bytes_after
;
3217 if ((XGetWindowProperty (dpy
, w
,
3218 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3219 (long)0, (long)100, False
, XA_ATOM
,
3220 &type
, &format
, &nitems
, &bytes_after
,
3221 (unsigned char **) &atoms
)
3223 && format
== 32 && type
== XA_ATOM
)
3227 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3229 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3231 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3234 if (atoms
) XFree ((char *) atoms
);
3240 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3242 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3244 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3246 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3247 XA_ATOM
, 32, PropModeAppend
,
3248 (unsigned char *) props
, count
);
3256 /* Support routines for XIC (X Input Context). */
3260 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3261 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3264 /* Supported XIM styles, ordered by preferenc. */
3266 static XIMStyle supported_xim_styles
[] =
3268 XIMPreeditPosition
| XIMStatusArea
,
3269 XIMPreeditPosition
| XIMStatusNothing
,
3270 XIMPreeditPosition
| XIMStatusNone
,
3271 XIMPreeditNothing
| XIMStatusArea
,
3272 XIMPreeditNothing
| XIMStatusNothing
,
3273 XIMPreeditNothing
| XIMStatusNone
,
3274 XIMPreeditNone
| XIMStatusArea
,
3275 XIMPreeditNone
| XIMStatusNothing
,
3276 XIMPreeditNone
| XIMStatusNone
,
3281 /* Create an X fontset on frame F with base font name
3285 xic_create_xfontset (f
, base_fontname
)
3287 char *base_fontname
;
3290 char **missing_list
;
3294 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3295 base_fontname
, &missing_list
,
3296 &missing_count
, &def_string
);
3298 XFreeStringList (missing_list
);
3300 /* No need to free def_string. */
3305 /* Value is the best input style, given user preferences USER (already
3306 checked to be supported by Emacs), and styles supported by the
3307 input method XIM. */
3310 best_xim_style (user
, xim
)
3316 for (i
= 0; i
< user
->count_styles
; ++i
)
3317 for (j
= 0; j
< xim
->count_styles
; ++j
)
3318 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3319 return user
->supported_styles
[i
];
3321 /* Return the default style. */
3322 return XIMPreeditNothing
| XIMStatusNothing
;
3325 /* Create XIC for frame F. */
3327 static XIMStyle xic_style
;
3330 create_frame_xic (f
)
3335 XFontSet xfs
= NULL
;
3340 xim
= FRAME_X_XIM (f
);
3345 XVaNestedList preedit_attr
;
3346 XVaNestedList status_attr
;
3347 char *base_fontname
;
3350 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3351 spot
.x
= 0; spot
.y
= 1;
3352 /* Create X fontset. */
3353 fontset
= FRAME_FONTSET (f
);
3355 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3358 /* Determine the base fontname from the ASCII font name of
3360 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3361 char *p
= ascii_font
;
3364 for (i
= 0; *p
; p
++)
3367 /* As the font name doesn't conform to XLFD, we can't
3368 modify it to get a suitable base fontname for the
3370 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3373 int len
= strlen (ascii_font
) + 1;
3376 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3385 base_fontname
= (char *) alloca (len
);
3386 bzero (base_fontname
, len
);
3387 strcpy (base_fontname
, "-*-*-");
3388 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3389 strcat (base_fontname
, "*-*-*-*-*-*-*");
3392 xfs
= xic_create_xfontset (f
, base_fontname
);
3394 /* Determine XIC style. */
3397 XIMStyles supported_list
;
3398 supported_list
.count_styles
= (sizeof supported_xim_styles
3399 / sizeof supported_xim_styles
[0]);
3400 supported_list
.supported_styles
= supported_xim_styles
;
3401 xic_style
= best_xim_style (&supported_list
,
3402 FRAME_X_XIM_STYLES (f
));
3405 preedit_attr
= XVaCreateNestedList (0,
3408 FRAME_FOREGROUND_PIXEL (f
),
3410 FRAME_BACKGROUND_PIXEL (f
),
3411 (xic_style
& XIMPreeditPosition
3416 status_attr
= XVaCreateNestedList (0,
3422 FRAME_FOREGROUND_PIXEL (f
),
3424 FRAME_BACKGROUND_PIXEL (f
),
3427 xic
= XCreateIC (xim
,
3428 XNInputStyle
, xic_style
,
3429 XNClientWindow
, FRAME_X_WINDOW(f
),
3430 XNFocusWindow
, FRAME_X_WINDOW(f
),
3431 XNStatusAttributes
, status_attr
,
3432 XNPreeditAttributes
, preedit_attr
,
3434 XFree (preedit_attr
);
3435 XFree (status_attr
);
3438 FRAME_XIC (f
) = xic
;
3439 FRAME_XIC_STYLE (f
) = xic_style
;
3440 FRAME_XIC_FONTSET (f
) = xfs
;
3444 /* Destroy XIC and free XIC fontset of frame F, if any. */
3450 if (FRAME_XIC (f
) == NULL
)
3453 XDestroyIC (FRAME_XIC (f
));
3454 if (FRAME_XIC_FONTSET (f
))
3455 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3457 FRAME_XIC (f
) = NULL
;
3458 FRAME_XIC_FONTSET (f
) = NULL
;
3462 /* Place preedit area for XIC of window W's frame to specified
3463 pixel position X/Y. X and Y are relative to window W. */
3466 xic_set_preeditarea (w
, x
, y
)
3470 struct frame
*f
= XFRAME (w
->frame
);
3474 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3475 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3476 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3477 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3482 /* Place status area for XIC in bottom right corner of frame F.. */
3485 xic_set_statusarea (f
)
3488 XIC xic
= FRAME_XIC (f
);
3493 /* Negotiate geometry of status area. If input method has existing
3494 status area, use its current size. */
3495 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3496 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3497 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3500 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3501 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3504 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3506 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3507 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3511 area
.width
= needed
->width
;
3512 area
.height
= needed
->height
;
3513 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3514 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3515 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3518 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3519 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3524 /* Set X fontset for XIC of frame F, using base font name
3525 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3528 xic_set_xfontset (f
, base_fontname
)
3530 char *base_fontname
;
3535 xfs
= xic_create_xfontset (f
, base_fontname
);
3537 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3538 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3539 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3540 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3541 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3544 if (FRAME_XIC_FONTSET (f
))
3545 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3546 FRAME_XIC_FONTSET (f
) = xfs
;
3549 #endif /* HAVE_X_I18N */
3553 #ifdef USE_X_TOOLKIT
3555 /* Create and set up the X widget for frame F. */
3558 x_window (f
, window_prompting
, minibuffer_only
)
3560 long window_prompting
;
3561 int minibuffer_only
;
3563 XClassHint class_hints
;
3564 XSetWindowAttributes attributes
;
3565 unsigned long attribute_mask
;
3566 Widget shell_widget
;
3568 Widget frame_widget
;
3574 /* Use the resource name as the top-level widget name
3575 for looking up resources. Make a non-Lisp copy
3576 for the window manager, so GC relocation won't bother it.
3578 Elsewhere we specify the window name for the window manager. */
3581 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3582 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3583 strcpy (f
->namebuf
, str
);
3587 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3588 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3589 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3590 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3591 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3592 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3593 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3594 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3595 applicationShellWidgetClass
,
3596 FRAME_X_DISPLAY (f
), al
, ac
);
3598 f
->output_data
.x
->widget
= shell_widget
;
3599 /* maybe_set_screen_title_format (shell_widget); */
3601 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3602 (widget_value
*) NULL
,
3603 shell_widget
, False
,
3607 (lw_callback
) NULL
);
3610 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3611 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3612 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3613 XtSetValues (pane_widget
, al
, ac
);
3614 f
->output_data
.x
->column_widget
= pane_widget
;
3616 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3617 the emacs screen when changing menubar. This reduces flickering. */
3620 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3621 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3622 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3623 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3624 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3625 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3626 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3627 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3628 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3631 f
->output_data
.x
->edit_widget
= frame_widget
;
3633 XtManageChild (frame_widget
);
3635 /* Do some needed geometry management. */
3638 char *tem
, shell_position
[32];
3641 int extra_borders
= 0;
3643 = (f
->output_data
.x
->menubar_widget
3644 ? (f
->output_data
.x
->menubar_widget
->core
.height
3645 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3648 #if 0 /* Experimentally, we now get the right results
3649 for -geometry -0-0 without this. 24 Aug 96, rms. */
3650 if (FRAME_EXTERNAL_MENU_BAR (f
))
3653 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3654 menubar_size
+= ibw
;
3658 f
->output_data
.x
->menubar_height
= menubar_size
;
3661 /* Motif seems to need this amount added to the sizes
3662 specified for the shell widget. The Athena/Lucid widgets don't.
3663 Both conclusions reached experimentally. -- rms. */
3664 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3665 &extra_borders
, NULL
);
3669 /* Convert our geometry parameters into a geometry string
3671 Note that we do not specify here whether the position
3672 is a user-specified or program-specified one.
3673 We pass that information later, in x_wm_set_size_hints. */
3675 int left
= f
->output_data
.x
->left_pos
;
3676 int xneg
= window_prompting
& XNegative
;
3677 int top
= f
->output_data
.x
->top_pos
;
3678 int yneg
= window_prompting
& YNegative
;
3684 if (window_prompting
& USPosition
)
3685 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3686 PIXEL_WIDTH (f
) + extra_borders
,
3687 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3688 (xneg
? '-' : '+'), left
,
3689 (yneg
? '-' : '+'), top
);
3691 sprintf (shell_position
, "=%dx%d",
3692 PIXEL_WIDTH (f
) + extra_borders
,
3693 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3696 len
= strlen (shell_position
) + 1;
3697 /* We don't free this because we don't know whether
3698 it is safe to free it while the frame exists.
3699 It isn't worth the trouble of arranging to free it
3700 when the frame is deleted. */
3701 tem
= (char *) xmalloc (len
);
3702 strncpy (tem
, shell_position
, len
);
3703 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3704 XtSetValues (shell_widget
, al
, ac
);
3707 XtManageChild (pane_widget
);
3708 XtRealizeWidget (shell_widget
);
3710 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3712 validate_x_resource_name ();
3714 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3715 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3716 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3719 FRAME_XIC (f
) = NULL
;
3721 create_frame_xic (f
);
3725 f
->output_data
.x
->wm_hints
.input
= True
;
3726 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3727 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3728 &f
->output_data
.x
->wm_hints
);
3730 hack_wm_protocols (f
, shell_widget
);
3733 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3736 /* Do a stupid property change to force the server to generate a
3737 PropertyNotify event so that the event_stream server timestamp will
3738 be initialized to something relevant to the time we created the window.
3740 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3741 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3742 XA_ATOM
, 32, PropModeAppend
,
3743 (unsigned char*) NULL
, 0);
3745 /* Make all the standard events reach the Emacs frame. */
3746 attributes
.event_mask
= STANDARD_EVENT_SET
;
3751 /* XIM server might require some X events. */
3752 unsigned long fevent
= NoEventMask
;
3753 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3754 attributes
.event_mask
|= fevent
;
3756 #endif /* HAVE_X_I18N */
3758 attribute_mask
= CWEventMask
;
3759 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3760 attribute_mask
, &attributes
);
3762 XtMapWidget (frame_widget
);
3764 /* x_set_name normally ignores requests to set the name if the
3765 requested name is the same as the current name. This is the one
3766 place where that assumption isn't correct; f->name is set, but
3767 the X server hasn't been told. */
3770 int explicit = f
->explicit_name
;
3772 f
->explicit_name
= 0;
3775 x_set_name (f
, name
, explicit);
3778 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3779 f
->output_data
.x
->text_cursor
);
3783 /* This is a no-op, except under Motif. Make sure main areas are
3784 set to something reasonable, in case we get an error later. */
3785 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3788 #else /* not USE_X_TOOLKIT */
3790 /* Create and set up the X window for frame F. */
3797 XClassHint class_hints
;
3798 XSetWindowAttributes attributes
;
3799 unsigned long attribute_mask
;
3801 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3802 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3803 attributes
.bit_gravity
= StaticGravity
;
3804 attributes
.backing_store
= NotUseful
;
3805 attributes
.save_under
= True
;
3806 attributes
.event_mask
= STANDARD_EVENT_SET
;
3807 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3808 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3813 = XCreateWindow (FRAME_X_DISPLAY (f
),
3814 f
->output_data
.x
->parent_desc
,
3815 f
->output_data
.x
->left_pos
,
3816 f
->output_data
.x
->top_pos
,
3817 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3818 f
->output_data
.x
->border_width
,
3819 CopyFromParent
, /* depth */
3820 InputOutput
, /* class */
3822 attribute_mask
, &attributes
);
3826 create_frame_xic (f
);
3829 /* XIM server might require some X events. */
3830 unsigned long fevent
= NoEventMask
;
3831 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3832 attributes
.event_mask
|= fevent
;
3833 attribute_mask
= CWEventMask
;
3834 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3835 attribute_mask
, &attributes
);
3838 #endif /* HAVE_X_I18N */
3840 validate_x_resource_name ();
3842 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3843 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3844 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3846 /* The menubar is part of the ordinary display;
3847 it does not count in addition to the height of the window. */
3848 f
->output_data
.x
->menubar_height
= 0;
3850 /* This indicates that we use the "Passive Input" input model.
3851 Unless we do this, we don't get the Focus{In,Out} events that we
3852 need to draw the cursor correctly. Accursed bureaucrats.
3853 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3855 f
->output_data
.x
->wm_hints
.input
= True
;
3856 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3857 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3858 &f
->output_data
.x
->wm_hints
);
3859 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3861 /* Request "save yourself" and "delete window" commands from wm. */
3864 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3865 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3866 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3869 /* x_set_name normally ignores requests to set the name if the
3870 requested name is the same as the current name. This is the one
3871 place where that assumption isn't correct; f->name is set, but
3872 the X server hasn't been told. */
3875 int explicit = f
->explicit_name
;
3877 f
->explicit_name
= 0;
3880 x_set_name (f
, name
, explicit);
3883 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3884 f
->output_data
.x
->text_cursor
);
3888 if (FRAME_X_WINDOW (f
) == 0)
3889 error ("Unable to create window");
3892 #endif /* not USE_X_TOOLKIT */
3894 /* Handle the icon stuff for this window. Perhaps later we might
3895 want an x_set_icon_position which can be called interactively as
3903 Lisp_Object icon_x
, icon_y
;
3904 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3906 /* Set the position of the icon. Note that twm groups all
3907 icons in an icon window. */
3908 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3909 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3910 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3912 CHECK_NUMBER (icon_x
, 0);
3913 CHECK_NUMBER (icon_y
, 0);
3915 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3916 error ("Both left and top icon corners of icon must be specified");
3920 if (! EQ (icon_x
, Qunbound
))
3921 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3923 /* Start up iconic or window? */
3924 x_wm_set_window_state
3925 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3930 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3937 /* Make the GCs needed for this window, setting the
3938 background, border and mouse colors; also create the
3939 mouse cursor and the gray border tile. */
3941 static char cursor_bits
[] =
3943 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3944 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3945 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3946 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3953 XGCValues gc_values
;
3957 /* Create the GCs of this frame.
3958 Note that many default values are used. */
3961 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3962 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3963 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3964 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3965 f
->output_data
.x
->normal_gc
3966 = XCreateGC (FRAME_X_DISPLAY (f
),
3968 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
3971 /* Reverse video style. */
3972 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3973 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3974 f
->output_data
.x
->reverse_gc
3975 = XCreateGC (FRAME_X_DISPLAY (f
),
3977 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
3980 /* Cursor has cursor-color background, background-color foreground. */
3981 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3982 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3983 gc_values
.fill_style
= FillOpaqueStippled
;
3985 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3986 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3987 cursor_bits
, 16, 16);
3988 f
->output_data
.x
->cursor_gc
3989 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3990 (GCFont
| GCForeground
| GCBackground
3991 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3995 f
->output_data
.x
->white_relief
.gc
= 0;
3996 f
->output_data
.x
->black_relief
.gc
= 0;
3998 /* Create the gray border tile used when the pointer is not in
3999 the frame. Since this depends on the frame's pixel values,
4000 this must be done on a per-frame basis. */
4001 f
->output_data
.x
->border_tile
4002 = (XCreatePixmapFromBitmapData
4003 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
4004 gray_bits
, gray_width
, gray_height
,
4005 f
->output_data
.x
->foreground_pixel
,
4006 f
->output_data
.x
->background_pixel
,
4007 DefaultDepth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
))));
4013 /* Free what was was allocated in x_make_gc. */
4019 Display
*dpy
= FRAME_X_DISPLAY (f
);
4023 if (f
->output_data
.x
->normal_gc
)
4025 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
4026 f
->output_data
.x
->normal_gc
= 0;
4029 if (f
->output_data
.x
->reverse_gc
)
4031 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4032 f
->output_data
.x
->reverse_gc
= 0;
4035 if (f
->output_data
.x
->cursor_gc
)
4037 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4038 f
->output_data
.x
->cursor_gc
= 0;
4041 if (f
->output_data
.x
->border_tile
)
4043 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4044 f
->output_data
.x
->border_tile
= 0;
4051 /* Handler for signals raised during x_create_frame and
4052 x_create_top_frame. FRAME is the frame which is partially
4056 unwind_create_frame (frame
)
4059 struct frame
*f
= XFRAME (frame
);
4061 /* If frame is ``official'', nothing to do. */
4062 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4065 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4068 x_free_frame_resources (f
);
4070 /* Check that reference counts are indeed correct. */
4071 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4072 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4080 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4082 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
4083 Returns an Emacs frame object.\n\
4084 ALIST is an alist of frame parameters.\n\
4085 If the parameters specify that the frame should not have a minibuffer,\n\
4086 and do not specify a specific minibuffer window to use,\n\
4087 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4088 be shared by the new frame.\n\
4090 This function is an internal primitive--use `make-frame' instead.")
4095 Lisp_Object frame
, tem
;
4097 int minibuffer_only
= 0;
4098 long window_prompting
= 0;
4100 int count
= BINDING_STACK_SIZE ();
4101 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4102 Lisp_Object display
;
4103 struct x_display_info
*dpyinfo
= NULL
;
4109 /* Use this general default value to start with
4110 until we know if this frame has a specified name. */
4111 Vx_resource_name
= Vinvocation_name
;
4113 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4114 if (EQ (display
, Qunbound
))
4116 dpyinfo
= check_x_display_info (display
);
4118 kb
= dpyinfo
->kboard
;
4120 kb
= &the_only_kboard
;
4123 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4125 && ! EQ (name
, Qunbound
)
4127 error ("Invalid frame name--not a string or nil");
4130 Vx_resource_name
= name
;
4132 /* See if parent window is specified. */
4133 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4134 if (EQ (parent
, Qunbound
))
4136 if (! NILP (parent
))
4137 CHECK_NUMBER (parent
, 0);
4139 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4140 /* No need to protect DISPLAY because that's not used after passing
4141 it to make_frame_without_minibuffer. */
4143 GCPRO4 (parms
, parent
, name
, frame
);
4144 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4146 if (EQ (tem
, Qnone
) || NILP (tem
))
4147 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4148 else if (EQ (tem
, Qonly
))
4150 f
= make_minibuffer_frame ();
4151 minibuffer_only
= 1;
4153 else if (WINDOWP (tem
))
4154 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4158 XSETFRAME (frame
, f
);
4160 /* Note that X Windows does support scroll bars. */
4161 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4163 f
->output_method
= output_x_window
;
4164 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4165 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4166 f
->output_data
.x
->icon_bitmap
= -1;
4167 f
->output_data
.x
->fontset
= -1;
4168 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4169 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4170 record_unwind_protect (unwind_create_frame
, frame
);
4173 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4175 if (! STRINGP (f
->icon_name
))
4176 f
->icon_name
= Qnil
;
4178 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4180 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4181 dpyinfo_refcount
= dpyinfo
->reference_count
;
4182 #endif /* GLYPH_DEBUG */
4184 FRAME_KBOARD (f
) = kb
;
4187 /* These colors will be set anyway later, but it's important
4188 to get the color reference counts right, so initialize them! */
4191 struct gcpro gcpro1
;
4193 /* Function x_decode_color can signal an error. Make
4194 sure to initialize color slots so that we won't try
4195 to free colors we haven't allocated. */
4196 f
->output_data
.x
->foreground_pixel
= -1;
4197 f
->output_data
.x
->background_pixel
= -1;
4198 f
->output_data
.x
->cursor_pixel
= -1;
4199 f
->output_data
.x
->cursor_foreground_pixel
= -1;
4200 f
->output_data
.x
->border_pixel
= -1;
4201 f
->output_data
.x
->mouse_pixel
= -1;
4203 black
= build_string ("black");
4205 f
->output_data
.x
->foreground_pixel
4206 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4207 f
->output_data
.x
->background_pixel
4208 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4209 f
->output_data
.x
->cursor_pixel
4210 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4211 f
->output_data
.x
->cursor_foreground_pixel
4212 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4213 f
->output_data
.x
->border_pixel
4214 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4215 f
->output_data
.x
->mouse_pixel
4216 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4220 /* Specify the parent under which to make this X window. */
4224 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4225 f
->output_data
.x
->explicit_parent
= 1;
4229 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4230 f
->output_data
.x
->explicit_parent
= 0;
4233 /* Set the name; the functions to which we pass f expect the name to
4235 if (EQ (name
, Qunbound
) || NILP (name
))
4237 f
->name
= build_string (dpyinfo
->x_id_name
);
4238 f
->explicit_name
= 0;
4243 f
->explicit_name
= 1;
4244 /* use the frame's title when getting resources for this frame. */
4245 specbind (Qx_resource_name
, name
);
4248 /* Extract the window parameters from the supplied values
4249 that are needed to determine window geometry. */
4253 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4256 /* First, try whatever font the caller has specified. */
4259 tem
= Fquery_fontset (font
, Qnil
);
4261 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4263 font
= x_new_font (f
, XSTRING (font
)->data
);
4266 /* Try out a font which we hope has bold and italic variations. */
4267 if (!STRINGP (font
))
4268 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4269 if (!STRINGP (font
))
4270 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4271 if (! STRINGP (font
))
4272 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4273 if (! STRINGP (font
))
4274 /* This was formerly the first thing tried, but it finds too many fonts
4275 and takes too long. */
4276 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4277 /* If those didn't work, look for something which will at least work. */
4278 if (! STRINGP (font
))
4279 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4281 if (! STRINGP (font
))
4282 font
= build_string ("fixed");
4284 x_default_parameter (f
, parms
, Qfont
, font
,
4285 "font", "Font", RES_TYPE_STRING
);
4289 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4290 whereby it fails to get any font. */
4291 xlwmenu_default_font
= f
->output_data
.x
->font
;
4294 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4295 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4297 /* This defaults to 2 in order to match xterm. We recognize either
4298 internalBorderWidth or internalBorder (which is what xterm calls
4300 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4304 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4305 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4306 if (! EQ (value
, Qunbound
))
4307 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4310 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4311 "internalBorderWidth", "internalBorderWidth",
4313 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4314 "verticalScrollBars", "ScrollBars",
4317 /* Also do the stuff which must be set before the window exists. */
4318 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4319 "foreground", "Foreground", RES_TYPE_STRING
);
4320 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4321 "background", "Background", RES_TYPE_STRING
);
4322 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4323 "pointerColor", "Foreground", RES_TYPE_STRING
);
4324 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4325 "cursorColor", "Foreground", RES_TYPE_STRING
);
4326 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4327 "borderColor", "BorderColor", RES_TYPE_STRING
);
4328 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4329 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4330 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4331 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4333 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4334 "scrollBarForeground",
4335 "ScrollBarForeground", 1);
4336 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4337 "scrollBarBackground",
4338 "ScrollBarBackground", 0);
4340 /* Init faces before x_default_parameter is called for scroll-bar
4341 parameters because that function calls x_set_scroll_bar_width,
4342 which calls change_frame_size, which calls Fset_window_buffer,
4343 which runs hooks, which call Fvertical_motion. At the end, we
4344 end up in init_iterator with a null face cache, which should not
4346 init_frame_faces (f
);
4348 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4349 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4350 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4351 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4352 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4353 "bufferPredicate", "BufferPredicate",
4355 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4356 "title", "Title", RES_TYPE_STRING
);
4357 x_default_parameter (f
, parms
, Qwait_for_wm
, Qt
,
4358 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN
);
4360 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4362 /* Add the tool-bar height to the initial frame height so that the
4363 user gets a text display area of the size he specified with -g or
4364 via .Xdefaults. Later changes of the tool-bar height don't
4365 change the frame size. This is done so that users can create
4366 tall Emacs frames without having to guess how tall the tool-bar
4368 if (FRAME_TOOL_BAR_LINES (f
))
4370 int margin
, relief
, bar_height
;
4372 relief
= (tool_bar_button_relief
> 0
4373 ? tool_bar_button_relief
4374 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4376 if (INTEGERP (Vtool_bar_button_margin
)
4377 && XINT (Vtool_bar_button_margin
) > 0)
4378 margin
= XFASTINT (Vtool_bar_button_margin
);
4379 else if (CONSP (Vtool_bar_button_margin
)
4380 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4381 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4382 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4386 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4387 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4390 /* Compute the size of the X window. */
4391 window_prompting
= x_figure_window_size (f
, parms
);
4393 if (window_prompting
& XNegative
)
4395 if (window_prompting
& YNegative
)
4396 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4398 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4402 if (window_prompting
& YNegative
)
4403 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4405 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4408 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4410 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4411 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4413 /* Create the X widget or window. */
4414 #ifdef USE_X_TOOLKIT
4415 x_window (f
, window_prompting
, minibuffer_only
);
4423 /* Now consider the frame official. */
4424 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4425 Vframe_list
= Fcons (frame
, Vframe_list
);
4427 /* We need to do this after creating the X window, so that the
4428 icon-creation functions can say whose icon they're describing. */
4429 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4430 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4432 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4433 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4434 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4435 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4436 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4437 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4438 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4439 "scrollBarWidth", "ScrollBarWidth",
4442 /* Dimensions, especially f->height, must be done via change_frame_size.
4443 Change will not be effected unless different from the current
4449 SET_FRAME_WIDTH (f
, 0);
4450 change_frame_size (f
, height
, width
, 1, 0, 0);
4452 /* Set up faces after all frame parameters are known. This call
4453 also merges in face attributes specified for new frames. If we
4454 don't do this, the `menu' face for instance won't have the right
4455 colors, and the menu bar won't appear in the specified colors for
4457 call1 (Qface_set_after_frame_default
, frame
);
4459 #ifdef USE_X_TOOLKIT
4460 /* Create the menu bar. */
4461 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4463 /* If this signals an error, we haven't set size hints for the
4464 frame and we didn't make it visible. */
4465 initialize_frame_menubar (f
);
4467 /* This is a no-op, except under Motif where it arranges the
4468 main window for the widgets on it. */
4469 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4470 f
->output_data
.x
->menubar_widget
,
4471 f
->output_data
.x
->edit_widget
);
4473 #endif /* USE_X_TOOLKIT */
4475 /* Tell the server what size and position, etc, we want, and how
4476 badly we want them. This should be done after we have the menu
4477 bar so that its size can be taken into account. */
4479 x_wm_set_size_hint (f
, window_prompting
, 0);
4482 /* Make the window appear on the frame and enable display, unless
4483 the caller says not to. However, with explicit parent, Emacs
4484 cannot control visibility, so don't try. */
4485 if (! f
->output_data
.x
->explicit_parent
)
4487 Lisp_Object visibility
;
4489 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4491 if (EQ (visibility
, Qunbound
))
4494 if (EQ (visibility
, Qicon
))
4495 x_iconify_frame (f
);
4496 else if (! NILP (visibility
))
4497 x_make_frame_visible (f
);
4499 /* Must have been Qnil. */
4505 /* Make sure windows on this frame appear in calls to next-window
4506 and similar functions. */
4507 Vwindow_list
= Qnil
;
4509 return unbind_to (count
, frame
);
4513 /* FRAME is used only to get a handle on the X display. We don't pass the
4514 display info directly because we're called from frame.c, which doesn't
4515 know about that structure. */
4518 x_get_focus_frame (frame
)
4519 struct frame
*frame
;
4521 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4523 if (! dpyinfo
->x_focus_frame
)
4526 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4531 /* In certain situations, when the window manager follows a
4532 click-to-focus policy, there seems to be no way around calling
4533 XSetInputFocus to give another frame the input focus .
4535 In an ideal world, XSetInputFocus should generally be avoided so
4536 that applications don't interfere with the window manager's focus
4537 policy. But I think it's okay to use when it's clearly done
4538 following a user-command. */
4540 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4541 "Set the input focus to FRAME.\n\
4542 FRAME nil means use the selected frame.")
4546 struct frame
*f
= check_x_frame (frame
);
4547 Display
*dpy
= FRAME_X_DISPLAY (f
);
4551 count
= x_catch_errors (dpy
);
4552 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4553 RevertToParent
, CurrentTime
);
4554 x_uncatch_errors (dpy
, count
);
4561 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4562 "Internal function called by `color-defined-p', which see.")
4564 Lisp_Object color
, frame
;
4567 FRAME_PTR f
= check_x_frame (frame
);
4569 CHECK_STRING (color
, 1);
4571 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4577 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4578 "Internal function called by `color-values', which see.")
4580 Lisp_Object color
, frame
;
4583 FRAME_PTR f
= check_x_frame (frame
);
4585 CHECK_STRING (color
, 1);
4587 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4591 rgb
[0] = make_number (foo
.red
);
4592 rgb
[1] = make_number (foo
.green
);
4593 rgb
[2] = make_number (foo
.blue
);
4594 return Flist (3, rgb
);
4600 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4601 "Internal function called by `display-color-p', which see.")
4603 Lisp_Object display
;
4605 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4607 if (dpyinfo
->n_planes
<= 2)
4610 switch (dpyinfo
->visual
->class)
4623 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4625 "Return t if the X display supports shades of gray.\n\
4626 Note that color displays do support shades of gray.\n\
4627 The optional argument DISPLAY specifies which display to ask about.\n\
4628 DISPLAY should be either a frame or a display name (a string).\n\
4629 If omitted or nil, that stands for the selected frame's display.")
4631 Lisp_Object display
;
4633 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4635 if (dpyinfo
->n_planes
<= 1)
4638 switch (dpyinfo
->visual
->class)
4653 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4655 "Returns the width in pixels of the X display DISPLAY.\n\
4656 The optional argument DISPLAY specifies which display to ask about.\n\
4657 DISPLAY should be either a frame or a display name (a string).\n\
4658 If omitted or nil, that stands for the selected frame's display.")
4660 Lisp_Object display
;
4662 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4664 return make_number (dpyinfo
->width
);
4667 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4668 Sx_display_pixel_height
, 0, 1, 0,
4669 "Returns the height in pixels of the X display DISPLAY.\n\
4670 The optional argument DISPLAY specifies which display to ask about.\n\
4671 DISPLAY should be either a frame or a display name (a string).\n\
4672 If omitted or nil, that stands for the selected frame's display.")
4674 Lisp_Object display
;
4676 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4678 return make_number (dpyinfo
->height
);
4681 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4683 "Returns the number of bitplanes of the X display DISPLAY.\n\
4684 The optional argument DISPLAY specifies which display to ask about.\n\
4685 DISPLAY should be either a frame or a display name (a string).\n\
4686 If omitted or nil, that stands for the selected frame's display.")
4688 Lisp_Object display
;
4690 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4692 return make_number (dpyinfo
->n_planes
);
4695 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4697 "Returns the number of color cells of the X display DISPLAY.\n\
4698 The optional argument DISPLAY specifies which display to ask about.\n\
4699 DISPLAY should be either a frame or a display name (a string).\n\
4700 If omitted or nil, that stands for the selected frame's display.")
4702 Lisp_Object display
;
4704 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4706 return make_number (DisplayCells (dpyinfo
->display
,
4707 XScreenNumberOfScreen (dpyinfo
->screen
)));
4710 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4711 Sx_server_max_request_size
,
4713 "Returns the maximum request size of the X server of display DISPLAY.\n\
4714 The optional argument DISPLAY specifies which display to ask about.\n\
4715 DISPLAY should be either a frame or a display name (a string).\n\
4716 If omitted or nil, that stands for the selected frame's display.")
4718 Lisp_Object display
;
4720 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4722 return make_number (MAXREQUEST (dpyinfo
->display
));
4725 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4726 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4727 The optional argument DISPLAY specifies which display to ask about.\n\
4728 DISPLAY should be either a frame or a display name (a string).\n\
4729 If omitted or nil, that stands for the selected frame's display.")
4731 Lisp_Object display
;
4733 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4734 char *vendor
= ServerVendor (dpyinfo
->display
);
4736 if (! vendor
) vendor
= "";
4737 return build_string (vendor
);
4740 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4741 "Returns the version numbers of the X server of display DISPLAY.\n\
4742 The value is a list of three integers: the major and minor\n\
4743 version numbers of the X Protocol in use, and the vendor-specific release\n\
4744 number. See also the function `x-server-vendor'.\n\n\
4745 The optional argument DISPLAY specifies which display to ask about.\n\
4746 DISPLAY should be either a frame or a display name (a string).\n\
4747 If omitted or nil, that stands for the selected frame's display.")
4749 Lisp_Object display
;
4751 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4752 Display
*dpy
= dpyinfo
->display
;
4754 return Fcons (make_number (ProtocolVersion (dpy
)),
4755 Fcons (make_number (ProtocolRevision (dpy
)),
4756 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4759 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4760 "Returns the number of screens on the X server of display DISPLAY.\n\
4761 The optional argument DISPLAY specifies which display to ask about.\n\
4762 DISPLAY should be either a frame or a display name (a string).\n\
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
);
4769 return make_number (ScreenCount (dpyinfo
->display
));
4772 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4773 "Returns the height in millimeters of the X display DISPLAY.\n\
4774 The optional argument DISPLAY specifies which display to ask about.\n\
4775 DISPLAY should be either a frame or a display name (a string).\n\
4776 If omitted or nil, that stands for the selected frame's display.")
4778 Lisp_Object display
;
4780 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4782 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4785 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4786 "Returns the width in millimeters of the X display DISPLAY.\n\
4787 The optional argument DISPLAY specifies which display to ask about.\n\
4788 DISPLAY should be either a frame or a display name (a string).\n\
4789 If omitted or nil, that stands for the selected frame's display.")
4791 Lisp_Object display
;
4793 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4795 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4798 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4799 Sx_display_backing_store
, 0, 1, 0,
4800 "Returns an indication of whether X display DISPLAY does backing store.\n\
4801 The value may be `always', `when-mapped', or `not-useful'.\n\
4802 The optional argument DISPLAY specifies which display to ask about.\n\
4803 DISPLAY should be either a frame or a display name (a string).\n\
4804 If omitted or nil, that stands for the selected frame's display.")
4806 Lisp_Object display
;
4808 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4811 switch (DoesBackingStore (dpyinfo
->screen
))
4814 result
= intern ("always");
4818 result
= intern ("when-mapped");
4822 result
= intern ("not-useful");
4826 error ("Strange value for BackingStore parameter of screen");
4833 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4834 Sx_display_visual_class
, 0, 1, 0,
4835 "Returns the visual class of the X display DISPLAY.\n\
4836 The value is one of the symbols `static-gray', `gray-scale',\n\
4837 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4838 The optional argument DISPLAY specifies which display to ask about.\n\
4839 DISPLAY should be either a frame or a display name (a string).\n\
4840 If omitted or nil, that stands for the selected frame's display.")
4842 Lisp_Object display
;
4844 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4847 switch (dpyinfo
->visual
->class)
4850 result
= intern ("static-gray");
4853 result
= intern ("gray-scale");
4856 result
= intern ("static-color");
4859 result
= intern ("pseudo-color");
4862 result
= intern ("true-color");
4865 result
= intern ("direct-color");
4868 error ("Display has an unknown visual class");
4875 DEFUN ("x-display-save-under", Fx_display_save_under
,
4876 Sx_display_save_under
, 0, 1, 0,
4877 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4878 The optional argument DISPLAY specifies which display to ask about.\n\
4879 DISPLAY should be either a frame or a display name (a string).\n\
4880 If omitted or nil, that stands for the selected frame's display.")
4882 Lisp_Object display
;
4884 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4886 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4894 register struct frame
*f
;
4896 return PIXEL_WIDTH (f
);
4901 register struct frame
*f
;
4903 return PIXEL_HEIGHT (f
);
4908 register struct frame
*f
;
4910 return FONT_WIDTH (f
->output_data
.x
->font
);
4915 register struct frame
*f
;
4917 return f
->output_data
.x
->line_height
;
4922 register struct frame
*f
;
4924 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4929 /************************************************************************
4931 ************************************************************************/
4934 /* Mapping visual names to visuals. */
4936 static struct visual_class
4943 {"StaticGray", StaticGray
},
4944 {"GrayScale", GrayScale
},
4945 {"StaticColor", StaticColor
},
4946 {"PseudoColor", PseudoColor
},
4947 {"TrueColor", TrueColor
},
4948 {"DirectColor", DirectColor
},
4953 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4955 /* Value is the screen number of screen SCR. This is a substitute for
4956 the X function with the same name when that doesn't exist. */
4959 XScreenNumberOfScreen (scr
)
4960 register Screen
*scr
;
4962 Display
*dpy
= scr
->display
;
4965 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4966 if (scr
== dpy
->screens
[i
])
4972 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4975 /* Select the visual that should be used on display DPYINFO. Set
4976 members of DPYINFO appropriately. Called from x_term_init. */
4979 select_visual (dpyinfo
)
4980 struct x_display_info
*dpyinfo
;
4982 Display
*dpy
= dpyinfo
->display
;
4983 Screen
*screen
= dpyinfo
->screen
;
4986 /* See if a visual is specified. */
4987 value
= display_x_get_resource (dpyinfo
,
4988 build_string ("visualClass"),
4989 build_string ("VisualClass"),
4991 if (STRINGP (value
))
4993 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4994 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4995 depth, a decimal number. NAME is compared with case ignored. */
4996 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
5001 strcpy (s
, XSTRING (value
)->data
);
5002 dash
= index (s
, '-');
5005 dpyinfo
->n_planes
= atoi (dash
+ 1);
5009 /* We won't find a matching visual with depth 0, so that
5010 an error will be printed below. */
5011 dpyinfo
->n_planes
= 0;
5013 /* Determine the visual class. */
5014 for (i
= 0; visual_classes
[i
].name
; ++i
)
5015 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
5017 class = visual_classes
[i
].class;
5021 /* Look up a matching visual for the specified class. */
5023 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
5024 dpyinfo
->n_planes
, class, &vinfo
))
5025 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
5027 dpyinfo
->visual
= vinfo
.visual
;
5032 XVisualInfo
*vinfo
, vinfo_template
;
5034 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
5037 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
5039 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
5041 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5042 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
5043 &vinfo_template
, &n_visuals
);
5045 fatal ("Can't get proper X visual info");
5047 dpyinfo
->n_planes
= vinfo
->depth
;
5048 XFree ((char *) vinfo
);
5053 /* Return the X display structure for the display named NAME.
5054 Open a new connection if necessary. */
5056 struct x_display_info
*
5057 x_display_info_for_name (name
)
5061 struct x_display_info
*dpyinfo
;
5063 CHECK_STRING (name
, 0);
5065 if (! EQ (Vwindow_system
, intern ("x")))
5066 error ("Not using X Windows");
5068 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5070 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5073 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5078 /* Use this general default value to start with. */
5079 Vx_resource_name
= Vinvocation_name
;
5081 validate_x_resource_name ();
5083 dpyinfo
= x_term_init (name
, (char *)0,
5084 (char *) XSTRING (Vx_resource_name
)->data
);
5087 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5090 XSETFASTINT (Vwindow_system_version
, 11);
5096 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5097 1, 3, 0, "Open a connection to an X server.\n\
5098 DISPLAY is the name of the display to connect to.\n\
5099 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5100 If the optional third arg MUST-SUCCEED is non-nil,\n\
5101 terminate Emacs if we can't open the connection.")
5102 (display
, xrm_string
, must_succeed
)
5103 Lisp_Object display
, xrm_string
, must_succeed
;
5105 unsigned char *xrm_option
;
5106 struct x_display_info
*dpyinfo
;
5108 CHECK_STRING (display
, 0);
5109 if (! NILP (xrm_string
))
5110 CHECK_STRING (xrm_string
, 1);
5112 if (! EQ (Vwindow_system
, intern ("x")))
5113 error ("Not using X Windows");
5115 if (! NILP (xrm_string
))
5116 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5118 xrm_option
= (unsigned char *) 0;
5120 validate_x_resource_name ();
5122 /* This is what opens the connection and sets x_current_display.
5123 This also initializes many symbols, such as those used for input. */
5124 dpyinfo
= x_term_init (display
, xrm_option
,
5125 (char *) XSTRING (Vx_resource_name
)->data
);
5129 if (!NILP (must_succeed
))
5130 fatal ("Cannot connect to X server %s.\n\
5131 Check the DISPLAY environment variable or use `-d'.\n\
5132 Also use the `xhost' program to verify that it is set to permit\n\
5133 connections from your machine.\n",
5134 XSTRING (display
)->data
);
5136 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5141 XSETFASTINT (Vwindow_system_version
, 11);
5145 DEFUN ("x-close-connection", Fx_close_connection
,
5146 Sx_close_connection
, 1, 1, 0,
5147 "Close the connection to DISPLAY's X server.\n\
5148 For DISPLAY, specify either a frame or a display name (a string).\n\
5149 If DISPLAY is nil, that stands for the selected frame's display.")
5151 Lisp_Object display
;
5153 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5156 if (dpyinfo
->reference_count
> 0)
5157 error ("Display still has frames on it");
5160 /* Free the fonts in the font table. */
5161 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5162 if (dpyinfo
->font_table
[i
].name
)
5164 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5165 xfree (dpyinfo
->font_table
[i
].full_name
);
5166 xfree (dpyinfo
->font_table
[i
].name
);
5167 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5170 x_destroy_all_bitmaps (dpyinfo
);
5171 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5173 #ifdef USE_X_TOOLKIT
5174 XtCloseDisplay (dpyinfo
->display
);
5176 XCloseDisplay (dpyinfo
->display
);
5179 x_delete_display (dpyinfo
);
5185 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5186 "Return the list of display names that Emacs has connections to.")
5189 Lisp_Object tail
, result
;
5192 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5193 result
= Fcons (XCAR (XCAR (tail
)), result
);
5198 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5199 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5200 If ON is nil, allow buffering of requests.\n\
5201 Turning on synchronization prohibits the Xlib routines from buffering\n\
5202 requests and seriously degrades performance, but makes debugging much\n\
5204 The optional second argument DISPLAY specifies which display to act on.\n\
5205 DISPLAY should be either a frame or a display name (a string).\n\
5206 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5208 Lisp_Object display
, on
;
5210 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5212 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5217 /* Wait for responses to all X commands issued so far for frame F. */
5224 XSync (FRAME_X_DISPLAY (f
), False
);
5229 /***********************************************************************
5231 ***********************************************************************/
5233 /* Value is the number of elements of vector VECTOR. */
5235 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5237 /* List of supported image types. Use define_image_type to add new
5238 types. Use lookup_image_type to find a type for a given symbol. */
5240 static struct image_type
*image_types
;
5242 /* The symbol `image' which is the car of the lists used to represent
5245 extern Lisp_Object Qimage
;
5247 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5253 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5254 extern Lisp_Object QCdata
;
5255 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5256 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5257 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5259 /* Other symbols. */
5261 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5263 /* Time in seconds after which images should be removed from the cache
5264 if not displayed. */
5266 Lisp_Object Vimage_cache_eviction_delay
;
5268 /* Function prototypes. */
5270 static void define_image_type
P_ ((struct image_type
*type
));
5271 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5272 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5273 static void x_laplace
P_ ((struct frame
*, struct image
*));
5274 static void x_emboss
P_ ((struct frame
*, struct image
*));
5275 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5279 /* Define a new image type from TYPE. This adds a copy of TYPE to
5280 image_types and adds the symbol *TYPE->type to Vimage_types. */
5283 define_image_type (type
)
5284 struct image_type
*type
;
5286 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5287 The initialized data segment is read-only. */
5288 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5289 bcopy (type
, p
, sizeof *p
);
5290 p
->next
= image_types
;
5292 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5296 /* Look up image type SYMBOL, and return a pointer to its image_type
5297 structure. Value is null if SYMBOL is not a known image type. */
5299 static INLINE
struct image_type
*
5300 lookup_image_type (symbol
)
5303 struct image_type
*type
;
5305 for (type
= image_types
; type
; type
= type
->next
)
5306 if (EQ (symbol
, *type
->type
))
5313 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5314 valid image specification is a list whose car is the symbol
5315 `image', and whose rest is a property list. The property list must
5316 contain a value for key `:type'. That value must be the name of a
5317 supported image type. The rest of the property list depends on the
5321 valid_image_p (object
)
5326 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5330 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
5331 if (EQ (XCAR (tem
), QCtype
))
5334 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
5336 struct image_type
*type
;
5337 type
= lookup_image_type (XCAR (tem
));
5339 valid_p
= type
->valid_p (object
);
5350 /* Log error message with format string FORMAT and argument ARG.
5351 Signaling an error, e.g. when an image cannot be loaded, is not a
5352 good idea because this would interrupt redisplay, and the error
5353 message display would lead to another redisplay. This function
5354 therefore simply displays a message. */
5357 image_error (format
, arg1
, arg2
)
5359 Lisp_Object arg1
, arg2
;
5361 add_to_log (format
, arg1
, arg2
);
5366 /***********************************************************************
5367 Image specifications
5368 ***********************************************************************/
5370 enum image_value_type
5372 IMAGE_DONT_CHECK_VALUE_TYPE
,
5374 IMAGE_STRING_OR_NIL_VALUE
,
5376 IMAGE_POSITIVE_INTEGER_VALUE
,
5377 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5378 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5380 IMAGE_INTEGER_VALUE
,
5381 IMAGE_FUNCTION_VALUE
,
5386 /* Structure used when parsing image specifications. */
5388 struct image_keyword
5390 /* Name of keyword. */
5393 /* The type of value allowed. */
5394 enum image_value_type type
;
5396 /* Non-zero means key must be present. */
5399 /* Used to recognize duplicate keywords in a property list. */
5402 /* The value that was found. */
5407 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5409 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5412 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5413 has the format (image KEYWORD VALUE ...). One of the keyword/
5414 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5415 image_keywords structures of size NKEYWORDS describing other
5416 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5419 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5421 struct image_keyword
*keywords
;
5428 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5431 plist
= XCDR (spec
);
5432 while (CONSP (plist
))
5434 Lisp_Object key
, value
;
5436 /* First element of a pair must be a symbol. */
5438 plist
= XCDR (plist
);
5442 /* There must follow a value. */
5445 value
= XCAR (plist
);
5446 plist
= XCDR (plist
);
5448 /* Find key in KEYWORDS. Error if not found. */
5449 for (i
= 0; i
< nkeywords
; ++i
)
5450 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5456 /* Record that we recognized the keyword. If a keywords
5457 was found more than once, it's an error. */
5458 keywords
[i
].value
= value
;
5459 ++keywords
[i
].count
;
5461 if (keywords
[i
].count
> 1)
5464 /* Check type of value against allowed type. */
5465 switch (keywords
[i
].type
)
5467 case IMAGE_STRING_VALUE
:
5468 if (!STRINGP (value
))
5472 case IMAGE_STRING_OR_NIL_VALUE
:
5473 if (!STRINGP (value
) && !NILP (value
))
5477 case IMAGE_SYMBOL_VALUE
:
5478 if (!SYMBOLP (value
))
5482 case IMAGE_POSITIVE_INTEGER_VALUE
:
5483 if (!INTEGERP (value
) || XINT (value
) <= 0)
5487 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5488 if (INTEGERP (value
) && XINT (value
) >= 0)
5491 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5492 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5496 case IMAGE_ASCENT_VALUE
:
5497 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5499 else if (INTEGERP (value
)
5500 && XINT (value
) >= 0
5501 && XINT (value
) <= 100)
5505 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5506 if (!INTEGERP (value
) || XINT (value
) < 0)
5510 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5513 case IMAGE_FUNCTION_VALUE
:
5514 value
= indirect_function (value
);
5516 || COMPILEDP (value
)
5517 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5521 case IMAGE_NUMBER_VALUE
:
5522 if (!INTEGERP (value
) && !FLOATP (value
))
5526 case IMAGE_INTEGER_VALUE
:
5527 if (!INTEGERP (value
))
5531 case IMAGE_BOOL_VALUE
:
5532 if (!NILP (value
) && !EQ (value
, Qt
))
5541 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5545 /* Check that all mandatory fields are present. */
5546 for (i
= 0; i
< nkeywords
; ++i
)
5547 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5550 return NILP (plist
);
5554 /* Return the value of KEY in image specification SPEC. Value is nil
5555 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5556 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5559 image_spec_value (spec
, key
, found
)
5560 Lisp_Object spec
, key
;
5565 xassert (valid_image_p (spec
));
5567 for (tail
= XCDR (spec
);
5568 CONSP (tail
) && CONSP (XCDR (tail
));
5569 tail
= XCDR (XCDR (tail
)))
5571 if (EQ (XCAR (tail
), key
))
5575 return XCAR (XCDR (tail
));
5585 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5586 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5587 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5588 size in canonical character units.\n\
5589 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5590 or omitted means use the selected frame.")
5591 (spec
, pixels
, frame
)
5592 Lisp_Object spec
, pixels
, frame
;
5597 if (valid_image_p (spec
))
5599 struct frame
*f
= check_x_frame (frame
);
5600 int id
= lookup_image (f
, spec
);
5601 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5602 int width
= img
->width
+ 2 * img
->hmargin
;
5603 int height
= img
->height
+ 2 * img
->vmargin
;
5606 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5607 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5609 size
= Fcons (make_number (width
), make_number (height
));
5612 error ("Invalid image specification");
5618 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5619 "Return t if image SPEC has a mask bitmap.\n\
5620 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5621 or omitted means use the selected frame.")
5623 Lisp_Object spec
, frame
;
5628 if (valid_image_p (spec
))
5630 struct frame
*f
= check_x_frame (frame
);
5631 int id
= lookup_image (f
, spec
);
5632 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5637 error ("Invalid image specification");
5644 /***********************************************************************
5645 Image type independent image structures
5646 ***********************************************************************/
5648 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5649 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5652 /* Allocate and return a new image structure for image specification
5653 SPEC. SPEC has a hash value of HASH. */
5655 static struct image
*
5656 make_image (spec
, hash
)
5660 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5662 xassert (valid_image_p (spec
));
5663 bzero (img
, sizeof *img
);
5664 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5665 xassert (img
->type
!= NULL
);
5667 img
->data
.lisp_val
= Qnil
;
5668 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5674 /* Free image IMG which was used on frame F, including its resources. */
5683 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5685 /* Remove IMG from the hash table of its cache. */
5687 img
->prev
->next
= img
->next
;
5689 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5692 img
->next
->prev
= img
->prev
;
5694 c
->images
[img
->id
] = NULL
;
5696 /* Free resources, then free IMG. */
5697 img
->type
->free (f
, img
);
5703 /* Prepare image IMG for display on frame F. Must be called before
5704 drawing an image. */
5707 prepare_image_for_display (f
, img
)
5713 /* We're about to display IMG, so set its timestamp to `now'. */
5715 img
->timestamp
= EMACS_SECS (t
);
5717 /* If IMG doesn't have a pixmap yet, load it now, using the image
5718 type dependent loader function. */
5719 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5720 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5724 /* Value is the number of pixels for the ascent of image IMG when
5725 drawn in face FACE. */
5728 image_ascent (img
, face
)
5732 int height
= img
->height
+ img
->vmargin
;
5735 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5738 /* This expression is arranged so that if the image can't be
5739 exactly centered, it will be moved slightly up. This is
5740 because a typical font is `top-heavy' (due to the presence
5741 uppercase letters), so the image placement should err towards
5742 being top-heavy too. It also just generally looks better. */
5743 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5745 ascent
= height
/ 2;
5748 ascent
= height
* img
->ascent
/ 100.0;
5755 /***********************************************************************
5756 Helper functions for X image types
5757 ***********************************************************************/
5759 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5761 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5762 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5764 Lisp_Object color_name
,
5765 unsigned long dflt
));
5768 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5769 free the pixmap if any. MASK_P non-zero means clear the mask
5770 pixmap if any. COLORS_P non-zero means free colors allocated for
5771 the image, if any. */
5774 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5777 int pixmap_p
, mask_p
, colors_p
;
5779 if (pixmap_p
&& img
->pixmap
)
5781 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5785 if (mask_p
&& img
->mask
)
5787 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5791 if (colors_p
&& img
->ncolors
)
5793 x_free_colors (f
, img
->colors
, img
->ncolors
);
5794 xfree (img
->colors
);
5800 /* Free X resources of image IMG which is used on frame F. */
5803 x_clear_image (f
, img
)
5808 x_clear_image_1 (f
, img
, 1, 1, 1);
5813 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5814 cannot be allocated, use DFLT. Add a newly allocated color to
5815 IMG->colors, so that it can be freed again. Value is the pixel
5818 static unsigned long
5819 x_alloc_image_color (f
, img
, color_name
, dflt
)
5822 Lisp_Object color_name
;
5826 unsigned long result
;
5828 xassert (STRINGP (color_name
));
5830 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5832 /* This isn't called frequently so we get away with simply
5833 reallocating the color vector to the needed size, here. */
5836 (unsigned long *) xrealloc (img
->colors
,
5837 img
->ncolors
* sizeof *img
->colors
);
5838 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5839 result
= color
.pixel
;
5849 /***********************************************************************
5851 ***********************************************************************/
5853 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5854 static void postprocess_image
P_ ((struct frame
*, struct image
*));
5857 /* Return a new, initialized image cache that is allocated from the
5858 heap. Call free_image_cache to free an image cache. */
5860 struct image_cache
*
5863 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5866 bzero (c
, sizeof *c
);
5868 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5869 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5870 c
->buckets
= (struct image
**) xmalloc (size
);
5871 bzero (c
->buckets
, size
);
5876 /* Free image cache of frame F. Be aware that X frames share images
5880 free_image_cache (f
)
5883 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5888 /* Cache should not be referenced by any frame when freed. */
5889 xassert (c
->refcount
== 0);
5891 for (i
= 0; i
< c
->used
; ++i
)
5892 free_image (f
, c
->images
[i
]);
5896 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5901 /* Clear image cache of frame F. FORCE_P non-zero means free all
5902 images. FORCE_P zero means clear only images that haven't been
5903 displayed for some time. Should be called from time to time to
5904 reduce the number of loaded images. If image-eviction-seconds is
5905 non-nil, this frees images in the cache which weren't displayed for
5906 at least that many seconds. */
5909 clear_image_cache (f
, force_p
)
5913 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5915 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5922 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5924 /* Block input so that we won't be interrupted by a SIGIO
5925 while being in an inconsistent state. */
5928 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5930 struct image
*img
= c
->images
[i
];
5932 && (force_p
|| img
->timestamp
< old
))
5934 free_image (f
, img
);
5939 /* We may be clearing the image cache because, for example,
5940 Emacs was iconified for a longer period of time. In that
5941 case, current matrices may still contain references to
5942 images freed above. So, clear these matrices. */
5945 Lisp_Object tail
, frame
;
5947 FOR_EACH_FRAME (tail
, frame
)
5949 struct frame
*f
= XFRAME (frame
);
5951 && FRAME_X_IMAGE_CACHE (f
) == c
)
5952 clear_current_matrices (f
);
5955 ++windows_or_buffers_changed
;
5963 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5965 "Clear the image cache of FRAME.\n\
5966 FRAME nil or omitted means use the selected frame.\n\
5967 FRAME t means clear the image caches of all frames.")
5975 FOR_EACH_FRAME (tail
, frame
)
5976 if (FRAME_X_P (XFRAME (frame
)))
5977 clear_image_cache (XFRAME (frame
), 1);
5980 clear_image_cache (check_x_frame (frame
), 1);
5986 /* Compute masks and transform image IMG on frame F, as specified
5987 by the image's specification, */
5990 postprocess_image (f
, img
)
5994 /* Manipulation of the image's mask. */
5997 Lisp_Object conversion
, spec
;
6002 /* `:heuristic-mask t'
6004 means build a mask heuristically.
6005 `:heuristic-mask (R G B)'
6006 `:mask (heuristic (R G B))'
6007 means build a mask from color (R G B) in the
6010 means remove a mask, if any. */
6012 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6014 x_build_heuristic_mask (f
, img
, mask
);
6019 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6021 if (EQ (mask
, Qheuristic
))
6022 x_build_heuristic_mask (f
, img
, Qt
);
6023 else if (CONSP (mask
)
6024 && EQ (XCAR (mask
), Qheuristic
))
6026 if (CONSP (XCDR (mask
)))
6027 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6029 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6031 else if (NILP (mask
) && found_p
&& img
->mask
)
6033 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6039 /* Should we apply an image transformation algorithm? */
6040 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6041 if (EQ (conversion
, Qdisabled
))
6042 x_disable_image (f
, img
);
6043 else if (EQ (conversion
, Qlaplace
))
6045 else if (EQ (conversion
, Qemboss
))
6047 else if (CONSP (conversion
)
6048 && EQ (XCAR (conversion
), Qedge_detection
))
6051 tem
= XCDR (conversion
);
6053 x_edge_detection (f
, img
,
6054 Fplist_get (tem
, QCmatrix
),
6055 Fplist_get (tem
, QCcolor_adjustment
));
6061 /* Return the id of image with Lisp specification SPEC on frame F.
6062 SPEC must be a valid Lisp image specification (see valid_image_p). */
6065 lookup_image (f
, spec
)
6069 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6073 struct gcpro gcpro1
;
6076 /* F must be a window-system frame, and SPEC must be a valid image
6078 xassert (FRAME_WINDOW_P (f
));
6079 xassert (valid_image_p (spec
));
6083 /* Look up SPEC in the hash table of the image cache. */
6084 hash
= sxhash (spec
, 0);
6085 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6087 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6088 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6091 /* If not found, create a new image and cache it. */
6094 extern Lisp_Object Qpostscript
;
6097 img
= make_image (spec
, hash
);
6098 cache_image (f
, img
);
6099 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6101 /* If we can't load the image, and we don't have a width and
6102 height, use some arbitrary width and height so that we can
6103 draw a rectangle for it. */
6104 if (img
->load_failed_p
)
6108 value
= image_spec_value (spec
, QCwidth
, NULL
);
6109 img
->width
= (INTEGERP (value
)
6110 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6111 value
= image_spec_value (spec
, QCheight
, NULL
);
6112 img
->height
= (INTEGERP (value
)
6113 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6117 /* Handle image type independent image attributes
6118 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
6119 Lisp_Object ascent
, margin
, relief
;
6121 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6122 if (INTEGERP (ascent
))
6123 img
->ascent
= XFASTINT (ascent
);
6124 else if (EQ (ascent
, Qcenter
))
6125 img
->ascent
= CENTERED_IMAGE_ASCENT
;
6127 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6128 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6129 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
6130 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
6131 && INTEGERP (XCDR (margin
)))
6133 if (XINT (XCAR (margin
)) > 0)
6134 img
->hmargin
= XFASTINT (XCAR (margin
));
6135 if (XINT (XCDR (margin
)) > 0)
6136 img
->vmargin
= XFASTINT (XCDR (margin
));
6139 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6140 if (INTEGERP (relief
))
6142 img
->relief
= XINT (relief
);
6143 img
->hmargin
+= abs (img
->relief
);
6144 img
->vmargin
+= abs (img
->relief
);
6147 /* Do image transformations and compute masks, unless we
6148 don't have the image yet. */
6149 if (!EQ (*img
->type
->type
, Qpostscript
))
6150 postprocess_image (f
, img
);
6154 xassert (!interrupt_input_blocked
);
6157 /* We're using IMG, so set its timestamp to `now'. */
6158 EMACS_GET_TIME (now
);
6159 img
->timestamp
= EMACS_SECS (now
);
6163 /* Value is the image id. */
6168 /* Cache image IMG in the image cache of frame F. */
6171 cache_image (f
, img
)
6175 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6178 /* Find a free slot in c->images. */
6179 for (i
= 0; i
< c
->used
; ++i
)
6180 if (c
->images
[i
] == NULL
)
6183 /* If no free slot found, maybe enlarge c->images. */
6184 if (i
== c
->used
&& c
->used
== c
->size
)
6187 c
->images
= (struct image
**) xrealloc (c
->images
,
6188 c
->size
* sizeof *c
->images
);
6191 /* Add IMG to c->images, and assign IMG an id. */
6197 /* Add IMG to the cache's hash table. */
6198 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6199 img
->next
= c
->buckets
[i
];
6201 img
->next
->prev
= img
;
6203 c
->buckets
[i
] = img
;
6207 /* Call FN on every image in the image cache of frame F. Used to mark
6208 Lisp Objects in the image cache. */
6211 forall_images_in_image_cache (f
, fn
)
6213 void (*fn
) P_ ((struct image
*img
));
6215 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6217 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6221 for (i
= 0; i
< c
->used
; ++i
)
6230 /***********************************************************************
6232 ***********************************************************************/
6234 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6235 XImage
**, Pixmap
*));
6236 static void x_destroy_x_image
P_ ((XImage
*));
6237 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6240 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6241 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6242 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6243 via xmalloc. Print error messages via image_error if an error
6244 occurs. Value is non-zero if successful. */
6247 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6249 int width
, height
, depth
;
6253 Display
*display
= FRAME_X_DISPLAY (f
);
6254 Screen
*screen
= FRAME_X_SCREEN (f
);
6255 Window window
= FRAME_X_WINDOW (f
);
6257 xassert (interrupt_input_blocked
);
6260 depth
= DefaultDepthOfScreen (screen
);
6261 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6262 depth
, ZPixmap
, 0, NULL
, width
, height
,
6263 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6266 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6270 /* Allocate image raster. */
6271 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6273 /* Allocate a pixmap of the same size. */
6274 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6275 if (*pixmap
== None
)
6277 x_destroy_x_image (*ximg
);
6279 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6287 /* Destroy XImage XIMG. Free XIMG->data. */
6290 x_destroy_x_image (ximg
)
6293 xassert (interrupt_input_blocked
);
6298 XDestroyImage (ximg
);
6303 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6304 are width and height of both the image and pixmap. */
6307 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6314 xassert (interrupt_input_blocked
);
6315 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6316 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6317 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6322 /***********************************************************************
6324 ***********************************************************************/
6326 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6327 static char *slurp_file
P_ ((char *, int *));
6330 /* Find image file FILE. Look in data-directory, then
6331 x-bitmap-file-path. Value is the full name of the file found, or
6332 nil if not found. */
6335 x_find_image_file (file
)
6338 Lisp_Object file_found
, search_path
;
6339 struct gcpro gcpro1
, gcpro2
;
6343 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6344 GCPRO2 (file_found
, search_path
);
6346 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6347 fd
= openp (search_path
, file
, "", &file_found
, 0);
6359 /* Read FILE into memory. Value is a pointer to a buffer allocated
6360 with xmalloc holding FILE's contents. Value is null if an error
6361 occurred. *SIZE is set to the size of the file. */
6364 slurp_file (file
, size
)
6372 if (stat (file
, &st
) == 0
6373 && (fp
= fopen (file
, "r")) != NULL
6374 && (buf
= (char *) xmalloc (st
.st_size
),
6375 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6396 /***********************************************************************
6398 ***********************************************************************/
6400 static int xbm_scan
P_ ((char **, char *, char *, int *));
6401 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6402 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6404 static int xbm_image_p
P_ ((Lisp_Object object
));
6405 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6407 static int xbm_file_p
P_ ((Lisp_Object
));
6410 /* Indices of image specification fields in xbm_format, below. */
6412 enum xbm_keyword_index
6430 /* Vector of image_keyword structures describing the format
6431 of valid XBM image specifications. */
6433 static struct image_keyword xbm_format
[XBM_LAST
] =
6435 {":type", IMAGE_SYMBOL_VALUE
, 1},
6436 {":file", IMAGE_STRING_VALUE
, 0},
6437 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6438 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6439 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6440 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
6441 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
6442 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6443 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6444 {":relief", IMAGE_INTEGER_VALUE
, 0},
6445 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6446 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6447 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6450 /* Structure describing the image type XBM. */
6452 static struct image_type xbm_type
=
6461 /* Tokens returned from xbm_scan. */
6470 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6471 A valid specification is a list starting with the symbol `image'
6472 The rest of the list is a property list which must contain an
6475 If the specification specifies a file to load, it must contain
6476 an entry `:file FILENAME' where FILENAME is a string.
6478 If the specification is for a bitmap loaded from memory it must
6479 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6480 WIDTH and HEIGHT are integers > 0. DATA may be:
6482 1. a string large enough to hold the bitmap data, i.e. it must
6483 have a size >= (WIDTH + 7) / 8 * HEIGHT
6485 2. a bool-vector of size >= WIDTH * HEIGHT
6487 3. a vector of strings or bool-vectors, one for each line of the
6490 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6491 may not be specified in this case because they are defined in the
6494 Both the file and data forms may contain the additional entries
6495 `:background COLOR' and `:foreground COLOR'. If not present,
6496 foreground and background of the frame on which the image is
6497 displayed is used. */
6500 xbm_image_p (object
)
6503 struct image_keyword kw
[XBM_LAST
];
6505 bcopy (xbm_format
, kw
, sizeof kw
);
6506 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6509 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6511 if (kw
[XBM_FILE
].count
)
6513 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6516 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6518 /* In-memory XBM file. */
6519 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6527 /* Entries for `:width', `:height' and `:data' must be present. */
6528 if (!kw
[XBM_WIDTH
].count
6529 || !kw
[XBM_HEIGHT
].count
6530 || !kw
[XBM_DATA
].count
)
6533 data
= kw
[XBM_DATA
].value
;
6534 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6535 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6537 /* Check type of data, and width and height against contents of
6543 /* Number of elements of the vector must be >= height. */
6544 if (XVECTOR (data
)->size
< height
)
6547 /* Each string or bool-vector in data must be large enough
6548 for one line of the image. */
6549 for (i
= 0; i
< height
; ++i
)
6551 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6555 if (XSTRING (elt
)->size
6556 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6559 else if (BOOL_VECTOR_P (elt
))
6561 if (XBOOL_VECTOR (elt
)->size
< width
)
6568 else if (STRINGP (data
))
6570 if (XSTRING (data
)->size
6571 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6574 else if (BOOL_VECTOR_P (data
))
6576 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6587 /* Scan a bitmap file. FP is the stream to read from. Value is
6588 either an enumerator from enum xbm_token, or a character for a
6589 single-character token, or 0 at end of file. If scanning an
6590 identifier, store the lexeme of the identifier in SVAL. If
6591 scanning a number, store its value in *IVAL. */
6594 xbm_scan (s
, end
, sval
, ival
)
6603 /* Skip white space. */
6604 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6609 else if (isdigit (c
))
6611 int value
= 0, digit
;
6613 if (c
== '0' && *s
< end
)
6616 if (c
== 'x' || c
== 'X')
6623 else if (c
>= 'a' && c
<= 'f')
6624 digit
= c
- 'a' + 10;
6625 else if (c
>= 'A' && c
<= 'F')
6626 digit
= c
- 'A' + 10;
6629 value
= 16 * value
+ digit
;
6632 else if (isdigit (c
))
6636 && (c
= *(*s
)++, isdigit (c
)))
6637 value
= 8 * value
+ c
- '0';
6644 && (c
= *(*s
)++, isdigit (c
)))
6645 value
= 10 * value
+ c
- '0';
6653 else if (isalpha (c
) || c
== '_')
6657 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6664 else if (c
== '/' && **s
== '*')
6666 /* C-style comment. */
6668 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6681 /* Replacement for XReadBitmapFileData which isn't available under old
6682 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6683 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6684 the image. Return in *DATA the bitmap data allocated with xmalloc.
6685 Value is non-zero if successful. DATA null means just test if
6686 CONTENTS looks like an in-memory XBM file. */
6689 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6690 char *contents
, *end
;
6691 int *width
, *height
;
6692 unsigned char **data
;
6695 char buffer
[BUFSIZ
];
6698 int bytes_per_line
, i
, nbytes
;
6704 LA1 = xbm_scan (&s, end, buffer, &value)
6706 #define expect(TOKEN) \
6707 if (LA1 != (TOKEN)) \
6712 #define expect_ident(IDENT) \
6713 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6718 *width
= *height
= -1;
6721 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6723 /* Parse defines for width, height and hot-spots. */
6727 expect_ident ("define");
6728 expect (XBM_TK_IDENT
);
6730 if (LA1
== XBM_TK_NUMBER
);
6732 char *p
= strrchr (buffer
, '_');
6733 p
= p
? p
+ 1 : buffer
;
6734 if (strcmp (p
, "width") == 0)
6736 else if (strcmp (p
, "height") == 0)
6739 expect (XBM_TK_NUMBER
);
6742 if (*width
< 0 || *height
< 0)
6744 else if (data
== NULL
)
6747 /* Parse bits. Must start with `static'. */
6748 expect_ident ("static");
6749 if (LA1
== XBM_TK_IDENT
)
6751 if (strcmp (buffer
, "unsigned") == 0)
6754 expect_ident ("char");
6756 else if (strcmp (buffer
, "short") == 0)
6760 if (*width
% 16 && *width
% 16 < 9)
6763 else if (strcmp (buffer
, "char") == 0)
6771 expect (XBM_TK_IDENT
);
6777 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6778 nbytes
= bytes_per_line
* *height
;
6779 p
= *data
= (char *) xmalloc (nbytes
);
6783 for (i
= 0; i
< nbytes
; i
+= 2)
6786 expect (XBM_TK_NUMBER
);
6789 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6792 if (LA1
== ',' || LA1
== '}')
6800 for (i
= 0; i
< nbytes
; ++i
)
6803 expect (XBM_TK_NUMBER
);
6807 if (LA1
== ',' || LA1
== '}')
6832 /* Load XBM image IMG which will be displayed on frame F from buffer
6833 CONTENTS. END is the end of the buffer. Value is non-zero if
6837 xbm_load_image (f
, img
, contents
, end
)
6840 char *contents
, *end
;
6843 unsigned char *data
;
6846 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6849 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6850 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6851 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6854 xassert (img
->width
> 0 && img
->height
> 0);
6856 /* Get foreground and background colors, maybe allocate colors. */
6857 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6859 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6861 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6863 background
= x_alloc_image_color (f
, img
, value
, background
);
6866 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6869 img
->width
, img
->height
,
6870 foreground
, background
,
6874 if (img
->pixmap
== None
)
6876 x_clear_image (f
, img
);
6877 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6883 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6889 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6896 return (STRINGP (data
)
6897 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6898 (XSTRING (data
)->data
6899 + STRING_BYTES (XSTRING (data
))),
6904 /* Fill image IMG which is used on frame F with pixmap data. Value is
6905 non-zero if successful. */
6913 Lisp_Object file_name
;
6915 xassert (xbm_image_p (img
->spec
));
6917 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6918 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6919 if (STRINGP (file_name
))
6924 struct gcpro gcpro1
;
6926 file
= x_find_image_file (file_name
);
6928 if (!STRINGP (file
))
6930 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6935 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6936 if (contents
== NULL
)
6938 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6943 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6948 struct image_keyword fmt
[XBM_LAST
];
6951 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6952 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6955 int in_memory_file_p
= 0;
6957 /* See if data looks like an in-memory XBM file. */
6958 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6959 in_memory_file_p
= xbm_file_p (data
);
6961 /* Parse the image specification. */
6962 bcopy (xbm_format
, fmt
, sizeof fmt
);
6963 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6966 /* Get specified width, and height. */
6967 if (!in_memory_file_p
)
6969 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6970 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6971 xassert (img
->width
> 0 && img
->height
> 0);
6974 /* Get foreground and background colors, maybe allocate colors. */
6975 if (fmt
[XBM_FOREGROUND
].count
6976 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
6977 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6979 if (fmt
[XBM_BACKGROUND
].count
6980 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
6981 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6984 if (in_memory_file_p
)
6985 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6986 (XSTRING (data
)->data
6987 + STRING_BYTES (XSTRING (data
))));
6994 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6996 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6997 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6999 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
7001 bcopy (XSTRING (line
)->data
, p
, nbytes
);
7003 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
7006 else if (STRINGP (data
))
7007 bits
= XSTRING (data
)->data
;
7009 bits
= XBOOL_VECTOR (data
)->data
;
7011 /* Create the pixmap. */
7012 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7014 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7017 img
->width
, img
->height
,
7018 foreground
, background
,
7024 image_error ("Unable to create pixmap for XBM image `%s'",
7026 x_clear_image (f
, img
);
7036 /***********************************************************************
7038 ***********************************************************************/
7042 static int xpm_image_p
P_ ((Lisp_Object object
));
7043 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
7044 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
7046 #include "X11/xpm.h"
7048 /* The symbol `xpm' identifying XPM-format images. */
7052 /* Indices of image specification fields in xpm_format, below. */
7054 enum xpm_keyword_index
7069 /* Vector of image_keyword structures describing the format
7070 of valid XPM image specifications. */
7072 static struct image_keyword xpm_format
[XPM_LAST
] =
7074 {":type", IMAGE_SYMBOL_VALUE
, 1},
7075 {":file", IMAGE_STRING_VALUE
, 0},
7076 {":data", IMAGE_STRING_VALUE
, 0},
7077 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7078 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7079 {":relief", IMAGE_INTEGER_VALUE
, 0},
7080 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7081 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7082 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7083 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7086 /* Structure describing the image type XBM. */
7088 static struct image_type xpm_type
=
7098 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7099 functions for allocating image colors. Our own functions handle
7100 color allocation failures more gracefully than the ones on the XPM
7103 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7104 #define ALLOC_XPM_COLORS
7107 #ifdef ALLOC_XPM_COLORS
7109 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7110 static void xpm_free_color_cache
P_ ((void));
7111 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7112 static int xpm_color_bucket
P_ ((char *));
7113 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7116 /* An entry in a hash table used to cache color definitions of named
7117 colors. This cache is necessary to speed up XPM image loading in
7118 case we do color allocations ourselves. Without it, we would need
7119 a call to XParseColor per pixel in the image. */
7121 struct xpm_cached_color
7123 /* Next in collision chain. */
7124 struct xpm_cached_color
*next
;
7126 /* Color definition (RGB and pixel color). */
7133 /* The hash table used for the color cache, and its bucket vector
7136 #define XPM_COLOR_CACHE_BUCKETS 1001
7137 struct xpm_cached_color
**xpm_color_cache
;
7139 /* Initialize the color cache. */
7142 xpm_init_color_cache (f
, attrs
)
7144 XpmAttributes
*attrs
;
7146 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7147 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7148 memset (xpm_color_cache
, 0, nbytes
);
7149 init_color_table ();
7151 if (attrs
->valuemask
& XpmColorSymbols
)
7156 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7157 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7158 attrs
->colorsymbols
[i
].value
, &color
))
7160 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7162 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7168 /* Free the color cache. */
7171 xpm_free_color_cache ()
7173 struct xpm_cached_color
*p
, *next
;
7176 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7177 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7183 xfree (xpm_color_cache
);
7184 xpm_color_cache
= NULL
;
7185 free_color_table ();
7189 /* Return the bucket index for color named COLOR_NAME in the color
7193 xpm_color_bucket (color_name
)
7199 for (s
= color_name
; *s
; ++s
)
7201 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7205 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7206 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7209 static struct xpm_cached_color
*
7210 xpm_cache_color (f
, color_name
, color
, bucket
)
7217 struct xpm_cached_color
*p
;
7220 bucket
= xpm_color_bucket (color_name
);
7222 nbytes
= sizeof *p
+ strlen (color_name
);
7223 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7224 strcpy (p
->name
, color_name
);
7226 p
->next
= xpm_color_cache
[bucket
];
7227 xpm_color_cache
[bucket
] = p
;
7232 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7233 return the cached definition in *COLOR. Otherwise, make a new
7234 entry in the cache and allocate the color. Value is zero if color
7235 allocation failed. */
7238 xpm_lookup_color (f
, color_name
, color
)
7243 struct xpm_cached_color
*p
;
7244 int h
= xpm_color_bucket (color_name
);
7246 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7247 if (strcmp (p
->name
, color_name
) == 0)
7252 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7255 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7257 p
= xpm_cache_color (f
, color_name
, color
, h
);
7264 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7265 CLOSURE is a pointer to the frame on which we allocate the
7266 color. Return in *COLOR the allocated color. Value is non-zero
7270 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7277 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7281 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7282 is a pointer to the frame on which we allocate the color. Value is
7283 non-zero if successful. */
7286 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7296 #endif /* ALLOC_XPM_COLORS */
7299 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7300 for XPM images. Such a list must consist of conses whose car and
7304 xpm_valid_color_symbols_p (color_symbols
)
7305 Lisp_Object color_symbols
;
7307 while (CONSP (color_symbols
))
7309 Lisp_Object sym
= XCAR (color_symbols
);
7311 || !STRINGP (XCAR (sym
))
7312 || !STRINGP (XCDR (sym
)))
7314 color_symbols
= XCDR (color_symbols
);
7317 return NILP (color_symbols
);
7321 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7324 xpm_image_p (object
)
7327 struct image_keyword fmt
[XPM_LAST
];
7328 bcopy (xpm_format
, fmt
, sizeof fmt
);
7329 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7330 /* Either `:file' or `:data' must be present. */
7331 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7332 /* Either no `:color-symbols' or it's a list of conses
7333 whose car and cdr are strings. */
7334 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7335 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7339 /* Load image IMG which will be displayed on frame F. Value is
7340 non-zero if successful. */
7348 XpmAttributes attrs
;
7349 Lisp_Object specified_file
, color_symbols
;
7351 /* Configure the XPM lib. Use the visual of frame F. Allocate
7352 close colors. Return colors allocated. */
7353 bzero (&attrs
, sizeof attrs
);
7354 attrs
.visual
= FRAME_X_VISUAL (f
);
7355 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7356 attrs
.valuemask
|= XpmVisual
;
7357 attrs
.valuemask
|= XpmColormap
;
7359 #ifdef ALLOC_XPM_COLORS
7360 /* Allocate colors with our own functions which handle
7361 failing color allocation more gracefully. */
7362 attrs
.color_closure
= f
;
7363 attrs
.alloc_color
= xpm_alloc_color
;
7364 attrs
.free_colors
= xpm_free_colors
;
7365 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7366 #else /* not ALLOC_XPM_COLORS */
7367 /* Let the XPM lib allocate colors. */
7368 attrs
.valuemask
|= XpmReturnAllocPixels
;
7369 #ifdef XpmAllocCloseColors
7370 attrs
.alloc_close_colors
= 1;
7371 attrs
.valuemask
|= XpmAllocCloseColors
;
7372 #else /* not XpmAllocCloseColors */
7373 attrs
.closeness
= 600;
7374 attrs
.valuemask
|= XpmCloseness
;
7375 #endif /* not XpmAllocCloseColors */
7376 #endif /* ALLOC_XPM_COLORS */
7378 /* If image specification contains symbolic color definitions, add
7379 these to `attrs'. */
7380 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7381 if (CONSP (color_symbols
))
7384 XpmColorSymbol
*xpm_syms
;
7387 attrs
.valuemask
|= XpmColorSymbols
;
7389 /* Count number of symbols. */
7390 attrs
.numsymbols
= 0;
7391 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7394 /* Allocate an XpmColorSymbol array. */
7395 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7396 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7397 bzero (xpm_syms
, size
);
7398 attrs
.colorsymbols
= xpm_syms
;
7400 /* Fill the color symbol array. */
7401 for (tail
= color_symbols
, i
= 0;
7403 ++i
, tail
= XCDR (tail
))
7405 Lisp_Object name
= XCAR (XCAR (tail
));
7406 Lisp_Object color
= XCDR (XCAR (tail
));
7407 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7408 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7409 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7410 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7414 /* Create a pixmap for the image, either from a file, or from a
7415 string buffer containing data in the same format as an XPM file. */
7416 #ifdef ALLOC_XPM_COLORS
7417 xpm_init_color_cache (f
, &attrs
);
7420 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7421 if (STRINGP (specified_file
))
7423 Lisp_Object file
= x_find_image_file (specified_file
);
7424 if (!STRINGP (file
))
7426 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7430 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7431 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7436 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7437 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7438 XSTRING (buffer
)->data
,
7439 &img
->pixmap
, &img
->mask
,
7443 if (rc
== XpmSuccess
)
7445 #ifdef ALLOC_XPM_COLORS
7446 img
->colors
= colors_in_color_table (&img
->ncolors
);
7447 #else /* not ALLOC_XPM_COLORS */
7450 img
->ncolors
= attrs
.nalloc_pixels
;
7451 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7452 * sizeof *img
->colors
);
7453 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7455 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7456 #ifdef DEBUG_X_COLORS
7457 register_color (img
->colors
[i
]);
7460 #endif /* not ALLOC_XPM_COLORS */
7462 img
->width
= attrs
.width
;
7463 img
->height
= attrs
.height
;
7464 xassert (img
->width
> 0 && img
->height
> 0);
7466 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7467 XpmFreeAttributes (&attrs
);
7474 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7477 case XpmFileInvalid
:
7478 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7482 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7485 case XpmColorFailed
:
7486 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7490 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7495 #ifdef ALLOC_XPM_COLORS
7496 xpm_free_color_cache ();
7498 return rc
== XpmSuccess
;
7501 #endif /* HAVE_XPM != 0 */
7504 /***********************************************************************
7506 ***********************************************************************/
7508 /* An entry in the color table mapping an RGB color to a pixel color. */
7513 unsigned long pixel
;
7515 /* Next in color table collision list. */
7516 struct ct_color
*next
;
7519 /* The bucket vector size to use. Must be prime. */
7523 /* Value is a hash of the RGB color given by R, G, and B. */
7525 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7527 /* The color hash table. */
7529 struct ct_color
**ct_table
;
7531 /* Number of entries in the color table. */
7533 int ct_colors_allocated
;
7535 /* Initialize the color table. */
7540 int size
= CT_SIZE
* sizeof (*ct_table
);
7541 ct_table
= (struct ct_color
**) xmalloc (size
);
7542 bzero (ct_table
, size
);
7543 ct_colors_allocated
= 0;
7547 /* Free memory associated with the color table. */
7553 struct ct_color
*p
, *next
;
7555 for (i
= 0; i
< CT_SIZE
; ++i
)
7556 for (p
= ct_table
[i
]; p
; p
= next
)
7567 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7568 entry for that color already is in the color table, return the
7569 pixel color of that entry. Otherwise, allocate a new color for R,
7570 G, B, and make an entry in the color table. */
7572 static unsigned long
7573 lookup_rgb_color (f
, r
, g
, b
)
7577 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7578 int i
= hash
% CT_SIZE
;
7581 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7582 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7595 cmap
= FRAME_X_COLORMAP (f
);
7596 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7600 ++ct_colors_allocated
;
7602 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7606 p
->pixel
= color
.pixel
;
7607 p
->next
= ct_table
[i
];
7611 return FRAME_FOREGROUND_PIXEL (f
);
7618 /* Look up pixel color PIXEL which is used on frame F in the color
7619 table. If not already present, allocate it. Value is PIXEL. */
7621 static unsigned long
7622 lookup_pixel_color (f
, pixel
)
7624 unsigned long pixel
;
7626 int i
= pixel
% CT_SIZE
;
7629 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7630 if (p
->pixel
== pixel
)
7639 cmap
= FRAME_X_COLORMAP (f
);
7640 color
.pixel
= pixel
;
7641 x_query_color (f
, &color
);
7642 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7646 ++ct_colors_allocated
;
7648 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7653 p
->next
= ct_table
[i
];
7657 return FRAME_FOREGROUND_PIXEL (f
);
7664 /* Value is a vector of all pixel colors contained in the color table,
7665 allocated via xmalloc. Set *N to the number of colors. */
7667 static unsigned long *
7668 colors_in_color_table (n
)
7673 unsigned long *colors
;
7675 if (ct_colors_allocated
== 0)
7682 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7684 *n
= ct_colors_allocated
;
7686 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7687 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7688 colors
[j
++] = p
->pixel
;
7696 /***********************************************************************
7698 ***********************************************************************/
7700 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7701 int, XImage
*, int));
7702 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7703 XColor
*, int, XImage
*, int));
7704 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7705 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7706 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7708 /* Non-zero means draw a cross on images having `:conversion
7711 int cross_disabled_images
;
7713 /* Edge detection matrices for different edge-detection
7716 static int emboss_matrix
[9] = {
7718 2, -1, 0, /* y - 1 */
7720 0, 1, -2 /* y + 1 */
7723 static int laplace_matrix
[9] = {
7725 1, 0, 0, /* y - 1 */
7727 0, 0, -1 /* y + 1 */
7730 /* Value is the intensity of the color whose red/green/blue values
7733 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7736 /* On frame F, return an array of XColor structures describing image
7737 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7738 non-zero means also fill the red/green/blue members of the XColor
7739 structures. Value is a pointer to the array of XColors structures,
7740 allocated with xmalloc; it must be freed by the caller. */
7743 x_to_xcolors (f
, img
, rgb_p
)
7752 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7754 /* Get the X image IMG->pixmap. */
7755 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7756 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7758 /* Fill the `pixel' members of the XColor array. I wished there
7759 were an easy and portable way to circumvent XGetPixel. */
7761 for (y
= 0; y
< img
->height
; ++y
)
7765 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7766 p
->pixel
= XGetPixel (ximg
, x
, y
);
7769 x_query_colors (f
, row
, img
->width
);
7772 XDestroyImage (ximg
);
7777 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7778 RGB members are set. F is the frame on which this all happens.
7779 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7782 x_from_xcolors (f
, img
, colors
)
7792 init_color_table ();
7794 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7797 for (y
= 0; y
< img
->height
; ++y
)
7798 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7800 unsigned long pixel
;
7801 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7802 XPutPixel (oimg
, x
, y
, pixel
);
7806 x_clear_image_1 (f
, img
, 1, 0, 1);
7808 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7809 x_destroy_x_image (oimg
);
7810 img
->pixmap
= pixmap
;
7811 img
->colors
= colors_in_color_table (&img
->ncolors
);
7812 free_color_table ();
7816 /* On frame F, perform edge-detection on image IMG.
7818 MATRIX is a nine-element array specifying the transformation
7819 matrix. See emboss_matrix for an example.
7821 COLOR_ADJUST is a color adjustment added to each pixel of the
7825 x_detect_edges (f
, img
, matrix
, color_adjust
)
7828 int matrix
[9], color_adjust
;
7830 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7834 for (i
= sum
= 0; i
< 9; ++i
)
7835 sum
+= abs (matrix
[i
]);
7837 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7839 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7841 for (y
= 0; y
< img
->height
; ++y
)
7843 p
= COLOR (new, 0, y
);
7844 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7845 p
= COLOR (new, img
->width
- 1, y
);
7846 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7849 for (x
= 1; x
< img
->width
- 1; ++x
)
7851 p
= COLOR (new, x
, 0);
7852 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7853 p
= COLOR (new, x
, img
->height
- 1);
7854 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7857 for (y
= 1; y
< img
->height
- 1; ++y
)
7859 p
= COLOR (new, 1, y
);
7861 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7863 int r
, g
, b
, y1
, x1
;
7866 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7867 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7870 XColor
*t
= COLOR (colors
, x1
, y1
);
7871 r
+= matrix
[i
] * t
->red
;
7872 g
+= matrix
[i
] * t
->green
;
7873 b
+= matrix
[i
] * t
->blue
;
7876 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7877 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7878 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7879 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7884 x_from_xcolors (f
, img
, new);
7890 /* Perform the pre-defined `emboss' edge-detection on image IMG
7898 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7902 /* Perform the pre-defined `laplace' edge-detection on image IMG
7910 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7914 /* Perform edge-detection on image IMG on frame F, with specified
7915 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7917 MATRIX must be either
7919 - a list of at least 9 numbers in row-major form
7920 - a vector of at least 9 numbers
7922 COLOR_ADJUST nil means use a default; otherwise it must be a
7926 x_edge_detection (f
, img
, matrix
, color_adjust
)
7929 Lisp_Object matrix
, color_adjust
;
7937 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7938 ++i
, matrix
= XCDR (matrix
))
7939 trans
[i
] = XFLOATINT (XCAR (matrix
));
7941 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7943 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7944 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7947 if (NILP (color_adjust
))
7948 color_adjust
= make_number (0xffff / 2);
7950 if (i
== 9 && NUMBERP (color_adjust
))
7951 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7955 /* Transform image IMG on frame F so that it looks disabled. */
7958 x_disable_image (f
, img
)
7962 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7964 if (dpyinfo
->n_planes
>= 2)
7966 /* Color (or grayscale). Convert to gray, and equalize. Just
7967 drawing such images with a stipple can look very odd, so
7968 we're using this method instead. */
7969 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7971 const int h
= 15000;
7972 const int l
= 30000;
7974 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7978 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7979 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7980 p
->red
= p
->green
= p
->blue
= i2
;
7983 x_from_xcolors (f
, img
, colors
);
7986 /* Draw a cross over the disabled image, if we must or if we
7988 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
7990 Display
*dpy
= FRAME_X_DISPLAY (f
);
7993 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
7994 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
7995 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
7996 img
->width
- 1, img
->height
- 1);
7997 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
8003 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
8004 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
8005 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
8006 img
->width
- 1, img
->height
- 1);
8007 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
8015 /* Build a mask for image IMG which is used on frame F. FILE is the
8016 name of an image file, for error messages. HOW determines how to
8017 determine the background color of IMG. If it is a list '(R G B)',
8018 with R, G, and B being integers >= 0, take that as the color of the
8019 background. Otherwise, determine the background color of IMG
8020 heuristically. Value is non-zero if successful. */
8023 x_build_heuristic_mask (f
, img
, how
)
8028 Display
*dpy
= FRAME_X_DISPLAY (f
);
8029 XImage
*ximg
, *mask_img
;
8030 int x
, y
, rc
, look_at_corners_p
;
8031 unsigned long bg
= 0;
8035 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8039 /* Create an image and pixmap serving as mask. */
8040 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
8041 &mask_img
, &img
->mask
);
8045 /* Get the X image of IMG->pixmap. */
8046 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
8049 /* Determine the background color of ximg. If HOW is `(R G B)'
8050 take that as color. Otherwise, try to determine the color
8052 look_at_corners_p
= 1;
8060 && NATNUMP (XCAR (how
)))
8062 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
8066 if (i
== 3 && NILP (how
))
8068 char color_name
[30];
8069 XColor exact
, color
;
8072 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
8074 cmap
= FRAME_X_COLORMAP (f
);
8075 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
8078 look_at_corners_p
= 0;
8083 if (look_at_corners_p
)
8085 unsigned long corners
[4];
8088 /* Get the colors at the corners of ximg. */
8089 corners
[0] = XGetPixel (ximg
, 0, 0);
8090 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
8091 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
8092 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
8094 /* Choose the most frequently found color as background. */
8095 for (i
= best_count
= 0; i
< 4; ++i
)
8099 for (j
= n
= 0; j
< 4; ++j
)
8100 if (corners
[i
] == corners
[j
])
8104 bg
= corners
[i
], best_count
= n
;
8108 /* Set all bits in mask_img to 1 whose color in ximg is different
8109 from the background color bg. */
8110 for (y
= 0; y
< img
->height
; ++y
)
8111 for (x
= 0; x
< img
->width
; ++x
)
8112 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8114 /* Put mask_img into img->mask. */
8115 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8116 x_destroy_x_image (mask_img
);
8117 XDestroyImage (ximg
);
8124 /***********************************************************************
8125 PBM (mono, gray, color)
8126 ***********************************************************************/
8128 static int pbm_image_p
P_ ((Lisp_Object object
));
8129 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8130 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8132 /* The symbol `pbm' identifying images of this type. */
8136 /* Indices of image specification fields in gs_format, below. */
8138 enum pbm_keyword_index
8154 /* Vector of image_keyword structures describing the format
8155 of valid user-defined image specifications. */
8157 static struct image_keyword pbm_format
[PBM_LAST
] =
8159 {":type", IMAGE_SYMBOL_VALUE
, 1},
8160 {":file", IMAGE_STRING_VALUE
, 0},
8161 {":data", IMAGE_STRING_VALUE
, 0},
8162 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8163 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8164 {":relief", IMAGE_INTEGER_VALUE
, 0},
8165 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8166 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8167 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8168 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8169 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8172 /* Structure describing the image type `pbm'. */
8174 static struct image_type pbm_type
=
8184 /* Return non-zero if OBJECT is a valid PBM image specification. */
8187 pbm_image_p (object
)
8190 struct image_keyword fmt
[PBM_LAST
];
8192 bcopy (pbm_format
, fmt
, sizeof fmt
);
8194 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8197 /* Must specify either :data or :file. */
8198 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8202 /* Scan a decimal number from *S and return it. Advance *S while
8203 reading the number. END is the end of the string. Value is -1 at
8207 pbm_scan_number (s
, end
)
8208 unsigned char **s
, *end
;
8210 int c
= 0, val
= -1;
8214 /* Skip white-space. */
8215 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8220 /* Skip comment to end of line. */
8221 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8224 else if (isdigit (c
))
8226 /* Read decimal number. */
8228 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8229 val
= 10 * val
+ c
- '0';
8240 /* Load PBM image IMG for use on frame F. */
8248 int width
, height
, max_color_idx
= 0;
8250 Lisp_Object file
, specified_file
;
8251 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8252 struct gcpro gcpro1
;
8253 unsigned char *contents
= NULL
;
8254 unsigned char *end
, *p
;
8257 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8261 if (STRINGP (specified_file
))
8263 file
= x_find_image_file (specified_file
);
8264 if (!STRINGP (file
))
8266 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8271 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8272 if (contents
== NULL
)
8274 image_error ("Error reading `%s'", file
, Qnil
);
8280 end
= contents
+ size
;
8285 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8286 p
= XSTRING (data
)->data
;
8287 end
= p
+ STRING_BYTES (XSTRING (data
));
8290 /* Check magic number. */
8291 if (end
- p
< 2 || *p
++ != 'P')
8293 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8303 raw_p
= 0, type
= PBM_MONO
;
8307 raw_p
= 0, type
= PBM_GRAY
;
8311 raw_p
= 0, type
= PBM_COLOR
;
8315 raw_p
= 1, type
= PBM_MONO
;
8319 raw_p
= 1, type
= PBM_GRAY
;
8323 raw_p
= 1, type
= PBM_COLOR
;
8327 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8331 /* Read width, height, maximum color-component. Characters
8332 starting with `#' up to the end of a line are ignored. */
8333 width
= pbm_scan_number (&p
, end
);
8334 height
= pbm_scan_number (&p
, end
);
8336 if (type
!= PBM_MONO
)
8338 max_color_idx
= pbm_scan_number (&p
, end
);
8339 if (raw_p
&& max_color_idx
> 255)
8340 max_color_idx
= 255;
8345 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8348 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8349 &ximg
, &img
->pixmap
))
8352 /* Initialize the color hash table. */
8353 init_color_table ();
8355 if (type
== PBM_MONO
)
8358 struct image_keyword fmt
[PBM_LAST
];
8359 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8360 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8362 /* Parse the image specification. */
8363 bcopy (pbm_format
, fmt
, sizeof fmt
);
8364 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8366 /* Get foreground and background colors, maybe allocate colors. */
8367 if (fmt
[PBM_FOREGROUND
].count
8368 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
8369 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8370 if (fmt
[PBM_BACKGROUND
].count
8371 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
8372 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8374 for (y
= 0; y
< height
; ++y
)
8375 for (x
= 0; x
< width
; ++x
)
8385 g
= pbm_scan_number (&p
, end
);
8387 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8392 for (y
= 0; y
< height
; ++y
)
8393 for (x
= 0; x
< width
; ++x
)
8397 if (type
== PBM_GRAY
)
8398 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8407 r
= pbm_scan_number (&p
, end
);
8408 g
= pbm_scan_number (&p
, end
);
8409 b
= pbm_scan_number (&p
, end
);
8412 if (r
< 0 || g
< 0 || b
< 0)
8416 XDestroyImage (ximg
);
8417 image_error ("Invalid pixel value in image `%s'",
8422 /* RGB values are now in the range 0..max_color_idx.
8423 Scale this to the range 0..0xffff supported by X. */
8424 r
= (double) r
* 65535 / max_color_idx
;
8425 g
= (double) g
* 65535 / max_color_idx
;
8426 b
= (double) b
* 65535 / max_color_idx
;
8427 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8431 /* Store in IMG->colors the colors allocated for the image, and
8432 free the color table. */
8433 img
->colors
= colors_in_color_table (&img
->ncolors
);
8434 free_color_table ();
8436 /* Put the image into a pixmap. */
8437 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8438 x_destroy_x_image (ximg
);
8441 img
->height
= height
;
8450 /***********************************************************************
8452 ***********************************************************************/
8458 /* Function prototypes. */
8460 static int png_image_p
P_ ((Lisp_Object object
));
8461 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8463 /* The symbol `png' identifying images of this type. */
8467 /* Indices of image specification fields in png_format, below. */
8469 enum png_keyword_index
8483 /* Vector of image_keyword structures describing the format
8484 of valid user-defined image specifications. */
8486 static struct image_keyword png_format
[PNG_LAST
] =
8488 {":type", IMAGE_SYMBOL_VALUE
, 1},
8489 {":data", IMAGE_STRING_VALUE
, 0},
8490 {":file", IMAGE_STRING_VALUE
, 0},
8491 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8492 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8493 {":relief", IMAGE_INTEGER_VALUE
, 0},
8494 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8495 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8496 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8499 /* Structure describing the image type `png'. */
8501 static struct image_type png_type
=
8511 /* Return non-zero if OBJECT is a valid PNG image specification. */
8514 png_image_p (object
)
8517 struct image_keyword fmt
[PNG_LAST
];
8518 bcopy (png_format
, fmt
, sizeof fmt
);
8520 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8523 /* Must specify either the :data or :file keyword. */
8524 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8528 /* Error and warning handlers installed when the PNG library
8532 my_png_error (png_ptr
, msg
)
8533 png_struct
*png_ptr
;
8536 xassert (png_ptr
!= NULL
);
8537 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8538 longjmp (png_ptr
->jmpbuf
, 1);
8543 my_png_warning (png_ptr
, msg
)
8544 png_struct
*png_ptr
;
8547 xassert (png_ptr
!= NULL
);
8548 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8551 /* Memory source for PNG decoding. */
8553 struct png_memory_storage
8555 unsigned char *bytes
; /* The data */
8556 size_t len
; /* How big is it? */
8557 int index
; /* Where are we? */
8561 /* Function set as reader function when reading PNG image from memory.
8562 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8563 bytes from the input to DATA. */
8566 png_read_from_memory (png_ptr
, data
, length
)
8567 png_structp png_ptr
;
8571 struct png_memory_storage
*tbr
8572 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8574 if (length
> tbr
->len
- tbr
->index
)
8575 png_error (png_ptr
, "Read error");
8577 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8578 tbr
->index
= tbr
->index
+ length
;
8581 /* Load PNG image IMG for use on frame F. Value is non-zero if
8589 Lisp_Object file
, specified_file
;
8590 Lisp_Object specified_data
;
8592 XImage
*ximg
, *mask_img
= NULL
;
8593 struct gcpro gcpro1
;
8594 png_struct
*png_ptr
= NULL
;
8595 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8596 FILE *volatile fp
= NULL
;
8598 png_byte
* volatile pixels
= NULL
;
8599 png_byte
** volatile rows
= NULL
;
8600 png_uint_32 width
, height
;
8601 int bit_depth
, color_type
, interlace_type
;
8603 png_uint_32 row_bytes
;
8606 double screen_gamma
, image_gamma
;
8608 struct png_memory_storage tbr
; /* Data to be read */
8610 /* Find out what file to load. */
8611 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8612 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8616 if (NILP (specified_data
))
8618 file
= x_find_image_file (specified_file
);
8619 if (!STRINGP (file
))
8621 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8626 /* Open the image file. */
8627 fp
= fopen (XSTRING (file
)->data
, "rb");
8630 image_error ("Cannot open image file `%s'", file
, Qnil
);
8636 /* Check PNG signature. */
8637 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8638 || !png_check_sig (sig
, sizeof sig
))
8640 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8648 /* Read from memory. */
8649 tbr
.bytes
= XSTRING (specified_data
)->data
;
8650 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8653 /* Check PNG signature. */
8654 if (tbr
.len
< sizeof sig
8655 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8657 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8662 /* Need to skip past the signature. */
8663 tbr
.bytes
+= sizeof (sig
);
8666 /* Initialize read and info structs for PNG lib. */
8667 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8668 my_png_error
, my_png_warning
);
8671 if (fp
) fclose (fp
);
8676 info_ptr
= png_create_info_struct (png_ptr
);
8679 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8680 if (fp
) fclose (fp
);
8685 end_info
= png_create_info_struct (png_ptr
);
8688 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8689 if (fp
) fclose (fp
);
8694 /* Set error jump-back. We come back here when the PNG library
8695 detects an error. */
8696 if (setjmp (png_ptr
->jmpbuf
))
8700 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8703 if (fp
) fclose (fp
);
8708 /* Read image info. */
8709 if (!NILP (specified_data
))
8710 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8712 png_init_io (png_ptr
, fp
);
8714 png_set_sig_bytes (png_ptr
, sizeof sig
);
8715 png_read_info (png_ptr
, info_ptr
);
8716 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8717 &interlace_type
, NULL
, NULL
);
8719 /* If image contains simply transparency data, we prefer to
8720 construct a clipping mask. */
8721 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8726 /* This function is easier to write if we only have to handle
8727 one data format: RGB or RGBA with 8 bits per channel. Let's
8728 transform other formats into that format. */
8730 /* Strip more than 8 bits per channel. */
8731 if (bit_depth
== 16)
8732 png_set_strip_16 (png_ptr
);
8734 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8736 png_set_expand (png_ptr
);
8738 /* Convert grayscale images to RGB. */
8739 if (color_type
== PNG_COLOR_TYPE_GRAY
8740 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8741 png_set_gray_to_rgb (png_ptr
);
8743 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8744 gamma_str
= getenv ("SCREEN_GAMMA");
8745 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8747 /* Tell the PNG lib to handle gamma correction for us. */
8749 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8750 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8751 /* There is a special chunk in the image specifying the gamma. */
8752 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8755 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8756 /* Image contains gamma information. */
8757 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8759 /* Use a default of 0.5 for the image gamma. */
8760 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8762 /* Handle alpha channel by combining the image with a background
8763 color. Do this only if a real alpha channel is supplied. For
8764 simple transparency, we prefer a clipping mask. */
8767 png_color_16
*image_background
;
8769 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8770 /* Image contains a background color with which to
8771 combine the image. */
8772 png_set_background (png_ptr
, image_background
,
8773 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8776 /* Image does not contain a background color with which
8777 to combine the image data via an alpha channel. Use
8778 the frame's background instead. */
8781 png_color_16 frame_background
;
8783 cmap
= FRAME_X_COLORMAP (f
);
8784 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8785 x_query_color (f
, &color
);
8787 bzero (&frame_background
, sizeof frame_background
);
8788 frame_background
.red
= color
.red
;
8789 frame_background
.green
= color
.green
;
8790 frame_background
.blue
= color
.blue
;
8792 png_set_background (png_ptr
, &frame_background
,
8793 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8797 /* Update info structure. */
8798 png_read_update_info (png_ptr
, info_ptr
);
8800 /* Get number of channels. Valid values are 1 for grayscale images
8801 and images with a palette, 2 for grayscale images with transparency
8802 information (alpha channel), 3 for RGB images, and 4 for RGB
8803 images with alpha channel, i.e. RGBA. If conversions above were
8804 sufficient we should only have 3 or 4 channels here. */
8805 channels
= png_get_channels (png_ptr
, info_ptr
);
8806 xassert (channels
== 3 || channels
== 4);
8808 /* Number of bytes needed for one row of the image. */
8809 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8811 /* Allocate memory for the image. */
8812 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8813 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8814 for (i
= 0; i
< height
; ++i
)
8815 rows
[i
] = pixels
+ i
* row_bytes
;
8817 /* Read the entire image. */
8818 png_read_image (png_ptr
, rows
);
8819 png_read_end (png_ptr
, info_ptr
);
8826 /* Create the X image and pixmap. */
8827 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8831 /* Create an image and pixmap serving as mask if the PNG image
8832 contains an alpha channel. */
8835 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8836 &mask_img
, &img
->mask
))
8838 x_destroy_x_image (ximg
);
8839 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8844 /* Fill the X image and mask from PNG data. */
8845 init_color_table ();
8847 for (y
= 0; y
< height
; ++y
)
8849 png_byte
*p
= rows
[y
];
8851 for (x
= 0; x
< width
; ++x
)
8858 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8860 /* An alpha channel, aka mask channel, associates variable
8861 transparency with an image. Where other image formats
8862 support binary transparency---fully transparent or fully
8863 opaque---PNG allows up to 254 levels of partial transparency.
8864 The PNG library implements partial transparency by combining
8865 the image with a specified background color.
8867 I'm not sure how to handle this here nicely: because the
8868 background on which the image is displayed may change, for
8869 real alpha channel support, it would be necessary to create
8870 a new image for each possible background.
8872 What I'm doing now is that a mask is created if we have
8873 boolean transparency information. Otherwise I'm using
8874 the frame's background color to combine the image with. */
8879 XPutPixel (mask_img
, x
, y
, *p
> 0);
8885 /* Remember colors allocated for this image. */
8886 img
->colors
= colors_in_color_table (&img
->ncolors
);
8887 free_color_table ();
8890 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8895 img
->height
= height
;
8897 /* Put the image into the pixmap, then free the X image and its buffer. */
8898 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8899 x_destroy_x_image (ximg
);
8901 /* Same for the mask. */
8904 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8905 x_destroy_x_image (mask_img
);
8912 #endif /* HAVE_PNG != 0 */
8916 /***********************************************************************
8918 ***********************************************************************/
8922 /* Work around a warning about HAVE_STDLIB_H being redefined in
8924 #ifdef HAVE_STDLIB_H
8925 #define HAVE_STDLIB_H_1
8926 #undef HAVE_STDLIB_H
8927 #endif /* HAVE_STLIB_H */
8929 #include <jpeglib.h>
8933 #ifdef HAVE_STLIB_H_1
8934 #define HAVE_STDLIB_H 1
8937 static int jpeg_image_p
P_ ((Lisp_Object object
));
8938 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8940 /* The symbol `jpeg' identifying images of this type. */
8944 /* Indices of image specification fields in gs_format, below. */
8946 enum jpeg_keyword_index
8955 JPEG_HEURISTIC_MASK
,
8960 /* Vector of image_keyword structures describing the format
8961 of valid user-defined image specifications. */
8963 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8965 {":type", IMAGE_SYMBOL_VALUE
, 1},
8966 {":data", IMAGE_STRING_VALUE
, 0},
8967 {":file", IMAGE_STRING_VALUE
, 0},
8968 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8969 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8970 {":relief", IMAGE_INTEGER_VALUE
, 0},
8971 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8972 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8973 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8976 /* Structure describing the image type `jpeg'. */
8978 static struct image_type jpeg_type
=
8988 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8991 jpeg_image_p (object
)
8994 struct image_keyword fmt
[JPEG_LAST
];
8996 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8998 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
9001 /* Must specify either the :data or :file keyword. */
9002 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
9006 struct my_jpeg_error_mgr
9008 struct jpeg_error_mgr pub
;
9009 jmp_buf setjmp_buffer
;
9014 my_error_exit (cinfo
)
9017 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
9018 longjmp (mgr
->setjmp_buffer
, 1);
9022 /* Init source method for JPEG data source manager. Called by
9023 jpeg_read_header() before any data is actually read. See
9024 libjpeg.doc from the JPEG lib distribution. */
9027 our_init_source (cinfo
)
9028 j_decompress_ptr cinfo
;
9033 /* Fill input buffer method for JPEG data source manager. Called
9034 whenever more data is needed. We read the whole image in one step,
9035 so this only adds a fake end of input marker at the end. */
9038 our_fill_input_buffer (cinfo
)
9039 j_decompress_ptr cinfo
;
9041 /* Insert a fake EOI marker. */
9042 struct jpeg_source_mgr
*src
= cinfo
->src
;
9043 static JOCTET buffer
[2];
9045 buffer
[0] = (JOCTET
) 0xFF;
9046 buffer
[1] = (JOCTET
) JPEG_EOI
;
9048 src
->next_input_byte
= buffer
;
9049 src
->bytes_in_buffer
= 2;
9054 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9055 is the JPEG data source manager. */
9058 our_skip_input_data (cinfo
, num_bytes
)
9059 j_decompress_ptr cinfo
;
9062 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9066 if (num_bytes
> src
->bytes_in_buffer
)
9067 ERREXIT (cinfo
, JERR_INPUT_EOF
);
9069 src
->bytes_in_buffer
-= num_bytes
;
9070 src
->next_input_byte
+= num_bytes
;
9075 /* Method to terminate data source. Called by
9076 jpeg_finish_decompress() after all data has been processed. */
9079 our_term_source (cinfo
)
9080 j_decompress_ptr cinfo
;
9085 /* Set up the JPEG lib for reading an image from DATA which contains
9086 LEN bytes. CINFO is the decompression info structure created for
9087 reading the image. */
9090 jpeg_memory_src (cinfo
, data
, len
)
9091 j_decompress_ptr cinfo
;
9095 struct jpeg_source_mgr
*src
;
9097 if (cinfo
->src
== NULL
)
9099 /* First time for this JPEG object? */
9100 cinfo
->src
= (struct jpeg_source_mgr
*)
9101 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9102 sizeof (struct jpeg_source_mgr
));
9103 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9104 src
->next_input_byte
= data
;
9107 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9108 src
->init_source
= our_init_source
;
9109 src
->fill_input_buffer
= our_fill_input_buffer
;
9110 src
->skip_input_data
= our_skip_input_data
;
9111 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9112 src
->term_source
= our_term_source
;
9113 src
->bytes_in_buffer
= len
;
9114 src
->next_input_byte
= data
;
9118 /* Load image IMG for use on frame F. Patterned after example.c
9119 from the JPEG lib. */
9126 struct jpeg_decompress_struct cinfo
;
9127 struct my_jpeg_error_mgr mgr
;
9128 Lisp_Object file
, specified_file
;
9129 Lisp_Object specified_data
;
9130 FILE * volatile fp
= NULL
;
9132 int row_stride
, x
, y
;
9133 XImage
*ximg
= NULL
;
9135 unsigned long *colors
;
9137 struct gcpro gcpro1
;
9139 /* Open the JPEG file. */
9140 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9141 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9145 if (NILP (specified_data
))
9147 file
= x_find_image_file (specified_file
);
9148 if (!STRINGP (file
))
9150 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9155 fp
= fopen (XSTRING (file
)->data
, "r");
9158 image_error ("Cannot open `%s'", file
, Qnil
);
9164 /* Customize libjpeg's error handling to call my_error_exit when an
9165 error is detected. This function will perform a longjmp. */
9166 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9167 mgr
.pub
.error_exit
= my_error_exit
;
9169 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9173 /* Called from my_error_exit. Display a JPEG error. */
9174 char buffer
[JMSG_LENGTH_MAX
];
9175 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9176 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9177 build_string (buffer
));
9180 /* Close the input file and destroy the JPEG object. */
9182 fclose ((FILE *) fp
);
9183 jpeg_destroy_decompress (&cinfo
);
9185 /* If we already have an XImage, free that. */
9186 x_destroy_x_image (ximg
);
9188 /* Free pixmap and colors. */
9189 x_clear_image (f
, img
);
9195 /* Create the JPEG decompression object. Let it read from fp.
9196 Read the JPEG image header. */
9197 jpeg_create_decompress (&cinfo
);
9199 if (NILP (specified_data
))
9200 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9202 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9203 STRING_BYTES (XSTRING (specified_data
)));
9205 jpeg_read_header (&cinfo
, TRUE
);
9207 /* Customize decompression so that color quantization will be used.
9208 Start decompression. */
9209 cinfo
.quantize_colors
= TRUE
;
9210 jpeg_start_decompress (&cinfo
);
9211 width
= img
->width
= cinfo
.output_width
;
9212 height
= img
->height
= cinfo
.output_height
;
9214 /* Create X image and pixmap. */
9215 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9216 longjmp (mgr
.setjmp_buffer
, 2);
9218 /* Allocate colors. When color quantization is used,
9219 cinfo.actual_number_of_colors has been set with the number of
9220 colors generated, and cinfo.colormap is a two-dimensional array
9221 of color indices in the range 0..cinfo.actual_number_of_colors.
9222 No more than 255 colors will be generated. */
9226 if (cinfo
.out_color_components
> 2)
9227 ir
= 0, ig
= 1, ib
= 2;
9228 else if (cinfo
.out_color_components
> 1)
9229 ir
= 0, ig
= 1, ib
= 0;
9231 ir
= 0, ig
= 0, ib
= 0;
9233 /* Use the color table mechanism because it handles colors that
9234 cannot be allocated nicely. Such colors will be replaced with
9235 a default color, and we don't have to care about which colors
9236 can be freed safely, and which can't. */
9237 init_color_table ();
9238 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9241 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9243 /* Multiply RGB values with 255 because X expects RGB values
9244 in the range 0..0xffff. */
9245 int r
= cinfo
.colormap
[ir
][i
] << 8;
9246 int g
= cinfo
.colormap
[ig
][i
] << 8;
9247 int b
= cinfo
.colormap
[ib
][i
] << 8;
9248 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9251 /* Remember those colors actually allocated. */
9252 img
->colors
= colors_in_color_table (&img
->ncolors
);
9253 free_color_table ();
9257 row_stride
= width
* cinfo
.output_components
;
9258 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9260 for (y
= 0; y
< height
; ++y
)
9262 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9263 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9264 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9268 jpeg_finish_decompress (&cinfo
);
9269 jpeg_destroy_decompress (&cinfo
);
9271 fclose ((FILE *) fp
);
9273 /* Put the image into the pixmap. */
9274 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9275 x_destroy_x_image (ximg
);
9280 #endif /* HAVE_JPEG */
9284 /***********************************************************************
9286 ***********************************************************************/
9292 static int tiff_image_p
P_ ((Lisp_Object object
));
9293 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9295 /* The symbol `tiff' identifying images of this type. */
9299 /* Indices of image specification fields in tiff_format, below. */
9301 enum tiff_keyword_index
9310 TIFF_HEURISTIC_MASK
,
9315 /* Vector of image_keyword structures describing the format
9316 of valid user-defined image specifications. */
9318 static struct image_keyword tiff_format
[TIFF_LAST
] =
9320 {":type", IMAGE_SYMBOL_VALUE
, 1},
9321 {":data", IMAGE_STRING_VALUE
, 0},
9322 {":file", IMAGE_STRING_VALUE
, 0},
9323 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9324 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9325 {":relief", IMAGE_INTEGER_VALUE
, 0},
9326 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9327 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9328 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9331 /* Structure describing the image type `tiff'. */
9333 static struct image_type tiff_type
=
9343 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9346 tiff_image_p (object
)
9349 struct image_keyword fmt
[TIFF_LAST
];
9350 bcopy (tiff_format
, fmt
, sizeof fmt
);
9352 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9355 /* Must specify either the :data or :file keyword. */
9356 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9360 /* Reading from a memory buffer for TIFF images Based on the PNG
9361 memory source, but we have to provide a lot of extra functions.
9364 We really only need to implement read and seek, but I am not
9365 convinced that the TIFF library is smart enough not to destroy
9366 itself if we only hand it the function pointers we need to
9371 unsigned char *bytes
;
9379 tiff_read_from_memory (data
, buf
, size
)
9384 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9386 if (size
> src
->len
- src
->index
)
9388 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9395 tiff_write_from_memory (data
, buf
, size
)
9405 tiff_seek_in_memory (data
, off
, whence
)
9410 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9415 case SEEK_SET
: /* Go from beginning of source. */
9419 case SEEK_END
: /* Go from end of source. */
9420 idx
= src
->len
+ off
;
9423 case SEEK_CUR
: /* Go from current position. */
9424 idx
= src
->index
+ off
;
9427 default: /* Invalid `whence'. */
9431 if (idx
> src
->len
|| idx
< 0)
9440 tiff_close_memory (data
)
9449 tiff_mmap_memory (data
, pbase
, psize
)
9454 /* It is already _IN_ memory. */
9460 tiff_unmap_memory (data
, base
, size
)
9465 /* We don't need to do this. */
9470 tiff_size_of_memory (data
)
9473 return ((tiff_memory_source
*) data
)->len
;
9477 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9485 Lisp_Object file
, specified_file
;
9486 Lisp_Object specified_data
;
9488 int width
, height
, x
, y
;
9492 struct gcpro gcpro1
;
9493 tiff_memory_source memsrc
;
9495 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9496 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9500 if (NILP (specified_data
))
9502 /* Read from a file */
9503 file
= x_find_image_file (specified_file
);
9504 if (!STRINGP (file
))
9506 image_error ("Cannot find image file `%s'", file
, Qnil
);
9511 /* Try to open the image file. */
9512 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9515 image_error ("Cannot open `%s'", file
, Qnil
);
9522 /* Memory source! */
9523 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9524 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9527 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9528 (TIFFReadWriteProc
) tiff_read_from_memory
,
9529 (TIFFReadWriteProc
) tiff_write_from_memory
,
9530 tiff_seek_in_memory
,
9532 tiff_size_of_memory
,
9538 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9544 /* Get width and height of the image, and allocate a raster buffer
9545 of width x height 32-bit values. */
9546 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9547 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9548 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9550 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9554 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9560 /* Create the X image and pixmap. */
9561 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9568 /* Initialize the color table. */
9569 init_color_table ();
9571 /* Process the pixel raster. Origin is in the lower-left corner. */
9572 for (y
= 0; y
< height
; ++y
)
9574 uint32
*row
= buf
+ y
* width
;
9576 for (x
= 0; x
< width
; ++x
)
9578 uint32 abgr
= row
[x
];
9579 int r
= TIFFGetR (abgr
) << 8;
9580 int g
= TIFFGetG (abgr
) << 8;
9581 int b
= TIFFGetB (abgr
) << 8;
9582 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9586 /* Remember the colors allocated for the image. Free the color table. */
9587 img
->colors
= colors_in_color_table (&img
->ncolors
);
9588 free_color_table ();
9590 /* Put the image into the pixmap, then free the X image and its buffer. */
9591 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9592 x_destroy_x_image (ximg
);
9596 img
->height
= height
;
9602 #endif /* HAVE_TIFF != 0 */
9606 /***********************************************************************
9608 ***********************************************************************/
9612 #include <gif_lib.h>
9614 static int gif_image_p
P_ ((Lisp_Object object
));
9615 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9617 /* The symbol `gif' identifying images of this type. */
9621 /* Indices of image specification fields in gif_format, below. */
9623 enum gif_keyword_index
9638 /* Vector of image_keyword structures describing the format
9639 of valid user-defined image specifications. */
9641 static struct image_keyword gif_format
[GIF_LAST
] =
9643 {":type", IMAGE_SYMBOL_VALUE
, 1},
9644 {":data", IMAGE_STRING_VALUE
, 0},
9645 {":file", IMAGE_STRING_VALUE
, 0},
9646 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9647 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9648 {":relief", IMAGE_INTEGER_VALUE
, 0},
9649 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9650 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9651 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9652 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9655 /* Structure describing the image type `gif'. */
9657 static struct image_type gif_type
=
9667 /* Return non-zero if OBJECT is a valid GIF image specification. */
9670 gif_image_p (object
)
9673 struct image_keyword fmt
[GIF_LAST
];
9674 bcopy (gif_format
, fmt
, sizeof fmt
);
9676 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9679 /* Must specify either the :data or :file keyword. */
9680 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9684 /* Reading a GIF image from memory
9685 Based on the PNG memory stuff to a certain extent. */
9689 unsigned char *bytes
;
9696 /* Make the current memory source available to gif_read_from_memory.
9697 It's done this way because not all versions of libungif support
9698 a UserData field in the GifFileType structure. */
9699 static gif_memory_source
*current_gif_memory_src
;
9702 gif_read_from_memory (file
, buf
, len
)
9707 gif_memory_source
*src
= current_gif_memory_src
;
9709 if (len
> src
->len
- src
->index
)
9712 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9718 /* Load GIF image IMG for use on frame F. Value is non-zero if
9726 Lisp_Object file
, specified_file
;
9727 Lisp_Object specified_data
;
9728 int rc
, width
, height
, x
, y
, i
;
9730 ColorMapObject
*gif_color_map
;
9731 unsigned long pixel_colors
[256];
9733 struct gcpro gcpro1
;
9735 int ino
, image_left
, image_top
, image_width
, image_height
;
9736 gif_memory_source memsrc
;
9737 unsigned char *raster
;
9739 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9740 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9744 if (NILP (specified_data
))
9746 file
= x_find_image_file (specified_file
);
9747 if (!STRINGP (file
))
9749 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9754 /* Open the GIF file. */
9755 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9758 image_error ("Cannot open `%s'", file
, Qnil
);
9765 /* Read from memory! */
9766 current_gif_memory_src
= &memsrc
;
9767 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9768 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9771 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9774 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9780 /* Read entire contents. */
9781 rc
= DGifSlurp (gif
);
9782 if (rc
== GIF_ERROR
)
9784 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9785 DGifCloseFile (gif
);
9790 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9791 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9792 if (ino
>= gif
->ImageCount
)
9794 image_error ("Invalid image number `%s' in image `%s'",
9796 DGifCloseFile (gif
);
9801 width
= img
->width
= gif
->SWidth
;
9802 height
= img
->height
= gif
->SHeight
;
9804 /* Create the X image and pixmap. */
9805 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9807 DGifCloseFile (gif
);
9812 /* Allocate colors. */
9813 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9815 gif_color_map
= gif
->SColorMap
;
9816 init_color_table ();
9817 bzero (pixel_colors
, sizeof pixel_colors
);
9819 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9821 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9822 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9823 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9824 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9827 img
->colors
= colors_in_color_table (&img
->ncolors
);
9828 free_color_table ();
9830 /* Clear the part of the screen image that are not covered by
9831 the image from the GIF file. Full animated GIF support
9832 requires more than can be done here (see the gif89 spec,
9833 disposal methods). Let's simply assume that the part
9834 not covered by a sub-image is in the frame's background color. */
9835 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9836 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9837 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9838 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9840 for (y
= 0; y
< image_top
; ++y
)
9841 for (x
= 0; x
< width
; ++x
)
9842 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9844 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9845 for (x
= 0; x
< width
; ++x
)
9846 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9848 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9850 for (x
= 0; x
< image_left
; ++x
)
9851 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9852 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9853 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9856 /* Read the GIF image into the X image. We use a local variable
9857 `raster' here because RasterBits below is a char *, and invites
9858 problems with bytes >= 0x80. */
9859 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9861 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9863 static int interlace_start
[] = {0, 4, 2, 1};
9864 static int interlace_increment
[] = {8, 8, 4, 2};
9866 int row
= interlace_start
[0];
9870 for (y
= 0; y
< image_height
; y
++)
9872 if (row
>= image_height
)
9874 row
= interlace_start
[++pass
];
9875 while (row
>= image_height
)
9876 row
= interlace_start
[++pass
];
9879 for (x
= 0; x
< image_width
; x
++)
9881 int i
= raster
[(y
* image_width
) + x
];
9882 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9886 row
+= interlace_increment
[pass
];
9891 for (y
= 0; y
< image_height
; ++y
)
9892 for (x
= 0; x
< image_width
; ++x
)
9894 int i
= raster
[y
* image_width
+ x
];
9895 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9899 DGifCloseFile (gif
);
9901 /* Put the image into the pixmap, then free the X image and its buffer. */
9902 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9903 x_destroy_x_image (ximg
);
9909 #endif /* HAVE_GIF != 0 */
9913 /***********************************************************************
9915 ***********************************************************************/
9917 static int gs_image_p
P_ ((Lisp_Object object
));
9918 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9919 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9921 /* The symbol `postscript' identifying images of this type. */
9923 Lisp_Object Qpostscript
;
9925 /* Keyword symbols. */
9927 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9929 /* Indices of image specification fields in gs_format, below. */
9931 enum gs_keyword_index
9948 /* Vector of image_keyword structures describing the format
9949 of valid user-defined image specifications. */
9951 static struct image_keyword gs_format
[GS_LAST
] =
9953 {":type", IMAGE_SYMBOL_VALUE
, 1},
9954 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9955 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9956 {":file", IMAGE_STRING_VALUE
, 1},
9957 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9958 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9959 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9960 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9961 {":relief", IMAGE_INTEGER_VALUE
, 0},
9962 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9963 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9964 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9967 /* Structure describing the image type `ghostscript'. */
9969 static struct image_type gs_type
=
9979 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9982 gs_clear_image (f
, img
)
9986 /* IMG->data.ptr_val may contain a recorded colormap. */
9987 xfree (img
->data
.ptr_val
);
9988 x_clear_image (f
, img
);
9992 /* Return non-zero if OBJECT is a valid Ghostscript image
9999 struct image_keyword fmt
[GS_LAST
];
10003 bcopy (gs_format
, fmt
, sizeof fmt
);
10005 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
10008 /* Bounding box must be a list or vector containing 4 integers. */
10009 tem
= fmt
[GS_BOUNDING_BOX
].value
;
10012 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
10013 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
10018 else if (VECTORP (tem
))
10020 if (XVECTOR (tem
)->size
!= 4)
10022 for (i
= 0; i
< 4; ++i
)
10023 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
10033 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
10042 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
10043 struct gcpro gcpro1
, gcpro2
;
10045 double in_width
, in_height
;
10046 Lisp_Object pixel_colors
= Qnil
;
10048 /* Compute pixel size of pixmap needed from the given size in the
10049 image specification. Sizes in the specification are in pt. 1 pt
10050 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10052 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
10053 in_width
= XFASTINT (pt_width
) / 72.0;
10054 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
10055 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
10056 in_height
= XFASTINT (pt_height
) / 72.0;
10057 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
10059 /* Create the pixmap. */
10060 xassert (img
->pixmap
== None
);
10061 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10062 img
->width
, img
->height
,
10063 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
10067 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
10071 /* Call the loader to fill the pixmap. It returns a process object
10072 if successful. We do not record_unwind_protect here because
10073 other places in redisplay like calling window scroll functions
10074 don't either. Let the Lisp loader use `unwind-protect' instead. */
10075 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
10077 sprintf (buffer
, "%lu %lu",
10078 (unsigned long) FRAME_X_WINDOW (f
),
10079 (unsigned long) img
->pixmap
);
10080 window_and_pixmap_id
= build_string (buffer
);
10082 sprintf (buffer
, "%lu %lu",
10083 FRAME_FOREGROUND_PIXEL (f
),
10084 FRAME_BACKGROUND_PIXEL (f
));
10085 pixel_colors
= build_string (buffer
);
10087 XSETFRAME (frame
, f
);
10088 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
10090 loader
= intern ("gs-load-image");
10092 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10093 make_number (img
->width
),
10094 make_number (img
->height
),
10095 window_and_pixmap_id
,
10098 return PROCESSP (img
->data
.lisp_val
);
10102 /* Kill the Ghostscript process that was started to fill PIXMAP on
10103 frame F. Called from XTread_socket when receiving an event
10104 telling Emacs that Ghostscript has finished drawing. */
10107 x_kill_gs_process (pixmap
, f
)
10111 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10115 /* Find the image containing PIXMAP. */
10116 for (i
= 0; i
< c
->used
; ++i
)
10117 if (c
->images
[i
]->pixmap
== pixmap
)
10120 /* Should someone in between have cleared the image cache, for
10121 instance, give up. */
10125 /* Kill the GS process. We should have found PIXMAP in the image
10126 cache and its image should contain a process object. */
10127 img
= c
->images
[i
];
10128 xassert (PROCESSP (img
->data
.lisp_val
));
10129 Fkill_process (img
->data
.lisp_val
, Qnil
);
10130 img
->data
.lisp_val
= Qnil
;
10132 /* On displays with a mutable colormap, figure out the colors
10133 allocated for the image by looking at the pixels of an XImage for
10135 class = FRAME_X_VISUAL (f
)->class;
10136 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10142 /* Try to get an XImage for img->pixmep. */
10143 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10144 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10149 /* Initialize the color table. */
10150 init_color_table ();
10152 /* For each pixel of the image, look its color up in the
10153 color table. After having done so, the color table will
10154 contain an entry for each color used by the image. */
10155 for (y
= 0; y
< img
->height
; ++y
)
10156 for (x
= 0; x
< img
->width
; ++x
)
10158 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10159 lookup_pixel_color (f
, pixel
);
10162 /* Record colors in the image. Free color table and XImage. */
10163 img
->colors
= colors_in_color_table (&img
->ncolors
);
10164 free_color_table ();
10165 XDestroyImage (ximg
);
10167 #if 0 /* This doesn't seem to be the case. If we free the colors
10168 here, we get a BadAccess later in x_clear_image when
10169 freeing the colors. */
10170 /* We have allocated colors once, but Ghostscript has also
10171 allocated colors on behalf of us. So, to get the
10172 reference counts right, free them once. */
10174 x_free_colors (f
, img
->colors
, img
->ncolors
);
10178 image_error ("Cannot get X image of `%s'; colors will not be freed",
10184 /* Now that we have the pixmap, compute mask and transform the
10185 image if requested. */
10187 postprocess_image (f
, img
);
10193 /***********************************************************************
10195 ***********************************************************************/
10197 DEFUN ("x-change-window-property", Fx_change_window_property
,
10198 Sx_change_window_property
, 2, 3, 0,
10199 "Change window property PROP to VALUE on the X window of FRAME.\n\
10200 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
10201 selected frame. Value is VALUE.")
10202 (prop
, value
, frame
)
10203 Lisp_Object frame
, prop
, value
;
10205 struct frame
*f
= check_x_frame (frame
);
10208 CHECK_STRING (prop
, 1);
10209 CHECK_STRING (value
, 2);
10212 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10213 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10214 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10215 XSTRING (value
)->data
, XSTRING (value
)->size
);
10217 /* Make sure the property is set when we return. */
10218 XFlush (FRAME_X_DISPLAY (f
));
10225 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10226 Sx_delete_window_property
, 1, 2, 0,
10227 "Remove window property PROP from X window of FRAME.\n\
10228 FRAME nil or omitted means use the selected frame. Value is PROP.")
10230 Lisp_Object prop
, frame
;
10232 struct frame
*f
= check_x_frame (frame
);
10235 CHECK_STRING (prop
, 1);
10237 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10238 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10240 /* Make sure the property is removed when we return. */
10241 XFlush (FRAME_X_DISPLAY (f
));
10248 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10250 "Value is the value of window property PROP on FRAME.\n\
10251 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10252 if FRAME hasn't a property with name PROP or if PROP has no string\n\
10255 Lisp_Object prop
, frame
;
10257 struct frame
*f
= check_x_frame (frame
);
10260 Lisp_Object prop_value
= Qnil
;
10261 char *tmp_data
= NULL
;
10264 unsigned long actual_size
, bytes_remaining
;
10266 CHECK_STRING (prop
, 1);
10268 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10269 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10270 prop_atom
, 0, 0, False
, XA_STRING
,
10271 &actual_type
, &actual_format
, &actual_size
,
10272 &bytes_remaining
, (unsigned char **) &tmp_data
);
10275 int size
= bytes_remaining
;
10280 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10281 prop_atom
, 0, bytes_remaining
,
10283 &actual_type
, &actual_format
,
10284 &actual_size
, &bytes_remaining
,
10285 (unsigned char **) &tmp_data
);
10286 if (rc
== Success
&& tmp_data
)
10287 prop_value
= make_string (tmp_data
, size
);
10298 /***********************************************************************
10300 ***********************************************************************/
10302 /* If non-null, an asynchronous timer that, when it expires, displays
10303 an hourglass cursor on all frames. */
10305 static struct atimer
*hourglass_atimer
;
10307 /* Non-zero means an hourglass cursor is currently shown. */
10309 static int hourglass_shown_p
;
10311 /* Number of seconds to wait before displaying an hourglass cursor. */
10313 static Lisp_Object Vhourglass_delay
;
10315 /* Default number of seconds to wait before displaying an hourglass
10318 #define DEFAULT_HOURGLASS_DELAY 1
10320 /* Function prototypes. */
10322 static void show_hourglass
P_ ((struct atimer
*));
10323 static void hide_hourglass
P_ ((void));
10326 /* Cancel a currently active hourglass timer, and start a new one. */
10332 int secs
, usecs
= 0;
10334 cancel_hourglass ();
10336 if (INTEGERP (Vhourglass_delay
)
10337 && XINT (Vhourglass_delay
) > 0)
10338 secs
= XFASTINT (Vhourglass_delay
);
10339 else if (FLOATP (Vhourglass_delay
)
10340 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10343 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10344 secs
= XFASTINT (tem
);
10345 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10348 secs
= DEFAULT_HOURGLASS_DELAY
;
10350 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10351 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10352 show_hourglass
, NULL
);
10356 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10360 cancel_hourglass ()
10362 if (hourglass_atimer
)
10364 cancel_atimer (hourglass_atimer
);
10365 hourglass_atimer
= NULL
;
10368 if (hourglass_shown_p
)
10373 /* Timer function of hourglass_atimer. TIMER is equal to
10376 Display an hourglass pointer on all frames by mapping the frames'
10377 hourglass_window. Set the hourglass_p flag in the frames'
10378 output_data.x structure to indicate that an hourglass cursor is
10379 shown on the frames. */
10382 show_hourglass (timer
)
10383 struct atimer
*timer
;
10385 /* The timer implementation will cancel this timer automatically
10386 after this function has run. Set hourglass_atimer to null
10387 so that we know the timer doesn't have to be canceled. */
10388 hourglass_atimer
= NULL
;
10390 if (!hourglass_shown_p
)
10392 Lisp_Object rest
, frame
;
10396 FOR_EACH_FRAME (rest
, frame
)
10398 struct frame
*f
= XFRAME (frame
);
10400 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10402 Display
*dpy
= FRAME_X_DISPLAY (f
);
10404 #ifdef USE_X_TOOLKIT
10405 if (f
->output_data
.x
->widget
)
10407 if (FRAME_OUTER_WINDOW (f
))
10410 f
->output_data
.x
->hourglass_p
= 1;
10412 if (!f
->output_data
.x
->hourglass_window
)
10414 unsigned long mask
= CWCursor
;
10415 XSetWindowAttributes attrs
;
10417 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10419 f
->output_data
.x
->hourglass_window
10420 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10421 0, 0, 32000, 32000, 0, 0,
10427 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10433 hourglass_shown_p
= 1;
10439 /* Hide the hourglass pointer on all frames, if it is currently
10445 if (hourglass_shown_p
)
10447 Lisp_Object rest
, frame
;
10450 FOR_EACH_FRAME (rest
, frame
)
10452 struct frame
*f
= XFRAME (frame
);
10455 /* Watch out for newly created frames. */
10456 && f
->output_data
.x
->hourglass_window
)
10458 XUnmapWindow (FRAME_X_DISPLAY (f
),
10459 f
->output_data
.x
->hourglass_window
);
10460 /* Sync here because XTread_socket looks at the
10461 hourglass_p flag that is reset to zero below. */
10462 XSync (FRAME_X_DISPLAY (f
), False
);
10463 f
->output_data
.x
->hourglass_p
= 0;
10467 hourglass_shown_p
= 0;
10474 /***********************************************************************
10476 ***********************************************************************/
10478 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10479 Lisp_Object
, Lisp_Object
));
10480 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10481 Lisp_Object
, int, int, int *, int *));
10483 /* The frame of a currently visible tooltip. */
10485 Lisp_Object tip_frame
;
10487 /* If non-nil, a timer started that hides the last tooltip when it
10490 Lisp_Object tip_timer
;
10493 /* If non-nil, a vector of 3 elements containing the last args
10494 with which x-show-tip was called. See there. */
10496 Lisp_Object last_show_tip_args
;
10498 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
10500 Lisp_Object Vx_max_tooltip_size
;
10504 unwind_create_tip_frame (frame
)
10507 Lisp_Object deleted
;
10509 deleted
= unwind_create_frame (frame
);
10510 if (EQ (deleted
, Qt
))
10520 /* Create a frame for a tooltip on the display described by DPYINFO.
10521 PARMS is a list of frame parameters. TEXT is the string to
10522 display in the tip frame. Value is the frame.
10524 Note that functions called here, esp. x_default_parameter can
10525 signal errors, for instance when a specified color name is
10526 undefined. We have to make sure that we're in a consistent state
10527 when this happens. */
10530 x_create_tip_frame (dpyinfo
, parms
, text
)
10531 struct x_display_info
*dpyinfo
;
10532 Lisp_Object parms
, text
;
10535 Lisp_Object frame
, tem
;
10537 long window_prompting
= 0;
10539 int count
= BINDING_STACK_SIZE ();
10540 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10542 int face_change_count_before
= face_change_count
;
10543 Lisp_Object buffer
;
10544 struct buffer
*old_buffer
;
10548 /* Use this general default value to start with until we know if
10549 this frame has a specified name. */
10550 Vx_resource_name
= Vinvocation_name
;
10552 #ifdef MULTI_KBOARD
10553 kb
= dpyinfo
->kboard
;
10555 kb
= &the_only_kboard
;
10558 /* Get the name of the frame to use for resource lookup. */
10559 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10560 if (!STRINGP (name
)
10561 && !EQ (name
, Qunbound
)
10563 error ("Invalid frame name--not a string or nil");
10564 Vx_resource_name
= name
;
10567 GCPRO3 (parms
, name
, frame
);
10568 f
= make_frame (1);
10569 XSETFRAME (frame
, f
);
10571 buffer
= Fget_buffer_create (build_string (" *tip*"));
10572 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10573 old_buffer
= current_buffer
;
10574 set_buffer_internal_1 (XBUFFER (buffer
));
10575 current_buffer
->truncate_lines
= Qnil
;
10577 Finsert (1, &text
);
10578 set_buffer_internal_1 (old_buffer
);
10580 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10581 record_unwind_protect (unwind_create_tip_frame
, frame
);
10583 /* By setting the output method, we're essentially saying that
10584 the frame is live, as per FRAME_LIVE_P. If we get a signal
10585 from this point on, x_destroy_window might screw up reference
10587 f
->output_method
= output_x_window
;
10588 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10589 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10590 f
->output_data
.x
->icon_bitmap
= -1;
10591 f
->output_data
.x
->fontset
= -1;
10592 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10593 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10594 f
->icon_name
= Qnil
;
10595 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10597 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10598 dpyinfo_refcount
= dpyinfo
->reference_count
;
10599 #endif /* GLYPH_DEBUG */
10600 #ifdef MULTI_KBOARD
10601 FRAME_KBOARD (f
) = kb
;
10603 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10604 f
->output_data
.x
->explicit_parent
= 0;
10606 /* These colors will be set anyway later, but it's important
10607 to get the color reference counts right, so initialize them! */
10610 struct gcpro gcpro1
;
10612 black
= build_string ("black");
10614 f
->output_data
.x
->foreground_pixel
10615 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10616 f
->output_data
.x
->background_pixel
10617 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10618 f
->output_data
.x
->cursor_pixel
10619 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10620 f
->output_data
.x
->cursor_foreground_pixel
10621 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10622 f
->output_data
.x
->border_pixel
10623 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10624 f
->output_data
.x
->mouse_pixel
10625 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10629 /* Set the name; the functions to which we pass f expect the name to
10631 if (EQ (name
, Qunbound
) || NILP (name
))
10633 f
->name
= build_string (dpyinfo
->x_id_name
);
10634 f
->explicit_name
= 0;
10639 f
->explicit_name
= 1;
10640 /* use the frame's title when getting resources for this frame. */
10641 specbind (Qx_resource_name
, name
);
10644 /* Extract the window parameters from the supplied values that are
10645 needed to determine window geometry. */
10649 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10652 /* First, try whatever font the caller has specified. */
10653 if (STRINGP (font
))
10655 tem
= Fquery_fontset (font
, Qnil
);
10657 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10659 font
= x_new_font (f
, XSTRING (font
)->data
);
10662 /* Try out a font which we hope has bold and italic variations. */
10663 if (!STRINGP (font
))
10664 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10665 if (!STRINGP (font
))
10666 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10667 if (! STRINGP (font
))
10668 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10669 if (! STRINGP (font
))
10670 /* This was formerly the first thing tried, but it finds too many fonts
10671 and takes too long. */
10672 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10673 /* If those didn't work, look for something which will at least work. */
10674 if (! STRINGP (font
))
10675 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10677 if (! STRINGP (font
))
10678 font
= build_string ("fixed");
10680 x_default_parameter (f
, parms
, Qfont
, font
,
10681 "font", "Font", RES_TYPE_STRING
);
10684 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10685 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10687 /* This defaults to 2 in order to match xterm. We recognize either
10688 internalBorderWidth or internalBorder (which is what xterm calls
10690 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10694 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10695 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10696 if (! EQ (value
, Qunbound
))
10697 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10701 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10702 "internalBorderWidth", "internalBorderWidth",
10705 /* Also do the stuff which must be set before the window exists. */
10706 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10707 "foreground", "Foreground", RES_TYPE_STRING
);
10708 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10709 "background", "Background", RES_TYPE_STRING
);
10710 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10711 "pointerColor", "Foreground", RES_TYPE_STRING
);
10712 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10713 "cursorColor", "Foreground", RES_TYPE_STRING
);
10714 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10715 "borderColor", "BorderColor", RES_TYPE_STRING
);
10717 /* Init faces before x_default_parameter is called for scroll-bar
10718 parameters because that function calls x_set_scroll_bar_width,
10719 which calls change_frame_size, which calls Fset_window_buffer,
10720 which runs hooks, which call Fvertical_motion. At the end, we
10721 end up in init_iterator with a null face cache, which should not
10723 init_frame_faces (f
);
10725 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10726 window_prompting
= x_figure_window_size (f
, parms
);
10728 if (window_prompting
& XNegative
)
10730 if (window_prompting
& YNegative
)
10731 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10733 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10737 if (window_prompting
& YNegative
)
10738 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10740 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10743 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10745 XSetWindowAttributes attrs
;
10746 unsigned long mask
;
10749 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10750 if (DoesSaveUnders (dpyinfo
->screen
))
10751 mask
|= CWSaveUnder
;
10753 /* Window managers look at the override-redirect flag to determine
10754 whether or net to give windows a decoration (Xlib spec, chapter
10756 attrs
.override_redirect
= True
;
10757 attrs
.save_under
= True
;
10758 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10759 /* Arrange for getting MapNotify and UnmapNotify events. */
10760 attrs
.event_mask
= StructureNotifyMask
;
10762 = FRAME_X_WINDOW (f
)
10763 = XCreateWindow (FRAME_X_DISPLAY (f
),
10764 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10765 /* x, y, width, height */
10769 CopyFromParent
, InputOutput
, CopyFromParent
,
10776 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10777 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10778 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10779 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10780 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10781 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10783 /* Dimensions, especially f->height, must be done via change_frame_size.
10784 Change will not be effected unless different from the current
10787 height
= f
->height
;
10789 SET_FRAME_WIDTH (f
, 0);
10790 change_frame_size (f
, height
, width
, 1, 0, 0);
10792 /* Set up faces after all frame parameters are known. This call
10793 also merges in face attributes specified for new frames.
10795 Frame parameters may be changed if .Xdefaults contains
10796 specifications for the default font. For example, if there is an
10797 `Emacs.default.attributeBackground: pink', the `background-color'
10798 attribute of the frame get's set, which let's the internal border
10799 of the tooltip frame appear in pink. Prevent this. */
10801 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
10803 /* Set tip_frame here, so that */
10805 call1 (Qface_set_after_frame_default
, frame
);
10807 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
10808 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
10816 /* It is now ok to make the frame official even if we get an error
10817 below. And the frame needs to be on Vframe_list or making it
10818 visible won't work. */
10819 Vframe_list
= Fcons (frame
, Vframe_list
);
10821 /* Now that the frame is official, it counts as a reference to
10823 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10825 /* Setting attributes of faces of the tooltip frame from resources
10826 and similar will increment face_change_count, which leads to the
10827 clearing of all current matrices. Since this isn't necessary
10828 here, avoid it by resetting face_change_count to the value it
10829 had before we created the tip frame. */
10830 face_change_count
= face_change_count_before
;
10832 /* Discard the unwind_protect. */
10833 return unbind_to (count
, frame
);
10837 /* Compute where to display tip frame F. PARMS is the list of frame
10838 parameters for F. DX and DY are specified offsets from the current
10839 location of the mouse. WIDTH and HEIGHT are the width and height
10840 of the tooltip. Return coordinates relative to the root window of
10841 the display in *ROOT_X, and *ROOT_Y. */
10844 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
10846 Lisp_Object parms
, dx
, dy
;
10848 int *root_x
, *root_y
;
10850 Lisp_Object left
, top
;
10852 Window root
, child
;
10855 /* User-specified position? */
10856 left
= Fcdr (Fassq (Qleft
, parms
));
10857 top
= Fcdr (Fassq (Qtop
, parms
));
10859 /* Move the tooltip window where the mouse pointer is. Resize and
10861 if (!INTEGERP (left
) && !INTEGERP (top
))
10864 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10865 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
10869 if (INTEGERP (top
))
10870 *root_y
= XINT (top
);
10871 else if (*root_y
+ XINT (dy
) - height
< 0)
10872 *root_y
-= XINT (dy
);
10876 *root_y
+= XINT (dy
);
10879 if (INTEGERP (left
))
10880 *root_x
= XINT (left
);
10881 else if (*root_x
+ XINT (dx
) + width
> FRAME_X_DISPLAY_INFO (f
)->width
)
10882 *root_x
-= width
+ XINT (dx
);
10884 *root_x
+= XINT (dx
);
10888 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10889 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10890 A tooltip window is a small X window displaying a string.\n\
10892 FRAME nil or omitted means use the selected frame.\n\
10894 PARMS is an optional list of frame parameters which can be\n\
10895 used to change the tooltip's appearance.\n\
10897 Automatically hide the tooltip after TIMEOUT seconds.\n\
10898 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10900 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10901 the tooltip is displayed at that x-position. Otherwise it is\n\
10902 displayed at the mouse position, with offset DX added (default is 5 if\n\
10903 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10904 parameter is specified, it determines the y-position of the tooltip\n\
10905 window, otherwise it is displayed at the mouse position, with offset\n\
10906 DY added (default is -10).\n\
10908 A tooltip's maximum size is specified by `x-max-tooltip-size'.\n\
10909 Text larger than the specified size is clipped.")
10910 (string
, frame
, parms
, timeout
, dx
, dy
)
10911 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10915 Lisp_Object buffer
, top
, left
, max_width
, max_height
;
10916 int root_x
, root_y
;
10917 struct buffer
*old_buffer
;
10918 struct text_pos pos
;
10919 int i
, width
, height
;
10920 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10921 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10922 int count
= BINDING_STACK_SIZE ();
10924 specbind (Qinhibit_redisplay
, Qt
);
10926 GCPRO4 (string
, parms
, frame
, timeout
);
10928 CHECK_STRING (string
, 0);
10929 f
= check_x_frame (frame
);
10930 if (NILP (timeout
))
10931 timeout
= make_number (5);
10933 CHECK_NATNUM (timeout
, 2);
10936 dx
= make_number (5);
10938 CHECK_NUMBER (dx
, 5);
10941 dy
= make_number (-10);
10943 CHECK_NUMBER (dy
, 6);
10945 if (NILP (last_show_tip_args
))
10946 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
10948 if (!NILP (tip_frame
))
10950 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
10951 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
10952 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
10954 if (EQ (frame
, last_frame
)
10955 && !NILP (Fequal (last_string
, string
))
10956 && !NILP (Fequal (last_parms
, parms
)))
10958 struct frame
*f
= XFRAME (tip_frame
);
10960 /* Only DX and DY have changed. */
10961 if (!NILP (tip_timer
))
10963 Lisp_Object timer
= tip_timer
;
10965 call1 (Qcancel_timer
, timer
);
10969 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
10970 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
10971 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10978 /* Hide a previous tip, if any. */
10981 ASET (last_show_tip_args
, 0, string
);
10982 ASET (last_show_tip_args
, 1, frame
);
10983 ASET (last_show_tip_args
, 2, parms
);
10985 /* Add default values to frame parameters. */
10986 if (NILP (Fassq (Qname
, parms
)))
10987 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10988 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10989 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10990 if (NILP (Fassq (Qborder_width
, parms
)))
10991 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10992 if (NILP (Fassq (Qborder_color
, parms
)))
10993 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10994 if (NILP (Fassq (Qbackground_color
, parms
)))
10995 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10998 /* Create a frame for the tooltip, and record it in the global
10999 variable tip_frame. */
11000 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
, string
);
11001 f
= XFRAME (frame
);
11003 /* Set up the frame's root window. */
11004 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
11005 w
->left
= w
->top
= make_number (0);
11007 if (CONSP (Vx_max_tooltip_size
)
11008 && INTEGERP (XCAR (Vx_max_tooltip_size
))
11009 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
11010 && INTEGERP (XCDR (Vx_max_tooltip_size
))
11011 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
11013 w
->width
= XCAR (Vx_max_tooltip_size
);
11014 w
->height
= XCDR (Vx_max_tooltip_size
);
11018 w
->width
= make_number (80);
11019 w
->height
= make_number (40);
11022 f
->window_width
= XINT (w
->width
);
11024 w
->pseudo_window_p
= 1;
11026 /* Display the tooltip text in a temporary buffer. */
11027 old_buffer
= current_buffer
;
11028 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
11029 current_buffer
->truncate_lines
= Qnil
;
11030 clear_glyph_matrix (w
->desired_matrix
);
11031 clear_glyph_matrix (w
->current_matrix
);
11032 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
11033 try_window (FRAME_ROOT_WINDOW (f
), pos
);
11035 /* Compute width and height of the tooltip. */
11036 width
= height
= 0;
11037 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
11039 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
11040 struct glyph
*last
;
11043 /* Stop at the first empty row at the end. */
11044 if (!row
->enabled_p
|| !row
->displays_text_p
)
11047 /* Let the row go over the full width of the frame. */
11048 row
->full_width_p
= 1;
11050 /* There's a glyph at the end of rows that is used to place
11051 the cursor there. Don't include the width of this glyph. */
11052 if (row
->used
[TEXT_AREA
])
11054 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
11055 row_width
= row
->pixel_width
- last
->pixel_width
;
11058 row_width
= row
->pixel_width
;
11060 height
+= row
->height
;
11061 width
= max (width
, row_width
);
11064 /* Add the frame's internal border to the width and height the X
11065 window should have. */
11066 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11067 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11069 /* Move the tooltip window where the mouse pointer is. Resize and
11071 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
11074 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11075 root_x
, root_y
, width
, height
);
11076 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
11079 /* Draw into the window. */
11080 w
->must_be_updated_p
= 1;
11081 update_single_window (w
, 1);
11083 /* Restore original current buffer. */
11084 set_buffer_internal_1 (old_buffer
);
11085 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
11088 /* Let the tip disappear after timeout seconds. */
11089 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
11090 intern ("x-hide-tip"));
11093 return unbind_to (count
, Qnil
);
11097 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
11098 "Hide the current tooltip window, if there is any.\n\
11099 Value is t is tooltip was open, nil otherwise.")
11103 Lisp_Object deleted
, frame
, timer
;
11104 struct gcpro gcpro1
, gcpro2
;
11106 /* Return quickly if nothing to do. */
11107 if (NILP (tip_timer
) && NILP (tip_frame
))
11112 GCPRO2 (frame
, timer
);
11113 tip_frame
= tip_timer
= deleted
= Qnil
;
11115 count
= BINDING_STACK_SIZE ();
11116 specbind (Qinhibit_redisplay
, Qt
);
11117 specbind (Qinhibit_quit
, Qt
);
11120 call1 (Qcancel_timer
, timer
);
11122 if (FRAMEP (frame
))
11124 Fdelete_frame (frame
, Qnil
);
11128 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11129 redisplay procedure is not called when a tip frame over menu
11130 items is unmapped. Redisplay the menu manually... */
11132 struct frame
*f
= SELECTED_FRAME ();
11133 Widget w
= f
->output_data
.x
->menubar_widget
;
11134 extern void xlwmenu_redisplay
P_ ((Widget
));
11136 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
11140 xlwmenu_redisplay (w
);
11144 #endif /* USE_LUCID */
11148 return unbind_to (count
, deleted
);
11153 /***********************************************************************
11154 File selection dialog
11155 ***********************************************************************/
11159 /* Callback for "OK" and "Cancel" on file selection dialog. */
11162 file_dialog_cb (widget
, client_data
, call_data
)
11164 XtPointer call_data
, client_data
;
11166 int *result
= (int *) client_data
;
11167 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11168 *result
= cb
->reason
;
11172 /* Callback for unmapping a file selection dialog. This is used to
11173 capture the case where a dialog is closed via a window manager's
11174 closer button, for example. Using a XmNdestroyCallback didn't work
11178 file_dialog_unmap_cb (widget
, client_data
, call_data
)
11180 XtPointer call_data
, client_data
;
11182 int *result
= (int *) client_data
;
11183 *result
= XmCR_CANCEL
;
11187 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11188 "Read file name, prompting with PROMPT in directory DIR.\n\
11189 Use a file selection dialog.\n\
11190 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
11191 specified. Don't let the user enter a file name in the file\n\
11192 selection dialog's entry field, if MUSTMATCH is non-nil.")
11193 (prompt
, dir
, default_filename
, mustmatch
)
11194 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11197 struct frame
*f
= SELECTED_FRAME ();
11198 Lisp_Object file
= Qnil
;
11199 Widget dialog
, text
, list
, help
;
11202 extern XtAppContext Xt_app_con
;
11204 XmString dir_xmstring
, pattern_xmstring
;
11205 int popup_activated_flag
;
11206 int count
= specpdl_ptr
- specpdl
;
11207 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11209 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11210 CHECK_STRING (prompt
, 0);
11211 CHECK_STRING (dir
, 1);
11213 /* Prevent redisplay. */
11214 specbind (Qinhibit_redisplay
, Qt
);
11218 /* Create the dialog with PROMPT as title, using DIR as initial
11219 directory and using "*" as pattern. */
11220 dir
= Fexpand_file_name (dir
, Qnil
);
11221 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11222 pattern_xmstring
= XmStringCreateLocalized ("*");
11224 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11225 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11226 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11227 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11228 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11229 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11231 XmStringFree (dir_xmstring
);
11232 XmStringFree (pattern_xmstring
);
11234 /* Add callbacks for OK and Cancel. */
11235 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11236 (XtPointer
) &result
);
11237 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11238 (XtPointer
) &result
);
11239 XtAddCallback (dialog
, XmNunmapCallback
, file_dialog_unmap_cb
,
11240 (XtPointer
) &result
);
11242 /* Disable the help button since we can't display help. */
11243 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11244 XtSetSensitive (help
, False
);
11246 /* Mark OK button as default. */
11247 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11248 XmNshowAsDefault
, True
, NULL
);
11250 /* If MUSTMATCH is non-nil, disable the file entry field of the
11251 dialog, so that the user must select a file from the files list
11252 box. We can't remove it because we wouldn't have a way to get at
11253 the result file name, then. */
11254 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11255 if (!NILP (mustmatch
))
11258 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11259 XtSetSensitive (text
, False
);
11260 XtSetSensitive (label
, False
);
11263 /* Manage the dialog, so that list boxes get filled. */
11264 XtManageChild (dialog
);
11266 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11267 must include the path for this to work. */
11268 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11269 if (STRINGP (default_filename
))
11271 XmString default_xmstring
;
11275 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11277 if (!XmListItemExists (list
, default_xmstring
))
11279 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11280 XmListAddItem (list
, default_xmstring
, 0);
11284 item_pos
= XmListItemPos (list
, default_xmstring
);
11285 XmStringFree (default_xmstring
);
11287 /* Select the item and scroll it into view. */
11288 XmListSelectPos (list
, item_pos
, True
);
11289 XmListSetPos (list
, item_pos
);
11292 /* Process events until the user presses Cancel or OK. Block
11293 and unblock input here so that we get a chance of processing
11297 while (result
== 0)
11300 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11305 /* Get the result. */
11306 if (result
== XmCR_OK
)
11311 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11312 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11313 XmStringFree (text
);
11314 file
= build_string (data
);
11321 XtUnmanageChild (dialog
);
11322 XtDestroyWidget (dialog
);
11326 /* Make "Cancel" equivalent to C-g. */
11328 Fsignal (Qquit
, Qnil
);
11330 return unbind_to (count
, file
);
11333 #endif /* USE_MOTIF */
11337 /***********************************************************************
11339 ***********************************************************************/
11341 #ifdef HAVE_XKBGETKEYBOARD
11342 #include <X11/XKBlib.h>
11343 #include <X11/keysym.h>
11346 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11347 Sx_backspace_delete_keys_p
, 0, 1, 0,
11348 "Check if both Backspace and Delete keys are on the keyboard of FRAME.\n\
11349 FRAME nil means use the selected frame.\n\
11350 Value is t if we know that both keys are present, and are mapped to the\n\
11355 #ifdef HAVE_XKBGETKEYBOARD
11357 struct frame
*f
= check_x_frame (frame
);
11358 Display
*dpy
= FRAME_X_DISPLAY (f
);
11359 Lisp_Object have_keys
;
11360 int major
, minor
, op
, event
, error
;
11364 /* Check library version in case we're dynamically linked. */
11365 major
= XkbMajorVersion
;
11366 minor
= XkbMinorVersion
;
11367 if (!XkbLibraryVersion (&major
, &minor
))
11373 /* Check that the server supports XKB. */
11374 major
= XkbMajorVersion
;
11375 minor
= XkbMinorVersion
;
11376 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11383 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11386 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11388 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11390 for (i
= kb
->min_key_code
;
11391 (i
< kb
->max_key_code
11392 && (delete_keycode
== 0 || backspace_keycode
== 0));
11395 /* The XKB symbolic key names can be seen most easily in
11396 the PS file generated by `xkbprint -label name
11398 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11399 delete_keycode
= i
;
11400 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11401 backspace_keycode
= i
;
11404 XkbFreeNames (kb
, 0, True
);
11407 XkbFreeClientMap (kb
, 0, True
);
11410 && backspace_keycode
11411 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11412 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11417 #else /* not HAVE_XKBGETKEYBOARD */
11419 #endif /* not HAVE_XKBGETKEYBOARD */
11424 /***********************************************************************
11426 ***********************************************************************/
11431 /* This is zero if not using X windows. */
11434 /* The section below is built by the lisp expression at the top of the file,
11435 just above where these variables are declared. */
11436 /*&&& init symbols here &&&*/
11437 Qauto_raise
= intern ("auto-raise");
11438 staticpro (&Qauto_raise
);
11439 Qauto_lower
= intern ("auto-lower");
11440 staticpro (&Qauto_lower
);
11441 Qbar
= intern ("bar");
11443 Qborder_color
= intern ("border-color");
11444 staticpro (&Qborder_color
);
11445 Qborder_width
= intern ("border-width");
11446 staticpro (&Qborder_width
);
11447 Qbox
= intern ("box");
11449 Qcursor_color
= intern ("cursor-color");
11450 staticpro (&Qcursor_color
);
11451 Qcursor_type
= intern ("cursor-type");
11452 staticpro (&Qcursor_type
);
11453 Qgeometry
= intern ("geometry");
11454 staticpro (&Qgeometry
);
11455 Qicon_left
= intern ("icon-left");
11456 staticpro (&Qicon_left
);
11457 Qicon_top
= intern ("icon-top");
11458 staticpro (&Qicon_top
);
11459 Qicon_type
= intern ("icon-type");
11460 staticpro (&Qicon_type
);
11461 Qicon_name
= intern ("icon-name");
11462 staticpro (&Qicon_name
);
11463 Qinternal_border_width
= intern ("internal-border-width");
11464 staticpro (&Qinternal_border_width
);
11465 Qleft
= intern ("left");
11466 staticpro (&Qleft
);
11467 Qright
= intern ("right");
11468 staticpro (&Qright
);
11469 Qmouse_color
= intern ("mouse-color");
11470 staticpro (&Qmouse_color
);
11471 Qnone
= intern ("none");
11472 staticpro (&Qnone
);
11473 Qparent_id
= intern ("parent-id");
11474 staticpro (&Qparent_id
);
11475 Qscroll_bar_width
= intern ("scroll-bar-width");
11476 staticpro (&Qscroll_bar_width
);
11477 Qsuppress_icon
= intern ("suppress-icon");
11478 staticpro (&Qsuppress_icon
);
11479 Qundefined_color
= intern ("undefined-color");
11480 staticpro (&Qundefined_color
);
11481 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11482 staticpro (&Qvertical_scroll_bars
);
11483 Qvisibility
= intern ("visibility");
11484 staticpro (&Qvisibility
);
11485 Qwindow_id
= intern ("window-id");
11486 staticpro (&Qwindow_id
);
11487 Qouter_window_id
= intern ("outer-window-id");
11488 staticpro (&Qouter_window_id
);
11489 Qx_frame_parameter
= intern ("x-frame-parameter");
11490 staticpro (&Qx_frame_parameter
);
11491 Qx_resource_name
= intern ("x-resource-name");
11492 staticpro (&Qx_resource_name
);
11493 Quser_position
= intern ("user-position");
11494 staticpro (&Quser_position
);
11495 Quser_size
= intern ("user-size");
11496 staticpro (&Quser_size
);
11497 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11498 staticpro (&Qscroll_bar_foreground
);
11499 Qscroll_bar_background
= intern ("scroll-bar-background");
11500 staticpro (&Qscroll_bar_background
);
11501 Qscreen_gamma
= intern ("screen-gamma");
11502 staticpro (&Qscreen_gamma
);
11503 Qline_spacing
= intern ("line-spacing");
11504 staticpro (&Qline_spacing
);
11505 Qcenter
= intern ("center");
11506 staticpro (&Qcenter
);
11507 Qcompound_text
= intern ("compound-text");
11508 staticpro (&Qcompound_text
);
11509 Qcancel_timer
= intern ("cancel-timer");
11510 staticpro (&Qcancel_timer
);
11511 Qwait_for_wm
= intern ("wait-for-wm");
11512 staticpro (&Qwait_for_wm
);
11513 /* This is the end of symbol initialization. */
11515 /* Text property `display' should be nonsticky by default. */
11516 Vtext_property_default_nonsticky
11517 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11520 Qlaplace
= intern ("laplace");
11521 staticpro (&Qlaplace
);
11522 Qemboss
= intern ("emboss");
11523 staticpro (&Qemboss
);
11524 Qedge_detection
= intern ("edge-detection");
11525 staticpro (&Qedge_detection
);
11526 Qheuristic
= intern ("heuristic");
11527 staticpro (&Qheuristic
);
11528 QCmatrix
= intern (":matrix");
11529 staticpro (&QCmatrix
);
11530 QCcolor_adjustment
= intern (":color-adjustment");
11531 staticpro (&QCcolor_adjustment
);
11532 QCmask
= intern (":mask");
11533 staticpro (&QCmask
);
11535 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11536 staticpro (&Qface_set_after_frame_default
);
11538 Fput (Qundefined_color
, Qerror_conditions
,
11539 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11540 Fput (Qundefined_color
, Qerror_message
,
11541 build_string ("Undefined color"));
11543 init_x_parm_symbols ();
11545 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11546 "Non-nil means always draw a cross over disabled images.\n\
11547 Disabled images are those having an `:conversion disabled' property.\n\
11548 A cross is always drawn on black & white displays.");
11549 cross_disabled_images
= 0;
11551 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11552 "List of directories to search for bitmap files for X.");
11553 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11555 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11556 "The shape of the pointer when over text.\n\
11557 Changing the value does not affect existing frames\n\
11558 unless you set the mouse color.");
11559 Vx_pointer_shape
= Qnil
;
11561 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11562 "The name Emacs uses to look up X resources.\n\
11563 `x-get-resource' uses this as the first component of the instance name\n\
11564 when requesting resource values.\n\
11565 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
11566 was invoked, or to the value specified with the `-name' or `-rn'\n\
11567 switches, if present.\n\
11569 It may be useful to bind this variable locally around a call\n\
11570 to `x-get-resource'. See also the variable `x-resource-class'.");
11571 Vx_resource_name
= Qnil
;
11573 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11574 "The class Emacs uses to look up X resources.\n\
11575 `x-get-resource' uses this as the first component of the instance class\n\
11576 when requesting resource values.\n\
11577 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
11579 Setting this variable permanently is not a reasonable thing to do,\n\
11580 but binding this variable locally around a call to `x-get-resource'\n\
11581 is a reasonable practice. See also the variable `x-resource-name'.");
11582 Vx_resource_class
= build_string (EMACS_CLASS
);
11584 #if 0 /* This doesn't really do anything. */
11585 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11586 "The shape of the pointer when not over text.\n\
11587 This variable takes effect when you create a new frame\n\
11588 or when you set the mouse color.");
11590 Vx_nontext_pointer_shape
= Qnil
;
11592 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
11593 "The shape of the pointer when Emacs is busy.\n\
11594 This variable takes effect when you create a new frame\n\
11595 or when you set the mouse color.");
11596 Vx_hourglass_pointer_shape
= Qnil
;
11598 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
11599 "Non-zero means Emacs displays an hourglass pointer on window systems.");
11600 display_hourglass_p
= 1;
11602 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
11603 "*Seconds to wait before displaying an hourglass pointer.\n\
11604 Value must be an integer or float.");
11605 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
11607 #if 0 /* This doesn't really do anything. */
11608 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11609 "The shape of the pointer when over the mode line.\n\
11610 This variable takes effect when you create a new frame\n\
11611 or when you set the mouse color.");
11613 Vx_mode_pointer_shape
= Qnil
;
11615 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11616 &Vx_sensitive_text_pointer_shape
,
11617 "The shape of the pointer when over mouse-sensitive text.\n\
11618 This variable takes effect when you create a new frame\n\
11619 or when you set the mouse color.");
11620 Vx_sensitive_text_pointer_shape
= Qnil
;
11622 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11623 &Vx_window_horizontal_drag_shape
,
11624 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
11625 This variable takes effect when you create a new frame\n\
11626 or when you set the mouse color.");
11627 Vx_window_horizontal_drag_shape
= Qnil
;
11629 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11630 "A string indicating the foreground color of the cursor box.");
11631 Vx_cursor_fore_pixel
= Qnil
;
11633 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
11634 "Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).\n\
11635 Text larger than this is clipped.");
11636 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
11638 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11639 "Non-nil if no X window manager is in use.\n\
11640 Emacs doesn't try to figure this out; this is always nil\n\
11641 unless you set it to something else.");
11642 /* We don't have any way to find this out, so set it to nil
11643 and maybe the user would like to set it to t. */
11644 Vx_no_window_manager
= Qnil
;
11646 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11647 &Vx_pixel_size_width_font_regexp
,
11648 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11650 Since Emacs gets width of a font matching with this regexp from\n\
11651 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11652 such a font. This is especially effective for such large fonts as\n\
11653 Chinese, Japanese, and Korean.");
11654 Vx_pixel_size_width_font_regexp
= Qnil
;
11656 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11657 "Time after which cached images are removed from the cache.\n\
11658 When an image has not been displayed this many seconds, remove it\n\
11659 from the image cache. Value must be an integer or nil with nil\n\
11660 meaning don't clear the cache.");
11661 Vimage_cache_eviction_delay
= make_number (30 * 60);
11663 #ifdef USE_X_TOOLKIT
11664 Fprovide (intern ("x-toolkit"));
11667 Fprovide (intern ("motif"));
11669 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string
,
11670 "Version info for LessTif/Motif.");
11671 Vmotif_version_string
= build_string (XmVERSION_STRING
);
11672 #endif /* USE_MOTIF */
11673 #endif /* USE_X_TOOLKIT */
11675 defsubr (&Sx_get_resource
);
11677 /* X window properties. */
11678 defsubr (&Sx_change_window_property
);
11679 defsubr (&Sx_delete_window_property
);
11680 defsubr (&Sx_window_property
);
11682 defsubr (&Sxw_display_color_p
);
11683 defsubr (&Sx_display_grayscale_p
);
11684 defsubr (&Sxw_color_defined_p
);
11685 defsubr (&Sxw_color_values
);
11686 defsubr (&Sx_server_max_request_size
);
11687 defsubr (&Sx_server_vendor
);
11688 defsubr (&Sx_server_version
);
11689 defsubr (&Sx_display_pixel_width
);
11690 defsubr (&Sx_display_pixel_height
);
11691 defsubr (&Sx_display_mm_width
);
11692 defsubr (&Sx_display_mm_height
);
11693 defsubr (&Sx_display_screens
);
11694 defsubr (&Sx_display_planes
);
11695 defsubr (&Sx_display_color_cells
);
11696 defsubr (&Sx_display_visual_class
);
11697 defsubr (&Sx_display_backing_store
);
11698 defsubr (&Sx_display_save_under
);
11699 defsubr (&Sx_parse_geometry
);
11700 defsubr (&Sx_create_frame
);
11701 defsubr (&Sx_open_connection
);
11702 defsubr (&Sx_close_connection
);
11703 defsubr (&Sx_display_list
);
11704 defsubr (&Sx_synchronize
);
11705 defsubr (&Sx_focus_frame
);
11706 defsubr (&Sx_backspace_delete_keys_p
);
11708 /* Setting callback functions for fontset handler. */
11709 get_font_info_func
= x_get_font_info
;
11711 #if 0 /* This function pointer doesn't seem to be used anywhere.
11712 And the pointer assigned has the wrong type, anyway. */
11713 list_fonts_func
= x_list_fonts
;
11716 load_font_func
= x_load_font
;
11717 find_ccl_program_func
= x_find_ccl_program
;
11718 query_font_func
= x_query_font
;
11719 set_frame_fontset_func
= x_set_font
;
11720 check_window_system_func
= check_x
;
11723 Qxbm
= intern ("xbm");
11725 QCtype
= intern (":type");
11726 staticpro (&QCtype
);
11727 QCconversion
= intern (":conversion");
11728 staticpro (&QCconversion
);
11729 QCheuristic_mask
= intern (":heuristic-mask");
11730 staticpro (&QCheuristic_mask
);
11731 QCcolor_symbols
= intern (":color-symbols");
11732 staticpro (&QCcolor_symbols
);
11733 QCascent
= intern (":ascent");
11734 staticpro (&QCascent
);
11735 QCmargin
= intern (":margin");
11736 staticpro (&QCmargin
);
11737 QCrelief
= intern (":relief");
11738 staticpro (&QCrelief
);
11739 Qpostscript
= intern ("postscript");
11740 staticpro (&Qpostscript
);
11741 QCloader
= intern (":loader");
11742 staticpro (&QCloader
);
11743 QCbounding_box
= intern (":bounding-box");
11744 staticpro (&QCbounding_box
);
11745 QCpt_width
= intern (":pt-width");
11746 staticpro (&QCpt_width
);
11747 QCpt_height
= intern (":pt-height");
11748 staticpro (&QCpt_height
);
11749 QCindex
= intern (":index");
11750 staticpro (&QCindex
);
11751 Qpbm
= intern ("pbm");
11755 Qxpm
= intern ("xpm");
11760 Qjpeg
= intern ("jpeg");
11761 staticpro (&Qjpeg
);
11765 Qtiff
= intern ("tiff");
11766 staticpro (&Qtiff
);
11770 Qgif
= intern ("gif");
11775 Qpng
= intern ("png");
11779 defsubr (&Sclear_image_cache
);
11780 defsubr (&Simage_size
);
11781 defsubr (&Simage_mask_p
);
11783 hourglass_atimer
= NULL
;
11784 hourglass_shown_p
= 0;
11786 defsubr (&Sx_show_tip
);
11787 defsubr (&Sx_hide_tip
);
11789 staticpro (&tip_timer
);
11791 staticpro (&tip_frame
);
11793 last_show_tip_args
= Qnil
;
11794 staticpro (&last_show_tip_args
);
11797 defsubr (&Sx_file_dialog
);
11805 image_types
= NULL
;
11806 Vimage_types
= Qnil
;
11808 define_image_type (&xbm_type
);
11809 define_image_type (&gs_type
);
11810 define_image_type (&pbm_type
);
11813 define_image_type (&xpm_type
);
11817 define_image_type (&jpeg_type
);
11821 define_image_type (&tiff_type
);
11825 define_image_type (&gif_type
);
11829 define_image_type (&png_type
);
11833 #endif /* HAVE_X_WINDOWS */