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 static void x_create_im
P_ ((struct frame
*));
733 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
734 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
735 static void x_set_wait_for_wm
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
736 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
737 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
738 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
739 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
740 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
741 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
742 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
743 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
744 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
745 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
747 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
750 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
752 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
755 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
760 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
762 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
767 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
768 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
770 static void init_color_table
P_ ((void));
771 static void free_color_table
P_ ((void));
772 static unsigned long *colors_in_color_table
P_ ((int *n
));
773 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
774 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
778 static struct x_frame_parm_table x_frame_parms
[] =
780 "auto-raise", x_set_autoraise
,
781 "auto-lower", x_set_autolower
,
782 "background-color", x_set_background_color
,
783 "border-color", x_set_border_color
,
784 "border-width", x_set_border_width
,
785 "cursor-color", x_set_cursor_color
,
786 "cursor-type", x_set_cursor_type
,
788 "foreground-color", x_set_foreground_color
,
789 "icon-name", x_set_icon_name
,
790 "icon-type", x_set_icon_type
,
791 "internal-border-width", x_set_internal_border_width
,
792 "menu-bar-lines", x_set_menu_bar_lines
,
793 "mouse-color", x_set_mouse_color
,
794 "name", x_explicitly_set_name
,
795 "scroll-bar-width", x_set_scroll_bar_width
,
796 "title", x_set_title
,
797 "unsplittable", x_set_unsplittable
,
798 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
799 "visibility", x_set_visibility
,
800 "tool-bar-lines", x_set_tool_bar_lines
,
801 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
802 "scroll-bar-background", x_set_scroll_bar_background
,
803 "screen-gamma", x_set_screen_gamma
,
804 "line-spacing", x_set_line_spacing
,
805 "wait-for-wm", x_set_wait_for_wm
808 /* Attach the `x-frame-parameter' properties to
809 the Lisp symbol names of parameters relevant to X. */
812 init_x_parm_symbols ()
816 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
817 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
821 /* Change the parameters of frame F as specified by ALIST.
822 If a parameter is not specially recognized, do nothing special;
823 otherwise call the `x_set_...' function for that parameter.
824 Except for certain geometry properties, always call store_frame_param
825 to store the new value in the parameter alist. */
828 x_set_frame_parameters (f
, alist
)
834 /* If both of these parameters are present, it's more efficient to
835 set them both at once. So we wait until we've looked at the
836 entire list before we set them. */
840 Lisp_Object left
, top
;
842 /* Same with these. */
843 Lisp_Object icon_left
, icon_top
;
845 /* Record in these vectors all the parms specified. */
849 int left_no_change
= 0, top_no_change
= 0;
850 int icon_left_no_change
= 0, icon_top_no_change
= 0;
852 struct gcpro gcpro1
, gcpro2
;
855 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
858 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
859 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
861 /* Extract parm names and values into those vectors. */
864 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
869 parms
[i
] = Fcar (elt
);
870 values
[i
] = Fcdr (elt
);
873 /* TAIL and ALIST are not used again below here. */
876 GCPRO2 (*parms
, *values
);
880 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
881 because their values appear in VALUES and strings are not valid. */
882 top
= left
= Qunbound
;
883 icon_left
= icon_top
= Qunbound
;
885 /* Provide default values for HEIGHT and WIDTH. */
886 if (FRAME_NEW_WIDTH (f
))
887 width
= FRAME_NEW_WIDTH (f
);
889 width
= FRAME_WIDTH (f
);
891 if (FRAME_NEW_HEIGHT (f
))
892 height
= FRAME_NEW_HEIGHT (f
);
894 height
= FRAME_HEIGHT (f
);
896 /* Process foreground_color and background_color before anything else.
897 They are independent of other properties, but other properties (e.g.,
898 cursor_color) are dependent upon them. */
899 for (p
= 0; p
< i
; p
++)
901 Lisp_Object prop
, val
;
905 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
907 register Lisp_Object param_index
, old_value
;
909 param_index
= Fget (prop
, Qx_frame_parameter
);
910 old_value
= get_frame_param (f
, prop
);
911 store_frame_param (f
, prop
, val
);
912 if (NATNUMP (param_index
)
913 && (XFASTINT (param_index
)
914 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
915 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
919 /* Now process them in reverse of specified order. */
920 for (i
--; i
>= 0; i
--)
922 Lisp_Object prop
, val
;
927 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
928 width
= XFASTINT (val
);
929 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
930 height
= XFASTINT (val
);
931 else if (EQ (prop
, Qtop
))
933 else if (EQ (prop
, Qleft
))
935 else if (EQ (prop
, Qicon_top
))
937 else if (EQ (prop
, Qicon_left
))
939 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
940 /* Processed above. */
944 register Lisp_Object param_index
, old_value
;
946 param_index
= Fget (prop
, Qx_frame_parameter
);
947 old_value
= get_frame_param (f
, prop
);
948 store_frame_param (f
, prop
, val
);
949 if (NATNUMP (param_index
)
950 && (XFASTINT (param_index
)
951 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
952 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
956 /* Don't die if just one of these was set. */
957 if (EQ (left
, Qunbound
))
960 if (f
->output_data
.x
->left_pos
< 0)
961 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
963 XSETINT (left
, f
->output_data
.x
->left_pos
);
965 if (EQ (top
, Qunbound
))
968 if (f
->output_data
.x
->top_pos
< 0)
969 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
971 XSETINT (top
, f
->output_data
.x
->top_pos
);
974 /* If one of the icon positions was not set, preserve or default it. */
975 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
977 icon_left_no_change
= 1;
978 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
979 if (NILP (icon_left
))
980 XSETINT (icon_left
, 0);
982 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
984 icon_top_no_change
= 1;
985 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
987 XSETINT (icon_top
, 0);
990 /* Don't set these parameters unless they've been explicitly
991 specified. The window might be mapped or resized while we're in
992 this function, and we don't want to override that unless the lisp
993 code has asked for it.
995 Don't set these parameters unless they actually differ from the
996 window's current parameters; the window may not actually exist
1001 check_frame_size (f
, &height
, &width
);
1003 XSETFRAME (frame
, f
);
1005 if (width
!= FRAME_WIDTH (f
)
1006 || height
!= FRAME_HEIGHT (f
)
1007 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1008 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1010 if ((!NILP (left
) || !NILP (top
))
1011 && ! (left_no_change
&& top_no_change
)
1012 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1013 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1018 /* Record the signs. */
1019 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1020 if (EQ (left
, Qminus
))
1021 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1022 else if (INTEGERP (left
))
1024 leftpos
= XINT (left
);
1026 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1028 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1029 && CONSP (XCDR (left
))
1030 && INTEGERP (XCAR (XCDR (left
))))
1032 leftpos
= - XINT (XCAR (XCDR (left
)));
1033 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1035 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1036 && CONSP (XCDR (left
))
1037 && INTEGERP (XCAR (XCDR (left
))))
1039 leftpos
= XINT (XCAR (XCDR (left
)));
1042 if (EQ (top
, Qminus
))
1043 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1044 else if (INTEGERP (top
))
1046 toppos
= XINT (top
);
1048 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1050 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1051 && CONSP (XCDR (top
))
1052 && INTEGERP (XCAR (XCDR (top
))))
1054 toppos
= - XINT (XCAR (XCDR (top
)));
1055 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1057 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1058 && CONSP (XCDR (top
))
1059 && INTEGERP (XCAR (XCDR (top
))))
1061 toppos
= XINT (XCAR (XCDR (top
)));
1065 /* Store the numeric value of the position. */
1066 f
->output_data
.x
->top_pos
= toppos
;
1067 f
->output_data
.x
->left_pos
= leftpos
;
1069 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1071 /* Actually set that position, and convert to absolute. */
1072 x_set_offset (f
, leftpos
, toppos
, -1);
1075 if ((!NILP (icon_left
) || !NILP (icon_top
))
1076 && ! (icon_left_no_change
&& icon_top_no_change
))
1077 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1083 /* Store the screen positions of frame F into XPTR and YPTR.
1084 These are the positions of the containing window manager window,
1085 not Emacs's own window. */
1088 x_real_positions (f
, xptr
, yptr
)
1095 /* This is pretty gross, but seems to be the easiest way out of
1096 the problem that arises when restarting window-managers. */
1098 #ifdef USE_X_TOOLKIT
1099 Window outer
= (f
->output_data
.x
->widget
1100 ? XtWindow (f
->output_data
.x
->widget
)
1101 : FRAME_X_WINDOW (f
));
1103 Window outer
= f
->output_data
.x
->window_desc
;
1105 Window tmp_root_window
;
1106 Window
*tmp_children
;
1107 unsigned int tmp_nchildren
;
1111 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1112 Window outer_window
;
1114 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1115 &f
->output_data
.x
->parent_desc
,
1116 &tmp_children
, &tmp_nchildren
);
1117 XFree ((char *) tmp_children
);
1121 /* Find the position of the outside upper-left corner of
1122 the inner window, with respect to the outer window. */
1123 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1124 outer_window
= f
->output_data
.x
->parent_desc
;
1126 outer_window
= outer
;
1128 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1130 /* From-window, to-window. */
1132 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1134 /* From-position, to-position. */
1135 0, 0, &win_x
, &win_y
,
1140 /* It is possible for the window returned by the XQueryNotify
1141 to become invalid by the time we call XTranslateCoordinates.
1142 That can happen when you restart some window managers.
1143 If so, we get an error in XTranslateCoordinates.
1144 Detect that and try the whole thing over. */
1145 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1147 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1151 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1158 /* Insert a description of internally-recorded parameters of frame X
1159 into the parameter alist *ALISTPTR that is to be given to the user.
1160 Only parameters that are specific to the X window system
1161 and whose values are not correctly recorded in the frame's
1162 param_alist need to be considered here. */
1165 x_report_frame_params (f
, alistptr
)
1167 Lisp_Object
*alistptr
;
1172 /* Represent negative positions (off the top or left screen edge)
1173 in a way that Fmodify_frame_parameters will understand correctly. */
1174 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1175 if (f
->output_data
.x
->left_pos
>= 0)
1176 store_in_alist (alistptr
, Qleft
, tem
);
1178 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1180 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1181 if (f
->output_data
.x
->top_pos
>= 0)
1182 store_in_alist (alistptr
, Qtop
, tem
);
1184 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1186 store_in_alist (alistptr
, Qborder_width
,
1187 make_number (f
->output_data
.x
->border_width
));
1188 store_in_alist (alistptr
, Qinternal_border_width
,
1189 make_number (f
->output_data
.x
->internal_border_width
));
1190 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1191 store_in_alist (alistptr
, Qwindow_id
,
1192 build_string (buf
));
1193 #ifdef USE_X_TOOLKIT
1194 /* Tooltip frame may not have this widget. */
1195 if (f
->output_data
.x
->widget
)
1197 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1198 store_in_alist (alistptr
, Qouter_window_id
,
1199 build_string (buf
));
1200 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1201 FRAME_SAMPLE_VISIBILITY (f
);
1202 store_in_alist (alistptr
, Qvisibility
,
1203 (FRAME_VISIBLE_P (f
) ? Qt
1204 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1205 store_in_alist (alistptr
, Qdisplay
,
1206 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1208 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1211 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1212 store_in_alist (alistptr
, Qparent_id
, tem
);
1217 /* Gamma-correct COLOR on frame F. */
1220 gamma_correct (f
, color
)
1226 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1227 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1228 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1233 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1234 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1235 allocate the color. Value is zero if COLOR_NAME is invalid, or
1236 no color could be allocated. */
1239 x_defined_color (f
, color_name
, color
, alloc_p
)
1246 Display
*dpy
= FRAME_X_DISPLAY (f
);
1247 Colormap cmap
= FRAME_X_COLORMAP (f
);
1250 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1251 if (success_p
&& alloc_p
)
1252 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1259 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1260 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1261 Signal an error if color can't be allocated. */
1264 x_decode_color (f
, color_name
, mono_color
)
1266 Lisp_Object color_name
;
1271 CHECK_STRING (color_name
, 0);
1273 #if 0 /* Don't do this. It's wrong when we're not using the default
1274 colormap, it makes freeing difficult, and it's probably not
1275 an important optimization. */
1276 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1277 return BLACK_PIX_DEFAULT (f
);
1278 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1279 return WHITE_PIX_DEFAULT (f
);
1282 /* Return MONO_COLOR for monochrome frames. */
1283 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1286 /* x_defined_color is responsible for coping with failures
1287 by looking for a near-miss. */
1288 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1291 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1292 Fcons (color_name
, Qnil
)));
1298 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1299 the previous value of that parameter, NEW_VALUE is the new value. */
1302 x_set_line_spacing (f
, new_value
, old_value
)
1304 Lisp_Object new_value
, old_value
;
1306 if (NILP (new_value
))
1307 f
->extra_line_spacing
= 0;
1308 else if (NATNUMP (new_value
))
1309 f
->extra_line_spacing
= XFASTINT (new_value
);
1311 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1312 Fcons (new_value
, Qnil
)));
1313 if (FRAME_VISIBLE_P (f
))
1318 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1319 the previous value of that parameter, NEW_VALUE is the new value.
1320 See also the comment of wait_for_wm in struct x_output. */
1323 x_set_wait_for_wm (f
, new_value
, old_value
)
1325 Lisp_Object new_value
, old_value
;
1327 f
->output_data
.x
->wait_for_wm
= !NILP (new_value
);
1331 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1332 the previous value of that parameter, NEW_VALUE is the new
1336 x_set_screen_gamma (f
, new_value
, old_value
)
1338 Lisp_Object new_value
, old_value
;
1340 if (NILP (new_value
))
1342 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1343 /* The value 0.4545 is the normal viewing gamma. */
1344 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1346 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1347 Fcons (new_value
, Qnil
)));
1349 clear_face_cache (0);
1353 /* Functions called only from `x_set_frame_param'
1354 to set individual parameters.
1356 If FRAME_X_WINDOW (f) is 0,
1357 the frame is being created and its X-window does not exist yet.
1358 In that case, just record the parameter's new value
1359 in the standard place; do not attempt to change the window. */
1362 x_set_foreground_color (f
, arg
, oldval
)
1364 Lisp_Object arg
, oldval
;
1366 struct x_output
*x
= f
->output_data
.x
;
1367 unsigned long fg
, old_fg
;
1369 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1370 old_fg
= x
->foreground_pixel
;
1371 x
->foreground_pixel
= fg
;
1373 if (FRAME_X_WINDOW (f
) != 0)
1375 Display
*dpy
= FRAME_X_DISPLAY (f
);
1378 XSetForeground (dpy
, x
->normal_gc
, fg
);
1379 XSetBackground (dpy
, x
->reverse_gc
, fg
);
1381 if (x
->cursor_pixel
== old_fg
)
1383 unload_color (f
, x
->cursor_pixel
);
1384 x
->cursor_pixel
= x_copy_color (f
, fg
);
1385 XSetBackground (dpy
, x
->cursor_gc
, x
->cursor_pixel
);
1390 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1392 if (FRAME_VISIBLE_P (f
))
1396 unload_color (f
, old_fg
);
1400 x_set_background_color (f
, arg
, oldval
)
1402 Lisp_Object arg
, oldval
;
1404 struct x_output
*x
= f
->output_data
.x
;
1407 bg
= x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1408 unload_color (f
, x
->background_pixel
);
1409 x
->background_pixel
= bg
;
1411 if (FRAME_X_WINDOW (f
) != 0)
1413 Display
*dpy
= FRAME_X_DISPLAY (f
);
1417 XSetBackground (dpy
, x
->normal_gc
, bg
);
1418 XSetForeground (dpy
, x
->reverse_gc
, bg
);
1419 XSetWindowBackground (dpy
, FRAME_X_WINDOW (f
), bg
);
1420 XSetForeground (dpy
, x
->cursor_gc
, bg
);
1422 for (bar
= FRAME_SCROLL_BARS (f
);
1424 bar
= XSCROLL_BAR (bar
)->next
)
1426 Window window
= SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
));
1427 XSetWindowBackground (dpy
, window
, bg
);
1431 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1433 if (FRAME_VISIBLE_P (f
))
1439 x_set_mouse_color (f
, arg
, oldval
)
1441 Lisp_Object arg
, oldval
;
1443 struct x_output
*x
= f
->output_data
.x
;
1444 Display
*dpy
= FRAME_X_DISPLAY (f
);
1445 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1446 Cursor hourglass_cursor
, horizontal_drag_cursor
;
1448 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1449 unsigned long mask_color
= x
->background_pixel
;
1451 /* Don't let pointers be invisible. */
1452 if (mask_color
== pixel
)
1454 x_free_colors (f
, &pixel
, 1);
1455 pixel
= x_copy_color (f
, x
->foreground_pixel
);
1458 unload_color (f
, x
->mouse_pixel
);
1459 x
->mouse_pixel
= pixel
;
1463 /* It's not okay to crash if the user selects a screwy cursor. */
1464 count
= x_catch_errors (dpy
);
1466 if (!NILP (Vx_pointer_shape
))
1468 CHECK_NUMBER (Vx_pointer_shape
, 0);
1469 cursor
= XCreateFontCursor (dpy
, XINT (Vx_pointer_shape
));
1472 cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1473 x_check_errors (dpy
, "bad text pointer cursor: %s");
1475 if (!NILP (Vx_nontext_pointer_shape
))
1477 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1479 = XCreateFontCursor (dpy
, XINT (Vx_nontext_pointer_shape
));
1482 nontext_cursor
= XCreateFontCursor (dpy
, XC_left_ptr
);
1483 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1485 if (!NILP (Vx_hourglass_pointer_shape
))
1487 CHECK_NUMBER (Vx_hourglass_pointer_shape
, 0);
1489 = XCreateFontCursor (dpy
, XINT (Vx_hourglass_pointer_shape
));
1492 hourglass_cursor
= XCreateFontCursor (dpy
, XC_watch
);
1493 x_check_errors (dpy
, "bad hourglass pointer cursor: %s");
1495 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1496 if (!NILP (Vx_mode_pointer_shape
))
1498 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1499 mode_cursor
= XCreateFontCursor (dpy
, XINT (Vx_mode_pointer_shape
));
1502 mode_cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1503 x_check_errors (dpy
, "bad modeline pointer cursor: %s");
1505 if (!NILP (Vx_sensitive_text_pointer_shape
))
1507 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1509 = XCreateFontCursor (dpy
, XINT (Vx_sensitive_text_pointer_shape
));
1512 cross_cursor
= XCreateFontCursor (dpy
, XC_crosshair
);
1514 if (!NILP (Vx_window_horizontal_drag_shape
))
1516 CHECK_NUMBER (Vx_window_horizontal_drag_shape
, 0);
1517 horizontal_drag_cursor
1518 = XCreateFontCursor (dpy
, XINT (Vx_window_horizontal_drag_shape
));
1521 horizontal_drag_cursor
1522 = XCreateFontCursor (dpy
, XC_sb_h_double_arrow
);
1524 /* Check and report errors with the above calls. */
1525 x_check_errors (dpy
, "can't set cursor shape: %s");
1526 x_uncatch_errors (dpy
, count
);
1529 XColor fore_color
, back_color
;
1531 fore_color
.pixel
= x
->mouse_pixel
;
1532 x_query_color (f
, &fore_color
);
1533 back_color
.pixel
= mask_color
;
1534 x_query_color (f
, &back_color
);
1536 XRecolorCursor (dpy
, cursor
, &fore_color
, &back_color
);
1537 XRecolorCursor (dpy
, nontext_cursor
, &fore_color
, &back_color
);
1538 XRecolorCursor (dpy
, mode_cursor
, &fore_color
, &back_color
);
1539 XRecolorCursor (dpy
, cross_cursor
, &fore_color
, &back_color
);
1540 XRecolorCursor (dpy
, hourglass_cursor
, &fore_color
, &back_color
);
1541 XRecolorCursor (dpy
, horizontal_drag_cursor
, &fore_color
, &back_color
);
1544 if (FRAME_X_WINDOW (f
) != 0)
1545 XDefineCursor (dpy
, FRAME_X_WINDOW (f
), cursor
);
1547 if (cursor
!= x
->text_cursor
1548 && x
->text_cursor
!= 0)
1549 XFreeCursor (dpy
, x
->text_cursor
);
1550 x
->text_cursor
= cursor
;
1552 if (nontext_cursor
!= x
->nontext_cursor
1553 && x
->nontext_cursor
!= 0)
1554 XFreeCursor (dpy
, x
->nontext_cursor
);
1555 x
->nontext_cursor
= nontext_cursor
;
1557 if (hourglass_cursor
!= x
->hourglass_cursor
1558 && x
->hourglass_cursor
!= 0)
1559 XFreeCursor (dpy
, x
->hourglass_cursor
);
1560 x
->hourglass_cursor
= hourglass_cursor
;
1562 if (mode_cursor
!= x
->modeline_cursor
1563 && x
->modeline_cursor
!= 0)
1564 XFreeCursor (dpy
, f
->output_data
.x
->modeline_cursor
);
1565 x
->modeline_cursor
= mode_cursor
;
1567 if (cross_cursor
!= x
->cross_cursor
1568 && x
->cross_cursor
!= 0)
1569 XFreeCursor (dpy
, x
->cross_cursor
);
1570 x
->cross_cursor
= cross_cursor
;
1572 if (horizontal_drag_cursor
!= x
->horizontal_drag_cursor
1573 && x
->horizontal_drag_cursor
!= 0)
1574 XFreeCursor (dpy
, x
->horizontal_drag_cursor
);
1575 x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1580 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1584 x_set_cursor_color (f
, arg
, oldval
)
1586 Lisp_Object arg
, oldval
;
1588 unsigned long fore_pixel
, pixel
;
1589 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1590 struct x_output
*x
= f
->output_data
.x
;
1592 if (!NILP (Vx_cursor_fore_pixel
))
1594 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1595 WHITE_PIX_DEFAULT (f
));
1596 fore_pixel_allocated_p
= 1;
1599 fore_pixel
= x
->background_pixel
;
1601 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1602 pixel_allocated_p
= 1;
1604 /* Make sure that the cursor color differs from the background color. */
1605 if (pixel
== x
->background_pixel
)
1607 if (pixel_allocated_p
)
1609 x_free_colors (f
, &pixel
, 1);
1610 pixel_allocated_p
= 0;
1613 pixel
= x
->mouse_pixel
;
1614 if (pixel
== fore_pixel
)
1616 if (fore_pixel_allocated_p
)
1618 x_free_colors (f
, &fore_pixel
, 1);
1619 fore_pixel_allocated_p
= 0;
1621 fore_pixel
= x
->background_pixel
;
1625 unload_color (f
, x
->cursor_foreground_pixel
);
1626 if (!fore_pixel_allocated_p
)
1627 fore_pixel
= x_copy_color (f
, fore_pixel
);
1628 x
->cursor_foreground_pixel
= fore_pixel
;
1630 unload_color (f
, x
->cursor_pixel
);
1631 if (!pixel_allocated_p
)
1632 pixel
= x_copy_color (f
, pixel
);
1633 x
->cursor_pixel
= pixel
;
1635 if (FRAME_X_WINDOW (f
) != 0)
1638 XSetBackground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, x
->cursor_pixel
);
1639 XSetForeground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, fore_pixel
);
1642 if (FRAME_VISIBLE_P (f
))
1644 x_update_cursor (f
, 0);
1645 x_update_cursor (f
, 1);
1649 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1652 /* Set the border-color of frame F to value described by ARG.
1653 ARG can be a string naming a color.
1654 The border-color is used for the border that is drawn by the X server.
1655 Note that this does not fully take effect if done before
1656 F has an x-window; it must be redone when the window is created.
1658 Note: this is done in two routines because of the way X10 works.
1660 Note: under X11, this is normally the province of the window manager,
1661 and so emacs' border colors may be overridden. */
1664 x_set_border_color (f
, arg
, oldval
)
1666 Lisp_Object arg
, oldval
;
1670 CHECK_STRING (arg
, 0);
1671 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1672 x_set_border_pixel (f
, pix
);
1673 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1676 /* Set the border-color of frame F to pixel value PIX.
1677 Note that this does not fully take effect if done before
1678 F has an x-window. */
1681 x_set_border_pixel (f
, pix
)
1685 unload_color (f
, f
->output_data
.x
->border_pixel
);
1686 f
->output_data
.x
->border_pixel
= pix
;
1688 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1691 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1692 (unsigned long)pix
);
1695 if (FRAME_VISIBLE_P (f
))
1701 /* Value is the internal representation of the specified cursor type
1702 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1703 of the bar cursor. */
1705 enum text_cursor_kinds
1706 x_specified_cursor_type (arg
, width
)
1710 enum text_cursor_kinds type
;
1717 else if (CONSP (arg
)
1718 && EQ (XCAR (arg
), Qbar
)
1719 && INTEGERP (XCDR (arg
))
1720 && XINT (XCDR (arg
)) >= 0)
1723 *width
= XINT (XCDR (arg
));
1725 else if (NILP (arg
))
1728 /* Treat anything unknown as "box cursor".
1729 It was bad to signal an error; people have trouble fixing
1730 .Xdefaults with Emacs, when it has something bad in it. */
1731 type
= FILLED_BOX_CURSOR
;
1737 x_set_cursor_type (f
, arg
, oldval
)
1739 Lisp_Object arg
, oldval
;
1743 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1744 f
->output_data
.x
->cursor_width
= width
;
1746 /* Make sure the cursor gets redrawn. This is overkill, but how
1747 often do people change cursor types? */
1748 update_mode_lines
++;
1752 x_set_icon_type (f
, arg
, oldval
)
1754 Lisp_Object arg
, oldval
;
1760 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1763 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1768 result
= x_text_icon (f
,
1769 (char *) XSTRING ((!NILP (f
->icon_name
)
1773 result
= x_bitmap_icon (f
, arg
);
1778 error ("No icon window available");
1781 XFlush (FRAME_X_DISPLAY (f
));
1785 /* Return non-nil if frame F wants a bitmap icon. */
1793 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1801 x_set_icon_name (f
, arg
, oldval
)
1803 Lisp_Object arg
, oldval
;
1809 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1812 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1817 if (f
->output_data
.x
->icon_bitmap
!= 0)
1822 result
= x_text_icon (f
,
1823 (char *) XSTRING ((!NILP (f
->icon_name
)
1832 error ("No icon window available");
1835 XFlush (FRAME_X_DISPLAY (f
));
1840 x_set_font (f
, arg
, oldval
)
1842 Lisp_Object arg
, oldval
;
1845 Lisp_Object fontset_name
;
1847 int old_fontset
= f
->output_data
.x
->fontset
;
1849 CHECK_STRING (arg
, 1);
1851 fontset_name
= Fquery_fontset (arg
, Qnil
);
1854 result
= (STRINGP (fontset_name
)
1855 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1856 : x_new_font (f
, XSTRING (arg
)->data
));
1859 if (EQ (result
, Qnil
))
1860 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1861 else if (EQ (result
, Qt
))
1862 error ("The characters of the given font have varying widths");
1863 else if (STRINGP (result
))
1865 if (STRINGP (fontset_name
))
1867 /* Fontset names are built from ASCII font names, so the
1868 names may be equal despite there was a change. */
1869 if (old_fontset
== f
->output_data
.x
->fontset
)
1872 else if (!NILP (Fequal (result
, oldval
)))
1875 store_frame_param (f
, Qfont
, result
);
1876 recompute_basic_faces (f
);
1881 do_pending_window_change (0);
1883 /* Don't call `face-set-after-frame-default' when faces haven't been
1884 initialized yet. This is the case when called from
1885 Fx_create_frame. In that case, the X widget or window doesn't
1886 exist either, and we can end up in x_report_frame_params with a
1887 null widget which gives a segfault. */
1888 if (FRAME_FACE_CACHE (f
))
1890 XSETFRAME (frame
, f
);
1891 call1 (Qface_set_after_frame_default
, frame
);
1896 x_set_border_width (f
, arg
, oldval
)
1898 Lisp_Object arg
, oldval
;
1900 CHECK_NUMBER (arg
, 0);
1902 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1905 if (FRAME_X_WINDOW (f
) != 0)
1906 error ("Cannot change the border width of a window");
1908 f
->output_data
.x
->border_width
= XINT (arg
);
1912 x_set_internal_border_width (f
, arg
, oldval
)
1914 Lisp_Object arg
, oldval
;
1916 int old
= f
->output_data
.x
->internal_border_width
;
1918 CHECK_NUMBER (arg
, 0);
1919 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1920 if (f
->output_data
.x
->internal_border_width
< 0)
1921 f
->output_data
.x
->internal_border_width
= 0;
1923 #ifdef USE_X_TOOLKIT
1924 if (f
->output_data
.x
->edit_widget
)
1925 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1928 if (f
->output_data
.x
->internal_border_width
== old
)
1931 if (FRAME_X_WINDOW (f
) != 0)
1933 x_set_window_size (f
, 0, f
->width
, f
->height
);
1934 SET_FRAME_GARBAGED (f
);
1935 do_pending_window_change (0);
1940 x_set_visibility (f
, value
, oldval
)
1942 Lisp_Object value
, oldval
;
1945 XSETFRAME (frame
, f
);
1948 Fmake_frame_invisible (frame
, Qt
);
1949 else if (EQ (value
, Qicon
))
1950 Ficonify_frame (frame
);
1952 Fmake_frame_visible (frame
);
1956 /* Change window heights in windows rooted in WINDOW by N lines. */
1959 x_change_window_heights (window
, n
)
1963 struct window
*w
= XWINDOW (window
);
1965 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1966 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1968 if (INTEGERP (w
->orig_top
))
1969 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1970 if (INTEGERP (w
->orig_height
))
1971 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1973 /* Handle just the top child in a vertical split. */
1974 if (!NILP (w
->vchild
))
1975 x_change_window_heights (w
->vchild
, n
);
1977 /* Adjust all children in a horizontal split. */
1978 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1980 w
= XWINDOW (window
);
1981 x_change_window_heights (window
, n
);
1986 x_set_menu_bar_lines (f
, value
, oldval
)
1988 Lisp_Object value
, oldval
;
1991 #ifndef USE_X_TOOLKIT
1992 int olines
= FRAME_MENU_BAR_LINES (f
);
1995 /* Right now, menu bars don't work properly in minibuf-only frames;
1996 most of the commands try to apply themselves to the minibuffer
1997 frame itself, and get an error because you can't switch buffers
1998 in or split the minibuffer window. */
1999 if (FRAME_MINIBUF_ONLY_P (f
))
2002 if (INTEGERP (value
))
2003 nlines
= XINT (value
);
2007 /* Make sure we redisplay all windows in this frame. */
2008 windows_or_buffers_changed
++;
2010 #ifdef USE_X_TOOLKIT
2011 FRAME_MENU_BAR_LINES (f
) = 0;
2014 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2015 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
2016 /* Make sure next redisplay shows the menu bar. */
2017 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2021 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2022 free_frame_menubar (f
);
2023 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2025 f
->output_data
.x
->menubar_widget
= 0;
2027 #else /* not USE_X_TOOLKIT */
2028 FRAME_MENU_BAR_LINES (f
) = nlines
;
2029 x_change_window_heights (f
->root_window
, nlines
- olines
);
2030 #endif /* not USE_X_TOOLKIT */
2035 /* Set the number of lines used for the tool bar of frame F to VALUE.
2036 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2037 is the old number of tool bar lines. This function changes the
2038 height of all windows on frame F to match the new tool bar height.
2039 The frame's height doesn't change. */
2042 x_set_tool_bar_lines (f
, value
, oldval
)
2044 Lisp_Object value
, oldval
;
2046 int delta
, nlines
, root_height
;
2047 Lisp_Object root_window
;
2049 /* Treat tool bars like menu bars. */
2050 if (FRAME_MINIBUF_ONLY_P (f
))
2053 /* Use VALUE only if an integer >= 0. */
2054 if (INTEGERP (value
) && XINT (value
) >= 0)
2055 nlines
= XFASTINT (value
);
2059 /* Make sure we redisplay all windows in this frame. */
2060 ++windows_or_buffers_changed
;
2062 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2064 /* Don't resize the tool-bar to more than we have room for. */
2065 root_window
= FRAME_ROOT_WINDOW (f
);
2066 root_height
= XINT (XWINDOW (root_window
)->height
);
2067 if (root_height
- delta
< 1)
2069 delta
= root_height
- 1;
2070 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2073 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2074 x_change_window_heights (root_window
, delta
);
2077 /* We also have to make sure that the internal border at the top of
2078 the frame, below the menu bar or tool bar, is redrawn when the
2079 tool bar disappears. This is so because the internal border is
2080 below the tool bar if one is displayed, but is below the menu bar
2081 if there isn't a tool bar. The tool bar draws into the area
2082 below the menu bar. */
2083 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2087 clear_current_matrices (f
);
2088 updating_frame
= NULL
;
2091 /* If the tool bar gets smaller, the internal border below it
2092 has to be cleared. It was formerly part of the display
2093 of the larger tool bar, and updating windows won't clear it. */
2096 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2097 int width
= PIXEL_WIDTH (f
);
2098 int y
= nlines
* CANON_Y_UNIT (f
);
2101 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2102 0, y
, width
, height
, False
);
2108 /* Set the foreground color for scroll bars on frame F to VALUE.
2109 VALUE should be a string, a color name. If it isn't a string or
2110 isn't a valid color name, do nothing. OLDVAL is the old value of
2111 the frame parameter. */
2114 x_set_scroll_bar_foreground (f
, value
, oldval
)
2116 Lisp_Object value
, oldval
;
2118 unsigned long pixel
;
2120 if (STRINGP (value
))
2121 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2125 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2126 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2128 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2129 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2131 /* Remove all scroll bars because they have wrong colors. */
2132 if (condemn_scroll_bars_hook
)
2133 (*condemn_scroll_bars_hook
) (f
);
2134 if (judge_scroll_bars_hook
)
2135 (*judge_scroll_bars_hook
) (f
);
2137 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2143 /* Set the background color for scroll bars on frame F to VALUE VALUE
2144 should be a string, a color name. If it isn't a string or isn't a
2145 valid color name, do nothing. OLDVAL is the old value of the frame
2149 x_set_scroll_bar_background (f
, value
, oldval
)
2151 Lisp_Object value
, oldval
;
2153 unsigned long pixel
;
2155 if (STRINGP (value
))
2156 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2160 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2161 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2163 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2164 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2166 /* Remove all scroll bars because they have wrong colors. */
2167 if (condemn_scroll_bars_hook
)
2168 (*condemn_scroll_bars_hook
) (f
);
2169 if (judge_scroll_bars_hook
)
2170 (*judge_scroll_bars_hook
) (f
);
2172 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2178 /* Encode Lisp string STRING as a text in a format appropriate for
2179 XICCC (X Inter Client Communication Conventions).
2181 If STRING contains only ASCII characters, do no conversion and
2182 return the string data of STRING. Otherwise, encode the text by
2183 CODING_SYSTEM, and return a newly allocated memory area which
2184 should be freed by `xfree' by a caller.
2186 Store the byte length of resulting text in *TEXT_BYTES.
2188 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2189 which means that the `encoding' of the result can be `STRING'.
2190 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2191 the result should be `COMPOUND_TEXT'. */
2194 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2195 Lisp_Object string
, coding_system
;
2196 int *text_bytes
, *stringp
;
2198 unsigned char *str
= XSTRING (string
)->data
;
2199 int chars
= XSTRING (string
)->size
;
2200 int bytes
= STRING_BYTES (XSTRING (string
));
2204 struct coding_system coding
;
2206 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2207 if (charset_info
== 0)
2209 /* No multibyte character in OBJ. We need not encode it. */
2210 *text_bytes
= bytes
;
2215 setup_coding_system (coding_system
, &coding
);
2216 coding
.src_multibyte
= 1;
2217 coding
.dst_multibyte
= 0;
2218 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2219 if (coding
.type
== coding_type_iso2022
)
2220 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2221 /* We suppress producing escape sequences for composition. */
2222 coding
.composing
= COMPOSITION_DISABLED
;
2223 bufsize
= encoding_buffer_size (&coding
, bytes
);
2224 buf
= (unsigned char *) xmalloc (bufsize
);
2225 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2226 *text_bytes
= coding
.produced
;
2227 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2232 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2235 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2236 name; if NAME is a string, set F's name to NAME and set
2237 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2239 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2240 suggesting a new name, which lisp code should override; if
2241 F->explicit_name is set, ignore the new name; otherwise, set it. */
2244 x_set_name (f
, name
, explicit)
2249 /* Make sure that requests from lisp code override requests from
2250 Emacs redisplay code. */
2253 /* If we're switching from explicit to implicit, we had better
2254 update the mode lines and thereby update the title. */
2255 if (f
->explicit_name
&& NILP (name
))
2256 update_mode_lines
= 1;
2258 f
->explicit_name
= ! NILP (name
);
2260 else if (f
->explicit_name
)
2263 /* If NAME is nil, set the name to the x_id_name. */
2266 /* Check for no change needed in this very common case
2267 before we do any consing. */
2268 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2269 XSTRING (f
->name
)->data
))
2271 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2274 CHECK_STRING (name
, 0);
2276 /* Don't change the name if it's already NAME. */
2277 if (! NILP (Fstring_equal (name
, f
->name
)))
2282 /* For setting the frame title, the title parameter should override
2283 the name parameter. */
2284 if (! NILP (f
->title
))
2287 if (FRAME_X_WINDOW (f
))
2292 XTextProperty text
, icon
;
2294 Lisp_Object coding_system
;
2296 coding_system
= Vlocale_coding_system
;
2297 if (NILP (coding_system
))
2298 coding_system
= Qcompound_text
;
2299 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2300 text
.encoding
= (stringp
? XA_STRING
2301 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2303 text
.nitems
= bytes
;
2305 if (NILP (f
->icon_name
))
2311 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2313 icon
.encoding
= (stringp
? XA_STRING
2314 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2316 icon
.nitems
= bytes
;
2318 #ifdef USE_X_TOOLKIT
2319 XSetWMName (FRAME_X_DISPLAY (f
),
2320 XtWindow (f
->output_data
.x
->widget
), &text
);
2321 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2323 #else /* not USE_X_TOOLKIT */
2324 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2325 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2326 #endif /* not USE_X_TOOLKIT */
2327 if (!NILP (f
->icon_name
)
2328 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2330 if (text
.value
!= XSTRING (name
)->data
)
2333 #else /* not HAVE_X11R4 */
2334 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2335 XSTRING (name
)->data
);
2336 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2337 XSTRING (name
)->data
);
2338 #endif /* not HAVE_X11R4 */
2343 /* This function should be called when the user's lisp code has
2344 specified a name for the frame; the name will override any set by the
2347 x_explicitly_set_name (f
, arg
, oldval
)
2349 Lisp_Object arg
, oldval
;
2351 x_set_name (f
, arg
, 1);
2354 /* This function should be called by Emacs redisplay code to set the
2355 name; names set this way will never override names set by the user's
2358 x_implicitly_set_name (f
, arg
, oldval
)
2360 Lisp_Object arg
, oldval
;
2362 x_set_name (f
, arg
, 0);
2365 /* Change the title of frame F to NAME.
2366 If NAME is nil, use the frame name as the title.
2368 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2369 name; if NAME is a string, set F's name to NAME and set
2370 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2372 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2373 suggesting a new name, which lisp code should override; if
2374 F->explicit_name is set, ignore the new name; otherwise, set it. */
2377 x_set_title (f
, name
, old_name
)
2379 Lisp_Object name
, old_name
;
2381 /* Don't change the title if it's already NAME. */
2382 if (EQ (name
, f
->title
))
2385 update_mode_lines
= 1;
2392 CHECK_STRING (name
, 0);
2394 if (FRAME_X_WINDOW (f
))
2399 XTextProperty text
, icon
;
2401 Lisp_Object coding_system
;
2403 coding_system
= Vlocale_coding_system
;
2404 if (NILP (coding_system
))
2405 coding_system
= Qcompound_text
;
2406 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2407 text
.encoding
= (stringp
? XA_STRING
2408 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2410 text
.nitems
= bytes
;
2412 if (NILP (f
->icon_name
))
2418 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2420 icon
.encoding
= (stringp
? XA_STRING
2421 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2423 icon
.nitems
= bytes
;
2425 #ifdef USE_X_TOOLKIT
2426 XSetWMName (FRAME_X_DISPLAY (f
),
2427 XtWindow (f
->output_data
.x
->widget
), &text
);
2428 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2430 #else /* not USE_X_TOOLKIT */
2431 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2432 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2433 #endif /* not USE_X_TOOLKIT */
2434 if (!NILP (f
->icon_name
)
2435 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2437 if (text
.value
!= XSTRING (name
)->data
)
2440 #else /* not HAVE_X11R4 */
2441 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2442 XSTRING (name
)->data
);
2443 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2444 XSTRING (name
)->data
);
2445 #endif /* not HAVE_X11R4 */
2451 x_set_autoraise (f
, arg
, oldval
)
2453 Lisp_Object arg
, oldval
;
2455 f
->auto_raise
= !EQ (Qnil
, arg
);
2459 x_set_autolower (f
, arg
, oldval
)
2461 Lisp_Object arg
, oldval
;
2463 f
->auto_lower
= !EQ (Qnil
, arg
);
2467 x_set_unsplittable (f
, arg
, oldval
)
2469 Lisp_Object arg
, oldval
;
2471 f
->no_split
= !NILP (arg
);
2475 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2477 Lisp_Object arg
, oldval
;
2479 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2480 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2481 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2482 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2484 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2486 ? vertical_scroll_bar_none
2488 ? vertical_scroll_bar_right
2489 : vertical_scroll_bar_left
);
2491 /* We set this parameter before creating the X window for the
2492 frame, so we can get the geometry right from the start.
2493 However, if the window hasn't been created yet, we shouldn't
2494 call x_set_window_size. */
2495 if (FRAME_X_WINDOW (f
))
2496 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2497 do_pending_window_change (0);
2502 x_set_scroll_bar_width (f
, arg
, oldval
)
2504 Lisp_Object arg
, oldval
;
2506 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2510 #ifdef USE_TOOLKIT_SCROLL_BARS
2511 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2512 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2513 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2514 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2516 /* Make the actual width at least 14 pixels and a multiple of a
2518 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2520 /* Use all of that space (aside from required margins) for the
2522 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2525 if (FRAME_X_WINDOW (f
))
2526 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2527 do_pending_window_change (0);
2529 else if (INTEGERP (arg
) && XINT (arg
) > 0
2530 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2532 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2533 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2535 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2536 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2537 if (FRAME_X_WINDOW (f
))
2538 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2541 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2542 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2543 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2548 /* Subroutines of creating an X frame. */
2550 /* Make sure that Vx_resource_name is set to a reasonable value.
2551 Fix it up, or set it to `emacs' if it is too hopeless. */
2554 validate_x_resource_name ()
2557 /* Number of valid characters in the resource name. */
2559 /* Number of invalid characters in the resource name. */
2564 if (!STRINGP (Vx_resource_class
))
2565 Vx_resource_class
= build_string (EMACS_CLASS
);
2567 if (STRINGP (Vx_resource_name
))
2569 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2572 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2574 /* Only letters, digits, - and _ are valid in resource names.
2575 Count the valid characters and count the invalid ones. */
2576 for (i
= 0; i
< len
; i
++)
2579 if (! ((c
>= 'a' && c
<= 'z')
2580 || (c
>= 'A' && c
<= 'Z')
2581 || (c
>= '0' && c
<= '9')
2582 || c
== '-' || c
== '_'))
2589 /* Not a string => completely invalid. */
2590 bad_count
= 5, good_count
= 0;
2592 /* If name is valid already, return. */
2596 /* If name is entirely invalid, or nearly so, use `emacs'. */
2598 || (good_count
== 1 && bad_count
> 0))
2600 Vx_resource_name
= build_string ("emacs");
2604 /* Name is partly valid. Copy it and replace the invalid characters
2605 with underscores. */
2607 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2609 for (i
= 0; i
< len
; i
++)
2611 int c
= XSTRING (new)->data
[i
];
2612 if (! ((c
>= 'a' && c
<= 'z')
2613 || (c
>= 'A' && c
<= 'Z')
2614 || (c
>= '0' && c
<= '9')
2615 || c
== '-' || c
== '_'))
2616 XSTRING (new)->data
[i
] = '_';
2621 extern char *x_get_string_resource ();
2623 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2624 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2625 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2626 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2627 the name specified by the `-name' or `-rn' command-line arguments.\n\
2629 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2630 class, respectively. You must specify both of them or neither.\n\
2631 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2632 and the class is `Emacs.CLASS.SUBCLASS'.")
2633 (attribute
, class, component
, subclass
)
2634 Lisp_Object attribute
, class, component
, subclass
;
2636 register char *value
;
2642 CHECK_STRING (attribute
, 0);
2643 CHECK_STRING (class, 0);
2645 if (!NILP (component
))
2646 CHECK_STRING (component
, 1);
2647 if (!NILP (subclass
))
2648 CHECK_STRING (subclass
, 2);
2649 if (NILP (component
) != NILP (subclass
))
2650 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2652 validate_x_resource_name ();
2654 /* Allocate space for the components, the dots which separate them,
2655 and the final '\0'. Make them big enough for the worst case. */
2656 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2657 + (STRINGP (component
)
2658 ? STRING_BYTES (XSTRING (component
)) : 0)
2659 + STRING_BYTES (XSTRING (attribute
))
2662 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2663 + STRING_BYTES (XSTRING (class))
2664 + (STRINGP (subclass
)
2665 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2668 /* Start with emacs.FRAMENAME for the name (the specific one)
2669 and with `Emacs' for the class key (the general one). */
2670 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2671 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2673 strcat (class_key
, ".");
2674 strcat (class_key
, XSTRING (class)->data
);
2676 if (!NILP (component
))
2678 strcat (class_key
, ".");
2679 strcat (class_key
, XSTRING (subclass
)->data
);
2681 strcat (name_key
, ".");
2682 strcat (name_key
, XSTRING (component
)->data
);
2685 strcat (name_key
, ".");
2686 strcat (name_key
, XSTRING (attribute
)->data
);
2688 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2689 name_key
, class_key
);
2691 if (value
!= (char *) 0)
2692 return build_string (value
);
2697 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2700 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2701 struct x_display_info
*dpyinfo
;
2702 Lisp_Object attribute
, class, component
, subclass
;
2704 register char *value
;
2708 CHECK_STRING (attribute
, 0);
2709 CHECK_STRING (class, 0);
2711 if (!NILP (component
))
2712 CHECK_STRING (component
, 1);
2713 if (!NILP (subclass
))
2714 CHECK_STRING (subclass
, 2);
2715 if (NILP (component
) != NILP (subclass
))
2716 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2718 validate_x_resource_name ();
2720 /* Allocate space for the components, the dots which separate them,
2721 and the final '\0'. Make them big enough for the worst case. */
2722 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2723 + (STRINGP (component
)
2724 ? STRING_BYTES (XSTRING (component
)) : 0)
2725 + STRING_BYTES (XSTRING (attribute
))
2728 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2729 + STRING_BYTES (XSTRING (class))
2730 + (STRINGP (subclass
)
2731 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2734 /* Start with emacs.FRAMENAME for the name (the specific one)
2735 and with `Emacs' for the class key (the general one). */
2736 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2737 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2739 strcat (class_key
, ".");
2740 strcat (class_key
, XSTRING (class)->data
);
2742 if (!NILP (component
))
2744 strcat (class_key
, ".");
2745 strcat (class_key
, XSTRING (subclass
)->data
);
2747 strcat (name_key
, ".");
2748 strcat (name_key
, XSTRING (component
)->data
);
2751 strcat (name_key
, ".");
2752 strcat (name_key
, XSTRING (attribute
)->data
);
2754 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2756 if (value
!= (char *) 0)
2757 return build_string (value
);
2762 /* Used when C code wants a resource value. */
2765 x_get_resource_string (attribute
, class)
2766 char *attribute
, *class;
2770 struct frame
*sf
= SELECTED_FRAME ();
2772 /* Allocate space for the components, the dots which separate them,
2773 and the final '\0'. */
2774 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2775 + strlen (attribute
) + 2);
2776 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2777 + strlen (class) + 2);
2779 sprintf (name_key
, "%s.%s",
2780 XSTRING (Vinvocation_name
)->data
,
2782 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2784 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2785 name_key
, class_key
);
2788 /* Types we might convert a resource string into. */
2798 /* Return the value of parameter PARAM.
2800 First search ALIST, then Vdefault_frame_alist, then the X defaults
2801 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2803 Convert the resource to the type specified by desired_type.
2805 If no default is specified, return Qunbound. If you call
2806 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2807 and don't let it get stored in any Lisp-visible variables! */
2810 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2811 struct x_display_info
*dpyinfo
;
2812 Lisp_Object alist
, param
;
2815 enum resource_types type
;
2817 register Lisp_Object tem
;
2819 tem
= Fassq (param
, alist
);
2821 tem
= Fassq (param
, Vdefault_frame_alist
);
2827 tem
= display_x_get_resource (dpyinfo
,
2828 build_string (attribute
),
2829 build_string (class),
2837 case RES_TYPE_NUMBER
:
2838 return make_number (atoi (XSTRING (tem
)->data
));
2840 case RES_TYPE_FLOAT
:
2841 return make_float (atof (XSTRING (tem
)->data
));
2843 case RES_TYPE_BOOLEAN
:
2844 tem
= Fdowncase (tem
);
2845 if (!strcmp (XSTRING (tem
)->data
, "on")
2846 || !strcmp (XSTRING (tem
)->data
, "true"))
2851 case RES_TYPE_STRING
:
2854 case RES_TYPE_SYMBOL
:
2855 /* As a special case, we map the values `true' and `on'
2856 to Qt, and `false' and `off' to Qnil. */
2859 lower
= Fdowncase (tem
);
2860 if (!strcmp (XSTRING (lower
)->data
, "on")
2861 || !strcmp (XSTRING (lower
)->data
, "true"))
2863 else if (!strcmp (XSTRING (lower
)->data
, "off")
2864 || !strcmp (XSTRING (lower
)->data
, "false"))
2867 return Fintern (tem
, Qnil
);
2880 /* Like x_get_arg, but also record the value in f->param_alist. */
2883 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2885 Lisp_Object alist
, param
;
2888 enum resource_types type
;
2892 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2893 attribute
, class, type
);
2895 store_frame_param (f
, param
, value
);
2900 /* Record in frame F the specified or default value according to ALIST
2901 of the parameter named PROP (a Lisp symbol).
2902 If no value is specified for PROP, look for an X default for XPROP
2903 on the frame named NAME.
2904 If that is not found either, use the value DEFLT. */
2907 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2914 enum resource_types type
;
2918 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2919 if (EQ (tem
, Qunbound
))
2921 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2926 /* Record in frame F the specified or default value according to ALIST
2927 of the parameter named PROP (a Lisp symbol). If no value is
2928 specified for PROP, look for an X default for XPROP on the frame
2929 named NAME. If that is not found either, use the value DEFLT. */
2932 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2941 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2944 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2945 if (EQ (tem
, Qunbound
))
2947 #ifdef USE_TOOLKIT_SCROLL_BARS
2949 /* See if an X resource for the scroll bar color has been
2951 tem
= display_x_get_resource (dpyinfo
,
2952 build_string (foreground_p
2956 build_string ("verticalScrollBar"),
2960 /* If nothing has been specified, scroll bars will use a
2961 toolkit-dependent default. Because these defaults are
2962 difficult to get at without actually creating a scroll
2963 bar, use nil to indicate that no color has been
2968 #else /* not USE_TOOLKIT_SCROLL_BARS */
2972 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2975 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2981 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2982 "Parse an X-style geometry string STRING.\n\
2983 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2984 The properties returned may include `top', `left', `height', and `width'.\n\
2985 The value of `left' or `top' may be an integer,\n\
2986 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2987 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2992 unsigned int width
, height
;
2995 CHECK_STRING (string
, 0);
2997 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2998 &x
, &y
, &width
, &height
);
3001 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
3002 error ("Must specify both x and y position, or neither");
3006 if (geometry
& XValue
)
3008 Lisp_Object element
;
3010 if (x
>= 0 && (geometry
& XNegative
))
3011 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3012 else if (x
< 0 && ! (geometry
& XNegative
))
3013 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3015 element
= Fcons (Qleft
, make_number (x
));
3016 result
= Fcons (element
, result
);
3019 if (geometry
& YValue
)
3021 Lisp_Object element
;
3023 if (y
>= 0 && (geometry
& YNegative
))
3024 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3025 else if (y
< 0 && ! (geometry
& YNegative
))
3026 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3028 element
= Fcons (Qtop
, make_number (y
));
3029 result
= Fcons (element
, result
);
3032 if (geometry
& WidthValue
)
3033 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3034 if (geometry
& HeightValue
)
3035 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3040 /* Calculate the desired size and position of this window,
3041 and return the flags saying which aspects were specified.
3043 This function does not make the coordinates positive. */
3045 #define DEFAULT_ROWS 40
3046 #define DEFAULT_COLS 80
3049 x_figure_window_size (f
, parms
)
3053 register Lisp_Object tem0
, tem1
, tem2
;
3054 long window_prompting
= 0;
3055 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3057 /* Default values if we fall through.
3058 Actually, if that happens we should get
3059 window manager prompting. */
3060 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3061 f
->height
= DEFAULT_ROWS
;
3062 /* Window managers expect that if program-specified
3063 positions are not (0,0), they're intentional, not defaults. */
3064 f
->output_data
.x
->top_pos
= 0;
3065 f
->output_data
.x
->left_pos
= 0;
3067 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3068 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3069 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3070 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3072 if (!EQ (tem0
, Qunbound
))
3074 CHECK_NUMBER (tem0
, 0);
3075 f
->height
= XINT (tem0
);
3077 if (!EQ (tem1
, Qunbound
))
3079 CHECK_NUMBER (tem1
, 0);
3080 SET_FRAME_WIDTH (f
, XINT (tem1
));
3082 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3083 window_prompting
|= USSize
;
3085 window_prompting
|= PSize
;
3088 f
->output_data
.x
->vertical_scroll_bar_extra
3089 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3091 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3092 f
->output_data
.x
->flags_areas_extra
3093 = FRAME_FLAGS_AREA_WIDTH (f
);
3094 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3095 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3097 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3098 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3099 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3100 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3102 if (EQ (tem0
, Qminus
))
3104 f
->output_data
.x
->top_pos
= 0;
3105 window_prompting
|= YNegative
;
3107 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3108 && CONSP (XCDR (tem0
))
3109 && INTEGERP (XCAR (XCDR (tem0
))))
3111 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3112 window_prompting
|= YNegative
;
3114 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3115 && CONSP (XCDR (tem0
))
3116 && INTEGERP (XCAR (XCDR (tem0
))))
3118 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3120 else if (EQ (tem0
, Qunbound
))
3121 f
->output_data
.x
->top_pos
= 0;
3124 CHECK_NUMBER (tem0
, 0);
3125 f
->output_data
.x
->top_pos
= XINT (tem0
);
3126 if (f
->output_data
.x
->top_pos
< 0)
3127 window_prompting
|= YNegative
;
3130 if (EQ (tem1
, Qminus
))
3132 f
->output_data
.x
->left_pos
= 0;
3133 window_prompting
|= XNegative
;
3135 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3136 && CONSP (XCDR (tem1
))
3137 && INTEGERP (XCAR (XCDR (tem1
))))
3139 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3140 window_prompting
|= XNegative
;
3142 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3143 && CONSP (XCDR (tem1
))
3144 && INTEGERP (XCAR (XCDR (tem1
))))
3146 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3148 else if (EQ (tem1
, Qunbound
))
3149 f
->output_data
.x
->left_pos
= 0;
3152 CHECK_NUMBER (tem1
, 0);
3153 f
->output_data
.x
->left_pos
= XINT (tem1
);
3154 if (f
->output_data
.x
->left_pos
< 0)
3155 window_prompting
|= XNegative
;
3158 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3159 window_prompting
|= USPosition
;
3161 window_prompting
|= PPosition
;
3164 return window_prompting
;
3167 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3170 XSetWMProtocols (dpy
, w
, protocols
, count
)
3177 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3178 if (prop
== None
) return False
;
3179 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3180 (unsigned char *) protocols
, count
);
3183 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3185 #ifdef USE_X_TOOLKIT
3187 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3188 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3189 already be present because of the toolkit (Motif adds some of them,
3190 for example, but Xt doesn't). */
3193 hack_wm_protocols (f
, widget
)
3197 Display
*dpy
= XtDisplay (widget
);
3198 Window w
= XtWindow (widget
);
3199 int need_delete
= 1;
3205 Atom type
, *atoms
= 0;
3207 unsigned long nitems
= 0;
3208 unsigned long bytes_after
;
3210 if ((XGetWindowProperty (dpy
, w
,
3211 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3212 (long)0, (long)100, False
, XA_ATOM
,
3213 &type
, &format
, &nitems
, &bytes_after
,
3214 (unsigned char **) &atoms
)
3216 && format
== 32 && type
== XA_ATOM
)
3220 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3222 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3224 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3227 if (atoms
) XFree ((char *) atoms
);
3233 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3235 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3237 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3239 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3240 XA_ATOM
, 32, PropModeAppend
,
3241 (unsigned char *) props
, count
);
3249 /* Support routines for XIC (X Input Context). */
3253 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3254 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3257 /* Supported XIM styles, ordered by preferenc. */
3259 static XIMStyle supported_xim_styles
[] =
3261 XIMPreeditPosition
| XIMStatusArea
,
3262 XIMPreeditPosition
| XIMStatusNothing
,
3263 XIMPreeditPosition
| XIMStatusNone
,
3264 XIMPreeditNothing
| XIMStatusArea
,
3265 XIMPreeditNothing
| XIMStatusNothing
,
3266 XIMPreeditNothing
| XIMStatusNone
,
3267 XIMPreeditNone
| XIMStatusArea
,
3268 XIMPreeditNone
| XIMStatusNothing
,
3269 XIMPreeditNone
| XIMStatusNone
,
3274 /* Create an X fontset on frame F with base font name
3278 xic_create_xfontset (f
, base_fontname
)
3280 char *base_fontname
;
3283 char **missing_list
;
3287 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3288 base_fontname
, &missing_list
,
3289 &missing_count
, &def_string
);
3291 XFreeStringList (missing_list
);
3293 /* No need to free def_string. */
3298 /* Value is the best input style, given user preferences USER (already
3299 checked to be supported by Emacs), and styles supported by the
3300 input method XIM. */
3303 best_xim_style (user
, xim
)
3309 for (i
= 0; i
< user
->count_styles
; ++i
)
3310 for (j
= 0; j
< xim
->count_styles
; ++j
)
3311 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3312 return user
->supported_styles
[i
];
3314 /* Return the default style. */
3315 return XIMPreeditNothing
| XIMStatusNothing
;
3318 /* Create XIC for frame F. */
3320 static XIMStyle xic_style
;
3323 create_frame_xic (f
)
3328 XFontSet xfs
= NULL
;
3333 xim
= FRAME_X_XIM (f
);
3338 XVaNestedList preedit_attr
;
3339 XVaNestedList status_attr
;
3340 char *base_fontname
;
3343 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3344 spot
.x
= 0; spot
.y
= 1;
3345 /* Create X fontset. */
3346 fontset
= FRAME_FONTSET (f
);
3348 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3351 /* Determine the base fontname from the ASCII font name of
3353 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3354 char *p
= ascii_font
;
3357 for (i
= 0; *p
; p
++)
3360 /* As the font name doesn't conform to XLFD, we can't
3361 modify it to get a suitable base fontname for the
3363 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3366 int len
= strlen (ascii_font
) + 1;
3369 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3378 base_fontname
= (char *) alloca (len
);
3379 bzero (base_fontname
, len
);
3380 strcpy (base_fontname
, "-*-*-");
3381 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3382 strcat (base_fontname
, "*-*-*-*-*-*-*");
3385 xfs
= xic_create_xfontset (f
, base_fontname
);
3387 /* Determine XIC style. */
3390 XIMStyles supported_list
;
3391 supported_list
.count_styles
= (sizeof supported_xim_styles
3392 / sizeof supported_xim_styles
[0]);
3393 supported_list
.supported_styles
= supported_xim_styles
;
3394 xic_style
= best_xim_style (&supported_list
,
3395 FRAME_X_XIM_STYLES (f
));
3398 preedit_attr
= XVaCreateNestedList (0,
3401 FRAME_FOREGROUND_PIXEL (f
),
3403 FRAME_BACKGROUND_PIXEL (f
),
3404 (xic_style
& XIMPreeditPosition
3409 status_attr
= XVaCreateNestedList (0,
3415 FRAME_FOREGROUND_PIXEL (f
),
3417 FRAME_BACKGROUND_PIXEL (f
),
3420 xic
= XCreateIC (xim
,
3421 XNInputStyle
, xic_style
,
3422 XNClientWindow
, FRAME_X_WINDOW(f
),
3423 XNFocusWindow
, FRAME_X_WINDOW(f
),
3424 XNStatusAttributes
, status_attr
,
3425 XNPreeditAttributes
, preedit_attr
,
3427 XFree (preedit_attr
);
3428 XFree (status_attr
);
3431 FRAME_XIC (f
) = xic
;
3432 FRAME_XIC_STYLE (f
) = xic_style
;
3433 FRAME_XIC_FONTSET (f
) = xfs
;
3437 /* Destroy XIC and free XIC fontset of frame F, if any. */
3443 if (FRAME_XIC (f
) == NULL
)
3446 XDestroyIC (FRAME_XIC (f
));
3447 if (FRAME_XIC_FONTSET (f
))
3448 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3450 FRAME_XIC (f
) = NULL
;
3451 FRAME_XIC_FONTSET (f
) = NULL
;
3455 /* Place preedit area for XIC of window W's frame to specified
3456 pixel position X/Y. X and Y are relative to window W. */
3459 xic_set_preeditarea (w
, x
, y
)
3463 struct frame
*f
= XFRAME (w
->frame
);
3467 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3468 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3469 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3470 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3475 /* Place status area for XIC in bottom right corner of frame F.. */
3478 xic_set_statusarea (f
)
3481 XIC xic
= FRAME_XIC (f
);
3486 /* Negotiate geometry of status area. If input method has existing
3487 status area, use its current size. */
3488 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3489 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3490 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3493 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3494 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3497 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3499 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3500 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3504 area
.width
= needed
->width
;
3505 area
.height
= needed
->height
;
3506 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3507 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3508 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3511 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3512 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3517 /* Set X fontset for XIC of frame F, using base font name
3518 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3521 xic_set_xfontset (f
, base_fontname
)
3523 char *base_fontname
;
3528 xfs
= xic_create_xfontset (f
, base_fontname
);
3530 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3531 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3532 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3533 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3534 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3537 if (FRAME_XIC_FONTSET (f
))
3538 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3539 FRAME_XIC_FONTSET (f
) = xfs
;
3542 #endif /* HAVE_X_I18N */
3546 #ifdef USE_X_TOOLKIT
3548 /* Create and set up the X widget for frame F. */
3551 x_window (f
, window_prompting
, minibuffer_only
)
3553 long window_prompting
;
3554 int minibuffer_only
;
3556 XClassHint class_hints
;
3557 XSetWindowAttributes attributes
;
3558 unsigned long attribute_mask
;
3559 Widget shell_widget
;
3561 Widget frame_widget
;
3567 /* Use the resource name as the top-level widget name
3568 for looking up resources. Make a non-Lisp copy
3569 for the window manager, so GC relocation won't bother it.
3571 Elsewhere we specify the window name for the window manager. */
3574 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3575 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3576 strcpy (f
->namebuf
, str
);
3580 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3581 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3582 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3583 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3584 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3585 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3586 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3587 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3588 applicationShellWidgetClass
,
3589 FRAME_X_DISPLAY (f
), al
, ac
);
3591 f
->output_data
.x
->widget
= shell_widget
;
3592 /* maybe_set_screen_title_format (shell_widget); */
3594 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3595 (widget_value
*) NULL
,
3596 shell_widget
, False
,
3600 (lw_callback
) NULL
);
3603 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3604 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3605 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3606 XtSetValues (pane_widget
, al
, ac
);
3607 f
->output_data
.x
->column_widget
= pane_widget
;
3609 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3610 the emacs screen when changing menubar. This reduces flickering. */
3613 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3614 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3615 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3616 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3617 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3618 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3619 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3620 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3621 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3624 f
->output_data
.x
->edit_widget
= frame_widget
;
3626 XtManageChild (frame_widget
);
3628 /* Do some needed geometry management. */
3631 char *tem
, shell_position
[32];
3634 int extra_borders
= 0;
3636 = (f
->output_data
.x
->menubar_widget
3637 ? (f
->output_data
.x
->menubar_widget
->core
.height
3638 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3641 #if 0 /* Experimentally, we now get the right results
3642 for -geometry -0-0 without this. 24 Aug 96, rms. */
3643 if (FRAME_EXTERNAL_MENU_BAR (f
))
3646 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3647 menubar_size
+= ibw
;
3651 f
->output_data
.x
->menubar_height
= menubar_size
;
3654 /* Motif seems to need this amount added to the sizes
3655 specified for the shell widget. The Athena/Lucid widgets don't.
3656 Both conclusions reached experimentally. -- rms. */
3657 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3658 &extra_borders
, NULL
);
3662 /* Convert our geometry parameters into a geometry string
3664 Note that we do not specify here whether the position
3665 is a user-specified or program-specified one.
3666 We pass that information later, in x_wm_set_size_hints. */
3668 int left
= f
->output_data
.x
->left_pos
;
3669 int xneg
= window_prompting
& XNegative
;
3670 int top
= f
->output_data
.x
->top_pos
;
3671 int yneg
= window_prompting
& YNegative
;
3677 if (window_prompting
& USPosition
)
3678 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3679 PIXEL_WIDTH (f
) + extra_borders
,
3680 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3681 (xneg
? '-' : '+'), left
,
3682 (yneg
? '-' : '+'), top
);
3684 sprintf (shell_position
, "=%dx%d",
3685 PIXEL_WIDTH (f
) + extra_borders
,
3686 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3689 len
= strlen (shell_position
) + 1;
3690 /* We don't free this because we don't know whether
3691 it is safe to free it while the frame exists.
3692 It isn't worth the trouble of arranging to free it
3693 when the frame is deleted. */
3694 tem
= (char *) xmalloc (len
);
3695 strncpy (tem
, shell_position
, len
);
3696 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3697 XtSetValues (shell_widget
, al
, ac
);
3700 XtManageChild (pane_widget
);
3701 XtRealizeWidget (shell_widget
);
3703 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3705 validate_x_resource_name ();
3707 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3708 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3709 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3712 FRAME_XIC (f
) = NULL
;
3714 create_frame_xic (f
);
3718 f
->output_data
.x
->wm_hints
.input
= True
;
3719 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3720 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3721 &f
->output_data
.x
->wm_hints
);
3723 hack_wm_protocols (f
, shell_widget
);
3726 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3729 /* Do a stupid property change to force the server to generate a
3730 PropertyNotify event so that the event_stream server timestamp will
3731 be initialized to something relevant to the time we created the window.
3733 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3734 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3735 XA_ATOM
, 32, PropModeAppend
,
3736 (unsigned char*) NULL
, 0);
3738 /* Make all the standard events reach the Emacs frame. */
3739 attributes
.event_mask
= STANDARD_EVENT_SET
;
3744 /* XIM server might require some X events. */
3745 unsigned long fevent
= NoEventMask
;
3746 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3747 attributes
.event_mask
|= fevent
;
3749 #endif /* HAVE_X_I18N */
3751 attribute_mask
= CWEventMask
;
3752 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3753 attribute_mask
, &attributes
);
3755 XtMapWidget (frame_widget
);
3757 /* x_set_name normally ignores requests to set the name if the
3758 requested name is the same as the current name. This is the one
3759 place where that assumption isn't correct; f->name is set, but
3760 the X server hasn't been told. */
3763 int explicit = f
->explicit_name
;
3765 f
->explicit_name
= 0;
3768 x_set_name (f
, name
, explicit);
3771 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3772 f
->output_data
.x
->text_cursor
);
3776 /* This is a no-op, except under Motif. Make sure main areas are
3777 set to something reasonable, in case we get an error later. */
3778 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3781 #else /* not USE_X_TOOLKIT */
3783 /* Create and set up the X window for frame F. */
3790 XClassHint class_hints
;
3791 XSetWindowAttributes attributes
;
3792 unsigned long attribute_mask
;
3794 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3795 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3796 attributes
.bit_gravity
= StaticGravity
;
3797 attributes
.backing_store
= NotUseful
;
3798 attributes
.save_under
= True
;
3799 attributes
.event_mask
= STANDARD_EVENT_SET
;
3800 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3801 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3806 = XCreateWindow (FRAME_X_DISPLAY (f
),
3807 f
->output_data
.x
->parent_desc
,
3808 f
->output_data
.x
->left_pos
,
3809 f
->output_data
.x
->top_pos
,
3810 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3811 f
->output_data
.x
->border_width
,
3812 CopyFromParent
, /* depth */
3813 InputOutput
, /* class */
3815 attribute_mask
, &attributes
);
3819 create_frame_xic (f
);
3822 /* XIM server might require some X events. */
3823 unsigned long fevent
= NoEventMask
;
3824 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3825 attributes
.event_mask
|= fevent
;
3826 attribute_mask
= CWEventMask
;
3827 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3828 attribute_mask
, &attributes
);
3831 #endif /* HAVE_X_I18N */
3833 validate_x_resource_name ();
3835 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3836 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3837 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3839 /* The menubar is part of the ordinary display;
3840 it does not count in addition to the height of the window. */
3841 f
->output_data
.x
->menubar_height
= 0;
3843 /* This indicates that we use the "Passive Input" input model.
3844 Unless we do this, we don't get the Focus{In,Out} events that we
3845 need to draw the cursor correctly. Accursed bureaucrats.
3846 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3848 f
->output_data
.x
->wm_hints
.input
= True
;
3849 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3850 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3851 &f
->output_data
.x
->wm_hints
);
3852 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3854 /* Request "save yourself" and "delete window" commands from wm. */
3857 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3858 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3859 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3862 /* x_set_name normally ignores requests to set the name if the
3863 requested name is the same as the current name. This is the one
3864 place where that assumption isn't correct; f->name is set, but
3865 the X server hasn't been told. */
3868 int explicit = f
->explicit_name
;
3870 f
->explicit_name
= 0;
3873 x_set_name (f
, name
, explicit);
3876 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3877 f
->output_data
.x
->text_cursor
);
3881 if (FRAME_X_WINDOW (f
) == 0)
3882 error ("Unable to create window");
3885 #endif /* not USE_X_TOOLKIT */
3887 /* Handle the icon stuff for this window. Perhaps later we might
3888 want an x_set_icon_position which can be called interactively as
3896 Lisp_Object icon_x
, icon_y
;
3897 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3899 /* Set the position of the icon. Note that twm groups all
3900 icons in an icon window. */
3901 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3902 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3903 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3905 CHECK_NUMBER (icon_x
, 0);
3906 CHECK_NUMBER (icon_y
, 0);
3908 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3909 error ("Both left and top icon corners of icon must be specified");
3913 if (! EQ (icon_x
, Qunbound
))
3914 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3916 /* Start up iconic or window? */
3917 x_wm_set_window_state
3918 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3923 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3930 /* Make the GCs needed for this window, setting the
3931 background, border and mouse colors; also create the
3932 mouse cursor and the gray border tile. */
3934 static char cursor_bits
[] =
3936 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3937 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3938 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3939 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3946 XGCValues gc_values
;
3950 /* Create the GCs of this frame.
3951 Note that many default values are used. */
3954 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3955 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3956 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3957 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3958 f
->output_data
.x
->normal_gc
3959 = XCreateGC (FRAME_X_DISPLAY (f
),
3961 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
3964 /* Reverse video style. */
3965 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3966 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3967 f
->output_data
.x
->reverse_gc
3968 = XCreateGC (FRAME_X_DISPLAY (f
),
3970 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
3973 /* Cursor has cursor-color background, background-color foreground. */
3974 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3975 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3976 gc_values
.fill_style
= FillOpaqueStippled
;
3978 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3979 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3980 cursor_bits
, 16, 16);
3981 f
->output_data
.x
->cursor_gc
3982 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3983 (GCFont
| GCForeground
| GCBackground
3984 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3988 f
->output_data
.x
->white_relief
.gc
= 0;
3989 f
->output_data
.x
->black_relief
.gc
= 0;
3991 /* Create the gray border tile used when the pointer is not in
3992 the frame. Since this depends on the frame's pixel values,
3993 this must be done on a per-frame basis. */
3994 f
->output_data
.x
->border_tile
3995 = (XCreatePixmapFromBitmapData
3996 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3997 gray_bits
, gray_width
, gray_height
,
3998 f
->output_data
.x
->foreground_pixel
,
3999 f
->output_data
.x
->background_pixel
,
4000 DefaultDepth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
))));
4006 /* Free what was was allocated in x_make_gc. */
4012 Display
*dpy
= FRAME_X_DISPLAY (f
);
4016 if (f
->output_data
.x
->normal_gc
)
4018 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
4019 f
->output_data
.x
->normal_gc
= 0;
4022 if (f
->output_data
.x
->reverse_gc
)
4024 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4025 f
->output_data
.x
->reverse_gc
= 0;
4028 if (f
->output_data
.x
->cursor_gc
)
4030 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4031 f
->output_data
.x
->cursor_gc
= 0;
4034 if (f
->output_data
.x
->border_tile
)
4036 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4037 f
->output_data
.x
->border_tile
= 0;
4044 /* Handler for signals raised during x_create_frame and
4045 x_create_top_frame. FRAME is the frame which is partially
4049 unwind_create_frame (frame
)
4052 struct frame
*f
= XFRAME (frame
);
4054 /* If frame is ``official'', nothing to do. */
4055 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4058 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4061 x_free_frame_resources (f
);
4063 /* Check that reference counts are indeed correct. */
4064 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4065 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4073 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4075 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
4076 Returns an Emacs frame object.\n\
4077 ALIST is an alist of frame parameters.\n\
4078 If the parameters specify that the frame should not have a minibuffer,\n\
4079 and do not specify a specific minibuffer window to use,\n\
4080 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4081 be shared by the new frame.\n\
4083 This function is an internal primitive--use `make-frame' instead.")
4088 Lisp_Object frame
, tem
;
4090 int minibuffer_only
= 0;
4091 long window_prompting
= 0;
4093 int count
= BINDING_STACK_SIZE ();
4094 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4095 Lisp_Object display
;
4096 struct x_display_info
*dpyinfo
= NULL
;
4102 /* Use this general default value to start with
4103 until we know if this frame has a specified name. */
4104 Vx_resource_name
= Vinvocation_name
;
4106 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4107 if (EQ (display
, Qunbound
))
4109 dpyinfo
= check_x_display_info (display
);
4111 kb
= dpyinfo
->kboard
;
4113 kb
= &the_only_kboard
;
4116 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4118 && ! EQ (name
, Qunbound
)
4120 error ("Invalid frame name--not a string or nil");
4123 Vx_resource_name
= name
;
4125 /* See if parent window is specified. */
4126 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4127 if (EQ (parent
, Qunbound
))
4129 if (! NILP (parent
))
4130 CHECK_NUMBER (parent
, 0);
4132 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4133 /* No need to protect DISPLAY because that's not used after passing
4134 it to make_frame_without_minibuffer. */
4136 GCPRO4 (parms
, parent
, name
, frame
);
4137 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4139 if (EQ (tem
, Qnone
) || NILP (tem
))
4140 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4141 else if (EQ (tem
, Qonly
))
4143 f
= make_minibuffer_frame ();
4144 minibuffer_only
= 1;
4146 else if (WINDOWP (tem
))
4147 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4151 XSETFRAME (frame
, f
);
4153 /* Note that X Windows does support scroll bars. */
4154 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4156 f
->output_method
= output_x_window
;
4157 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4158 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4159 f
->output_data
.x
->icon_bitmap
= -1;
4160 f
->output_data
.x
->fontset
= -1;
4161 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4162 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4163 record_unwind_protect (unwind_create_frame
, frame
);
4166 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4168 if (! STRINGP (f
->icon_name
))
4169 f
->icon_name
= Qnil
;
4171 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4173 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4174 dpyinfo_refcount
= dpyinfo
->reference_count
;
4175 #endif /* GLYPH_DEBUG */
4177 FRAME_KBOARD (f
) = kb
;
4180 /* These colors will be set anyway later, but it's important
4181 to get the color reference counts right, so initialize them! */
4184 struct gcpro gcpro1
;
4186 /* Function x_decode_color can signal an error. Make
4187 sure to initialize color slots so that we won't try
4188 to free colors we haven't allocated. */
4189 f
->output_data
.x
->foreground_pixel
= -1;
4190 f
->output_data
.x
->background_pixel
= -1;
4191 f
->output_data
.x
->cursor_pixel
= -1;
4192 f
->output_data
.x
->cursor_foreground_pixel
= -1;
4193 f
->output_data
.x
->border_pixel
= -1;
4194 f
->output_data
.x
->mouse_pixel
= -1;
4196 black
= build_string ("black");
4198 f
->output_data
.x
->foreground_pixel
4199 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4200 f
->output_data
.x
->background_pixel
4201 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4202 f
->output_data
.x
->cursor_pixel
4203 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4204 f
->output_data
.x
->cursor_foreground_pixel
4205 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4206 f
->output_data
.x
->border_pixel
4207 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4208 f
->output_data
.x
->mouse_pixel
4209 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4213 /* Specify the parent under which to make this X window. */
4217 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4218 f
->output_data
.x
->explicit_parent
= 1;
4222 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4223 f
->output_data
.x
->explicit_parent
= 0;
4226 /* Set the name; the functions to which we pass f expect the name to
4228 if (EQ (name
, Qunbound
) || NILP (name
))
4230 f
->name
= build_string (dpyinfo
->x_id_name
);
4231 f
->explicit_name
= 0;
4236 f
->explicit_name
= 1;
4237 /* use the frame's title when getting resources for this frame. */
4238 specbind (Qx_resource_name
, name
);
4241 /* Extract the window parameters from the supplied values
4242 that are needed to determine window geometry. */
4246 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4249 /* First, try whatever font the caller has specified. */
4252 tem
= Fquery_fontset (font
, Qnil
);
4254 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4256 font
= x_new_font (f
, XSTRING (font
)->data
);
4259 /* Try out a font which we hope has bold and italic variations. */
4260 if (!STRINGP (font
))
4261 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4262 if (!STRINGP (font
))
4263 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4264 if (! STRINGP (font
))
4265 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4266 if (! STRINGP (font
))
4267 /* This was formerly the first thing tried, but it finds too many fonts
4268 and takes too long. */
4269 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4270 /* If those didn't work, look for something which will at least work. */
4271 if (! STRINGP (font
))
4272 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4274 if (! STRINGP (font
))
4275 font
= build_string ("fixed");
4277 x_default_parameter (f
, parms
, Qfont
, font
,
4278 "font", "Font", RES_TYPE_STRING
);
4282 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4283 whereby it fails to get any font. */
4284 xlwmenu_default_font
= f
->output_data
.x
->font
;
4287 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4288 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4290 /* This defaults to 2 in order to match xterm. We recognize either
4291 internalBorderWidth or internalBorder (which is what xterm calls
4293 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4297 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4298 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4299 if (! EQ (value
, Qunbound
))
4300 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4303 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4304 "internalBorderWidth", "internalBorderWidth",
4306 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4307 "verticalScrollBars", "ScrollBars",
4310 /* Also do the stuff which must be set before the window exists. */
4311 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4312 "foreground", "Foreground", RES_TYPE_STRING
);
4313 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4314 "background", "Background", RES_TYPE_STRING
);
4315 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4316 "pointerColor", "Foreground", RES_TYPE_STRING
);
4317 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4318 "cursorColor", "Foreground", RES_TYPE_STRING
);
4319 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4320 "borderColor", "BorderColor", RES_TYPE_STRING
);
4321 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4322 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4323 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4324 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4326 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4327 "scrollBarForeground",
4328 "ScrollBarForeground", 1);
4329 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4330 "scrollBarBackground",
4331 "ScrollBarBackground", 0);
4333 /* Init faces before x_default_parameter is called for scroll-bar
4334 parameters because that function calls x_set_scroll_bar_width,
4335 which calls change_frame_size, which calls Fset_window_buffer,
4336 which runs hooks, which call Fvertical_motion. At the end, we
4337 end up in init_iterator with a null face cache, which should not
4339 init_frame_faces (f
);
4341 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4342 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4343 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4344 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4345 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4346 "bufferPredicate", "BufferPredicate",
4348 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4349 "title", "Title", RES_TYPE_STRING
);
4350 x_default_parameter (f
, parms
, Qwait_for_wm
, Qt
,
4351 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN
);
4353 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4355 /* Add the tool-bar height to the initial frame height so that the
4356 user gets a text display area of the size he specified with -g or
4357 via .Xdefaults. Later changes of the tool-bar height don't
4358 change the frame size. This is done so that users can create
4359 tall Emacs frames without having to guess how tall the tool-bar
4361 if (FRAME_TOOL_BAR_LINES (f
))
4363 int margin
, relief
, bar_height
;
4365 relief
= (tool_bar_button_relief
> 0
4366 ? tool_bar_button_relief
4367 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4369 if (INTEGERP (Vtool_bar_button_margin
)
4370 && XINT (Vtool_bar_button_margin
) > 0)
4371 margin
= XFASTINT (Vtool_bar_button_margin
);
4372 else if (CONSP (Vtool_bar_button_margin
)
4373 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4374 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4375 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4379 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4380 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4383 /* Compute the size of the X window. */
4384 window_prompting
= x_figure_window_size (f
, parms
);
4386 if (window_prompting
& XNegative
)
4388 if (window_prompting
& YNegative
)
4389 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4391 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4395 if (window_prompting
& YNegative
)
4396 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4398 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4401 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4403 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4404 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4406 /* Create the X widget or window. */
4407 #ifdef USE_X_TOOLKIT
4408 x_window (f
, window_prompting
, minibuffer_only
);
4416 /* Now consider the frame official. */
4417 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4418 Vframe_list
= Fcons (frame
, Vframe_list
);
4420 /* We need to do this after creating the X window, so that the
4421 icon-creation functions can say whose icon they're describing. */
4422 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4423 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4425 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4426 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4427 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4428 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4429 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4430 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4431 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4432 "scrollBarWidth", "ScrollBarWidth",
4435 /* Dimensions, especially f->height, must be done via change_frame_size.
4436 Change will not be effected unless different from the current
4442 SET_FRAME_WIDTH (f
, 0);
4443 change_frame_size (f
, height
, width
, 1, 0, 0);
4445 /* Set up faces after all frame parameters are known. This call
4446 also merges in face attributes specified for new frames. If we
4447 don't do this, the `menu' face for instance won't have the right
4448 colors, and the menu bar won't appear in the specified colors for
4450 call1 (Qface_set_after_frame_default
, frame
);
4452 #ifdef USE_X_TOOLKIT
4453 /* Create the menu bar. */
4454 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4456 /* If this signals an error, we haven't set size hints for the
4457 frame and we didn't make it visible. */
4458 initialize_frame_menubar (f
);
4460 /* This is a no-op, except under Motif where it arranges the
4461 main window for the widgets on it. */
4462 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4463 f
->output_data
.x
->menubar_widget
,
4464 f
->output_data
.x
->edit_widget
);
4466 #endif /* USE_X_TOOLKIT */
4468 /* Tell the server what size and position, etc, we want, and how
4469 badly we want them. This should be done after we have the menu
4470 bar so that its size can be taken into account. */
4472 x_wm_set_size_hint (f
, window_prompting
, 0);
4475 /* Make the window appear on the frame and enable display, unless
4476 the caller says not to. However, with explicit parent, Emacs
4477 cannot control visibility, so don't try. */
4478 if (! f
->output_data
.x
->explicit_parent
)
4480 Lisp_Object visibility
;
4482 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4484 if (EQ (visibility
, Qunbound
))
4487 if (EQ (visibility
, Qicon
))
4488 x_iconify_frame (f
);
4489 else if (! NILP (visibility
))
4490 x_make_frame_visible (f
);
4492 /* Must have been Qnil. */
4498 /* Make sure windows on this frame appear in calls to next-window
4499 and similar functions. */
4500 Vwindow_list
= Qnil
;
4502 return unbind_to (count
, frame
);
4506 /* FRAME is used only to get a handle on the X display. We don't pass the
4507 display info directly because we're called from frame.c, which doesn't
4508 know about that structure. */
4511 x_get_focus_frame (frame
)
4512 struct frame
*frame
;
4514 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4516 if (! dpyinfo
->x_focus_frame
)
4519 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4524 /* In certain situations, when the window manager follows a
4525 click-to-focus policy, there seems to be no way around calling
4526 XSetInputFocus to give another frame the input focus .
4528 In an ideal world, XSetInputFocus should generally be avoided so
4529 that applications don't interfere with the window manager's focus
4530 policy. But I think it's okay to use when it's clearly done
4531 following a user-command. */
4533 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4534 "Set the input focus to FRAME.\n\
4535 FRAME nil means use the selected frame.")
4539 struct frame
*f
= check_x_frame (frame
);
4540 Display
*dpy
= FRAME_X_DISPLAY (f
);
4544 count
= x_catch_errors (dpy
);
4545 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4546 RevertToParent
, CurrentTime
);
4547 x_uncatch_errors (dpy
, count
);
4554 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4555 "Internal function called by `color-defined-p', which see.")
4557 Lisp_Object color
, frame
;
4560 FRAME_PTR f
= check_x_frame (frame
);
4562 CHECK_STRING (color
, 1);
4564 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4570 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4571 "Internal function called by `color-values', which see.")
4573 Lisp_Object color
, frame
;
4576 FRAME_PTR f
= check_x_frame (frame
);
4578 CHECK_STRING (color
, 1);
4580 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4584 rgb
[0] = make_number (foo
.red
);
4585 rgb
[1] = make_number (foo
.green
);
4586 rgb
[2] = make_number (foo
.blue
);
4587 return Flist (3, rgb
);
4593 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4594 "Internal function called by `display-color-p', which see.")
4596 Lisp_Object display
;
4598 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4600 if (dpyinfo
->n_planes
<= 2)
4603 switch (dpyinfo
->visual
->class)
4616 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4618 "Return t if the X display supports shades of gray.\n\
4619 Note that color displays do support shades of gray.\n\
4620 The optional argument DISPLAY specifies which display to ask about.\n\
4621 DISPLAY should be either a frame or a display name (a string).\n\
4622 If omitted or nil, that stands for the selected frame's display.")
4624 Lisp_Object display
;
4626 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4628 if (dpyinfo
->n_planes
<= 1)
4631 switch (dpyinfo
->visual
->class)
4646 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4648 "Returns the width in pixels of the X display DISPLAY.\n\
4649 The optional argument DISPLAY specifies which display to ask about.\n\
4650 DISPLAY should be either a frame or a display name (a string).\n\
4651 If omitted or nil, that stands for the selected frame's display.")
4653 Lisp_Object display
;
4655 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4657 return make_number (dpyinfo
->width
);
4660 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4661 Sx_display_pixel_height
, 0, 1, 0,
4662 "Returns the height in pixels of the X display DISPLAY.\n\
4663 The optional argument DISPLAY specifies which display to ask about.\n\
4664 DISPLAY should be either a frame or a display name (a string).\n\
4665 If omitted or nil, that stands for the selected frame's display.")
4667 Lisp_Object display
;
4669 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4671 return make_number (dpyinfo
->height
);
4674 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4676 "Returns the number of bitplanes of the X display DISPLAY.\n\
4677 The optional argument DISPLAY specifies which display to ask about.\n\
4678 DISPLAY should be either a frame or a display name (a string).\n\
4679 If omitted or nil, that stands for the selected frame's display.")
4681 Lisp_Object display
;
4683 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4685 return make_number (dpyinfo
->n_planes
);
4688 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4690 "Returns the number of color cells of the X display DISPLAY.\n\
4691 The optional argument DISPLAY specifies which display to ask about.\n\
4692 DISPLAY should be either a frame or a display name (a string).\n\
4693 If omitted or nil, that stands for the selected frame's display.")
4695 Lisp_Object display
;
4697 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4699 return make_number (DisplayCells (dpyinfo
->display
,
4700 XScreenNumberOfScreen (dpyinfo
->screen
)));
4703 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4704 Sx_server_max_request_size
,
4706 "Returns the maximum request size of the X server of display DISPLAY.\n\
4707 The optional argument DISPLAY specifies which display to ask about.\n\
4708 DISPLAY should be either a frame or a display name (a string).\n\
4709 If omitted or nil, that stands for the selected frame's display.")
4711 Lisp_Object display
;
4713 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4715 return make_number (MAXREQUEST (dpyinfo
->display
));
4718 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4719 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4720 The optional argument DISPLAY specifies which display to ask about.\n\
4721 DISPLAY should be either a frame or a display name (a string).\n\
4722 If omitted or nil, that stands for the selected frame's display.")
4724 Lisp_Object display
;
4726 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4727 char *vendor
= ServerVendor (dpyinfo
->display
);
4729 if (! vendor
) vendor
= "";
4730 return build_string (vendor
);
4733 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4734 "Returns the version numbers of the X server of display DISPLAY.\n\
4735 The value is a list of three integers: the major and minor\n\
4736 version numbers of the X Protocol in use, and the vendor-specific release\n\
4737 number. See also the function `x-server-vendor'.\n\n\
4738 The optional argument DISPLAY specifies which display to ask about.\n\
4739 DISPLAY should be either a frame or a display name (a string).\n\
4740 If omitted or nil, that stands for the selected frame's display.")
4742 Lisp_Object display
;
4744 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4745 Display
*dpy
= dpyinfo
->display
;
4747 return Fcons (make_number (ProtocolVersion (dpy
)),
4748 Fcons (make_number (ProtocolRevision (dpy
)),
4749 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4752 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4753 "Returns the number of screens on the X server of display DISPLAY.\n\
4754 The optional argument DISPLAY specifies which display to ask about.\n\
4755 DISPLAY should be either a frame or a display name (a string).\n\
4756 If omitted or nil, that stands for the selected frame's display.")
4758 Lisp_Object display
;
4760 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4762 return make_number (ScreenCount (dpyinfo
->display
));
4765 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4766 "Returns the height in millimeters of the X display DISPLAY.\n\
4767 The optional argument DISPLAY specifies which display to ask about.\n\
4768 DISPLAY should be either a frame or a display name (a string).\n\
4769 If omitted or nil, that stands for the selected frame's display.")
4771 Lisp_Object display
;
4773 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4775 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4778 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4779 "Returns the width in millimeters of the X display DISPLAY.\n\
4780 The optional argument DISPLAY specifies which display to ask about.\n\
4781 DISPLAY should be either a frame or a display name (a string).\n\
4782 If omitted or nil, that stands for the selected frame's display.")
4784 Lisp_Object display
;
4786 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4788 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4791 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4792 Sx_display_backing_store
, 0, 1, 0,
4793 "Returns an indication of whether X display DISPLAY does backing store.\n\
4794 The value may be `always', `when-mapped', or `not-useful'.\n\
4795 The optional argument DISPLAY specifies which display to ask about.\n\
4796 DISPLAY should be either a frame or a display name (a string).\n\
4797 If omitted or nil, that stands for the selected frame's display.")
4799 Lisp_Object display
;
4801 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4804 switch (DoesBackingStore (dpyinfo
->screen
))
4807 result
= intern ("always");
4811 result
= intern ("when-mapped");
4815 result
= intern ("not-useful");
4819 error ("Strange value for BackingStore parameter of screen");
4826 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4827 Sx_display_visual_class
, 0, 1, 0,
4828 "Returns the visual class of the X display DISPLAY.\n\
4829 The value is one of the symbols `static-gray', `gray-scale',\n\
4830 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4831 The optional argument DISPLAY specifies which display to ask about.\n\
4832 DISPLAY should be either a frame or a display name (a string).\n\
4833 If omitted or nil, that stands for the selected frame's display.")
4835 Lisp_Object display
;
4837 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4840 switch (dpyinfo
->visual
->class)
4843 result
= intern ("static-gray");
4846 result
= intern ("gray-scale");
4849 result
= intern ("static-color");
4852 result
= intern ("pseudo-color");
4855 result
= intern ("true-color");
4858 result
= intern ("direct-color");
4861 error ("Display has an unknown visual class");
4868 DEFUN ("x-display-save-under", Fx_display_save_under
,
4869 Sx_display_save_under
, 0, 1, 0,
4870 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4871 The optional argument DISPLAY specifies which display to ask about.\n\
4872 DISPLAY should be either a frame or a display name (a string).\n\
4873 If omitted or nil, that stands for the selected frame's display.")
4875 Lisp_Object display
;
4877 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4879 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4887 register struct frame
*f
;
4889 return PIXEL_WIDTH (f
);
4894 register struct frame
*f
;
4896 return PIXEL_HEIGHT (f
);
4901 register struct frame
*f
;
4903 return FONT_WIDTH (f
->output_data
.x
->font
);
4908 register struct frame
*f
;
4910 return f
->output_data
.x
->line_height
;
4915 register struct frame
*f
;
4917 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4922 /************************************************************************
4924 ************************************************************************/
4927 /* Mapping visual names to visuals. */
4929 static struct visual_class
4936 {"StaticGray", StaticGray
},
4937 {"GrayScale", GrayScale
},
4938 {"StaticColor", StaticColor
},
4939 {"PseudoColor", PseudoColor
},
4940 {"TrueColor", TrueColor
},
4941 {"DirectColor", DirectColor
},
4946 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4948 /* Value is the screen number of screen SCR. This is a substitute for
4949 the X function with the same name when that doesn't exist. */
4952 XScreenNumberOfScreen (scr
)
4953 register Screen
*scr
;
4955 Display
*dpy
= scr
->display
;
4958 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4959 if (scr
== dpy
->screens
[i
])
4965 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4968 /* Select the visual that should be used on display DPYINFO. Set
4969 members of DPYINFO appropriately. Called from x_term_init. */
4972 select_visual (dpyinfo
)
4973 struct x_display_info
*dpyinfo
;
4975 Display
*dpy
= dpyinfo
->display
;
4976 Screen
*screen
= dpyinfo
->screen
;
4979 /* See if a visual is specified. */
4980 value
= display_x_get_resource (dpyinfo
,
4981 build_string ("visualClass"),
4982 build_string ("VisualClass"),
4984 if (STRINGP (value
))
4986 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4987 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4988 depth, a decimal number. NAME is compared with case ignored. */
4989 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4994 strcpy (s
, XSTRING (value
)->data
);
4995 dash
= index (s
, '-');
4998 dpyinfo
->n_planes
= atoi (dash
+ 1);
5002 /* We won't find a matching visual with depth 0, so that
5003 an error will be printed below. */
5004 dpyinfo
->n_planes
= 0;
5006 /* Determine the visual class. */
5007 for (i
= 0; visual_classes
[i
].name
; ++i
)
5008 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
5010 class = visual_classes
[i
].class;
5014 /* Look up a matching visual for the specified class. */
5016 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
5017 dpyinfo
->n_planes
, class, &vinfo
))
5018 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
5020 dpyinfo
->visual
= vinfo
.visual
;
5025 XVisualInfo
*vinfo
, vinfo_template
;
5027 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
5030 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
5032 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
5034 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5035 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
5036 &vinfo_template
, &n_visuals
);
5038 fatal ("Can't get proper X visual info");
5040 dpyinfo
->n_planes
= vinfo
->depth
;
5041 XFree ((char *) vinfo
);
5046 /* Return the X display structure for the display named NAME.
5047 Open a new connection if necessary. */
5049 struct x_display_info
*
5050 x_display_info_for_name (name
)
5054 struct x_display_info
*dpyinfo
;
5056 CHECK_STRING (name
, 0);
5058 if (! EQ (Vwindow_system
, intern ("x")))
5059 error ("Not using X Windows");
5061 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5063 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5066 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5071 /* Use this general default value to start with. */
5072 Vx_resource_name
= Vinvocation_name
;
5074 validate_x_resource_name ();
5076 dpyinfo
= x_term_init (name
, (char *)0,
5077 (char *) XSTRING (Vx_resource_name
)->data
);
5080 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5083 XSETFASTINT (Vwindow_system_version
, 11);
5089 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5090 1, 3, 0, "Open a connection to an X server.\n\
5091 DISPLAY is the name of the display to connect to.\n\
5092 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5093 If the optional third arg MUST-SUCCEED is non-nil,\n\
5094 terminate Emacs if we can't open the connection.")
5095 (display
, xrm_string
, must_succeed
)
5096 Lisp_Object display
, xrm_string
, must_succeed
;
5098 unsigned char *xrm_option
;
5099 struct x_display_info
*dpyinfo
;
5101 CHECK_STRING (display
, 0);
5102 if (! NILP (xrm_string
))
5103 CHECK_STRING (xrm_string
, 1);
5105 if (! EQ (Vwindow_system
, intern ("x")))
5106 error ("Not using X Windows");
5108 if (! NILP (xrm_string
))
5109 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5111 xrm_option
= (unsigned char *) 0;
5113 validate_x_resource_name ();
5115 /* This is what opens the connection and sets x_current_display.
5116 This also initializes many symbols, such as those used for input. */
5117 dpyinfo
= x_term_init (display
, xrm_option
,
5118 (char *) XSTRING (Vx_resource_name
)->data
);
5122 if (!NILP (must_succeed
))
5123 fatal ("Cannot connect to X server %s.\n\
5124 Check the DISPLAY environment variable or use `-d'.\n\
5125 Also use the `xhost' program to verify that it is set to permit\n\
5126 connections from your machine.\n",
5127 XSTRING (display
)->data
);
5129 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5134 XSETFASTINT (Vwindow_system_version
, 11);
5138 DEFUN ("x-close-connection", Fx_close_connection
,
5139 Sx_close_connection
, 1, 1, 0,
5140 "Close the connection to DISPLAY's X server.\n\
5141 For DISPLAY, specify either a frame or a display name (a string).\n\
5142 If DISPLAY is nil, that stands for the selected frame's display.")
5144 Lisp_Object display
;
5146 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5149 if (dpyinfo
->reference_count
> 0)
5150 error ("Display still has frames on it");
5153 /* Free the fonts in the font table. */
5154 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5155 if (dpyinfo
->font_table
[i
].name
)
5157 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5158 xfree (dpyinfo
->font_table
[i
].full_name
);
5159 xfree (dpyinfo
->font_table
[i
].name
);
5160 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5163 x_destroy_all_bitmaps (dpyinfo
);
5164 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5166 #ifdef USE_X_TOOLKIT
5167 XtCloseDisplay (dpyinfo
->display
);
5169 XCloseDisplay (dpyinfo
->display
);
5172 x_delete_display (dpyinfo
);
5178 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5179 "Return the list of display names that Emacs has connections to.")
5182 Lisp_Object tail
, result
;
5185 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5186 result
= Fcons (XCAR (XCAR (tail
)), result
);
5191 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5192 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5193 If ON is nil, allow buffering of requests.\n\
5194 Turning on synchronization prohibits the Xlib routines from buffering\n\
5195 requests and seriously degrades performance, but makes debugging much\n\
5197 The optional second argument DISPLAY specifies which display to act on.\n\
5198 DISPLAY should be either a frame or a display name (a string).\n\
5199 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5201 Lisp_Object display
, on
;
5203 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5205 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5210 /* Wait for responses to all X commands issued so far for frame F. */
5217 XSync (FRAME_X_DISPLAY (f
), False
);
5222 /***********************************************************************
5224 ***********************************************************************/
5226 /* Value is the number of elements of vector VECTOR. */
5228 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5230 /* List of supported image types. Use define_image_type to add new
5231 types. Use lookup_image_type to find a type for a given symbol. */
5233 static struct image_type
*image_types
;
5235 /* The symbol `image' which is the car of the lists used to represent
5238 extern Lisp_Object Qimage
;
5240 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5246 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5247 extern Lisp_Object QCdata
;
5248 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5249 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5250 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5252 /* Other symbols. */
5254 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5256 /* Time in seconds after which images should be removed from the cache
5257 if not displayed. */
5259 Lisp_Object Vimage_cache_eviction_delay
;
5261 /* Function prototypes. */
5263 static void define_image_type
P_ ((struct image_type
*type
));
5264 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5265 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5266 static void x_laplace
P_ ((struct frame
*, struct image
*));
5267 static void x_emboss
P_ ((struct frame
*, struct image
*));
5268 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5272 /* Define a new image type from TYPE. This adds a copy of TYPE to
5273 image_types and adds the symbol *TYPE->type to Vimage_types. */
5276 define_image_type (type
)
5277 struct image_type
*type
;
5279 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5280 The initialized data segment is read-only. */
5281 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5282 bcopy (type
, p
, sizeof *p
);
5283 p
->next
= image_types
;
5285 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5289 /* Look up image type SYMBOL, and return a pointer to its image_type
5290 structure. Value is null if SYMBOL is not a known image type. */
5292 static INLINE
struct image_type
*
5293 lookup_image_type (symbol
)
5296 struct image_type
*type
;
5298 for (type
= image_types
; type
; type
= type
->next
)
5299 if (EQ (symbol
, *type
->type
))
5306 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5307 valid image specification is a list whose car is the symbol
5308 `image', and whose rest is a property list. The property list must
5309 contain a value for key `:type'. That value must be the name of a
5310 supported image type. The rest of the property list depends on the
5314 valid_image_p (object
)
5319 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5323 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
5324 if (EQ (XCAR (tem
), QCtype
))
5327 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
5329 struct image_type
*type
;
5330 type
= lookup_image_type (XCAR (tem
));
5332 valid_p
= type
->valid_p (object
);
5343 /* Log error message with format string FORMAT and argument ARG.
5344 Signaling an error, e.g. when an image cannot be loaded, is not a
5345 good idea because this would interrupt redisplay, and the error
5346 message display would lead to another redisplay. This function
5347 therefore simply displays a message. */
5350 image_error (format
, arg1
, arg2
)
5352 Lisp_Object arg1
, arg2
;
5354 add_to_log (format
, arg1
, arg2
);
5359 /***********************************************************************
5360 Image specifications
5361 ***********************************************************************/
5363 enum image_value_type
5365 IMAGE_DONT_CHECK_VALUE_TYPE
,
5367 IMAGE_STRING_OR_NIL_VALUE
,
5369 IMAGE_POSITIVE_INTEGER_VALUE
,
5370 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5371 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5373 IMAGE_INTEGER_VALUE
,
5374 IMAGE_FUNCTION_VALUE
,
5379 /* Structure used when parsing image specifications. */
5381 struct image_keyword
5383 /* Name of keyword. */
5386 /* The type of value allowed. */
5387 enum image_value_type type
;
5389 /* Non-zero means key must be present. */
5392 /* Used to recognize duplicate keywords in a property list. */
5395 /* The value that was found. */
5400 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5402 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5405 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5406 has the format (image KEYWORD VALUE ...). One of the keyword/
5407 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5408 image_keywords structures of size NKEYWORDS describing other
5409 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5412 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5414 struct image_keyword
*keywords
;
5421 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5424 plist
= XCDR (spec
);
5425 while (CONSP (plist
))
5427 Lisp_Object key
, value
;
5429 /* First element of a pair must be a symbol. */
5431 plist
= XCDR (plist
);
5435 /* There must follow a value. */
5438 value
= XCAR (plist
);
5439 plist
= XCDR (plist
);
5441 /* Find key in KEYWORDS. Error if not found. */
5442 for (i
= 0; i
< nkeywords
; ++i
)
5443 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5449 /* Record that we recognized the keyword. If a keywords
5450 was found more than once, it's an error. */
5451 keywords
[i
].value
= value
;
5452 ++keywords
[i
].count
;
5454 if (keywords
[i
].count
> 1)
5457 /* Check type of value against allowed type. */
5458 switch (keywords
[i
].type
)
5460 case IMAGE_STRING_VALUE
:
5461 if (!STRINGP (value
))
5465 case IMAGE_STRING_OR_NIL_VALUE
:
5466 if (!STRINGP (value
) && !NILP (value
))
5470 case IMAGE_SYMBOL_VALUE
:
5471 if (!SYMBOLP (value
))
5475 case IMAGE_POSITIVE_INTEGER_VALUE
:
5476 if (!INTEGERP (value
) || XINT (value
) <= 0)
5480 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5481 if (INTEGERP (value
) && XINT (value
) >= 0)
5484 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5485 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5489 case IMAGE_ASCENT_VALUE
:
5490 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5492 else if (INTEGERP (value
)
5493 && XINT (value
) >= 0
5494 && XINT (value
) <= 100)
5498 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5499 if (!INTEGERP (value
) || XINT (value
) < 0)
5503 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5506 case IMAGE_FUNCTION_VALUE
:
5507 value
= indirect_function (value
);
5509 || COMPILEDP (value
)
5510 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5514 case IMAGE_NUMBER_VALUE
:
5515 if (!INTEGERP (value
) && !FLOATP (value
))
5519 case IMAGE_INTEGER_VALUE
:
5520 if (!INTEGERP (value
))
5524 case IMAGE_BOOL_VALUE
:
5525 if (!NILP (value
) && !EQ (value
, Qt
))
5534 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5538 /* Check that all mandatory fields are present. */
5539 for (i
= 0; i
< nkeywords
; ++i
)
5540 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5543 return NILP (plist
);
5547 /* Return the value of KEY in image specification SPEC. Value is nil
5548 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5549 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5552 image_spec_value (spec
, key
, found
)
5553 Lisp_Object spec
, key
;
5558 xassert (valid_image_p (spec
));
5560 for (tail
= XCDR (spec
);
5561 CONSP (tail
) && CONSP (XCDR (tail
));
5562 tail
= XCDR (XCDR (tail
)))
5564 if (EQ (XCAR (tail
), key
))
5568 return XCAR (XCDR (tail
));
5578 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5579 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5580 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5581 size in canonical character units.\n\
5582 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5583 or omitted means use the selected frame.")
5584 (spec
, pixels
, frame
)
5585 Lisp_Object spec
, pixels
, frame
;
5590 if (valid_image_p (spec
))
5592 struct frame
*f
= check_x_frame (frame
);
5593 int id
= lookup_image (f
, spec
);
5594 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5595 int width
= img
->width
+ 2 * img
->hmargin
;
5596 int height
= img
->height
+ 2 * img
->vmargin
;
5599 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5600 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5602 size
= Fcons (make_number (width
), make_number (height
));
5605 error ("Invalid image specification");
5611 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5612 "Return t if image SPEC has a mask bitmap.\n\
5613 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5614 or omitted means use the selected frame.")
5616 Lisp_Object spec
, frame
;
5621 if (valid_image_p (spec
))
5623 struct frame
*f
= check_x_frame (frame
);
5624 int id
= lookup_image (f
, spec
);
5625 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5630 error ("Invalid image specification");
5637 /***********************************************************************
5638 Image type independent image structures
5639 ***********************************************************************/
5641 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5642 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5645 /* Allocate and return a new image structure for image specification
5646 SPEC. SPEC has a hash value of HASH. */
5648 static struct image
*
5649 make_image (spec
, hash
)
5653 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5655 xassert (valid_image_p (spec
));
5656 bzero (img
, sizeof *img
);
5657 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5658 xassert (img
->type
!= NULL
);
5660 img
->data
.lisp_val
= Qnil
;
5661 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5667 /* Free image IMG which was used on frame F, including its resources. */
5676 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5678 /* Remove IMG from the hash table of its cache. */
5680 img
->prev
->next
= img
->next
;
5682 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5685 img
->next
->prev
= img
->prev
;
5687 c
->images
[img
->id
] = NULL
;
5689 /* Free resources, then free IMG. */
5690 img
->type
->free (f
, img
);
5696 /* Prepare image IMG for display on frame F. Must be called before
5697 drawing an image. */
5700 prepare_image_for_display (f
, img
)
5706 /* We're about to display IMG, so set its timestamp to `now'. */
5708 img
->timestamp
= EMACS_SECS (t
);
5710 /* If IMG doesn't have a pixmap yet, load it now, using the image
5711 type dependent loader function. */
5712 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5713 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5717 /* Value is the number of pixels for the ascent of image IMG when
5718 drawn in face FACE. */
5721 image_ascent (img
, face
)
5725 int height
= img
->height
+ img
->vmargin
;
5728 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5731 /* This expression is arranged so that if the image can't be
5732 exactly centered, it will be moved slightly up. This is
5733 because a typical font is `top-heavy' (due to the presence
5734 uppercase letters), so the image placement should err towards
5735 being top-heavy too. It also just generally looks better. */
5736 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5738 ascent
= height
/ 2;
5741 ascent
= height
* img
->ascent
/ 100.0;
5748 /***********************************************************************
5749 Helper functions for X image types
5750 ***********************************************************************/
5752 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5754 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5755 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5757 Lisp_Object color_name
,
5758 unsigned long dflt
));
5761 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5762 free the pixmap if any. MASK_P non-zero means clear the mask
5763 pixmap if any. COLORS_P non-zero means free colors allocated for
5764 the image, if any. */
5767 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5770 int pixmap_p
, mask_p
, colors_p
;
5772 if (pixmap_p
&& img
->pixmap
)
5774 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5778 if (mask_p
&& img
->mask
)
5780 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5784 if (colors_p
&& img
->ncolors
)
5786 x_free_colors (f
, img
->colors
, img
->ncolors
);
5787 xfree (img
->colors
);
5793 /* Free X resources of image IMG which is used on frame F. */
5796 x_clear_image (f
, img
)
5801 x_clear_image_1 (f
, img
, 1, 1, 1);
5806 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5807 cannot be allocated, use DFLT. Add a newly allocated color to
5808 IMG->colors, so that it can be freed again. Value is the pixel
5811 static unsigned long
5812 x_alloc_image_color (f
, img
, color_name
, dflt
)
5815 Lisp_Object color_name
;
5819 unsigned long result
;
5821 xassert (STRINGP (color_name
));
5823 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5825 /* This isn't called frequently so we get away with simply
5826 reallocating the color vector to the needed size, here. */
5829 (unsigned long *) xrealloc (img
->colors
,
5830 img
->ncolors
* sizeof *img
->colors
);
5831 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5832 result
= color
.pixel
;
5842 /***********************************************************************
5844 ***********************************************************************/
5846 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5847 static void postprocess_image
P_ ((struct frame
*, struct image
*));
5850 /* Return a new, initialized image cache that is allocated from the
5851 heap. Call free_image_cache to free an image cache. */
5853 struct image_cache
*
5856 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5859 bzero (c
, sizeof *c
);
5861 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5862 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5863 c
->buckets
= (struct image
**) xmalloc (size
);
5864 bzero (c
->buckets
, size
);
5869 /* Free image cache of frame F. Be aware that X frames share images
5873 free_image_cache (f
)
5876 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5881 /* Cache should not be referenced by any frame when freed. */
5882 xassert (c
->refcount
== 0);
5884 for (i
= 0; i
< c
->used
; ++i
)
5885 free_image (f
, c
->images
[i
]);
5889 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5894 /* Clear image cache of frame F. FORCE_P non-zero means free all
5895 images. FORCE_P zero means clear only images that haven't been
5896 displayed for some time. Should be called from time to time to
5897 reduce the number of loaded images. If image-eviction-seconds is
5898 non-nil, this frees images in the cache which weren't displayed for
5899 at least that many seconds. */
5902 clear_image_cache (f
, force_p
)
5906 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5908 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5915 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5917 /* Block input so that we won't be interrupted by a SIGIO
5918 while being in an inconsistent state. */
5921 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5923 struct image
*img
= c
->images
[i
];
5925 && (force_p
|| img
->timestamp
< old
))
5927 free_image (f
, img
);
5932 /* We may be clearing the image cache because, for example,
5933 Emacs was iconified for a longer period of time. In that
5934 case, current matrices may still contain references to
5935 images freed above. So, clear these matrices. */
5938 Lisp_Object tail
, frame
;
5940 FOR_EACH_FRAME (tail
, frame
)
5942 struct frame
*f
= XFRAME (frame
);
5944 && FRAME_X_IMAGE_CACHE (f
) == c
)
5945 clear_current_matrices (f
);
5948 ++windows_or_buffers_changed
;
5956 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5958 "Clear the image cache of FRAME.\n\
5959 FRAME nil or omitted means use the selected frame.\n\
5960 FRAME t means clear the image caches of all frames.")
5968 FOR_EACH_FRAME (tail
, frame
)
5969 if (FRAME_X_P (XFRAME (frame
)))
5970 clear_image_cache (XFRAME (frame
), 1);
5973 clear_image_cache (check_x_frame (frame
), 1);
5979 /* Compute masks and transform image IMG on frame F, as specified
5980 by the image's specification, */
5983 postprocess_image (f
, img
)
5987 /* Manipulation of the image's mask. */
5990 Lisp_Object conversion
, spec
;
5995 /* `:heuristic-mask t'
5997 means build a mask heuristically.
5998 `:heuristic-mask (R G B)'
5999 `:mask (heuristic (R G B))'
6000 means build a mask from color (R G B) in the
6003 means remove a mask, if any. */
6005 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6007 x_build_heuristic_mask (f
, img
, mask
);
6012 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6014 if (EQ (mask
, Qheuristic
))
6015 x_build_heuristic_mask (f
, img
, Qt
);
6016 else if (CONSP (mask
)
6017 && EQ (XCAR (mask
), Qheuristic
))
6019 if (CONSP (XCDR (mask
)))
6020 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6022 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6024 else if (NILP (mask
) && found_p
&& img
->mask
)
6026 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6032 /* Should we apply an image transformation algorithm? */
6033 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6034 if (EQ (conversion
, Qdisabled
))
6035 x_disable_image (f
, img
);
6036 else if (EQ (conversion
, Qlaplace
))
6038 else if (EQ (conversion
, Qemboss
))
6040 else if (CONSP (conversion
)
6041 && EQ (XCAR (conversion
), Qedge_detection
))
6044 tem
= XCDR (conversion
);
6046 x_edge_detection (f
, img
,
6047 Fplist_get (tem
, QCmatrix
),
6048 Fplist_get (tem
, QCcolor_adjustment
));
6054 /* Return the id of image with Lisp specification SPEC on frame F.
6055 SPEC must be a valid Lisp image specification (see valid_image_p). */
6058 lookup_image (f
, spec
)
6062 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6066 struct gcpro gcpro1
;
6069 /* F must be a window-system frame, and SPEC must be a valid image
6071 xassert (FRAME_WINDOW_P (f
));
6072 xassert (valid_image_p (spec
));
6076 /* Look up SPEC in the hash table of the image cache. */
6077 hash
= sxhash (spec
, 0);
6078 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6080 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6081 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6084 /* If not found, create a new image and cache it. */
6087 extern Lisp_Object Qpostscript
;
6090 img
= make_image (spec
, hash
);
6091 cache_image (f
, img
);
6092 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6094 /* If we can't load the image, and we don't have a width and
6095 height, use some arbitrary width and height so that we can
6096 draw a rectangle for it. */
6097 if (img
->load_failed_p
)
6101 value
= image_spec_value (spec
, QCwidth
, NULL
);
6102 img
->width
= (INTEGERP (value
)
6103 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6104 value
= image_spec_value (spec
, QCheight
, NULL
);
6105 img
->height
= (INTEGERP (value
)
6106 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6110 /* Handle image type independent image attributes
6111 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
6112 Lisp_Object ascent
, margin
, relief
;
6114 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6115 if (INTEGERP (ascent
))
6116 img
->ascent
= XFASTINT (ascent
);
6117 else if (EQ (ascent
, Qcenter
))
6118 img
->ascent
= CENTERED_IMAGE_ASCENT
;
6120 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6121 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6122 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
6123 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
6124 && INTEGERP (XCDR (margin
)))
6126 if (XINT (XCAR (margin
)) > 0)
6127 img
->hmargin
= XFASTINT (XCAR (margin
));
6128 if (XINT (XCDR (margin
)) > 0)
6129 img
->vmargin
= XFASTINT (XCDR (margin
));
6132 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6133 if (INTEGERP (relief
))
6135 img
->relief
= XINT (relief
);
6136 img
->hmargin
+= abs (img
->relief
);
6137 img
->vmargin
+= abs (img
->relief
);
6140 /* Do image transformations and compute masks, unless we
6141 don't have the image yet. */
6142 if (!EQ (*img
->type
->type
, Qpostscript
))
6143 postprocess_image (f
, img
);
6147 xassert (!interrupt_input_blocked
);
6150 /* We're using IMG, so set its timestamp to `now'. */
6151 EMACS_GET_TIME (now
);
6152 img
->timestamp
= EMACS_SECS (now
);
6156 /* Value is the image id. */
6161 /* Cache image IMG in the image cache of frame F. */
6164 cache_image (f
, img
)
6168 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6171 /* Find a free slot in c->images. */
6172 for (i
= 0; i
< c
->used
; ++i
)
6173 if (c
->images
[i
] == NULL
)
6176 /* If no free slot found, maybe enlarge c->images. */
6177 if (i
== c
->used
&& c
->used
== c
->size
)
6180 c
->images
= (struct image
**) xrealloc (c
->images
,
6181 c
->size
* sizeof *c
->images
);
6184 /* Add IMG to c->images, and assign IMG an id. */
6190 /* Add IMG to the cache's hash table. */
6191 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6192 img
->next
= c
->buckets
[i
];
6194 img
->next
->prev
= img
;
6196 c
->buckets
[i
] = img
;
6200 /* Call FN on every image in the image cache of frame F. Used to mark
6201 Lisp Objects in the image cache. */
6204 forall_images_in_image_cache (f
, fn
)
6206 void (*fn
) P_ ((struct image
*img
));
6208 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6210 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6214 for (i
= 0; i
< c
->used
; ++i
)
6223 /***********************************************************************
6225 ***********************************************************************/
6227 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6228 XImage
**, Pixmap
*));
6229 static void x_destroy_x_image
P_ ((XImage
*));
6230 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6233 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6234 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6235 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6236 via xmalloc. Print error messages via image_error if an error
6237 occurs. Value is non-zero if successful. */
6240 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6242 int width
, height
, depth
;
6246 Display
*display
= FRAME_X_DISPLAY (f
);
6247 Screen
*screen
= FRAME_X_SCREEN (f
);
6248 Window window
= FRAME_X_WINDOW (f
);
6250 xassert (interrupt_input_blocked
);
6253 depth
= DefaultDepthOfScreen (screen
);
6254 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6255 depth
, ZPixmap
, 0, NULL
, width
, height
,
6256 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6259 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6263 /* Allocate image raster. */
6264 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6266 /* Allocate a pixmap of the same size. */
6267 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6268 if (*pixmap
== None
)
6270 x_destroy_x_image (*ximg
);
6272 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6280 /* Destroy XImage XIMG. Free XIMG->data. */
6283 x_destroy_x_image (ximg
)
6286 xassert (interrupt_input_blocked
);
6291 XDestroyImage (ximg
);
6296 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6297 are width and height of both the image and pixmap. */
6300 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6307 xassert (interrupt_input_blocked
);
6308 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6309 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6310 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6315 /***********************************************************************
6317 ***********************************************************************/
6319 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6320 static char *slurp_file
P_ ((char *, int *));
6323 /* Find image file FILE. Look in data-directory, then
6324 x-bitmap-file-path. Value is the full name of the file found, or
6325 nil if not found. */
6328 x_find_image_file (file
)
6331 Lisp_Object file_found
, search_path
;
6332 struct gcpro gcpro1
, gcpro2
;
6336 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6337 GCPRO2 (file_found
, search_path
);
6339 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6340 fd
= openp (search_path
, file
, "", &file_found
, 0);
6352 /* Read FILE into memory. Value is a pointer to a buffer allocated
6353 with xmalloc holding FILE's contents. Value is null if an error
6354 occurred. *SIZE is set to the size of the file. */
6357 slurp_file (file
, size
)
6365 if (stat (file
, &st
) == 0
6366 && (fp
= fopen (file
, "r")) != NULL
6367 && (buf
= (char *) xmalloc (st
.st_size
),
6368 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6389 /***********************************************************************
6391 ***********************************************************************/
6393 static int xbm_scan
P_ ((char **, char *, char *, int *));
6394 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6395 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6397 static int xbm_image_p
P_ ((Lisp_Object object
));
6398 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6400 static int xbm_file_p
P_ ((Lisp_Object
));
6403 /* Indices of image specification fields in xbm_format, below. */
6405 enum xbm_keyword_index
6423 /* Vector of image_keyword structures describing the format
6424 of valid XBM image specifications. */
6426 static struct image_keyword xbm_format
[XBM_LAST
] =
6428 {":type", IMAGE_SYMBOL_VALUE
, 1},
6429 {":file", IMAGE_STRING_VALUE
, 0},
6430 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6431 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6432 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6433 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
6434 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
6435 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6436 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6437 {":relief", IMAGE_INTEGER_VALUE
, 0},
6438 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6439 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6440 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6443 /* Structure describing the image type XBM. */
6445 static struct image_type xbm_type
=
6454 /* Tokens returned from xbm_scan. */
6463 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6464 A valid specification is a list starting with the symbol `image'
6465 The rest of the list is a property list which must contain an
6468 If the specification specifies a file to load, it must contain
6469 an entry `:file FILENAME' where FILENAME is a string.
6471 If the specification is for a bitmap loaded from memory it must
6472 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6473 WIDTH and HEIGHT are integers > 0. DATA may be:
6475 1. a string large enough to hold the bitmap data, i.e. it must
6476 have a size >= (WIDTH + 7) / 8 * HEIGHT
6478 2. a bool-vector of size >= WIDTH * HEIGHT
6480 3. a vector of strings or bool-vectors, one for each line of the
6483 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6484 may not be specified in this case because they are defined in the
6487 Both the file and data forms may contain the additional entries
6488 `:background COLOR' and `:foreground COLOR'. If not present,
6489 foreground and background of the frame on which the image is
6490 displayed is used. */
6493 xbm_image_p (object
)
6496 struct image_keyword kw
[XBM_LAST
];
6498 bcopy (xbm_format
, kw
, sizeof kw
);
6499 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6502 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6504 if (kw
[XBM_FILE
].count
)
6506 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6509 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6511 /* In-memory XBM file. */
6512 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6520 /* Entries for `:width', `:height' and `:data' must be present. */
6521 if (!kw
[XBM_WIDTH
].count
6522 || !kw
[XBM_HEIGHT
].count
6523 || !kw
[XBM_DATA
].count
)
6526 data
= kw
[XBM_DATA
].value
;
6527 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6528 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6530 /* Check type of data, and width and height against contents of
6536 /* Number of elements of the vector must be >= height. */
6537 if (XVECTOR (data
)->size
< height
)
6540 /* Each string or bool-vector in data must be large enough
6541 for one line of the image. */
6542 for (i
= 0; i
< height
; ++i
)
6544 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6548 if (XSTRING (elt
)->size
6549 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6552 else if (BOOL_VECTOR_P (elt
))
6554 if (XBOOL_VECTOR (elt
)->size
< width
)
6561 else if (STRINGP (data
))
6563 if (XSTRING (data
)->size
6564 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6567 else if (BOOL_VECTOR_P (data
))
6569 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6580 /* Scan a bitmap file. FP is the stream to read from. Value is
6581 either an enumerator from enum xbm_token, or a character for a
6582 single-character token, or 0 at end of file. If scanning an
6583 identifier, store the lexeme of the identifier in SVAL. If
6584 scanning a number, store its value in *IVAL. */
6587 xbm_scan (s
, end
, sval
, ival
)
6596 /* Skip white space. */
6597 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6602 else if (isdigit (c
))
6604 int value
= 0, digit
;
6606 if (c
== '0' && *s
< end
)
6609 if (c
== 'x' || c
== 'X')
6616 else if (c
>= 'a' && c
<= 'f')
6617 digit
= c
- 'a' + 10;
6618 else if (c
>= 'A' && c
<= 'F')
6619 digit
= c
- 'A' + 10;
6622 value
= 16 * value
+ digit
;
6625 else if (isdigit (c
))
6629 && (c
= *(*s
)++, isdigit (c
)))
6630 value
= 8 * value
+ c
- '0';
6637 && (c
= *(*s
)++, isdigit (c
)))
6638 value
= 10 * value
+ c
- '0';
6646 else if (isalpha (c
) || c
== '_')
6650 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6657 else if (c
== '/' && **s
== '*')
6659 /* C-style comment. */
6661 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6674 /* Replacement for XReadBitmapFileData which isn't available under old
6675 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6676 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6677 the image. Return in *DATA the bitmap data allocated with xmalloc.
6678 Value is non-zero if successful. DATA null means just test if
6679 CONTENTS looks like an in-memory XBM file. */
6682 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6683 char *contents
, *end
;
6684 int *width
, *height
;
6685 unsigned char **data
;
6688 char buffer
[BUFSIZ
];
6691 int bytes_per_line
, i
, nbytes
;
6697 LA1 = xbm_scan (&s, end, buffer, &value)
6699 #define expect(TOKEN) \
6700 if (LA1 != (TOKEN)) \
6705 #define expect_ident(IDENT) \
6706 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6711 *width
= *height
= -1;
6714 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6716 /* Parse defines for width, height and hot-spots. */
6720 expect_ident ("define");
6721 expect (XBM_TK_IDENT
);
6723 if (LA1
== XBM_TK_NUMBER
);
6725 char *p
= strrchr (buffer
, '_');
6726 p
= p
? p
+ 1 : buffer
;
6727 if (strcmp (p
, "width") == 0)
6729 else if (strcmp (p
, "height") == 0)
6732 expect (XBM_TK_NUMBER
);
6735 if (*width
< 0 || *height
< 0)
6737 else if (data
== NULL
)
6740 /* Parse bits. Must start with `static'. */
6741 expect_ident ("static");
6742 if (LA1
== XBM_TK_IDENT
)
6744 if (strcmp (buffer
, "unsigned") == 0)
6747 expect_ident ("char");
6749 else if (strcmp (buffer
, "short") == 0)
6753 if (*width
% 16 && *width
% 16 < 9)
6756 else if (strcmp (buffer
, "char") == 0)
6764 expect (XBM_TK_IDENT
);
6770 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6771 nbytes
= bytes_per_line
* *height
;
6772 p
= *data
= (char *) xmalloc (nbytes
);
6776 for (i
= 0; i
< nbytes
; i
+= 2)
6779 expect (XBM_TK_NUMBER
);
6782 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6785 if (LA1
== ',' || LA1
== '}')
6793 for (i
= 0; i
< nbytes
; ++i
)
6796 expect (XBM_TK_NUMBER
);
6800 if (LA1
== ',' || LA1
== '}')
6825 /* Load XBM image IMG which will be displayed on frame F from buffer
6826 CONTENTS. END is the end of the buffer. Value is non-zero if
6830 xbm_load_image (f
, img
, contents
, end
)
6833 char *contents
, *end
;
6836 unsigned char *data
;
6839 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6842 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6843 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6844 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6847 xassert (img
->width
> 0 && img
->height
> 0);
6849 /* Get foreground and background colors, maybe allocate colors. */
6850 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6852 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6854 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6856 background
= x_alloc_image_color (f
, img
, value
, background
);
6859 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6862 img
->width
, img
->height
,
6863 foreground
, background
,
6867 if (img
->pixmap
== None
)
6869 x_clear_image (f
, img
);
6870 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6876 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6882 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6889 return (STRINGP (data
)
6890 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6891 (XSTRING (data
)->data
6892 + STRING_BYTES (XSTRING (data
))),
6897 /* Fill image IMG which is used on frame F with pixmap data. Value is
6898 non-zero if successful. */
6906 Lisp_Object file_name
;
6908 xassert (xbm_image_p (img
->spec
));
6910 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6911 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6912 if (STRINGP (file_name
))
6917 struct gcpro gcpro1
;
6919 file
= x_find_image_file (file_name
);
6921 if (!STRINGP (file
))
6923 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6928 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6929 if (contents
== NULL
)
6931 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6936 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6941 struct image_keyword fmt
[XBM_LAST
];
6944 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6945 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6948 int in_memory_file_p
= 0;
6950 /* See if data looks like an in-memory XBM file. */
6951 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6952 in_memory_file_p
= xbm_file_p (data
);
6954 /* Parse the image specification. */
6955 bcopy (xbm_format
, fmt
, sizeof fmt
);
6956 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6959 /* Get specified width, and height. */
6960 if (!in_memory_file_p
)
6962 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6963 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6964 xassert (img
->width
> 0 && img
->height
> 0);
6967 /* Get foreground and background colors, maybe allocate colors. */
6968 if (fmt
[XBM_FOREGROUND
].count
6969 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
6970 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6972 if (fmt
[XBM_BACKGROUND
].count
6973 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
6974 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6977 if (in_memory_file_p
)
6978 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6979 (XSTRING (data
)->data
6980 + STRING_BYTES (XSTRING (data
))));
6987 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6989 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6990 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6992 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6994 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6996 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6999 else if (STRINGP (data
))
7000 bits
= XSTRING (data
)->data
;
7002 bits
= XBOOL_VECTOR (data
)->data
;
7004 /* Create the pixmap. */
7005 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7007 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7010 img
->width
, img
->height
,
7011 foreground
, background
,
7017 image_error ("Unable to create pixmap for XBM image `%s'",
7019 x_clear_image (f
, img
);
7029 /***********************************************************************
7031 ***********************************************************************/
7035 static int xpm_image_p
P_ ((Lisp_Object object
));
7036 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
7037 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
7039 #include "X11/xpm.h"
7041 /* The symbol `xpm' identifying XPM-format images. */
7045 /* Indices of image specification fields in xpm_format, below. */
7047 enum xpm_keyword_index
7062 /* Vector of image_keyword structures describing the format
7063 of valid XPM image specifications. */
7065 static struct image_keyword xpm_format
[XPM_LAST
] =
7067 {":type", IMAGE_SYMBOL_VALUE
, 1},
7068 {":file", IMAGE_STRING_VALUE
, 0},
7069 {":data", IMAGE_STRING_VALUE
, 0},
7070 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7071 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7072 {":relief", IMAGE_INTEGER_VALUE
, 0},
7073 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7074 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7075 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7076 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7079 /* Structure describing the image type XBM. */
7081 static struct image_type xpm_type
=
7091 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7092 functions for allocating image colors. Our own functions handle
7093 color allocation failures more gracefully than the ones on the XPM
7096 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7097 #define ALLOC_XPM_COLORS
7100 #ifdef ALLOC_XPM_COLORS
7102 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7103 static void xpm_free_color_cache
P_ ((void));
7104 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7105 static int xpm_color_bucket
P_ ((char *));
7106 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7109 /* An entry in a hash table used to cache color definitions of named
7110 colors. This cache is necessary to speed up XPM image loading in
7111 case we do color allocations ourselves. Without it, we would need
7112 a call to XParseColor per pixel in the image. */
7114 struct xpm_cached_color
7116 /* Next in collision chain. */
7117 struct xpm_cached_color
*next
;
7119 /* Color definition (RGB and pixel color). */
7126 /* The hash table used for the color cache, and its bucket vector
7129 #define XPM_COLOR_CACHE_BUCKETS 1001
7130 struct xpm_cached_color
**xpm_color_cache
;
7132 /* Initialize the color cache. */
7135 xpm_init_color_cache (f
, attrs
)
7137 XpmAttributes
*attrs
;
7139 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7140 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7141 memset (xpm_color_cache
, 0, nbytes
);
7142 init_color_table ();
7144 if (attrs
->valuemask
& XpmColorSymbols
)
7149 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7150 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7151 attrs
->colorsymbols
[i
].value
, &color
))
7153 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7155 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7161 /* Free the color cache. */
7164 xpm_free_color_cache ()
7166 struct xpm_cached_color
*p
, *next
;
7169 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7170 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7176 xfree (xpm_color_cache
);
7177 xpm_color_cache
= NULL
;
7178 free_color_table ();
7182 /* Return the bucket index for color named COLOR_NAME in the color
7186 xpm_color_bucket (color_name
)
7192 for (s
= color_name
; *s
; ++s
)
7194 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7198 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7199 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7202 static struct xpm_cached_color
*
7203 xpm_cache_color (f
, color_name
, color
, bucket
)
7210 struct xpm_cached_color
*p
;
7213 bucket
= xpm_color_bucket (color_name
);
7215 nbytes
= sizeof *p
+ strlen (color_name
);
7216 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7217 strcpy (p
->name
, color_name
);
7219 p
->next
= xpm_color_cache
[bucket
];
7220 xpm_color_cache
[bucket
] = p
;
7225 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7226 return the cached definition in *COLOR. Otherwise, make a new
7227 entry in the cache and allocate the color. Value is zero if color
7228 allocation failed. */
7231 xpm_lookup_color (f
, color_name
, color
)
7236 struct xpm_cached_color
*p
;
7237 int h
= xpm_color_bucket (color_name
);
7239 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7240 if (strcmp (p
->name
, color_name
) == 0)
7245 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7248 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7250 p
= xpm_cache_color (f
, color_name
, color
, h
);
7257 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7258 CLOSURE is a pointer to the frame on which we allocate the
7259 color. Return in *COLOR the allocated color. Value is non-zero
7263 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7270 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7274 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7275 is a pointer to the frame on which we allocate the color. Value is
7276 non-zero if successful. */
7279 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7289 #endif /* ALLOC_XPM_COLORS */
7292 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7293 for XPM images. Such a list must consist of conses whose car and
7297 xpm_valid_color_symbols_p (color_symbols
)
7298 Lisp_Object color_symbols
;
7300 while (CONSP (color_symbols
))
7302 Lisp_Object sym
= XCAR (color_symbols
);
7304 || !STRINGP (XCAR (sym
))
7305 || !STRINGP (XCDR (sym
)))
7307 color_symbols
= XCDR (color_symbols
);
7310 return NILP (color_symbols
);
7314 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7317 xpm_image_p (object
)
7320 struct image_keyword fmt
[XPM_LAST
];
7321 bcopy (xpm_format
, fmt
, sizeof fmt
);
7322 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7323 /* Either `:file' or `:data' must be present. */
7324 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7325 /* Either no `:color-symbols' or it's a list of conses
7326 whose car and cdr are strings. */
7327 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7328 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7332 /* Load image IMG which will be displayed on frame F. Value is
7333 non-zero if successful. */
7341 XpmAttributes attrs
;
7342 Lisp_Object specified_file
, color_symbols
;
7344 /* Configure the XPM lib. Use the visual of frame F. Allocate
7345 close colors. Return colors allocated. */
7346 bzero (&attrs
, sizeof attrs
);
7347 attrs
.visual
= FRAME_X_VISUAL (f
);
7348 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7349 attrs
.valuemask
|= XpmVisual
;
7350 attrs
.valuemask
|= XpmColormap
;
7352 #ifdef ALLOC_XPM_COLORS
7353 /* Allocate colors with our own functions which handle
7354 failing color allocation more gracefully. */
7355 attrs
.color_closure
= f
;
7356 attrs
.alloc_color
= xpm_alloc_color
;
7357 attrs
.free_colors
= xpm_free_colors
;
7358 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7359 #else /* not ALLOC_XPM_COLORS */
7360 /* Let the XPM lib allocate colors. */
7361 attrs
.valuemask
|= XpmReturnAllocPixels
;
7362 #ifdef XpmAllocCloseColors
7363 attrs
.alloc_close_colors
= 1;
7364 attrs
.valuemask
|= XpmAllocCloseColors
;
7365 #else /* not XpmAllocCloseColors */
7366 attrs
.closeness
= 600;
7367 attrs
.valuemask
|= XpmCloseness
;
7368 #endif /* not XpmAllocCloseColors */
7369 #endif /* ALLOC_XPM_COLORS */
7371 /* If image specification contains symbolic color definitions, add
7372 these to `attrs'. */
7373 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7374 if (CONSP (color_symbols
))
7377 XpmColorSymbol
*xpm_syms
;
7380 attrs
.valuemask
|= XpmColorSymbols
;
7382 /* Count number of symbols. */
7383 attrs
.numsymbols
= 0;
7384 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7387 /* Allocate an XpmColorSymbol array. */
7388 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7389 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7390 bzero (xpm_syms
, size
);
7391 attrs
.colorsymbols
= xpm_syms
;
7393 /* Fill the color symbol array. */
7394 for (tail
= color_symbols
, i
= 0;
7396 ++i
, tail
= XCDR (tail
))
7398 Lisp_Object name
= XCAR (XCAR (tail
));
7399 Lisp_Object color
= XCDR (XCAR (tail
));
7400 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7401 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7402 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7403 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7407 /* Create a pixmap for the image, either from a file, or from a
7408 string buffer containing data in the same format as an XPM file. */
7409 #ifdef ALLOC_XPM_COLORS
7410 xpm_init_color_cache (f
, &attrs
);
7413 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7414 if (STRINGP (specified_file
))
7416 Lisp_Object file
= x_find_image_file (specified_file
);
7417 if (!STRINGP (file
))
7419 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7423 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7424 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7429 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7430 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7431 XSTRING (buffer
)->data
,
7432 &img
->pixmap
, &img
->mask
,
7436 if (rc
== XpmSuccess
)
7438 #ifdef ALLOC_XPM_COLORS
7439 img
->colors
= colors_in_color_table (&img
->ncolors
);
7440 #else /* not ALLOC_XPM_COLORS */
7443 img
->ncolors
= attrs
.nalloc_pixels
;
7444 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7445 * sizeof *img
->colors
);
7446 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7448 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7449 #ifdef DEBUG_X_COLORS
7450 register_color (img
->colors
[i
]);
7453 #endif /* not ALLOC_XPM_COLORS */
7455 img
->width
= attrs
.width
;
7456 img
->height
= attrs
.height
;
7457 xassert (img
->width
> 0 && img
->height
> 0);
7459 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7460 XpmFreeAttributes (&attrs
);
7467 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7470 case XpmFileInvalid
:
7471 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7475 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7478 case XpmColorFailed
:
7479 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7483 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7488 #ifdef ALLOC_XPM_COLORS
7489 xpm_free_color_cache ();
7491 return rc
== XpmSuccess
;
7494 #endif /* HAVE_XPM != 0 */
7497 /***********************************************************************
7499 ***********************************************************************/
7501 /* An entry in the color table mapping an RGB color to a pixel color. */
7506 unsigned long pixel
;
7508 /* Next in color table collision list. */
7509 struct ct_color
*next
;
7512 /* The bucket vector size to use. Must be prime. */
7516 /* Value is a hash of the RGB color given by R, G, and B. */
7518 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7520 /* The color hash table. */
7522 struct ct_color
**ct_table
;
7524 /* Number of entries in the color table. */
7526 int ct_colors_allocated
;
7528 /* Initialize the color table. */
7533 int size
= CT_SIZE
* sizeof (*ct_table
);
7534 ct_table
= (struct ct_color
**) xmalloc (size
);
7535 bzero (ct_table
, size
);
7536 ct_colors_allocated
= 0;
7540 /* Free memory associated with the color table. */
7546 struct ct_color
*p
, *next
;
7548 for (i
= 0; i
< CT_SIZE
; ++i
)
7549 for (p
= ct_table
[i
]; p
; p
= next
)
7560 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7561 entry for that color already is in the color table, return the
7562 pixel color of that entry. Otherwise, allocate a new color for R,
7563 G, B, and make an entry in the color table. */
7565 static unsigned long
7566 lookup_rgb_color (f
, r
, g
, b
)
7570 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7571 int i
= hash
% CT_SIZE
;
7574 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7575 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7588 cmap
= FRAME_X_COLORMAP (f
);
7589 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7593 ++ct_colors_allocated
;
7595 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7599 p
->pixel
= color
.pixel
;
7600 p
->next
= ct_table
[i
];
7604 return FRAME_FOREGROUND_PIXEL (f
);
7611 /* Look up pixel color PIXEL which is used on frame F in the color
7612 table. If not already present, allocate it. Value is PIXEL. */
7614 static unsigned long
7615 lookup_pixel_color (f
, pixel
)
7617 unsigned long pixel
;
7619 int i
= pixel
% CT_SIZE
;
7622 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7623 if (p
->pixel
== pixel
)
7632 cmap
= FRAME_X_COLORMAP (f
);
7633 color
.pixel
= pixel
;
7634 x_query_color (f
, &color
);
7635 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7639 ++ct_colors_allocated
;
7641 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7646 p
->next
= ct_table
[i
];
7650 return FRAME_FOREGROUND_PIXEL (f
);
7657 /* Value is a vector of all pixel colors contained in the color table,
7658 allocated via xmalloc. Set *N to the number of colors. */
7660 static unsigned long *
7661 colors_in_color_table (n
)
7666 unsigned long *colors
;
7668 if (ct_colors_allocated
== 0)
7675 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7677 *n
= ct_colors_allocated
;
7679 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7680 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7681 colors
[j
++] = p
->pixel
;
7689 /***********************************************************************
7691 ***********************************************************************/
7693 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7694 int, XImage
*, int));
7695 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7696 XColor
*, int, XImage
*, int));
7697 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7698 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7699 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7701 /* Non-zero means draw a cross on images having `:conversion
7704 int cross_disabled_images
;
7706 /* Edge detection matrices for different edge-detection
7709 static int emboss_matrix
[9] = {
7711 2, -1, 0, /* y - 1 */
7713 0, 1, -2 /* y + 1 */
7716 static int laplace_matrix
[9] = {
7718 1, 0, 0, /* y - 1 */
7720 0, 0, -1 /* y + 1 */
7723 /* Value is the intensity of the color whose red/green/blue values
7726 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7729 /* On frame F, return an array of XColor structures describing image
7730 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7731 non-zero means also fill the red/green/blue members of the XColor
7732 structures. Value is a pointer to the array of XColors structures,
7733 allocated with xmalloc; it must be freed by the caller. */
7736 x_to_xcolors (f
, img
, rgb_p
)
7745 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7747 /* Get the X image IMG->pixmap. */
7748 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7749 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7751 /* Fill the `pixel' members of the XColor array. I wished there
7752 were an easy and portable way to circumvent XGetPixel. */
7754 for (y
= 0; y
< img
->height
; ++y
)
7758 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7759 p
->pixel
= XGetPixel (ximg
, x
, y
);
7762 x_query_colors (f
, row
, img
->width
);
7765 XDestroyImage (ximg
);
7770 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7771 RGB members are set. F is the frame on which this all happens.
7772 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7775 x_from_xcolors (f
, img
, colors
)
7785 init_color_table ();
7787 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7790 for (y
= 0; y
< img
->height
; ++y
)
7791 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7793 unsigned long pixel
;
7794 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7795 XPutPixel (oimg
, x
, y
, pixel
);
7799 x_clear_image_1 (f
, img
, 1, 0, 1);
7801 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7802 x_destroy_x_image (oimg
);
7803 img
->pixmap
= pixmap
;
7804 img
->colors
= colors_in_color_table (&img
->ncolors
);
7805 free_color_table ();
7809 /* On frame F, perform edge-detection on image IMG.
7811 MATRIX is a nine-element array specifying the transformation
7812 matrix. See emboss_matrix for an example.
7814 COLOR_ADJUST is a color adjustment added to each pixel of the
7818 x_detect_edges (f
, img
, matrix
, color_adjust
)
7821 int matrix
[9], color_adjust
;
7823 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7827 for (i
= sum
= 0; i
< 9; ++i
)
7828 sum
+= abs (matrix
[i
]);
7830 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7832 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7834 for (y
= 0; y
< img
->height
; ++y
)
7836 p
= COLOR (new, 0, y
);
7837 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7838 p
= COLOR (new, img
->width
- 1, y
);
7839 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7842 for (x
= 1; x
< img
->width
- 1; ++x
)
7844 p
= COLOR (new, x
, 0);
7845 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7846 p
= COLOR (new, x
, img
->height
- 1);
7847 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7850 for (y
= 1; y
< img
->height
- 1; ++y
)
7852 p
= COLOR (new, 1, y
);
7854 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7856 int r
, g
, b
, y1
, x1
;
7859 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7860 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7863 XColor
*t
= COLOR (colors
, x1
, y1
);
7864 r
+= matrix
[i
] * t
->red
;
7865 g
+= matrix
[i
] * t
->green
;
7866 b
+= matrix
[i
] * t
->blue
;
7869 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7870 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7871 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7872 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7877 x_from_xcolors (f
, img
, new);
7883 /* Perform the pre-defined `emboss' edge-detection on image IMG
7891 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7895 /* Perform the pre-defined `laplace' edge-detection on image IMG
7903 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7907 /* Perform edge-detection on image IMG on frame F, with specified
7908 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7910 MATRIX must be either
7912 - a list of at least 9 numbers in row-major form
7913 - a vector of at least 9 numbers
7915 COLOR_ADJUST nil means use a default; otherwise it must be a
7919 x_edge_detection (f
, img
, matrix
, color_adjust
)
7922 Lisp_Object matrix
, color_adjust
;
7930 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7931 ++i
, matrix
= XCDR (matrix
))
7932 trans
[i
] = XFLOATINT (XCAR (matrix
));
7934 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7936 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7937 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7940 if (NILP (color_adjust
))
7941 color_adjust
= make_number (0xffff / 2);
7943 if (i
== 9 && NUMBERP (color_adjust
))
7944 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7948 /* Transform image IMG on frame F so that it looks disabled. */
7951 x_disable_image (f
, img
)
7955 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7957 if (dpyinfo
->n_planes
>= 2)
7959 /* Color (or grayscale). Convert to gray, and equalize. Just
7960 drawing such images with a stipple can look very odd, so
7961 we're using this method instead. */
7962 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7964 const int h
= 15000;
7965 const int l
= 30000;
7967 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7971 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7972 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7973 p
->red
= p
->green
= p
->blue
= i2
;
7976 x_from_xcolors (f
, img
, colors
);
7979 /* Draw a cross over the disabled image, if we must or if we
7981 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
7983 Display
*dpy
= FRAME_X_DISPLAY (f
);
7986 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
7987 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
7988 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
7989 img
->width
- 1, img
->height
- 1);
7990 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
7996 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
7997 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
7998 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
7999 img
->width
- 1, img
->height
- 1);
8000 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
8008 /* Build a mask for image IMG which is used on frame F. FILE is the
8009 name of an image file, for error messages. HOW determines how to
8010 determine the background color of IMG. If it is a list '(R G B)',
8011 with R, G, and B being integers >= 0, take that as the color of the
8012 background. Otherwise, determine the background color of IMG
8013 heuristically. Value is non-zero if successful. */
8016 x_build_heuristic_mask (f
, img
, how
)
8021 Display
*dpy
= FRAME_X_DISPLAY (f
);
8022 XImage
*ximg
, *mask_img
;
8023 int x
, y
, rc
, look_at_corners_p
;
8024 unsigned long bg
= 0;
8028 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8032 /* Create an image and pixmap serving as mask. */
8033 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
8034 &mask_img
, &img
->mask
);
8038 /* Get the X image of IMG->pixmap. */
8039 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
8042 /* Determine the background color of ximg. If HOW is `(R G B)'
8043 take that as color. Otherwise, try to determine the color
8045 look_at_corners_p
= 1;
8053 && NATNUMP (XCAR (how
)))
8055 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
8059 if (i
== 3 && NILP (how
))
8061 char color_name
[30];
8062 XColor exact
, color
;
8065 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
8067 cmap
= FRAME_X_COLORMAP (f
);
8068 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
8071 look_at_corners_p
= 0;
8076 if (look_at_corners_p
)
8078 unsigned long corners
[4];
8081 /* Get the colors at the corners of ximg. */
8082 corners
[0] = XGetPixel (ximg
, 0, 0);
8083 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
8084 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
8085 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
8087 /* Choose the most frequently found color as background. */
8088 for (i
= best_count
= 0; i
< 4; ++i
)
8092 for (j
= n
= 0; j
< 4; ++j
)
8093 if (corners
[i
] == corners
[j
])
8097 bg
= corners
[i
], best_count
= n
;
8101 /* Set all bits in mask_img to 1 whose color in ximg is different
8102 from the background color bg. */
8103 for (y
= 0; y
< img
->height
; ++y
)
8104 for (x
= 0; x
< img
->width
; ++x
)
8105 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8107 /* Put mask_img into img->mask. */
8108 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8109 x_destroy_x_image (mask_img
);
8110 XDestroyImage (ximg
);
8117 /***********************************************************************
8118 PBM (mono, gray, color)
8119 ***********************************************************************/
8121 static int pbm_image_p
P_ ((Lisp_Object object
));
8122 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8123 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8125 /* The symbol `pbm' identifying images of this type. */
8129 /* Indices of image specification fields in gs_format, below. */
8131 enum pbm_keyword_index
8147 /* Vector of image_keyword structures describing the format
8148 of valid user-defined image specifications. */
8150 static struct image_keyword pbm_format
[PBM_LAST
] =
8152 {":type", IMAGE_SYMBOL_VALUE
, 1},
8153 {":file", IMAGE_STRING_VALUE
, 0},
8154 {":data", IMAGE_STRING_VALUE
, 0},
8155 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8156 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8157 {":relief", IMAGE_INTEGER_VALUE
, 0},
8158 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8159 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8160 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8161 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8162 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8165 /* Structure describing the image type `pbm'. */
8167 static struct image_type pbm_type
=
8177 /* Return non-zero if OBJECT is a valid PBM image specification. */
8180 pbm_image_p (object
)
8183 struct image_keyword fmt
[PBM_LAST
];
8185 bcopy (pbm_format
, fmt
, sizeof fmt
);
8187 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8190 /* Must specify either :data or :file. */
8191 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8195 /* Scan a decimal number from *S and return it. Advance *S while
8196 reading the number. END is the end of the string. Value is -1 at
8200 pbm_scan_number (s
, end
)
8201 unsigned char **s
, *end
;
8203 int c
= 0, val
= -1;
8207 /* Skip white-space. */
8208 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8213 /* Skip comment to end of line. */
8214 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8217 else if (isdigit (c
))
8219 /* Read decimal number. */
8221 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8222 val
= 10 * val
+ c
- '0';
8233 /* Load PBM image IMG for use on frame F. */
8241 int width
, height
, max_color_idx
= 0;
8243 Lisp_Object file
, specified_file
;
8244 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8245 struct gcpro gcpro1
;
8246 unsigned char *contents
= NULL
;
8247 unsigned char *end
, *p
;
8250 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8254 if (STRINGP (specified_file
))
8256 file
= x_find_image_file (specified_file
);
8257 if (!STRINGP (file
))
8259 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8264 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8265 if (contents
== NULL
)
8267 image_error ("Error reading `%s'", file
, Qnil
);
8273 end
= contents
+ size
;
8278 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8279 p
= XSTRING (data
)->data
;
8280 end
= p
+ STRING_BYTES (XSTRING (data
));
8283 /* Check magic number. */
8284 if (end
- p
< 2 || *p
++ != 'P')
8286 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8296 raw_p
= 0, type
= PBM_MONO
;
8300 raw_p
= 0, type
= PBM_GRAY
;
8304 raw_p
= 0, type
= PBM_COLOR
;
8308 raw_p
= 1, type
= PBM_MONO
;
8312 raw_p
= 1, type
= PBM_GRAY
;
8316 raw_p
= 1, type
= PBM_COLOR
;
8320 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8324 /* Read width, height, maximum color-component. Characters
8325 starting with `#' up to the end of a line are ignored. */
8326 width
= pbm_scan_number (&p
, end
);
8327 height
= pbm_scan_number (&p
, end
);
8329 if (type
!= PBM_MONO
)
8331 max_color_idx
= pbm_scan_number (&p
, end
);
8332 if (raw_p
&& max_color_idx
> 255)
8333 max_color_idx
= 255;
8338 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8341 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8342 &ximg
, &img
->pixmap
))
8345 /* Initialize the color hash table. */
8346 init_color_table ();
8348 if (type
== PBM_MONO
)
8351 struct image_keyword fmt
[PBM_LAST
];
8352 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8353 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8355 /* Parse the image specification. */
8356 bcopy (pbm_format
, fmt
, sizeof fmt
);
8357 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8359 /* Get foreground and background colors, maybe allocate colors. */
8360 if (fmt
[PBM_FOREGROUND
].count
8361 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
8362 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8363 if (fmt
[PBM_BACKGROUND
].count
8364 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
8365 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8367 for (y
= 0; y
< height
; ++y
)
8368 for (x
= 0; x
< width
; ++x
)
8378 g
= pbm_scan_number (&p
, end
);
8380 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8385 for (y
= 0; y
< height
; ++y
)
8386 for (x
= 0; x
< width
; ++x
)
8390 if (type
== PBM_GRAY
)
8391 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8400 r
= pbm_scan_number (&p
, end
);
8401 g
= pbm_scan_number (&p
, end
);
8402 b
= pbm_scan_number (&p
, end
);
8405 if (r
< 0 || g
< 0 || b
< 0)
8409 XDestroyImage (ximg
);
8410 image_error ("Invalid pixel value in image `%s'",
8415 /* RGB values are now in the range 0..max_color_idx.
8416 Scale this to the range 0..0xffff supported by X. */
8417 r
= (double) r
* 65535 / max_color_idx
;
8418 g
= (double) g
* 65535 / max_color_idx
;
8419 b
= (double) b
* 65535 / max_color_idx
;
8420 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8424 /* Store in IMG->colors the colors allocated for the image, and
8425 free the color table. */
8426 img
->colors
= colors_in_color_table (&img
->ncolors
);
8427 free_color_table ();
8429 /* Put the image into a pixmap. */
8430 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8431 x_destroy_x_image (ximg
);
8434 img
->height
= height
;
8443 /***********************************************************************
8445 ***********************************************************************/
8451 /* Function prototypes. */
8453 static int png_image_p
P_ ((Lisp_Object object
));
8454 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8456 /* The symbol `png' identifying images of this type. */
8460 /* Indices of image specification fields in png_format, below. */
8462 enum png_keyword_index
8476 /* Vector of image_keyword structures describing the format
8477 of valid user-defined image specifications. */
8479 static struct image_keyword png_format
[PNG_LAST
] =
8481 {":type", IMAGE_SYMBOL_VALUE
, 1},
8482 {":data", IMAGE_STRING_VALUE
, 0},
8483 {":file", IMAGE_STRING_VALUE
, 0},
8484 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8485 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8486 {":relief", IMAGE_INTEGER_VALUE
, 0},
8487 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8488 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8489 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8492 /* Structure describing the image type `png'. */
8494 static struct image_type png_type
=
8504 /* Return non-zero if OBJECT is a valid PNG image specification. */
8507 png_image_p (object
)
8510 struct image_keyword fmt
[PNG_LAST
];
8511 bcopy (png_format
, fmt
, sizeof fmt
);
8513 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8516 /* Must specify either the :data or :file keyword. */
8517 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8521 /* Error and warning handlers installed when the PNG library
8525 my_png_error (png_ptr
, msg
)
8526 png_struct
*png_ptr
;
8529 xassert (png_ptr
!= NULL
);
8530 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8531 longjmp (png_ptr
->jmpbuf
, 1);
8536 my_png_warning (png_ptr
, msg
)
8537 png_struct
*png_ptr
;
8540 xassert (png_ptr
!= NULL
);
8541 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8544 /* Memory source for PNG decoding. */
8546 struct png_memory_storage
8548 unsigned char *bytes
; /* The data */
8549 size_t len
; /* How big is it? */
8550 int index
; /* Where are we? */
8554 /* Function set as reader function when reading PNG image from memory.
8555 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8556 bytes from the input to DATA. */
8559 png_read_from_memory (png_ptr
, data
, length
)
8560 png_structp png_ptr
;
8564 struct png_memory_storage
*tbr
8565 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8567 if (length
> tbr
->len
- tbr
->index
)
8568 png_error (png_ptr
, "Read error");
8570 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8571 tbr
->index
= tbr
->index
+ length
;
8574 /* Load PNG image IMG for use on frame F. Value is non-zero if
8582 Lisp_Object file
, specified_file
;
8583 Lisp_Object specified_data
;
8585 XImage
*ximg
, *mask_img
= NULL
;
8586 struct gcpro gcpro1
;
8587 png_struct
*png_ptr
= NULL
;
8588 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8589 FILE *volatile fp
= NULL
;
8591 png_byte
* volatile pixels
= NULL
;
8592 png_byte
** volatile rows
= NULL
;
8593 png_uint_32 width
, height
;
8594 int bit_depth
, color_type
, interlace_type
;
8596 png_uint_32 row_bytes
;
8599 double screen_gamma
, image_gamma
;
8601 struct png_memory_storage tbr
; /* Data to be read */
8603 /* Find out what file to load. */
8604 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8605 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8609 if (NILP (specified_data
))
8611 file
= x_find_image_file (specified_file
);
8612 if (!STRINGP (file
))
8614 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8619 /* Open the image file. */
8620 fp
= fopen (XSTRING (file
)->data
, "rb");
8623 image_error ("Cannot open image file `%s'", file
, Qnil
);
8629 /* Check PNG signature. */
8630 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8631 || !png_check_sig (sig
, sizeof sig
))
8633 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8641 /* Read from memory. */
8642 tbr
.bytes
= XSTRING (specified_data
)->data
;
8643 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8646 /* Check PNG signature. */
8647 if (tbr
.len
< sizeof sig
8648 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8650 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8655 /* Need to skip past the signature. */
8656 tbr
.bytes
+= sizeof (sig
);
8659 /* Initialize read and info structs for PNG lib. */
8660 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8661 my_png_error
, my_png_warning
);
8664 if (fp
) fclose (fp
);
8669 info_ptr
= png_create_info_struct (png_ptr
);
8672 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8673 if (fp
) fclose (fp
);
8678 end_info
= png_create_info_struct (png_ptr
);
8681 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8682 if (fp
) fclose (fp
);
8687 /* Set error jump-back. We come back here when the PNG library
8688 detects an error. */
8689 if (setjmp (png_ptr
->jmpbuf
))
8693 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8696 if (fp
) fclose (fp
);
8701 /* Read image info. */
8702 if (!NILP (specified_data
))
8703 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8705 png_init_io (png_ptr
, fp
);
8707 png_set_sig_bytes (png_ptr
, sizeof sig
);
8708 png_read_info (png_ptr
, info_ptr
);
8709 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8710 &interlace_type
, NULL
, NULL
);
8712 /* If image contains simply transparency data, we prefer to
8713 construct a clipping mask. */
8714 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8719 /* This function is easier to write if we only have to handle
8720 one data format: RGB or RGBA with 8 bits per channel. Let's
8721 transform other formats into that format. */
8723 /* Strip more than 8 bits per channel. */
8724 if (bit_depth
== 16)
8725 png_set_strip_16 (png_ptr
);
8727 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8729 png_set_expand (png_ptr
);
8731 /* Convert grayscale images to RGB. */
8732 if (color_type
== PNG_COLOR_TYPE_GRAY
8733 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8734 png_set_gray_to_rgb (png_ptr
);
8736 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8737 gamma_str
= getenv ("SCREEN_GAMMA");
8738 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8740 /* Tell the PNG lib to handle gamma correction for us. */
8742 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8743 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8744 /* There is a special chunk in the image specifying the gamma. */
8745 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8748 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8749 /* Image contains gamma information. */
8750 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8752 /* Use a default of 0.5 for the image gamma. */
8753 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8755 /* Handle alpha channel by combining the image with a background
8756 color. Do this only if a real alpha channel is supplied. For
8757 simple transparency, we prefer a clipping mask. */
8760 png_color_16
*image_background
;
8762 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8763 /* Image contains a background color with which to
8764 combine the image. */
8765 png_set_background (png_ptr
, image_background
,
8766 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8769 /* Image does not contain a background color with which
8770 to combine the image data via an alpha channel. Use
8771 the frame's background instead. */
8774 png_color_16 frame_background
;
8776 cmap
= FRAME_X_COLORMAP (f
);
8777 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8778 x_query_color (f
, &color
);
8780 bzero (&frame_background
, sizeof frame_background
);
8781 frame_background
.red
= color
.red
;
8782 frame_background
.green
= color
.green
;
8783 frame_background
.blue
= color
.blue
;
8785 png_set_background (png_ptr
, &frame_background
,
8786 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8790 /* Update info structure. */
8791 png_read_update_info (png_ptr
, info_ptr
);
8793 /* Get number of channels. Valid values are 1 for grayscale images
8794 and images with a palette, 2 for grayscale images with transparency
8795 information (alpha channel), 3 for RGB images, and 4 for RGB
8796 images with alpha channel, i.e. RGBA. If conversions above were
8797 sufficient we should only have 3 or 4 channels here. */
8798 channels
= png_get_channels (png_ptr
, info_ptr
);
8799 xassert (channels
== 3 || channels
== 4);
8801 /* Number of bytes needed for one row of the image. */
8802 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8804 /* Allocate memory for the image. */
8805 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8806 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8807 for (i
= 0; i
< height
; ++i
)
8808 rows
[i
] = pixels
+ i
* row_bytes
;
8810 /* Read the entire image. */
8811 png_read_image (png_ptr
, rows
);
8812 png_read_end (png_ptr
, info_ptr
);
8819 /* Create the X image and pixmap. */
8820 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8824 /* Create an image and pixmap serving as mask if the PNG image
8825 contains an alpha channel. */
8828 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8829 &mask_img
, &img
->mask
))
8831 x_destroy_x_image (ximg
);
8832 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8837 /* Fill the X image and mask from PNG data. */
8838 init_color_table ();
8840 for (y
= 0; y
< height
; ++y
)
8842 png_byte
*p
= rows
[y
];
8844 for (x
= 0; x
< width
; ++x
)
8851 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8853 /* An alpha channel, aka mask channel, associates variable
8854 transparency with an image. Where other image formats
8855 support binary transparency---fully transparent or fully
8856 opaque---PNG allows up to 254 levels of partial transparency.
8857 The PNG library implements partial transparency by combining
8858 the image with a specified background color.
8860 I'm not sure how to handle this here nicely: because the
8861 background on which the image is displayed may change, for
8862 real alpha channel support, it would be necessary to create
8863 a new image for each possible background.
8865 What I'm doing now is that a mask is created if we have
8866 boolean transparency information. Otherwise I'm using
8867 the frame's background color to combine the image with. */
8872 XPutPixel (mask_img
, x
, y
, *p
> 0);
8878 /* Remember colors allocated for this image. */
8879 img
->colors
= colors_in_color_table (&img
->ncolors
);
8880 free_color_table ();
8883 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8888 img
->height
= height
;
8890 /* Put the image into the pixmap, then free the X image and its buffer. */
8891 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8892 x_destroy_x_image (ximg
);
8894 /* Same for the mask. */
8897 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8898 x_destroy_x_image (mask_img
);
8905 #endif /* HAVE_PNG != 0 */
8909 /***********************************************************************
8911 ***********************************************************************/
8915 /* Work around a warning about HAVE_STDLIB_H being redefined in
8917 #ifdef HAVE_STDLIB_H
8918 #define HAVE_STDLIB_H_1
8919 #undef HAVE_STDLIB_H
8920 #endif /* HAVE_STLIB_H */
8922 #include <jpeglib.h>
8926 #ifdef HAVE_STLIB_H_1
8927 #define HAVE_STDLIB_H 1
8930 static int jpeg_image_p
P_ ((Lisp_Object object
));
8931 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8933 /* The symbol `jpeg' identifying images of this type. */
8937 /* Indices of image specification fields in gs_format, below. */
8939 enum jpeg_keyword_index
8948 JPEG_HEURISTIC_MASK
,
8953 /* Vector of image_keyword structures describing the format
8954 of valid user-defined image specifications. */
8956 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8958 {":type", IMAGE_SYMBOL_VALUE
, 1},
8959 {":data", IMAGE_STRING_VALUE
, 0},
8960 {":file", IMAGE_STRING_VALUE
, 0},
8961 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8962 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8963 {":relief", IMAGE_INTEGER_VALUE
, 0},
8964 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8965 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8966 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8969 /* Structure describing the image type `jpeg'. */
8971 static struct image_type jpeg_type
=
8981 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8984 jpeg_image_p (object
)
8987 struct image_keyword fmt
[JPEG_LAST
];
8989 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8991 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8994 /* Must specify either the :data or :file keyword. */
8995 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8999 struct my_jpeg_error_mgr
9001 struct jpeg_error_mgr pub
;
9002 jmp_buf setjmp_buffer
;
9007 my_error_exit (cinfo
)
9010 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
9011 longjmp (mgr
->setjmp_buffer
, 1);
9015 /* Init source method for JPEG data source manager. Called by
9016 jpeg_read_header() before any data is actually read. See
9017 libjpeg.doc from the JPEG lib distribution. */
9020 our_init_source (cinfo
)
9021 j_decompress_ptr cinfo
;
9026 /* Fill input buffer method for JPEG data source manager. Called
9027 whenever more data is needed. We read the whole image in one step,
9028 so this only adds a fake end of input marker at the end. */
9031 our_fill_input_buffer (cinfo
)
9032 j_decompress_ptr cinfo
;
9034 /* Insert a fake EOI marker. */
9035 struct jpeg_source_mgr
*src
= cinfo
->src
;
9036 static JOCTET buffer
[2];
9038 buffer
[0] = (JOCTET
) 0xFF;
9039 buffer
[1] = (JOCTET
) JPEG_EOI
;
9041 src
->next_input_byte
= buffer
;
9042 src
->bytes_in_buffer
= 2;
9047 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9048 is the JPEG data source manager. */
9051 our_skip_input_data (cinfo
, num_bytes
)
9052 j_decompress_ptr cinfo
;
9055 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9059 if (num_bytes
> src
->bytes_in_buffer
)
9060 ERREXIT (cinfo
, JERR_INPUT_EOF
);
9062 src
->bytes_in_buffer
-= num_bytes
;
9063 src
->next_input_byte
+= num_bytes
;
9068 /* Method to terminate data source. Called by
9069 jpeg_finish_decompress() after all data has been processed. */
9072 our_term_source (cinfo
)
9073 j_decompress_ptr cinfo
;
9078 /* Set up the JPEG lib for reading an image from DATA which contains
9079 LEN bytes. CINFO is the decompression info structure created for
9080 reading the image. */
9083 jpeg_memory_src (cinfo
, data
, len
)
9084 j_decompress_ptr cinfo
;
9088 struct jpeg_source_mgr
*src
;
9090 if (cinfo
->src
== NULL
)
9092 /* First time for this JPEG object? */
9093 cinfo
->src
= (struct jpeg_source_mgr
*)
9094 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9095 sizeof (struct jpeg_source_mgr
));
9096 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9097 src
->next_input_byte
= data
;
9100 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9101 src
->init_source
= our_init_source
;
9102 src
->fill_input_buffer
= our_fill_input_buffer
;
9103 src
->skip_input_data
= our_skip_input_data
;
9104 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9105 src
->term_source
= our_term_source
;
9106 src
->bytes_in_buffer
= len
;
9107 src
->next_input_byte
= data
;
9111 /* Load image IMG for use on frame F. Patterned after example.c
9112 from the JPEG lib. */
9119 struct jpeg_decompress_struct cinfo
;
9120 struct my_jpeg_error_mgr mgr
;
9121 Lisp_Object file
, specified_file
;
9122 Lisp_Object specified_data
;
9123 FILE * volatile fp
= NULL
;
9125 int row_stride
, x
, y
;
9126 XImage
*ximg
= NULL
;
9128 unsigned long *colors
;
9130 struct gcpro gcpro1
;
9132 /* Open the JPEG file. */
9133 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9134 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9138 if (NILP (specified_data
))
9140 file
= x_find_image_file (specified_file
);
9141 if (!STRINGP (file
))
9143 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9148 fp
= fopen (XSTRING (file
)->data
, "r");
9151 image_error ("Cannot open `%s'", file
, Qnil
);
9157 /* Customize libjpeg's error handling to call my_error_exit when an
9158 error is detected. This function will perform a longjmp. */
9159 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9160 mgr
.pub
.error_exit
= my_error_exit
;
9162 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9166 /* Called from my_error_exit. Display a JPEG error. */
9167 char buffer
[JMSG_LENGTH_MAX
];
9168 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9169 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9170 build_string (buffer
));
9173 /* Close the input file and destroy the JPEG object. */
9175 fclose ((FILE *) fp
);
9176 jpeg_destroy_decompress (&cinfo
);
9178 /* If we already have an XImage, free that. */
9179 x_destroy_x_image (ximg
);
9181 /* Free pixmap and colors. */
9182 x_clear_image (f
, img
);
9188 /* Create the JPEG decompression object. Let it read from fp.
9189 Read the JPEG image header. */
9190 jpeg_create_decompress (&cinfo
);
9192 if (NILP (specified_data
))
9193 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9195 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9196 STRING_BYTES (XSTRING (specified_data
)));
9198 jpeg_read_header (&cinfo
, TRUE
);
9200 /* Customize decompression so that color quantization will be used.
9201 Start decompression. */
9202 cinfo
.quantize_colors
= TRUE
;
9203 jpeg_start_decompress (&cinfo
);
9204 width
= img
->width
= cinfo
.output_width
;
9205 height
= img
->height
= cinfo
.output_height
;
9207 /* Create X image and pixmap. */
9208 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9209 longjmp (mgr
.setjmp_buffer
, 2);
9211 /* Allocate colors. When color quantization is used,
9212 cinfo.actual_number_of_colors has been set with the number of
9213 colors generated, and cinfo.colormap is a two-dimensional array
9214 of color indices in the range 0..cinfo.actual_number_of_colors.
9215 No more than 255 colors will be generated. */
9219 if (cinfo
.out_color_components
> 2)
9220 ir
= 0, ig
= 1, ib
= 2;
9221 else if (cinfo
.out_color_components
> 1)
9222 ir
= 0, ig
= 1, ib
= 0;
9224 ir
= 0, ig
= 0, ib
= 0;
9226 /* Use the color table mechanism because it handles colors that
9227 cannot be allocated nicely. Such colors will be replaced with
9228 a default color, and we don't have to care about which colors
9229 can be freed safely, and which can't. */
9230 init_color_table ();
9231 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9234 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9236 /* Multiply RGB values with 255 because X expects RGB values
9237 in the range 0..0xffff. */
9238 int r
= cinfo
.colormap
[ir
][i
] << 8;
9239 int g
= cinfo
.colormap
[ig
][i
] << 8;
9240 int b
= cinfo
.colormap
[ib
][i
] << 8;
9241 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9244 /* Remember those colors actually allocated. */
9245 img
->colors
= colors_in_color_table (&img
->ncolors
);
9246 free_color_table ();
9250 row_stride
= width
* cinfo
.output_components
;
9251 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9253 for (y
= 0; y
< height
; ++y
)
9255 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9256 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9257 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9261 jpeg_finish_decompress (&cinfo
);
9262 jpeg_destroy_decompress (&cinfo
);
9264 fclose ((FILE *) fp
);
9266 /* Put the image into the pixmap. */
9267 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9268 x_destroy_x_image (ximg
);
9273 #endif /* HAVE_JPEG */
9277 /***********************************************************************
9279 ***********************************************************************/
9285 static int tiff_image_p
P_ ((Lisp_Object object
));
9286 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9288 /* The symbol `tiff' identifying images of this type. */
9292 /* Indices of image specification fields in tiff_format, below. */
9294 enum tiff_keyword_index
9303 TIFF_HEURISTIC_MASK
,
9308 /* Vector of image_keyword structures describing the format
9309 of valid user-defined image specifications. */
9311 static struct image_keyword tiff_format
[TIFF_LAST
] =
9313 {":type", IMAGE_SYMBOL_VALUE
, 1},
9314 {":data", IMAGE_STRING_VALUE
, 0},
9315 {":file", IMAGE_STRING_VALUE
, 0},
9316 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9317 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9318 {":relief", IMAGE_INTEGER_VALUE
, 0},
9319 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9320 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9321 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9324 /* Structure describing the image type `tiff'. */
9326 static struct image_type tiff_type
=
9336 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9339 tiff_image_p (object
)
9342 struct image_keyword fmt
[TIFF_LAST
];
9343 bcopy (tiff_format
, fmt
, sizeof fmt
);
9345 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9348 /* Must specify either the :data or :file keyword. */
9349 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9353 /* Reading from a memory buffer for TIFF images Based on the PNG
9354 memory source, but we have to provide a lot of extra functions.
9357 We really only need to implement read and seek, but I am not
9358 convinced that the TIFF library is smart enough not to destroy
9359 itself if we only hand it the function pointers we need to
9364 unsigned char *bytes
;
9372 tiff_read_from_memory (data
, buf
, size
)
9377 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9379 if (size
> src
->len
- src
->index
)
9381 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9388 tiff_write_from_memory (data
, buf
, size
)
9398 tiff_seek_in_memory (data
, off
, whence
)
9403 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9408 case SEEK_SET
: /* Go from beginning of source. */
9412 case SEEK_END
: /* Go from end of source. */
9413 idx
= src
->len
+ off
;
9416 case SEEK_CUR
: /* Go from current position. */
9417 idx
= src
->index
+ off
;
9420 default: /* Invalid `whence'. */
9424 if (idx
> src
->len
|| idx
< 0)
9433 tiff_close_memory (data
)
9442 tiff_mmap_memory (data
, pbase
, psize
)
9447 /* It is already _IN_ memory. */
9453 tiff_unmap_memory (data
, base
, size
)
9458 /* We don't need to do this. */
9463 tiff_size_of_memory (data
)
9466 return ((tiff_memory_source
*) data
)->len
;
9470 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9478 Lisp_Object file
, specified_file
;
9479 Lisp_Object specified_data
;
9481 int width
, height
, x
, y
;
9485 struct gcpro gcpro1
;
9486 tiff_memory_source memsrc
;
9488 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9489 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9493 if (NILP (specified_data
))
9495 /* Read from a file */
9496 file
= x_find_image_file (specified_file
);
9497 if (!STRINGP (file
))
9499 image_error ("Cannot find image file `%s'", file
, Qnil
);
9504 /* Try to open the image file. */
9505 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9508 image_error ("Cannot open `%s'", file
, Qnil
);
9515 /* Memory source! */
9516 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9517 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9520 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9521 (TIFFReadWriteProc
) tiff_read_from_memory
,
9522 (TIFFReadWriteProc
) tiff_write_from_memory
,
9523 tiff_seek_in_memory
,
9525 tiff_size_of_memory
,
9531 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9537 /* Get width and height of the image, and allocate a raster buffer
9538 of width x height 32-bit values. */
9539 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9540 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9541 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9543 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9547 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9553 /* Create the X image and pixmap. */
9554 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9561 /* Initialize the color table. */
9562 init_color_table ();
9564 /* Process the pixel raster. Origin is in the lower-left corner. */
9565 for (y
= 0; y
< height
; ++y
)
9567 uint32
*row
= buf
+ y
* width
;
9569 for (x
= 0; x
< width
; ++x
)
9571 uint32 abgr
= row
[x
];
9572 int r
= TIFFGetR (abgr
) << 8;
9573 int g
= TIFFGetG (abgr
) << 8;
9574 int b
= TIFFGetB (abgr
) << 8;
9575 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9579 /* Remember the colors allocated for the image. Free the color table. */
9580 img
->colors
= colors_in_color_table (&img
->ncolors
);
9581 free_color_table ();
9583 /* Put the image into the pixmap, then free the X image and its buffer. */
9584 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9585 x_destroy_x_image (ximg
);
9589 img
->height
= height
;
9595 #endif /* HAVE_TIFF != 0 */
9599 /***********************************************************************
9601 ***********************************************************************/
9605 #include <gif_lib.h>
9607 static int gif_image_p
P_ ((Lisp_Object object
));
9608 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9610 /* The symbol `gif' identifying images of this type. */
9614 /* Indices of image specification fields in gif_format, below. */
9616 enum gif_keyword_index
9631 /* Vector of image_keyword structures describing the format
9632 of valid user-defined image specifications. */
9634 static struct image_keyword gif_format
[GIF_LAST
] =
9636 {":type", IMAGE_SYMBOL_VALUE
, 1},
9637 {":data", IMAGE_STRING_VALUE
, 0},
9638 {":file", IMAGE_STRING_VALUE
, 0},
9639 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9640 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9641 {":relief", IMAGE_INTEGER_VALUE
, 0},
9642 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9643 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9644 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9645 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9648 /* Structure describing the image type `gif'. */
9650 static struct image_type gif_type
=
9660 /* Return non-zero if OBJECT is a valid GIF image specification. */
9663 gif_image_p (object
)
9666 struct image_keyword fmt
[GIF_LAST
];
9667 bcopy (gif_format
, fmt
, sizeof fmt
);
9669 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9672 /* Must specify either the :data or :file keyword. */
9673 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9677 /* Reading a GIF image from memory
9678 Based on the PNG memory stuff to a certain extent. */
9682 unsigned char *bytes
;
9689 /* Make the current memory source available to gif_read_from_memory.
9690 It's done this way because not all versions of libungif support
9691 a UserData field in the GifFileType structure. */
9692 static gif_memory_source
*current_gif_memory_src
;
9695 gif_read_from_memory (file
, buf
, len
)
9700 gif_memory_source
*src
= current_gif_memory_src
;
9702 if (len
> src
->len
- src
->index
)
9705 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9711 /* Load GIF image IMG for use on frame F. Value is non-zero if
9719 Lisp_Object file
, specified_file
;
9720 Lisp_Object specified_data
;
9721 int rc
, width
, height
, x
, y
, i
;
9723 ColorMapObject
*gif_color_map
;
9724 unsigned long pixel_colors
[256];
9726 struct gcpro gcpro1
;
9728 int ino
, image_left
, image_top
, image_width
, image_height
;
9729 gif_memory_source memsrc
;
9730 unsigned char *raster
;
9732 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9733 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9737 if (NILP (specified_data
))
9739 file
= x_find_image_file (specified_file
);
9740 if (!STRINGP (file
))
9742 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9747 /* Open the GIF file. */
9748 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9751 image_error ("Cannot open `%s'", file
, Qnil
);
9758 /* Read from memory! */
9759 current_gif_memory_src
= &memsrc
;
9760 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9761 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9764 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9767 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9773 /* Read entire contents. */
9774 rc
= DGifSlurp (gif
);
9775 if (rc
== GIF_ERROR
)
9777 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9778 DGifCloseFile (gif
);
9783 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9784 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9785 if (ino
>= gif
->ImageCount
)
9787 image_error ("Invalid image number `%s' in image `%s'",
9789 DGifCloseFile (gif
);
9794 width
= img
->width
= gif
->SWidth
;
9795 height
= img
->height
= gif
->SHeight
;
9797 /* Create the X image and pixmap. */
9798 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9800 DGifCloseFile (gif
);
9805 /* Allocate colors. */
9806 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9808 gif_color_map
= gif
->SColorMap
;
9809 init_color_table ();
9810 bzero (pixel_colors
, sizeof pixel_colors
);
9812 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9814 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9815 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9816 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9817 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9820 img
->colors
= colors_in_color_table (&img
->ncolors
);
9821 free_color_table ();
9823 /* Clear the part of the screen image that are not covered by
9824 the image from the GIF file. Full animated GIF support
9825 requires more than can be done here (see the gif89 spec,
9826 disposal methods). Let's simply assume that the part
9827 not covered by a sub-image is in the frame's background color. */
9828 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9829 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9830 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9831 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9833 for (y
= 0; y
< image_top
; ++y
)
9834 for (x
= 0; x
< width
; ++x
)
9835 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9837 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9838 for (x
= 0; x
< width
; ++x
)
9839 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9841 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9843 for (x
= 0; x
< image_left
; ++x
)
9844 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9845 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9846 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9849 /* Read the GIF image into the X image. We use a local variable
9850 `raster' here because RasterBits below is a char *, and invites
9851 problems with bytes >= 0x80. */
9852 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9854 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9856 static int interlace_start
[] = {0, 4, 2, 1};
9857 static int interlace_increment
[] = {8, 8, 4, 2};
9859 int row
= interlace_start
[0];
9863 for (y
= 0; y
< image_height
; y
++)
9865 if (row
>= image_height
)
9867 row
= interlace_start
[++pass
];
9868 while (row
>= image_height
)
9869 row
= interlace_start
[++pass
];
9872 for (x
= 0; x
< image_width
; x
++)
9874 int i
= raster
[(y
* image_width
) + x
];
9875 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9879 row
+= interlace_increment
[pass
];
9884 for (y
= 0; y
< image_height
; ++y
)
9885 for (x
= 0; x
< image_width
; ++x
)
9887 int i
= raster
[y
* image_width
+ x
];
9888 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9892 DGifCloseFile (gif
);
9894 /* Put the image into the pixmap, then free the X image and its buffer. */
9895 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9896 x_destroy_x_image (ximg
);
9902 #endif /* HAVE_GIF != 0 */
9906 /***********************************************************************
9908 ***********************************************************************/
9910 static int gs_image_p
P_ ((Lisp_Object object
));
9911 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9912 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9914 /* The symbol `postscript' identifying images of this type. */
9916 Lisp_Object Qpostscript
;
9918 /* Keyword symbols. */
9920 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9922 /* Indices of image specification fields in gs_format, below. */
9924 enum gs_keyword_index
9941 /* Vector of image_keyword structures describing the format
9942 of valid user-defined image specifications. */
9944 static struct image_keyword gs_format
[GS_LAST
] =
9946 {":type", IMAGE_SYMBOL_VALUE
, 1},
9947 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9948 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9949 {":file", IMAGE_STRING_VALUE
, 1},
9950 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9951 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9952 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9953 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9954 {":relief", IMAGE_INTEGER_VALUE
, 0},
9955 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9956 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9957 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9960 /* Structure describing the image type `ghostscript'. */
9962 static struct image_type gs_type
=
9972 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9975 gs_clear_image (f
, img
)
9979 /* IMG->data.ptr_val may contain a recorded colormap. */
9980 xfree (img
->data
.ptr_val
);
9981 x_clear_image (f
, img
);
9985 /* Return non-zero if OBJECT is a valid Ghostscript image
9992 struct image_keyword fmt
[GS_LAST
];
9996 bcopy (gs_format
, fmt
, sizeof fmt
);
9998 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
10001 /* Bounding box must be a list or vector containing 4 integers. */
10002 tem
= fmt
[GS_BOUNDING_BOX
].value
;
10005 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
10006 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
10011 else if (VECTORP (tem
))
10013 if (XVECTOR (tem
)->size
!= 4)
10015 for (i
= 0; i
< 4; ++i
)
10016 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
10026 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
10035 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
10036 struct gcpro gcpro1
, gcpro2
;
10038 double in_width
, in_height
;
10039 Lisp_Object pixel_colors
= Qnil
;
10041 /* Compute pixel size of pixmap needed from the given size in the
10042 image specification. Sizes in the specification are in pt. 1 pt
10043 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10045 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
10046 in_width
= XFASTINT (pt_width
) / 72.0;
10047 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
10048 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
10049 in_height
= XFASTINT (pt_height
) / 72.0;
10050 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
10052 /* Create the pixmap. */
10053 xassert (img
->pixmap
== None
);
10054 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10055 img
->width
, img
->height
,
10056 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
10060 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
10064 /* Call the loader to fill the pixmap. It returns a process object
10065 if successful. We do not record_unwind_protect here because
10066 other places in redisplay like calling window scroll functions
10067 don't either. Let the Lisp loader use `unwind-protect' instead. */
10068 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
10070 sprintf (buffer
, "%lu %lu",
10071 (unsigned long) FRAME_X_WINDOW (f
),
10072 (unsigned long) img
->pixmap
);
10073 window_and_pixmap_id
= build_string (buffer
);
10075 sprintf (buffer
, "%lu %lu",
10076 FRAME_FOREGROUND_PIXEL (f
),
10077 FRAME_BACKGROUND_PIXEL (f
));
10078 pixel_colors
= build_string (buffer
);
10080 XSETFRAME (frame
, f
);
10081 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
10083 loader
= intern ("gs-load-image");
10085 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10086 make_number (img
->width
),
10087 make_number (img
->height
),
10088 window_and_pixmap_id
,
10091 return PROCESSP (img
->data
.lisp_val
);
10095 /* Kill the Ghostscript process that was started to fill PIXMAP on
10096 frame F. Called from XTread_socket when receiving an event
10097 telling Emacs that Ghostscript has finished drawing. */
10100 x_kill_gs_process (pixmap
, f
)
10104 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10108 /* Find the image containing PIXMAP. */
10109 for (i
= 0; i
< c
->used
; ++i
)
10110 if (c
->images
[i
]->pixmap
== pixmap
)
10113 /* Kill the GS process. We should have found PIXMAP in the image
10114 cache and its image should contain a process object. */
10115 xassert (i
< c
->used
);
10116 img
= c
->images
[i
];
10117 xassert (PROCESSP (img
->data
.lisp_val
));
10118 Fkill_process (img
->data
.lisp_val
, Qnil
);
10119 img
->data
.lisp_val
= Qnil
;
10121 /* On displays with a mutable colormap, figure out the colors
10122 allocated for the image by looking at the pixels of an XImage for
10124 class = FRAME_X_VISUAL (f
)->class;
10125 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10131 /* Try to get an XImage for img->pixmep. */
10132 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10133 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10138 /* Initialize the color table. */
10139 init_color_table ();
10141 /* For each pixel of the image, look its color up in the
10142 color table. After having done so, the color table will
10143 contain an entry for each color used by the image. */
10144 for (y
= 0; y
< img
->height
; ++y
)
10145 for (x
= 0; x
< img
->width
; ++x
)
10147 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10148 lookup_pixel_color (f
, pixel
);
10151 /* Record colors in the image. Free color table and XImage. */
10152 img
->colors
= colors_in_color_table (&img
->ncolors
);
10153 free_color_table ();
10154 XDestroyImage (ximg
);
10156 #if 0 /* This doesn't seem to be the case. If we free the colors
10157 here, we get a BadAccess later in x_clear_image when
10158 freeing the colors. */
10159 /* We have allocated colors once, but Ghostscript has also
10160 allocated colors on behalf of us. So, to get the
10161 reference counts right, free them once. */
10163 x_free_colors (f
, img
->colors
, img
->ncolors
);
10167 image_error ("Cannot get X image of `%s'; colors will not be freed",
10173 /* Now that we have the pixmap, compute mask and transform the
10174 image if requested. */
10176 postprocess_image (f
, img
);
10182 /***********************************************************************
10184 ***********************************************************************/
10186 DEFUN ("x-change-window-property", Fx_change_window_property
,
10187 Sx_change_window_property
, 2, 3, 0,
10188 "Change window property PROP to VALUE on the X window of FRAME.\n\
10189 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
10190 selected frame. Value is VALUE.")
10191 (prop
, value
, frame
)
10192 Lisp_Object frame
, prop
, value
;
10194 struct frame
*f
= check_x_frame (frame
);
10197 CHECK_STRING (prop
, 1);
10198 CHECK_STRING (value
, 2);
10201 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10202 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10203 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10204 XSTRING (value
)->data
, XSTRING (value
)->size
);
10206 /* Make sure the property is set when we return. */
10207 XFlush (FRAME_X_DISPLAY (f
));
10214 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10215 Sx_delete_window_property
, 1, 2, 0,
10216 "Remove window property PROP from X window of FRAME.\n\
10217 FRAME nil or omitted means use the selected frame. Value is PROP.")
10219 Lisp_Object prop
, frame
;
10221 struct frame
*f
= check_x_frame (frame
);
10224 CHECK_STRING (prop
, 1);
10226 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10227 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10229 /* Make sure the property is removed when we return. */
10230 XFlush (FRAME_X_DISPLAY (f
));
10237 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10239 "Value is the value of window property PROP on FRAME.\n\
10240 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10241 if FRAME hasn't a property with name PROP or if PROP has no string\n\
10244 Lisp_Object prop
, frame
;
10246 struct frame
*f
= check_x_frame (frame
);
10249 Lisp_Object prop_value
= Qnil
;
10250 char *tmp_data
= NULL
;
10253 unsigned long actual_size
, bytes_remaining
;
10255 CHECK_STRING (prop
, 1);
10257 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10258 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10259 prop_atom
, 0, 0, False
, XA_STRING
,
10260 &actual_type
, &actual_format
, &actual_size
,
10261 &bytes_remaining
, (unsigned char **) &tmp_data
);
10264 int size
= bytes_remaining
;
10269 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10270 prop_atom
, 0, bytes_remaining
,
10272 &actual_type
, &actual_format
,
10273 &actual_size
, &bytes_remaining
,
10274 (unsigned char **) &tmp_data
);
10276 prop_value
= make_string (tmp_data
, size
);
10287 /***********************************************************************
10289 ***********************************************************************/
10291 /* If non-null, an asynchronous timer that, when it expires, displays
10292 an hourglass cursor on all frames. */
10294 static struct atimer
*hourglass_atimer
;
10296 /* Non-zero means an hourglass cursor is currently shown. */
10298 static int hourglass_shown_p
;
10300 /* Number of seconds to wait before displaying an hourglass cursor. */
10302 static Lisp_Object Vhourglass_delay
;
10304 /* Default number of seconds to wait before displaying an hourglass
10307 #define DEFAULT_HOURGLASS_DELAY 1
10309 /* Function prototypes. */
10311 static void show_hourglass
P_ ((struct atimer
*));
10312 static void hide_hourglass
P_ ((void));
10315 /* Cancel a currently active hourglass timer, and start a new one. */
10321 int secs
, usecs
= 0;
10323 cancel_hourglass ();
10325 if (INTEGERP (Vhourglass_delay
)
10326 && XINT (Vhourglass_delay
) > 0)
10327 secs
= XFASTINT (Vhourglass_delay
);
10328 else if (FLOATP (Vhourglass_delay
)
10329 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10332 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10333 secs
= XFASTINT (tem
);
10334 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10337 secs
= DEFAULT_HOURGLASS_DELAY
;
10339 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10340 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10341 show_hourglass
, NULL
);
10345 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10349 cancel_hourglass ()
10351 if (hourglass_atimer
)
10353 cancel_atimer (hourglass_atimer
);
10354 hourglass_atimer
= NULL
;
10357 if (hourglass_shown_p
)
10362 /* Timer function of hourglass_atimer. TIMER is equal to
10365 Display an hourglass pointer on all frames by mapping the frames'
10366 hourglass_window. Set the hourglass_p flag in the frames'
10367 output_data.x structure to indicate that an hourglass cursor is
10368 shown on the frames. */
10371 show_hourglass (timer
)
10372 struct atimer
*timer
;
10374 /* The timer implementation will cancel this timer automatically
10375 after this function has run. Set hourglass_atimer to null
10376 so that we know the timer doesn't have to be canceled. */
10377 hourglass_atimer
= NULL
;
10379 if (!hourglass_shown_p
)
10381 Lisp_Object rest
, frame
;
10385 FOR_EACH_FRAME (rest
, frame
)
10387 struct frame
*f
= XFRAME (frame
);
10389 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10391 Display
*dpy
= FRAME_X_DISPLAY (f
);
10393 #ifdef USE_X_TOOLKIT
10394 if (f
->output_data
.x
->widget
)
10396 if (FRAME_OUTER_WINDOW (f
))
10399 f
->output_data
.x
->hourglass_p
= 1;
10401 if (!f
->output_data
.x
->hourglass_window
)
10403 unsigned long mask
= CWCursor
;
10404 XSetWindowAttributes attrs
;
10406 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10408 f
->output_data
.x
->hourglass_window
10409 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10410 0, 0, 32000, 32000, 0, 0,
10416 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10422 hourglass_shown_p
= 1;
10428 /* Hide the hourglass pointer on all frames, if it is currently
10434 if (hourglass_shown_p
)
10436 Lisp_Object rest
, frame
;
10439 FOR_EACH_FRAME (rest
, frame
)
10441 struct frame
*f
= XFRAME (frame
);
10444 /* Watch out for newly created frames. */
10445 && f
->output_data
.x
->hourglass_window
)
10447 XUnmapWindow (FRAME_X_DISPLAY (f
),
10448 f
->output_data
.x
->hourglass_window
);
10449 /* Sync here because XTread_socket looks at the
10450 hourglass_p flag that is reset to zero below. */
10451 XSync (FRAME_X_DISPLAY (f
), False
);
10452 f
->output_data
.x
->hourglass_p
= 0;
10456 hourglass_shown_p
= 0;
10463 /***********************************************************************
10465 ***********************************************************************/
10467 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10468 Lisp_Object
, Lisp_Object
));
10469 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10470 Lisp_Object
, int, int, int *, int *));
10472 /* The frame of a currently visible tooltip. */
10474 Lisp_Object tip_frame
;
10476 /* If non-nil, a timer started that hides the last tooltip when it
10479 Lisp_Object tip_timer
;
10482 /* If non-nil, a vector of 3 elements containing the last args
10483 with which x-show-tip was called. See there. */
10485 Lisp_Object last_show_tip_args
;
10489 unwind_create_tip_frame (frame
)
10492 Lisp_Object deleted
;
10494 deleted
= unwind_create_frame (frame
);
10495 if (EQ (deleted
, Qt
))
10505 /* Create a frame for a tooltip on the display described by DPYINFO.
10506 PARMS is a list of frame parameters. TEXT is the string to
10507 display in the tip frame. Value is the frame.
10509 Note that functions called here, esp. x_default_parameter can
10510 signal errors, for instance when a specified color name is
10511 undefined. We have to make sure that we're in a consistent state
10512 when this happens. */
10515 x_create_tip_frame (dpyinfo
, parms
, text
)
10516 struct x_display_info
*dpyinfo
;
10517 Lisp_Object parms
, text
;
10520 Lisp_Object frame
, tem
;
10522 long window_prompting
= 0;
10524 int count
= BINDING_STACK_SIZE ();
10525 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10527 int face_change_count_before
= face_change_count
;
10528 Lisp_Object buffer
;
10529 struct buffer
*old_buffer
;
10533 /* Use this general default value to start with until we know if
10534 this frame has a specified name. */
10535 Vx_resource_name
= Vinvocation_name
;
10537 #ifdef MULTI_KBOARD
10538 kb
= dpyinfo
->kboard
;
10540 kb
= &the_only_kboard
;
10543 /* Get the name of the frame to use for resource lookup. */
10544 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10545 if (!STRINGP (name
)
10546 && !EQ (name
, Qunbound
)
10548 error ("Invalid frame name--not a string or nil");
10549 Vx_resource_name
= name
;
10552 GCPRO3 (parms
, name
, frame
);
10553 f
= make_frame (1);
10554 XSETFRAME (frame
, f
);
10556 buffer
= Fget_buffer_create (build_string (" *tip*"));
10557 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10558 old_buffer
= current_buffer
;
10559 set_buffer_internal_1 (XBUFFER (buffer
));
10561 Finsert (1, &text
);
10562 set_buffer_internal_1 (old_buffer
);
10564 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10565 record_unwind_protect (unwind_create_tip_frame
, frame
);
10567 /* By setting the output method, we're essentially saying that
10568 the frame is live, as per FRAME_LIVE_P. If we get a signal
10569 from this point on, x_destroy_window might screw up reference
10571 f
->output_method
= output_x_window
;
10572 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10573 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10574 f
->output_data
.x
->icon_bitmap
= -1;
10575 f
->output_data
.x
->fontset
= -1;
10576 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10577 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10578 f
->icon_name
= Qnil
;
10579 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10581 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10582 dpyinfo_refcount
= dpyinfo
->reference_count
;
10583 #endif /* GLYPH_DEBUG */
10584 #ifdef MULTI_KBOARD
10585 FRAME_KBOARD (f
) = kb
;
10587 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10588 f
->output_data
.x
->explicit_parent
= 0;
10590 /* These colors will be set anyway later, but it's important
10591 to get the color reference counts right, so initialize them! */
10594 struct gcpro gcpro1
;
10596 black
= build_string ("black");
10598 f
->output_data
.x
->foreground_pixel
10599 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10600 f
->output_data
.x
->background_pixel
10601 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10602 f
->output_data
.x
->cursor_pixel
10603 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10604 f
->output_data
.x
->cursor_foreground_pixel
10605 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10606 f
->output_data
.x
->border_pixel
10607 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10608 f
->output_data
.x
->mouse_pixel
10609 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10613 /* Set the name; the functions to which we pass f expect the name to
10615 if (EQ (name
, Qunbound
) || NILP (name
))
10617 f
->name
= build_string (dpyinfo
->x_id_name
);
10618 f
->explicit_name
= 0;
10623 f
->explicit_name
= 1;
10624 /* use the frame's title when getting resources for this frame. */
10625 specbind (Qx_resource_name
, name
);
10628 /* Extract the window parameters from the supplied values that are
10629 needed to determine window geometry. */
10633 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10636 /* First, try whatever font the caller has specified. */
10637 if (STRINGP (font
))
10639 tem
= Fquery_fontset (font
, Qnil
);
10641 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10643 font
= x_new_font (f
, XSTRING (font
)->data
);
10646 /* Try out a font which we hope has bold and italic variations. */
10647 if (!STRINGP (font
))
10648 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10649 if (!STRINGP (font
))
10650 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10651 if (! STRINGP (font
))
10652 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10653 if (! STRINGP (font
))
10654 /* This was formerly the first thing tried, but it finds too many fonts
10655 and takes too long. */
10656 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10657 /* If those didn't work, look for something which will at least work. */
10658 if (! STRINGP (font
))
10659 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10661 if (! STRINGP (font
))
10662 font
= build_string ("fixed");
10664 x_default_parameter (f
, parms
, Qfont
, font
,
10665 "font", "Font", RES_TYPE_STRING
);
10668 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10669 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10671 /* This defaults to 2 in order to match xterm. We recognize either
10672 internalBorderWidth or internalBorder (which is what xterm calls
10674 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10678 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10679 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10680 if (! EQ (value
, Qunbound
))
10681 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10685 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10686 "internalBorderWidth", "internalBorderWidth",
10689 /* Also do the stuff which must be set before the window exists. */
10690 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10691 "foreground", "Foreground", RES_TYPE_STRING
);
10692 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10693 "background", "Background", RES_TYPE_STRING
);
10694 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10695 "pointerColor", "Foreground", RES_TYPE_STRING
);
10696 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10697 "cursorColor", "Foreground", RES_TYPE_STRING
);
10698 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10699 "borderColor", "BorderColor", RES_TYPE_STRING
);
10701 /* Init faces before x_default_parameter is called for scroll-bar
10702 parameters because that function calls x_set_scroll_bar_width,
10703 which calls change_frame_size, which calls Fset_window_buffer,
10704 which runs hooks, which call Fvertical_motion. At the end, we
10705 end up in init_iterator with a null face cache, which should not
10707 init_frame_faces (f
);
10709 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10710 window_prompting
= x_figure_window_size (f
, parms
);
10712 if (window_prompting
& XNegative
)
10714 if (window_prompting
& YNegative
)
10715 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10717 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10721 if (window_prompting
& YNegative
)
10722 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10724 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10727 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10729 XSetWindowAttributes attrs
;
10730 unsigned long mask
;
10733 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10734 if (DoesSaveUnders (dpyinfo
->screen
))
10735 mask
|= CWSaveUnder
;
10737 /* Window managers look at the override-redirect flag to determine
10738 whether or net to give windows a decoration (Xlib spec, chapter
10740 attrs
.override_redirect
= True
;
10741 attrs
.save_under
= True
;
10742 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10743 /* Arrange for getting MapNotify and UnmapNotify events. */
10744 attrs
.event_mask
= StructureNotifyMask
;
10746 = FRAME_X_WINDOW (f
)
10747 = XCreateWindow (FRAME_X_DISPLAY (f
),
10748 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10749 /* x, y, width, height */
10753 CopyFromParent
, InputOutput
, CopyFromParent
,
10760 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10761 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10762 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10763 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10764 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10765 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10767 /* Dimensions, especially f->height, must be done via change_frame_size.
10768 Change will not be effected unless different from the current
10771 height
= f
->height
;
10773 SET_FRAME_WIDTH (f
, 0);
10774 change_frame_size (f
, height
, width
, 1, 0, 0);
10776 /* Set up faces after all frame parameters are known. This call
10777 also merges in face attributes specified for new frames.
10779 Frame parameters may be changed if .Xdefaults contains
10780 specifications for the default font. For example, if there is an
10781 `Emacs.default.attributeBackground: pink', the `background-color'
10782 attribute of the frame get's set, which let's the internal border
10783 of the tooltip frame appear in pink. Prevent this. */
10785 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
10787 /* Set tip_frame here, so that */
10789 call1 (Qface_set_after_frame_default
, frame
);
10791 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
10792 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
10800 /* It is now ok to make the frame official even if we get an error
10801 below. And the frame needs to be on Vframe_list or making it
10802 visible won't work. */
10803 Vframe_list
= Fcons (frame
, Vframe_list
);
10805 /* Now that the frame is official, it counts as a reference to
10807 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10809 /* Setting attributes of faces of the tooltip frame from resources
10810 and similar will increment face_change_count, which leads to the
10811 clearing of all current matrices. Since this isn't necessary
10812 here, avoid it by resetting face_change_count to the value it
10813 had before we created the tip frame. */
10814 face_change_count
= face_change_count_before
;
10816 /* Discard the unwind_protect. */
10817 return unbind_to (count
, frame
);
10821 /* Compute where to display tip frame F. PARMS is the list of frame
10822 parameters for F. DX and DY are specified offsets from the current
10823 location of the mouse. WIDTH and HEIGHT are the width and height
10824 of the tooltip. Return coordinates relative to the root window of
10825 the display in *ROOT_X, and *ROOT_Y. */
10828 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
10830 Lisp_Object parms
, dx
, dy
;
10832 int *root_x
, *root_y
;
10834 Lisp_Object left
, top
;
10836 Window root
, child
;
10839 /* User-specified position? */
10840 left
= Fcdr (Fassq (Qleft
, parms
));
10841 top
= Fcdr (Fassq (Qtop
, parms
));
10843 /* Move the tooltip window where the mouse pointer is. Resize and
10845 if (!INTEGERP (left
) && !INTEGERP (top
))
10848 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10849 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
10853 if (INTEGERP (top
))
10854 *root_y
= XINT (top
);
10855 else if (*root_y
+ XINT (dy
) - height
< 0)
10856 *root_y
-= XINT (dy
);
10860 *root_y
+= XINT (dy
);
10863 if (INTEGERP (left
))
10864 *root_x
= XINT (left
);
10865 else if (*root_x
+ XINT (dx
) + width
> FRAME_X_DISPLAY_INFO (f
)->width
)
10866 *root_x
-= width
+ XINT (dx
);
10868 *root_x
+= XINT (dx
);
10872 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10873 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10874 A tooltip window is a small X window displaying a string.\n\
10876 FRAME nil or omitted means use the selected frame.\n\
10878 PARMS is an optional list of frame parameters which can be\n\
10879 used to change the tooltip's appearance.\n\
10881 Automatically hide the tooltip after TIMEOUT seconds.\n\
10882 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10884 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10885 the tooltip is displayed at that x-position. Otherwise it is\n\
10886 displayed at the mouse position, with offset DX added (default is 5 if\n\
10887 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10888 parameter is specified, it determines the y-position of the tooltip\n\
10889 window, otherwise it is displayed at the mouse position, with offset\n\
10890 DY added (default is -10).")
10891 (string
, frame
, parms
, timeout
, dx
, dy
)
10892 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10896 Lisp_Object buffer
, top
, left
;
10897 int root_x
, root_y
;
10898 struct buffer
*old_buffer
;
10899 struct text_pos pos
;
10900 int i
, width
, height
;
10901 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10902 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10903 int count
= BINDING_STACK_SIZE ();
10905 specbind (Qinhibit_redisplay
, Qt
);
10907 GCPRO4 (string
, parms
, frame
, timeout
);
10909 CHECK_STRING (string
, 0);
10910 f
= check_x_frame (frame
);
10911 if (NILP (timeout
))
10912 timeout
= make_number (5);
10914 CHECK_NATNUM (timeout
, 2);
10917 dx
= make_number (5);
10919 CHECK_NUMBER (dx
, 5);
10922 dy
= make_number (-10);
10924 CHECK_NUMBER (dy
, 6);
10926 if (NILP (last_show_tip_args
))
10927 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
10929 if (!NILP (tip_frame
))
10931 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
10932 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
10933 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
10935 if (EQ (frame
, last_frame
)
10936 && !NILP (Fequal (last_string
, string
))
10937 && !NILP (Fequal (last_parms
, parms
)))
10939 struct frame
*f
= XFRAME (tip_frame
);
10941 /* Only DX and DY have changed. */
10942 if (!NILP (tip_timer
))
10944 Lisp_Object timer
= tip_timer
;
10946 call1 (Qcancel_timer
, timer
);
10950 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
10951 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
10952 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10959 /* Hide a previous tip, if any. */
10962 ASET (last_show_tip_args
, 0, string
);
10963 ASET (last_show_tip_args
, 1, frame
);
10964 ASET (last_show_tip_args
, 2, parms
);
10966 /* Add default values to frame parameters. */
10967 if (NILP (Fassq (Qname
, parms
)))
10968 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10969 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10970 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10971 if (NILP (Fassq (Qborder_width
, parms
)))
10972 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10973 if (NILP (Fassq (Qborder_color
, parms
)))
10974 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10975 if (NILP (Fassq (Qbackground_color
, parms
)))
10976 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10979 /* Create a frame for the tooltip, and record it in the global
10980 variable tip_frame. */
10981 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
, string
);
10982 f
= XFRAME (frame
);
10984 /* Set up the frame's root window. Currently we use a size of 80
10985 columns x 40 lines. If someone wants to show a larger tip, he
10986 will loose. I don't think this is a realistic case. */
10987 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10988 w
->left
= w
->top
= make_number (0);
10989 w
->width
= make_number (80);
10990 w
->height
= make_number (40);
10992 w
->pseudo_window_p
= 1;
10994 /* Display the tooltip text in a temporary buffer. */
10995 old_buffer
= current_buffer
;
10996 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
10997 clear_glyph_matrix (w
->desired_matrix
);
10998 clear_glyph_matrix (w
->current_matrix
);
10999 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
11000 try_window (FRAME_ROOT_WINDOW (f
), pos
);
11002 /* Compute width and height of the tooltip. */
11003 width
= height
= 0;
11004 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
11006 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
11007 struct glyph
*last
;
11010 /* Stop at the first empty row at the end. */
11011 if (!row
->enabled_p
|| !row
->displays_text_p
)
11014 /* Let the row go over the full width of the frame. */
11015 row
->full_width_p
= 1;
11017 /* There's a glyph at the end of rows that is used to place
11018 the cursor there. Don't include the width of this glyph. */
11019 if (row
->used
[TEXT_AREA
])
11021 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
11022 row_width
= row
->pixel_width
- last
->pixel_width
;
11025 row_width
= row
->pixel_width
;
11027 height
+= row
->height
;
11028 width
= max (width
, row_width
);
11031 /* Add the frame's internal border to the width and height the X
11032 window should have. */
11033 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11034 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11036 /* Move the tooltip window where the mouse pointer is. Resize and
11038 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
11041 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11042 root_x
, root_y
, width
, height
);
11043 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
11046 /* Draw into the window. */
11047 w
->must_be_updated_p
= 1;
11048 update_single_window (w
, 1);
11050 /* Restore original current buffer. */
11051 set_buffer_internal_1 (old_buffer
);
11052 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
11055 /* Let the tip disappear after timeout seconds. */
11056 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
11057 intern ("x-hide-tip"));
11060 return unbind_to (count
, Qnil
);
11064 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
11065 "Hide the current tooltip window, if there is any.\n\
11066 Value is t is tooltip was open, nil otherwise.")
11070 Lisp_Object deleted
, frame
, timer
;
11071 struct gcpro gcpro1
, gcpro2
;
11073 /* Return quickly if nothing to do. */
11074 if (NILP (tip_timer
) && NILP (tip_frame
))
11079 GCPRO2 (frame
, timer
);
11080 tip_frame
= tip_timer
= deleted
= Qnil
;
11082 count
= BINDING_STACK_SIZE ();
11083 specbind (Qinhibit_redisplay
, Qt
);
11084 specbind (Qinhibit_quit
, Qt
);
11087 call1 (Qcancel_timer
, timer
);
11089 if (FRAMEP (frame
))
11091 Fdelete_frame (frame
, Qnil
);
11095 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11096 redisplay procedure is not called when a tip frame over menu
11097 items is unmapped. Redisplay the menu manually... */
11099 struct frame
*f
= SELECTED_FRAME ();
11100 Widget w
= f
->output_data
.x
->menubar_widget
;
11101 extern void xlwmenu_redisplay
P_ ((Widget
));
11103 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
11107 xlwmenu_redisplay (w
);
11111 #endif /* USE_LUCID */
11115 return unbind_to (count
, deleted
);
11120 /***********************************************************************
11121 File selection dialog
11122 ***********************************************************************/
11126 /* Callback for "OK" and "Cancel" on file selection dialog. */
11129 file_dialog_cb (widget
, client_data
, call_data
)
11131 XtPointer call_data
, client_data
;
11133 int *result
= (int *) client_data
;
11134 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11135 *result
= cb
->reason
;
11139 /* Callback for unmapping a file selection dialog. This is used to
11140 capture the case where a dialog is closed via a window manager's
11141 closer button, for example. Using a XmNdestroyCallback didn't work
11145 file_dialog_unmap_cb (widget
, client_data
, call_data
)
11147 XtPointer call_data
, client_data
;
11149 int *result
= (int *) client_data
;
11150 *result
= XmCR_CANCEL
;
11154 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11155 "Read file name, prompting with PROMPT in directory DIR.\n\
11156 Use a file selection dialog.\n\
11157 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
11158 specified. Don't let the user enter a file name in the file\n\
11159 selection dialog's entry field, if MUSTMATCH is non-nil.")
11160 (prompt
, dir
, default_filename
, mustmatch
)
11161 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11164 struct frame
*f
= SELECTED_FRAME ();
11165 Lisp_Object file
= Qnil
;
11166 Widget dialog
, text
, list
, help
;
11169 extern XtAppContext Xt_app_con
;
11171 XmString dir_xmstring
, pattern_xmstring
;
11172 int popup_activated_flag
;
11173 int count
= specpdl_ptr
- specpdl
;
11174 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11176 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11177 CHECK_STRING (prompt
, 0);
11178 CHECK_STRING (dir
, 1);
11180 /* Prevent redisplay. */
11181 specbind (Qinhibit_redisplay
, Qt
);
11185 /* Create the dialog with PROMPT as title, using DIR as initial
11186 directory and using "*" as pattern. */
11187 dir
= Fexpand_file_name (dir
, Qnil
);
11188 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11189 pattern_xmstring
= XmStringCreateLocalized ("*");
11191 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11192 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11193 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11194 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11195 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11196 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11198 XmStringFree (dir_xmstring
);
11199 XmStringFree (pattern_xmstring
);
11201 /* Add callbacks for OK and Cancel. */
11202 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11203 (XtPointer
) &result
);
11204 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11205 (XtPointer
) &result
);
11206 XtAddCallback (dialog
, XmNunmapCallback
, file_dialog_unmap_cb
,
11207 (XtPointer
) &result
);
11209 /* Disable the help button since we can't display help. */
11210 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11211 XtSetSensitive (help
, False
);
11213 /* Mark OK button as default. */
11214 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11215 XmNshowAsDefault
, True
, NULL
);
11217 /* If MUSTMATCH is non-nil, disable the file entry field of the
11218 dialog, so that the user must select a file from the files list
11219 box. We can't remove it because we wouldn't have a way to get at
11220 the result file name, then. */
11221 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11222 if (!NILP (mustmatch
))
11225 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11226 XtSetSensitive (text
, False
);
11227 XtSetSensitive (label
, False
);
11230 /* Manage the dialog, so that list boxes get filled. */
11231 XtManageChild (dialog
);
11233 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11234 must include the path for this to work. */
11235 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11236 if (STRINGP (default_filename
))
11238 XmString default_xmstring
;
11242 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11244 if (!XmListItemExists (list
, default_xmstring
))
11246 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11247 XmListAddItem (list
, default_xmstring
, 0);
11251 item_pos
= XmListItemPos (list
, default_xmstring
);
11252 XmStringFree (default_xmstring
);
11254 /* Select the item and scroll it into view. */
11255 XmListSelectPos (list
, item_pos
, True
);
11256 XmListSetPos (list
, item_pos
);
11259 /* Process events until the user presses Cancel or OK. Block
11260 and unblock input here so that we get a chance of processing
11264 while (result
== 0)
11267 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11272 /* Get the result. */
11273 if (result
== XmCR_OK
)
11278 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11279 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11280 XmStringFree (text
);
11281 file
= build_string (data
);
11288 XtUnmanageChild (dialog
);
11289 XtDestroyWidget (dialog
);
11293 /* Make "Cancel" equivalent to C-g. */
11295 Fsignal (Qquit
, Qnil
);
11297 return unbind_to (count
, file
);
11300 #endif /* USE_MOTIF */
11304 /***********************************************************************
11306 ***********************************************************************/
11308 #ifdef HAVE_XKBGETKEYBOARD
11309 #include <X11/XKBlib.h>
11310 #include <X11/keysym.h>
11313 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11314 Sx_backspace_delete_keys_p
, 0, 1, 0,
11315 "Check if both Backspace and Delete keys are on the keyboard of FRAME.\n\
11316 FRAME nil means use the selected frame.\n\
11317 Value is t if we know that both keys are present, and are mapped to the\n\
11322 #ifdef HAVE_XKBGETKEYBOARD
11324 struct frame
*f
= check_x_frame (frame
);
11325 Display
*dpy
= FRAME_X_DISPLAY (f
);
11326 Lisp_Object have_keys
;
11327 int major
, minor
, op
, event
, error
;
11331 /* Check library version in case we're dynamically linked. */
11332 major
= XkbMajorVersion
;
11333 minor
= XkbMinorVersion
;
11334 if (!XkbLibraryVersion (&major
, &minor
))
11340 /* Check that the server supports XKB. */
11341 major
= XkbMajorVersion
;
11342 minor
= XkbMinorVersion
;
11343 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11350 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11353 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11355 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11357 for (i
= kb
->min_key_code
;
11358 (i
< kb
->max_key_code
11359 && (delete_keycode
== 0 || backspace_keycode
== 0));
11362 /* The XKB symbolic key names can be seen most easily
11363 in the PS file generated by `xkbprint -label name $DISPLAY'. */
11364 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11365 delete_keycode
= i
;
11366 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11367 backspace_keycode
= i
;
11370 XkbFreeNames (kb
, 0, True
);
11373 XkbFreeClientMap (kb
, 0, True
);
11376 && backspace_keycode
11377 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11378 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11383 #else /* not HAVE_XKBGETKEYBOARD */
11385 #endif /* not HAVE_XKBGETKEYBOARD */
11390 /***********************************************************************
11392 ***********************************************************************/
11397 /* This is zero if not using X windows. */
11400 /* The section below is built by the lisp expression at the top of the file,
11401 just above where these variables are declared. */
11402 /*&&& init symbols here &&&*/
11403 Qauto_raise
= intern ("auto-raise");
11404 staticpro (&Qauto_raise
);
11405 Qauto_lower
= intern ("auto-lower");
11406 staticpro (&Qauto_lower
);
11407 Qbar
= intern ("bar");
11409 Qborder_color
= intern ("border-color");
11410 staticpro (&Qborder_color
);
11411 Qborder_width
= intern ("border-width");
11412 staticpro (&Qborder_width
);
11413 Qbox
= intern ("box");
11415 Qcursor_color
= intern ("cursor-color");
11416 staticpro (&Qcursor_color
);
11417 Qcursor_type
= intern ("cursor-type");
11418 staticpro (&Qcursor_type
);
11419 Qgeometry
= intern ("geometry");
11420 staticpro (&Qgeometry
);
11421 Qicon_left
= intern ("icon-left");
11422 staticpro (&Qicon_left
);
11423 Qicon_top
= intern ("icon-top");
11424 staticpro (&Qicon_top
);
11425 Qicon_type
= intern ("icon-type");
11426 staticpro (&Qicon_type
);
11427 Qicon_name
= intern ("icon-name");
11428 staticpro (&Qicon_name
);
11429 Qinternal_border_width
= intern ("internal-border-width");
11430 staticpro (&Qinternal_border_width
);
11431 Qleft
= intern ("left");
11432 staticpro (&Qleft
);
11433 Qright
= intern ("right");
11434 staticpro (&Qright
);
11435 Qmouse_color
= intern ("mouse-color");
11436 staticpro (&Qmouse_color
);
11437 Qnone
= intern ("none");
11438 staticpro (&Qnone
);
11439 Qparent_id
= intern ("parent-id");
11440 staticpro (&Qparent_id
);
11441 Qscroll_bar_width
= intern ("scroll-bar-width");
11442 staticpro (&Qscroll_bar_width
);
11443 Qsuppress_icon
= intern ("suppress-icon");
11444 staticpro (&Qsuppress_icon
);
11445 Qundefined_color
= intern ("undefined-color");
11446 staticpro (&Qundefined_color
);
11447 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11448 staticpro (&Qvertical_scroll_bars
);
11449 Qvisibility
= intern ("visibility");
11450 staticpro (&Qvisibility
);
11451 Qwindow_id
= intern ("window-id");
11452 staticpro (&Qwindow_id
);
11453 Qouter_window_id
= intern ("outer-window-id");
11454 staticpro (&Qouter_window_id
);
11455 Qx_frame_parameter
= intern ("x-frame-parameter");
11456 staticpro (&Qx_frame_parameter
);
11457 Qx_resource_name
= intern ("x-resource-name");
11458 staticpro (&Qx_resource_name
);
11459 Quser_position
= intern ("user-position");
11460 staticpro (&Quser_position
);
11461 Quser_size
= intern ("user-size");
11462 staticpro (&Quser_size
);
11463 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11464 staticpro (&Qscroll_bar_foreground
);
11465 Qscroll_bar_background
= intern ("scroll-bar-background");
11466 staticpro (&Qscroll_bar_background
);
11467 Qscreen_gamma
= intern ("screen-gamma");
11468 staticpro (&Qscreen_gamma
);
11469 Qline_spacing
= intern ("line-spacing");
11470 staticpro (&Qline_spacing
);
11471 Qcenter
= intern ("center");
11472 staticpro (&Qcenter
);
11473 Qcompound_text
= intern ("compound-text");
11474 staticpro (&Qcompound_text
);
11475 Qcancel_timer
= intern ("cancel-timer");
11476 staticpro (&Qcancel_timer
);
11477 Qwait_for_wm
= intern ("wait-for-wm");
11478 staticpro (&Qwait_for_wm
);
11479 /* This is the end of symbol initialization. */
11481 /* Text property `display' should be nonsticky by default. */
11482 Vtext_property_default_nonsticky
11483 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11486 Qlaplace
= intern ("laplace");
11487 staticpro (&Qlaplace
);
11488 Qemboss
= intern ("emboss");
11489 staticpro (&Qemboss
);
11490 Qedge_detection
= intern ("edge-detection");
11491 staticpro (&Qedge_detection
);
11492 Qheuristic
= intern ("heuristic");
11493 staticpro (&Qheuristic
);
11494 QCmatrix
= intern (":matrix");
11495 staticpro (&QCmatrix
);
11496 QCcolor_adjustment
= intern (":color-adjustment");
11497 staticpro (&QCcolor_adjustment
);
11498 QCmask
= intern (":mask");
11499 staticpro (&QCmask
);
11501 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11502 staticpro (&Qface_set_after_frame_default
);
11504 Fput (Qundefined_color
, Qerror_conditions
,
11505 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11506 Fput (Qundefined_color
, Qerror_message
,
11507 build_string ("Undefined color"));
11509 init_x_parm_symbols ();
11511 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11512 "Non-nil means always draw a cross over disabled images.\n\
11513 Disabled images are those having an `:conversion disabled' property.\n\
11514 A cross is always drawn on black & white displays.");
11515 cross_disabled_images
= 0;
11517 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11518 "List of directories to search for bitmap files for X.");
11519 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11521 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11522 "The shape of the pointer when over text.\n\
11523 Changing the value does not affect existing frames\n\
11524 unless you set the mouse color.");
11525 Vx_pointer_shape
= Qnil
;
11527 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11528 "The name Emacs uses to look up X resources.\n\
11529 `x-get-resource' uses this as the first component of the instance name\n\
11530 when requesting resource values.\n\
11531 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
11532 was invoked, or to the value specified with the `-name' or `-rn'\n\
11533 switches, if present.\n\
11535 It may be useful to bind this variable locally around a call\n\
11536 to `x-get-resource'. See also the variable `x-resource-class'.");
11537 Vx_resource_name
= Qnil
;
11539 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11540 "The class Emacs uses to look up X resources.\n\
11541 `x-get-resource' uses this as the first component of the instance class\n\
11542 when requesting resource values.\n\
11543 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
11545 Setting this variable permanently is not a reasonable thing to do,\n\
11546 but binding this variable locally around a call to `x-get-resource'\n\
11547 is a reasonable practice. See also the variable `x-resource-name'.");
11548 Vx_resource_class
= build_string (EMACS_CLASS
);
11550 #if 0 /* This doesn't really do anything. */
11551 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11552 "The shape of the pointer when not over text.\n\
11553 This variable takes effect when you create a new frame\n\
11554 or when you set the mouse color.");
11556 Vx_nontext_pointer_shape
= Qnil
;
11558 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
11559 "The shape of the pointer when Emacs is busy.\n\
11560 This variable takes effect when you create a new frame\n\
11561 or when you set the mouse color.");
11562 Vx_hourglass_pointer_shape
= Qnil
;
11564 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
11565 "Non-zero means Emacs displays an hourglass pointer on window systems.");
11566 display_hourglass_p
= 1;
11568 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
11569 "*Seconds to wait before displaying an hourglass pointer.\n\
11570 Value must be an integer or float.");
11571 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
11573 #if 0 /* This doesn't really do anything. */
11574 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11575 "The shape of the pointer when over the mode line.\n\
11576 This variable takes effect when you create a new frame\n\
11577 or when you set the mouse color.");
11579 Vx_mode_pointer_shape
= Qnil
;
11581 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11582 &Vx_sensitive_text_pointer_shape
,
11583 "The shape of the pointer when over mouse-sensitive text.\n\
11584 This variable takes effect when you create a new frame\n\
11585 or when you set the mouse color.");
11586 Vx_sensitive_text_pointer_shape
= Qnil
;
11588 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11589 &Vx_window_horizontal_drag_shape
,
11590 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
11591 This variable takes effect when you create a new frame\n\
11592 or when you set the mouse color.");
11593 Vx_window_horizontal_drag_shape
= Qnil
;
11595 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11596 "A string indicating the foreground color of the cursor box.");
11597 Vx_cursor_fore_pixel
= Qnil
;
11599 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11600 "Non-nil if no X window manager is in use.\n\
11601 Emacs doesn't try to figure this out; this is always nil\n\
11602 unless you set it to something else.");
11603 /* We don't have any way to find this out, so set it to nil
11604 and maybe the user would like to set it to t. */
11605 Vx_no_window_manager
= Qnil
;
11607 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11608 &Vx_pixel_size_width_font_regexp
,
11609 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11611 Since Emacs gets width of a font matching with this regexp from\n\
11612 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11613 such a font. This is especially effective for such large fonts as\n\
11614 Chinese, Japanese, and Korean.");
11615 Vx_pixel_size_width_font_regexp
= Qnil
;
11617 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11618 "Time after which cached images are removed from the cache.\n\
11619 When an image has not been displayed this many seconds, remove it\n\
11620 from the image cache. Value must be an integer or nil with nil\n\
11621 meaning don't clear the cache.");
11622 Vimage_cache_eviction_delay
= make_number (30 * 60);
11624 #ifdef USE_X_TOOLKIT
11625 Fprovide (intern ("x-toolkit"));
11628 Fprovide (intern ("motif"));
11630 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string
,
11631 "Version info for LessTif/Motif.");
11632 Vmotif_version_string
= build_string (XmVERSION_STRING
);
11633 #endif /* USE_MOTIF */
11634 #endif /* USE_X_TOOLKIT */
11636 defsubr (&Sx_get_resource
);
11638 /* X window properties. */
11639 defsubr (&Sx_change_window_property
);
11640 defsubr (&Sx_delete_window_property
);
11641 defsubr (&Sx_window_property
);
11643 defsubr (&Sxw_display_color_p
);
11644 defsubr (&Sx_display_grayscale_p
);
11645 defsubr (&Sxw_color_defined_p
);
11646 defsubr (&Sxw_color_values
);
11647 defsubr (&Sx_server_max_request_size
);
11648 defsubr (&Sx_server_vendor
);
11649 defsubr (&Sx_server_version
);
11650 defsubr (&Sx_display_pixel_width
);
11651 defsubr (&Sx_display_pixel_height
);
11652 defsubr (&Sx_display_mm_width
);
11653 defsubr (&Sx_display_mm_height
);
11654 defsubr (&Sx_display_screens
);
11655 defsubr (&Sx_display_planes
);
11656 defsubr (&Sx_display_color_cells
);
11657 defsubr (&Sx_display_visual_class
);
11658 defsubr (&Sx_display_backing_store
);
11659 defsubr (&Sx_display_save_under
);
11660 defsubr (&Sx_parse_geometry
);
11661 defsubr (&Sx_create_frame
);
11662 defsubr (&Sx_open_connection
);
11663 defsubr (&Sx_close_connection
);
11664 defsubr (&Sx_display_list
);
11665 defsubr (&Sx_synchronize
);
11666 defsubr (&Sx_focus_frame
);
11667 defsubr (&Sx_backspace_delete_keys_p
);
11669 /* Setting callback functions for fontset handler. */
11670 get_font_info_func
= x_get_font_info
;
11672 #if 0 /* This function pointer doesn't seem to be used anywhere.
11673 And the pointer assigned has the wrong type, anyway. */
11674 list_fonts_func
= x_list_fonts
;
11677 load_font_func
= x_load_font
;
11678 find_ccl_program_func
= x_find_ccl_program
;
11679 query_font_func
= x_query_font
;
11680 set_frame_fontset_func
= x_set_font
;
11681 check_window_system_func
= check_x
;
11684 Qxbm
= intern ("xbm");
11686 QCtype
= intern (":type");
11687 staticpro (&QCtype
);
11688 QCconversion
= intern (":conversion");
11689 staticpro (&QCconversion
);
11690 QCheuristic_mask
= intern (":heuristic-mask");
11691 staticpro (&QCheuristic_mask
);
11692 QCcolor_symbols
= intern (":color-symbols");
11693 staticpro (&QCcolor_symbols
);
11694 QCascent
= intern (":ascent");
11695 staticpro (&QCascent
);
11696 QCmargin
= intern (":margin");
11697 staticpro (&QCmargin
);
11698 QCrelief
= intern (":relief");
11699 staticpro (&QCrelief
);
11700 Qpostscript
= intern ("postscript");
11701 staticpro (&Qpostscript
);
11702 QCloader
= intern (":loader");
11703 staticpro (&QCloader
);
11704 QCbounding_box
= intern (":bounding-box");
11705 staticpro (&QCbounding_box
);
11706 QCpt_width
= intern (":pt-width");
11707 staticpro (&QCpt_width
);
11708 QCpt_height
= intern (":pt-height");
11709 staticpro (&QCpt_height
);
11710 QCindex
= intern (":index");
11711 staticpro (&QCindex
);
11712 Qpbm
= intern ("pbm");
11716 Qxpm
= intern ("xpm");
11721 Qjpeg
= intern ("jpeg");
11722 staticpro (&Qjpeg
);
11726 Qtiff
= intern ("tiff");
11727 staticpro (&Qtiff
);
11731 Qgif
= intern ("gif");
11736 Qpng
= intern ("png");
11740 defsubr (&Sclear_image_cache
);
11741 defsubr (&Simage_size
);
11742 defsubr (&Simage_mask_p
);
11744 hourglass_atimer
= NULL
;
11745 hourglass_shown_p
= 0;
11747 defsubr (&Sx_show_tip
);
11748 defsubr (&Sx_hide_tip
);
11750 staticpro (&tip_timer
);
11752 staticpro (&tip_frame
);
11754 last_show_tip_args
= Qnil
;
11755 staticpro (&last_show_tip_args
);
11758 defsubr (&Sx_file_dialog
);
11766 image_types
= NULL
;
11767 Vimage_types
= Qnil
;
11769 define_image_type (&xbm_type
);
11770 define_image_type (&gs_type
);
11771 define_image_type (&pbm_type
);
11774 define_image_type (&xpm_type
);
11778 define_image_type (&jpeg_type
);
11782 define_image_type (&tiff_type
);
11786 define_image_type (&gif_type
);
11790 define_image_type (&png_type
);
11794 #endif /* HAVE_X_WINDOWS */