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
;
221 /* The below are defined in frame.c. */
223 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
224 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
225 extern Lisp_Object Qtool_bar_lines
;
227 extern Lisp_Object Vwindow_system_version
;
229 Lisp_Object Qface_set_after_frame_default
;
232 int image_cache_refcount
, dpyinfo_refcount
;
237 /* Error if we are not connected to X. */
243 error ("X windows are not in use or not initialized");
246 /* Nonzero if we can use mouse menus.
247 You should not call this unless HAVE_MENUS is defined. */
255 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
256 and checking validity for X. */
259 check_x_frame (frame
)
265 frame
= selected_frame
;
266 CHECK_LIVE_FRAME (frame
, 0);
269 error ("Non-X frame used");
273 /* Let the user specify an X display with a frame.
274 nil stands for the selected frame--or, if that is not an X frame,
275 the first X display on the list. */
277 static struct x_display_info
*
278 check_x_display_info (frame
)
281 struct x_display_info
*dpyinfo
= NULL
;
285 struct frame
*sf
= XFRAME (selected_frame
);
287 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
288 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
289 else if (x_display_list
!= 0)
290 dpyinfo
= x_display_list
;
292 error ("X windows are not in use or not initialized");
294 else if (STRINGP (frame
))
295 dpyinfo
= x_display_info_for_name (frame
);
300 CHECK_LIVE_FRAME (frame
, 0);
303 error ("Non-X frame used");
304 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
311 /* Return the Emacs frame-object corresponding to an X window.
312 It could be the frame's main window or an icon window. */
314 /* This function can be called during GC, so use GC_xxx type test macros. */
317 x_window_to_frame (dpyinfo
, wdesc
)
318 struct x_display_info
*dpyinfo
;
321 Lisp_Object tail
, frame
;
324 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
327 if (!GC_FRAMEP (frame
))
330 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
332 if (f
->output_data
.x
->hourglass_window
== wdesc
)
335 if ((f
->output_data
.x
->edit_widget
336 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
337 /* A tooltip frame? */
338 || (!f
->output_data
.x
->edit_widget
339 && FRAME_X_WINDOW (f
) == wdesc
)
340 || f
->output_data
.x
->icon_desc
== wdesc
)
342 #else /* not USE_X_TOOLKIT */
343 if (FRAME_X_WINDOW (f
) == wdesc
344 || f
->output_data
.x
->icon_desc
== wdesc
)
346 #endif /* not USE_X_TOOLKIT */
352 /* Like x_window_to_frame but also compares the window with the widget's
356 x_any_window_to_frame (dpyinfo
, wdesc
)
357 struct x_display_info
*dpyinfo
;
360 Lisp_Object tail
, frame
;
361 struct frame
*f
, *found
;
365 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
368 if (!GC_FRAMEP (frame
))
372 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
374 /* This frame matches if the window is any of its widgets. */
375 x
= f
->output_data
.x
;
376 if (x
->hourglass_window
== wdesc
)
380 if (wdesc
== XtWindow (x
->widget
)
381 || wdesc
== XtWindow (x
->column_widget
)
382 || wdesc
== XtWindow (x
->edit_widget
))
384 /* Match if the window is this frame's menubar. */
385 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
388 else if (FRAME_X_WINDOW (f
) == wdesc
)
389 /* A tooltip frame. */
397 /* Likewise, but exclude the menu bar widget. */
400 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
401 struct x_display_info
*dpyinfo
;
404 Lisp_Object tail
, frame
;
408 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
411 if (!GC_FRAMEP (frame
))
414 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
416 x
= f
->output_data
.x
;
417 /* This frame matches if the window is any of its widgets. */
418 if (x
->hourglass_window
== wdesc
)
422 if (wdesc
== XtWindow (x
->widget
)
423 || wdesc
== XtWindow (x
->column_widget
)
424 || wdesc
== XtWindow (x
->edit_widget
))
427 else if (FRAME_X_WINDOW (f
) == wdesc
)
428 /* A tooltip frame. */
434 /* Likewise, but consider only the menu bar widget. */
437 x_menubar_window_to_frame (dpyinfo
, wdesc
)
438 struct x_display_info
*dpyinfo
;
441 Lisp_Object tail
, frame
;
445 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
448 if (!GC_FRAMEP (frame
))
451 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
453 x
= f
->output_data
.x
;
454 /* Match if the window is this frame's menubar. */
455 if (x
->menubar_widget
456 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
462 /* Return the frame whose principal (outermost) window is WDESC.
463 If WDESC is some other (smaller) window, we return 0. */
466 x_top_window_to_frame (dpyinfo
, wdesc
)
467 struct x_display_info
*dpyinfo
;
470 Lisp_Object tail
, frame
;
474 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
477 if (!GC_FRAMEP (frame
))
480 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
482 x
= f
->output_data
.x
;
486 /* This frame matches if the window is its topmost widget. */
487 if (wdesc
== XtWindow (x
->widget
))
489 #if 0 /* I don't know why it did this,
490 but it seems logically wrong,
491 and it causes trouble for MapNotify events. */
492 /* Match if the window is this frame's menubar. */
493 if (x
->menubar_widget
494 && wdesc
== XtWindow (x
->menubar_widget
))
498 else if (FRAME_X_WINDOW (f
) == wdesc
)
504 #endif /* USE_X_TOOLKIT */
508 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
509 id, which is just an int that this section returns. Bitmaps are
510 reference counted so they can be shared among frames.
512 Bitmap indices are guaranteed to be > 0, so a negative number can
513 be used to indicate no bitmap.
515 If you use x_create_bitmap_from_data, then you must keep track of
516 the bitmaps yourself. That is, creating a bitmap from the same
517 data more than once will not be caught. */
520 /* Functions to access the contents of a bitmap, given an id. */
523 x_bitmap_height (f
, id
)
527 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
531 x_bitmap_width (f
, id
)
535 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
539 x_bitmap_pixmap (f
, id
)
543 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
547 /* Allocate a new bitmap record. Returns index of new record. */
550 x_allocate_bitmap_record (f
)
553 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
556 if (dpyinfo
->bitmaps
== NULL
)
558 dpyinfo
->bitmaps_size
= 10;
560 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
561 dpyinfo
->bitmaps_last
= 1;
565 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
566 return ++dpyinfo
->bitmaps_last
;
568 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
569 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
572 dpyinfo
->bitmaps_size
*= 2;
574 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
575 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
576 return ++dpyinfo
->bitmaps_last
;
579 /* Add one reference to the reference count of the bitmap with id ID. */
582 x_reference_bitmap (f
, id
)
586 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
589 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
592 x_create_bitmap_from_data (f
, bits
, width
, height
)
595 unsigned int width
, height
;
597 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
601 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
602 bits
, width
, height
);
607 id
= x_allocate_bitmap_record (f
);
608 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
609 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
610 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
611 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
612 dpyinfo
->bitmaps
[id
- 1].height
= height
;
613 dpyinfo
->bitmaps
[id
- 1].width
= width
;
618 /* Create bitmap from file FILE for frame F. */
621 x_create_bitmap_from_file (f
, file
)
625 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
626 unsigned int width
, height
;
628 int xhot
, yhot
, result
, id
;
633 /* Look for an existing bitmap with the same name. */
634 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
636 if (dpyinfo
->bitmaps
[id
].refcount
637 && dpyinfo
->bitmaps
[id
].file
638 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
640 ++dpyinfo
->bitmaps
[id
].refcount
;
645 /* Search bitmap-file-path for the file, if appropriate. */
646 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
651 filename
= (char *) XSTRING (found
)->data
;
653 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
654 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
655 if (result
!= BitmapSuccess
)
658 id
= x_allocate_bitmap_record (f
);
659 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
660 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
661 dpyinfo
->bitmaps
[id
- 1].file
662 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
663 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
664 dpyinfo
->bitmaps
[id
- 1].height
= height
;
665 dpyinfo
->bitmaps
[id
- 1].width
= width
;
666 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
671 /* Remove reference to bitmap with id number ID. */
674 x_destroy_bitmap (f
, id
)
678 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
682 --dpyinfo
->bitmaps
[id
- 1].refcount
;
683 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
686 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
687 if (dpyinfo
->bitmaps
[id
- 1].file
)
689 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
690 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
697 /* Free all the bitmaps for the display specified by DPYINFO. */
700 x_destroy_all_bitmaps (dpyinfo
)
701 struct x_display_info
*dpyinfo
;
704 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
705 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
707 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
708 if (dpyinfo
->bitmaps
[i
].file
)
709 xfree (dpyinfo
->bitmaps
[i
].file
);
711 dpyinfo
->bitmaps_last
= 0;
714 /* Connect the frame-parameter names for X frames
715 to the ways of passing the parameter values to the window system.
717 The name of a parameter, as a Lisp symbol,
718 has an `x-frame-parameter' property which is an integer in Lisp
719 that is an index in this table. */
721 struct x_frame_parm_table
724 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
727 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
728 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
729 static void x_change_window_heights
P_ ((Lisp_Object
, int));
730 static void x_disable_image
P_ ((struct frame
*, struct image
*));
731 static void x_create_im
P_ ((struct frame
*));
732 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
733 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
734 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
735 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
736 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
737 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
738 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
739 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
740 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
741 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
742 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
743 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
745 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
746 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
750 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
755 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
758 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
760 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
765 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
766 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
768 static void init_color_table
P_ ((void));
769 static void free_color_table
P_ ((void));
770 static unsigned long *colors_in_color_table
P_ ((int *n
));
771 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
772 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
776 static struct x_frame_parm_table x_frame_parms
[] =
778 "auto-raise", x_set_autoraise
,
779 "auto-lower", x_set_autolower
,
780 "background-color", x_set_background_color
,
781 "border-color", x_set_border_color
,
782 "border-width", x_set_border_width
,
783 "cursor-color", x_set_cursor_color
,
784 "cursor-type", x_set_cursor_type
,
786 "foreground-color", x_set_foreground_color
,
787 "icon-name", x_set_icon_name
,
788 "icon-type", x_set_icon_type
,
789 "internal-border-width", x_set_internal_border_width
,
790 "menu-bar-lines", x_set_menu_bar_lines
,
791 "mouse-color", x_set_mouse_color
,
792 "name", x_explicitly_set_name
,
793 "scroll-bar-width", x_set_scroll_bar_width
,
794 "title", x_set_title
,
795 "unsplittable", x_set_unsplittable
,
796 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
797 "visibility", x_set_visibility
,
798 "tool-bar-lines", x_set_tool_bar_lines
,
799 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
800 "scroll-bar-background", x_set_scroll_bar_background
,
801 "screen-gamma", x_set_screen_gamma
,
802 "line-spacing", x_set_line_spacing
805 /* Attach the `x-frame-parameter' properties to
806 the Lisp symbol names of parameters relevant to X. */
809 init_x_parm_symbols ()
813 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
814 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
818 /* Change the parameters of frame F as specified by ALIST.
819 If a parameter is not specially recognized, do nothing special;
820 otherwise call the `x_set_...' function for that parameter.
821 Except for certain geometry properties, always call store_frame_param
822 to store the new value in the parameter alist. */
825 x_set_frame_parameters (f
, alist
)
831 /* If both of these parameters are present, it's more efficient to
832 set them both at once. So we wait until we've looked at the
833 entire list before we set them. */
837 Lisp_Object left
, top
;
839 /* Same with these. */
840 Lisp_Object icon_left
, icon_top
;
842 /* Record in these vectors all the parms specified. */
846 int left_no_change
= 0, top_no_change
= 0;
847 int icon_left_no_change
= 0, icon_top_no_change
= 0;
849 struct gcpro gcpro1
, gcpro2
;
852 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
855 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
856 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
858 /* Extract parm names and values into those vectors. */
861 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
866 parms
[i
] = Fcar (elt
);
867 values
[i
] = Fcdr (elt
);
870 /* TAIL and ALIST are not used again below here. */
873 GCPRO2 (*parms
, *values
);
877 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
878 because their values appear in VALUES and strings are not valid. */
879 top
= left
= Qunbound
;
880 icon_left
= icon_top
= Qunbound
;
882 /* Provide default values for HEIGHT and WIDTH. */
883 if (FRAME_NEW_WIDTH (f
))
884 width
= FRAME_NEW_WIDTH (f
);
886 width
= FRAME_WIDTH (f
);
888 if (FRAME_NEW_HEIGHT (f
))
889 height
= FRAME_NEW_HEIGHT (f
);
891 height
= FRAME_HEIGHT (f
);
893 /* Process foreground_color and background_color before anything else.
894 They are independent of other properties, but other properties (e.g.,
895 cursor_color) are dependent upon them. */
896 for (p
= 0; p
< i
; p
++)
898 Lisp_Object prop
, val
;
902 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
904 register Lisp_Object param_index
, old_value
;
906 param_index
= Fget (prop
, Qx_frame_parameter
);
907 old_value
= get_frame_param (f
, prop
);
908 store_frame_param (f
, prop
, val
);
909 if (NATNUMP (param_index
)
910 && (XFASTINT (param_index
)
911 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
912 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
916 /* Now process them in reverse of specified order. */
917 for (i
--; i
>= 0; i
--)
919 Lisp_Object prop
, val
;
924 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
925 width
= XFASTINT (val
);
926 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
927 height
= XFASTINT (val
);
928 else if (EQ (prop
, Qtop
))
930 else if (EQ (prop
, Qleft
))
932 else if (EQ (prop
, Qicon_top
))
934 else if (EQ (prop
, Qicon_left
))
936 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
937 /* Processed above. */
941 register Lisp_Object param_index
, old_value
;
943 param_index
= Fget (prop
, Qx_frame_parameter
);
944 old_value
= get_frame_param (f
, prop
);
945 store_frame_param (f
, prop
, val
);
946 if (NATNUMP (param_index
)
947 && (XFASTINT (param_index
)
948 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
949 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
953 /* Don't die if just one of these was set. */
954 if (EQ (left
, Qunbound
))
957 if (f
->output_data
.x
->left_pos
< 0)
958 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
960 XSETINT (left
, f
->output_data
.x
->left_pos
);
962 if (EQ (top
, Qunbound
))
965 if (f
->output_data
.x
->top_pos
< 0)
966 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
968 XSETINT (top
, f
->output_data
.x
->top_pos
);
971 /* If one of the icon positions was not set, preserve or default it. */
972 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
974 icon_left_no_change
= 1;
975 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
976 if (NILP (icon_left
))
977 XSETINT (icon_left
, 0);
979 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
981 icon_top_no_change
= 1;
982 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
984 XSETINT (icon_top
, 0);
987 /* Don't set these parameters unless they've been explicitly
988 specified. The window might be mapped or resized while we're in
989 this function, and we don't want to override that unless the lisp
990 code has asked for it.
992 Don't set these parameters unless they actually differ from the
993 window's current parameters; the window may not actually exist
998 check_frame_size (f
, &height
, &width
);
1000 XSETFRAME (frame
, f
);
1002 if (width
!= FRAME_WIDTH (f
)
1003 || height
!= FRAME_HEIGHT (f
)
1004 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1005 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1007 if ((!NILP (left
) || !NILP (top
))
1008 && ! (left_no_change
&& top_no_change
)
1009 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1010 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1015 /* Record the signs. */
1016 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1017 if (EQ (left
, Qminus
))
1018 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1019 else if (INTEGERP (left
))
1021 leftpos
= XINT (left
);
1023 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1025 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1026 && CONSP (XCDR (left
))
1027 && INTEGERP (XCAR (XCDR (left
))))
1029 leftpos
= - XINT (XCAR (XCDR (left
)));
1030 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1032 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1033 && CONSP (XCDR (left
))
1034 && INTEGERP (XCAR (XCDR (left
))))
1036 leftpos
= XINT (XCAR (XCDR (left
)));
1039 if (EQ (top
, Qminus
))
1040 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1041 else if (INTEGERP (top
))
1043 toppos
= XINT (top
);
1045 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1047 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1048 && CONSP (XCDR (top
))
1049 && INTEGERP (XCAR (XCDR (top
))))
1051 toppos
= - XINT (XCAR (XCDR (top
)));
1052 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1054 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1055 && CONSP (XCDR (top
))
1056 && INTEGERP (XCAR (XCDR (top
))))
1058 toppos
= XINT (XCAR (XCDR (top
)));
1062 /* Store the numeric value of the position. */
1063 f
->output_data
.x
->top_pos
= toppos
;
1064 f
->output_data
.x
->left_pos
= leftpos
;
1066 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1068 /* Actually set that position, and convert to absolute. */
1069 x_set_offset (f
, leftpos
, toppos
, -1);
1072 if ((!NILP (icon_left
) || !NILP (icon_top
))
1073 && ! (icon_left_no_change
&& icon_top_no_change
))
1074 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1080 /* Store the screen positions of frame F into XPTR and YPTR.
1081 These are the positions of the containing window manager window,
1082 not Emacs's own window. */
1085 x_real_positions (f
, xptr
, yptr
)
1092 /* This is pretty gross, but seems to be the easiest way out of
1093 the problem that arises when restarting window-managers. */
1095 #ifdef USE_X_TOOLKIT
1096 Window outer
= (f
->output_data
.x
->widget
1097 ? XtWindow (f
->output_data
.x
->widget
)
1098 : FRAME_X_WINDOW (f
));
1100 Window outer
= f
->output_data
.x
->window_desc
;
1102 Window tmp_root_window
;
1103 Window
*tmp_children
;
1104 unsigned int tmp_nchildren
;
1108 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1109 Window outer_window
;
1111 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1112 &f
->output_data
.x
->parent_desc
,
1113 &tmp_children
, &tmp_nchildren
);
1114 XFree ((char *) tmp_children
);
1118 /* Find the position of the outside upper-left corner of
1119 the inner window, with respect to the outer window. */
1120 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1121 outer_window
= f
->output_data
.x
->parent_desc
;
1123 outer_window
= outer
;
1125 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1127 /* From-window, to-window. */
1129 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1131 /* From-position, to-position. */
1132 0, 0, &win_x
, &win_y
,
1137 /* It is possible for the window returned by the XQueryNotify
1138 to become invalid by the time we call XTranslateCoordinates.
1139 That can happen when you restart some window managers.
1140 If so, we get an error in XTranslateCoordinates.
1141 Detect that and try the whole thing over. */
1142 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1144 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1148 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1155 /* Insert a description of internally-recorded parameters of frame X
1156 into the parameter alist *ALISTPTR that is to be given to the user.
1157 Only parameters that are specific to the X window system
1158 and whose values are not correctly recorded in the frame's
1159 param_alist need to be considered here. */
1162 x_report_frame_params (f
, alistptr
)
1164 Lisp_Object
*alistptr
;
1169 /* Represent negative positions (off the top or left screen edge)
1170 in a way that Fmodify_frame_parameters will understand correctly. */
1171 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1172 if (f
->output_data
.x
->left_pos
>= 0)
1173 store_in_alist (alistptr
, Qleft
, tem
);
1175 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1177 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1178 if (f
->output_data
.x
->top_pos
>= 0)
1179 store_in_alist (alistptr
, Qtop
, tem
);
1181 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1183 store_in_alist (alistptr
, Qborder_width
,
1184 make_number (f
->output_data
.x
->border_width
));
1185 store_in_alist (alistptr
, Qinternal_border_width
,
1186 make_number (f
->output_data
.x
->internal_border_width
));
1187 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1188 store_in_alist (alistptr
, Qwindow_id
,
1189 build_string (buf
));
1190 #ifdef USE_X_TOOLKIT
1191 /* Tooltip frame may not have this widget. */
1192 if (f
->output_data
.x
->widget
)
1194 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1195 store_in_alist (alistptr
, Qouter_window_id
,
1196 build_string (buf
));
1197 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1198 FRAME_SAMPLE_VISIBILITY (f
);
1199 store_in_alist (alistptr
, Qvisibility
,
1200 (FRAME_VISIBLE_P (f
) ? Qt
1201 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1202 store_in_alist (alistptr
, Qdisplay
,
1203 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1205 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1208 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1209 store_in_alist (alistptr
, Qparent_id
, tem
);
1214 /* Gamma-correct COLOR on frame F. */
1217 gamma_correct (f
, color
)
1223 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1224 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1225 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1230 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1231 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1232 allocate the color. Value is zero if COLOR_NAME is invalid, or
1233 no color could be allocated. */
1236 x_defined_color (f
, color_name
, color
, alloc_p
)
1243 Display
*dpy
= FRAME_X_DISPLAY (f
);
1244 Colormap cmap
= FRAME_X_COLORMAP (f
);
1247 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1248 if (success_p
&& alloc_p
)
1249 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1256 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1257 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1258 Signal an error if color can't be allocated. */
1261 x_decode_color (f
, color_name
, mono_color
)
1263 Lisp_Object color_name
;
1268 CHECK_STRING (color_name
, 0);
1270 #if 0 /* Don't do this. It's wrong when we're not using the default
1271 colormap, it makes freeing difficult, and it's probably not
1272 an important optimization. */
1273 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1274 return BLACK_PIX_DEFAULT (f
);
1275 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1276 return WHITE_PIX_DEFAULT (f
);
1279 /* Return MONO_COLOR for monochrome frames. */
1280 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1283 /* x_defined_color is responsible for coping with failures
1284 by looking for a near-miss. */
1285 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1288 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1289 Fcons (color_name
, Qnil
)));
1295 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1296 the previous value of that parameter, NEW_VALUE is the new value. */
1299 x_set_line_spacing (f
, new_value
, old_value
)
1301 Lisp_Object new_value
, old_value
;
1303 if (NILP (new_value
))
1304 f
->extra_line_spacing
= 0;
1305 else if (NATNUMP (new_value
))
1306 f
->extra_line_spacing
= XFASTINT (new_value
);
1308 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1309 Fcons (new_value
, Qnil
)));
1310 if (FRAME_VISIBLE_P (f
))
1315 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1316 the previous value of that parameter, NEW_VALUE is the new value. */
1319 x_set_screen_gamma (f
, new_value
, old_value
)
1321 Lisp_Object new_value
, old_value
;
1323 if (NILP (new_value
))
1325 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1326 /* The value 0.4545 is the normal viewing gamma. */
1327 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1329 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1330 Fcons (new_value
, Qnil
)));
1332 clear_face_cache (0);
1336 /* Functions called only from `x_set_frame_param'
1337 to set individual parameters.
1339 If FRAME_X_WINDOW (f) is 0,
1340 the frame is being created and its X-window does not exist yet.
1341 In that case, just record the parameter's new value
1342 in the standard place; do not attempt to change the window. */
1345 x_set_foreground_color (f
, arg
, oldval
)
1347 Lisp_Object arg
, oldval
;
1349 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1351 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1352 f
->output_data
.x
->foreground_pixel
= pixel
;
1354 if (FRAME_X_WINDOW (f
) != 0)
1357 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1358 f
->output_data
.x
->foreground_pixel
);
1359 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1360 f
->output_data
.x
->foreground_pixel
);
1361 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1362 f
->output_data
.x
->foreground_pixel
);
1364 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1365 if (FRAME_VISIBLE_P (f
))
1371 x_set_background_color (f
, arg
, oldval
)
1373 Lisp_Object arg
, oldval
;
1375 unsigned long pixel
= x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1377 unload_color (f
, f
->output_data
.x
->background_pixel
);
1378 f
->output_data
.x
->background_pixel
= pixel
;
1380 if (FRAME_X_WINDOW (f
) != 0)
1383 /* The main frame area. */
1384 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1385 f
->output_data
.x
->background_pixel
);
1386 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1387 f
->output_data
.x
->background_pixel
);
1388 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1389 f
->output_data
.x
->background_pixel
);
1390 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1391 f
->output_data
.x
->background_pixel
);
1394 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1395 bar
= XSCROLL_BAR (bar
)->next
)
1396 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1397 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1398 f
->output_data
.x
->background_pixel
);
1402 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1404 if (FRAME_VISIBLE_P (f
))
1410 x_set_mouse_color (f
, arg
, oldval
)
1412 Lisp_Object arg
, oldval
;
1414 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1415 Cursor hourglass_cursor
, horizontal_drag_cursor
;
1417 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1418 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1420 /* Don't let pointers be invisible. */
1421 if (mask_color
== pixel
1422 && mask_color
== f
->output_data
.x
->background_pixel
)
1424 x_free_colors (f
, &pixel
, 1);
1425 pixel
= x_copy_color (f
, f
->output_data
.x
->foreground_pixel
);
1428 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1429 f
->output_data
.x
->mouse_pixel
= pixel
;
1433 /* It's not okay to crash if the user selects a screwy cursor. */
1434 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1436 if (!EQ (Qnil
, Vx_pointer_shape
))
1438 CHECK_NUMBER (Vx_pointer_shape
, 0);
1439 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1442 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1443 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1445 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1447 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1448 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1449 XINT (Vx_nontext_pointer_shape
));
1452 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1453 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1455 if (!EQ (Qnil
, Vx_hourglass_pointer_shape
))
1457 CHECK_NUMBER (Vx_hourglass_pointer_shape
, 0);
1458 hourglass_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1459 XINT (Vx_hourglass_pointer_shape
));
1462 hourglass_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1463 x_check_errors (FRAME_X_DISPLAY (f
), "bad hourglass pointer cursor: %s");
1465 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1466 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1468 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1469 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1470 XINT (Vx_mode_pointer_shape
));
1473 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1474 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1476 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1478 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1480 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1481 XINT (Vx_sensitive_text_pointer_shape
));
1484 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1486 if (!NILP (Vx_window_horizontal_drag_shape
))
1488 CHECK_NUMBER (Vx_window_horizontal_drag_shape
, 0);
1489 horizontal_drag_cursor
1490 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1491 XINT (Vx_window_horizontal_drag_shape
));
1494 horizontal_drag_cursor
1495 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
1497 /* Check and report errors with the above calls. */
1498 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1499 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1502 XColor fore_color
, back_color
;
1504 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1505 x_query_color (f
, &fore_color
);
1506 back_color
.pixel
= mask_color
;
1507 x_query_color (f
, &back_color
);
1509 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1510 &fore_color
, &back_color
);
1511 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1512 &fore_color
, &back_color
);
1513 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1514 &fore_color
, &back_color
);
1515 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1516 &fore_color
, &back_color
);
1517 XRecolorCursor (FRAME_X_DISPLAY (f
), hourglass_cursor
,
1518 &fore_color
, &back_color
);
1519 XRecolorCursor (FRAME_X_DISPLAY (f
), horizontal_drag_cursor
,
1520 &fore_color
, &back_color
);
1523 if (FRAME_X_WINDOW (f
) != 0)
1524 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1526 if (cursor
!= f
->output_data
.x
->text_cursor
1527 && f
->output_data
.x
->text_cursor
!= 0)
1528 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1529 f
->output_data
.x
->text_cursor
= cursor
;
1531 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1532 && f
->output_data
.x
->nontext_cursor
!= 0)
1533 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1534 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1536 if (hourglass_cursor
!= f
->output_data
.x
->hourglass_cursor
1537 && f
->output_data
.x
->hourglass_cursor
!= 0)
1538 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->hourglass_cursor
);
1539 f
->output_data
.x
->hourglass_cursor
= hourglass_cursor
;
1541 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1542 && f
->output_data
.x
->modeline_cursor
!= 0)
1543 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1544 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1546 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1547 && f
->output_data
.x
->cross_cursor
!= 0)
1548 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1549 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1551 if (horizontal_drag_cursor
!= f
->output_data
.x
->horizontal_drag_cursor
1552 && f
->output_data
.x
->horizontal_drag_cursor
!= 0)
1553 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->horizontal_drag_cursor
);
1554 f
->output_data
.x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1556 XFlush (FRAME_X_DISPLAY (f
));
1559 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1563 x_set_cursor_color (f
, arg
, oldval
)
1565 Lisp_Object arg
, oldval
;
1567 unsigned long fore_pixel
, pixel
;
1568 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1570 if (!NILP (Vx_cursor_fore_pixel
))
1572 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1573 WHITE_PIX_DEFAULT (f
));
1574 fore_pixel_allocated_p
= 1;
1577 fore_pixel
= f
->output_data
.x
->background_pixel
;
1579 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1580 pixel_allocated_p
= 1;
1582 /* Make sure that the cursor color differs from the background color. */
1583 if (pixel
== f
->output_data
.x
->background_pixel
)
1585 if (pixel_allocated_p
)
1587 x_free_colors (f
, &pixel
, 1);
1588 pixel_allocated_p
= 0;
1591 pixel
= f
->output_data
.x
->mouse_pixel
;
1592 if (pixel
== fore_pixel
)
1594 if (fore_pixel_allocated_p
)
1596 x_free_colors (f
, &fore_pixel
, 1);
1597 fore_pixel_allocated_p
= 0;
1599 fore_pixel
= f
->output_data
.x
->background_pixel
;
1603 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1604 if (!fore_pixel_allocated_p
)
1605 fore_pixel
= x_copy_color (f
, fore_pixel
);
1606 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1608 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1609 if (!pixel_allocated_p
)
1610 pixel
= x_copy_color (f
, pixel
);
1611 f
->output_data
.x
->cursor_pixel
= pixel
;
1613 if (FRAME_X_WINDOW (f
) != 0)
1616 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1617 f
->output_data
.x
->cursor_pixel
);
1618 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1622 if (FRAME_VISIBLE_P (f
))
1624 x_update_cursor (f
, 0);
1625 x_update_cursor (f
, 1);
1629 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1632 /* Set the border-color of frame F to value described by ARG.
1633 ARG can be a string naming a color.
1634 The border-color is used for the border that is drawn by the X server.
1635 Note that this does not fully take effect if done before
1636 F has an x-window; it must be redone when the window is created.
1638 Note: this is done in two routines because of the way X10 works.
1640 Note: under X11, this is normally the province of the window manager,
1641 and so emacs' border colors may be overridden. */
1644 x_set_border_color (f
, arg
, oldval
)
1646 Lisp_Object arg
, oldval
;
1650 CHECK_STRING (arg
, 0);
1651 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1652 x_set_border_pixel (f
, pix
);
1653 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1656 /* Set the border-color of frame F to pixel value PIX.
1657 Note that this does not fully take effect if done before
1658 F has an x-window. */
1661 x_set_border_pixel (f
, pix
)
1665 unload_color (f
, f
->output_data
.x
->border_pixel
);
1666 f
->output_data
.x
->border_pixel
= pix
;
1668 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1671 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1672 (unsigned long)pix
);
1675 if (FRAME_VISIBLE_P (f
))
1681 /* Value is the internal representation of the specified cursor type
1682 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1683 of the bar cursor. */
1685 enum text_cursor_kinds
1686 x_specified_cursor_type (arg
, width
)
1690 enum text_cursor_kinds type
;
1697 else if (CONSP (arg
)
1698 && EQ (XCAR (arg
), Qbar
)
1699 && INTEGERP (XCDR (arg
))
1700 && XINT (XCDR (arg
)) >= 0)
1703 *width
= XINT (XCDR (arg
));
1705 else if (NILP (arg
))
1708 /* Treat anything unknown as "box cursor".
1709 It was bad to signal an error; people have trouble fixing
1710 .Xdefaults with Emacs, when it has something bad in it. */
1711 type
= FILLED_BOX_CURSOR
;
1717 x_set_cursor_type (f
, arg
, oldval
)
1719 Lisp_Object arg
, oldval
;
1723 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1724 f
->output_data
.x
->cursor_width
= width
;
1726 /* Make sure the cursor gets redrawn. This is overkill, but how
1727 often do people change cursor types? */
1728 update_mode_lines
++;
1732 x_set_icon_type (f
, arg
, oldval
)
1734 Lisp_Object arg
, oldval
;
1740 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1743 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1748 result
= x_text_icon (f
,
1749 (char *) XSTRING ((!NILP (f
->icon_name
)
1753 result
= x_bitmap_icon (f
, arg
);
1758 error ("No icon window available");
1761 XFlush (FRAME_X_DISPLAY (f
));
1765 /* Return non-nil if frame F wants a bitmap icon. */
1773 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1781 x_set_icon_name (f
, arg
, oldval
)
1783 Lisp_Object arg
, oldval
;
1789 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1792 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1797 if (f
->output_data
.x
->icon_bitmap
!= 0)
1802 result
= x_text_icon (f
,
1803 (char *) XSTRING ((!NILP (f
->icon_name
)
1812 error ("No icon window available");
1815 XFlush (FRAME_X_DISPLAY (f
));
1820 x_set_font (f
, arg
, oldval
)
1822 Lisp_Object arg
, oldval
;
1825 Lisp_Object fontset_name
;
1827 int old_fontset
= f
->output_data
.x
->fontset
;
1829 CHECK_STRING (arg
, 1);
1831 fontset_name
= Fquery_fontset (arg
, Qnil
);
1834 result
= (STRINGP (fontset_name
)
1835 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1836 : x_new_font (f
, XSTRING (arg
)->data
));
1839 if (EQ (result
, Qnil
))
1840 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1841 else if (EQ (result
, Qt
))
1842 error ("The characters of the given font have varying widths");
1843 else if (STRINGP (result
))
1845 if (STRINGP (fontset_name
))
1847 /* Fontset names are built from ASCII font names, so the
1848 names may be equal despite there was a change. */
1849 if (old_fontset
== f
->output_data
.x
->fontset
)
1852 else if (!NILP (Fequal (result
, oldval
)))
1855 store_frame_param (f
, Qfont
, result
);
1856 recompute_basic_faces (f
);
1861 do_pending_window_change (0);
1863 /* Don't call `face-set-after-frame-default' when faces haven't been
1864 initialized yet. This is the case when called from
1865 Fx_create_frame. In that case, the X widget or window doesn't
1866 exist either, and we can end up in x_report_frame_params with a
1867 null widget which gives a segfault. */
1868 if (FRAME_FACE_CACHE (f
))
1870 XSETFRAME (frame
, f
);
1871 call1 (Qface_set_after_frame_default
, frame
);
1876 x_set_border_width (f
, arg
, oldval
)
1878 Lisp_Object arg
, oldval
;
1880 CHECK_NUMBER (arg
, 0);
1882 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1885 if (FRAME_X_WINDOW (f
) != 0)
1886 error ("Cannot change the border width of a window");
1888 f
->output_data
.x
->border_width
= XINT (arg
);
1892 x_set_internal_border_width (f
, arg
, oldval
)
1894 Lisp_Object arg
, oldval
;
1896 int old
= f
->output_data
.x
->internal_border_width
;
1898 CHECK_NUMBER (arg
, 0);
1899 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1900 if (f
->output_data
.x
->internal_border_width
< 0)
1901 f
->output_data
.x
->internal_border_width
= 0;
1903 #ifdef USE_X_TOOLKIT
1904 if (f
->output_data
.x
->edit_widget
)
1905 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1908 if (f
->output_data
.x
->internal_border_width
== old
)
1911 if (FRAME_X_WINDOW (f
) != 0)
1913 x_set_window_size (f
, 0, f
->width
, f
->height
);
1914 SET_FRAME_GARBAGED (f
);
1915 do_pending_window_change (0);
1920 x_set_visibility (f
, value
, oldval
)
1922 Lisp_Object value
, oldval
;
1925 XSETFRAME (frame
, f
);
1928 Fmake_frame_invisible (frame
, Qt
);
1929 else if (EQ (value
, Qicon
))
1930 Ficonify_frame (frame
);
1932 Fmake_frame_visible (frame
);
1936 /* Change window heights in windows rooted in WINDOW by N lines. */
1939 x_change_window_heights (window
, n
)
1943 struct window
*w
= XWINDOW (window
);
1945 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1946 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1948 if (INTEGERP (w
->orig_top
))
1949 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1950 if (INTEGERP (w
->orig_height
))
1951 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1953 /* Handle just the top child in a vertical split. */
1954 if (!NILP (w
->vchild
))
1955 x_change_window_heights (w
->vchild
, n
);
1957 /* Adjust all children in a horizontal split. */
1958 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1960 w
= XWINDOW (window
);
1961 x_change_window_heights (window
, n
);
1966 x_set_menu_bar_lines (f
, value
, oldval
)
1968 Lisp_Object value
, oldval
;
1971 #ifndef USE_X_TOOLKIT
1972 int olines
= FRAME_MENU_BAR_LINES (f
);
1975 /* Right now, menu bars don't work properly in minibuf-only frames;
1976 most of the commands try to apply themselves to the minibuffer
1977 frame itself, and get an error because you can't switch buffers
1978 in or split the minibuffer window. */
1979 if (FRAME_MINIBUF_ONLY_P (f
))
1982 if (INTEGERP (value
))
1983 nlines
= XINT (value
);
1987 /* Make sure we redisplay all windows in this frame. */
1988 windows_or_buffers_changed
++;
1990 #ifdef USE_X_TOOLKIT
1991 FRAME_MENU_BAR_LINES (f
) = 0;
1994 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1995 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1996 /* Make sure next redisplay shows the menu bar. */
1997 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2001 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2002 free_frame_menubar (f
);
2003 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2005 f
->output_data
.x
->menubar_widget
= 0;
2007 #else /* not USE_X_TOOLKIT */
2008 FRAME_MENU_BAR_LINES (f
) = nlines
;
2009 x_change_window_heights (f
->root_window
, nlines
- olines
);
2010 #endif /* not USE_X_TOOLKIT */
2015 /* Set the number of lines used for the tool bar of frame F to VALUE.
2016 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2017 is the old number of tool bar lines. This function changes the
2018 height of all windows on frame F to match the new tool bar height.
2019 The frame's height doesn't change. */
2022 x_set_tool_bar_lines (f
, value
, oldval
)
2024 Lisp_Object value
, oldval
;
2026 int delta
, nlines
, root_height
;
2027 Lisp_Object root_window
;
2029 /* Treat tool bars like menu bars. */
2030 if (FRAME_MINIBUF_ONLY_P (f
))
2033 /* Use VALUE only if an integer >= 0. */
2034 if (INTEGERP (value
) && XINT (value
) >= 0)
2035 nlines
= XFASTINT (value
);
2039 /* Make sure we redisplay all windows in this frame. */
2040 ++windows_or_buffers_changed
;
2042 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2044 /* Don't resize the tool-bar to more than we have room for. */
2045 root_window
= FRAME_ROOT_WINDOW (f
);
2046 root_height
= XINT (XWINDOW (root_window
)->height
);
2047 if (root_height
- delta
< 1)
2049 delta
= root_height
- 1;
2050 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2053 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2054 x_change_window_heights (root_window
, delta
);
2057 /* We also have to make sure that the internal border at the top of
2058 the frame, below the menu bar or tool bar, is redrawn when the
2059 tool bar disappears. This is so because the internal border is
2060 below the tool bar if one is displayed, but is below the menu bar
2061 if there isn't a tool bar. The tool bar draws into the area
2062 below the menu bar. */
2063 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2067 clear_current_matrices (f
);
2068 updating_frame
= NULL
;
2071 /* If the tool bar gets smaller, the internal border below it
2072 has to be cleared. It was formerly part of the display
2073 of the larger tool bar, and updating windows won't clear it. */
2076 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2077 int width
= PIXEL_WIDTH (f
);
2078 int y
= nlines
* CANON_Y_UNIT (f
);
2081 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2082 0, y
, width
, height
, False
);
2088 /* Set the foreground color for scroll bars on frame F to VALUE.
2089 VALUE should be a string, a color name. If it isn't a string or
2090 isn't a valid color name, do nothing. OLDVAL is the old value of
2091 the frame parameter. */
2094 x_set_scroll_bar_foreground (f
, value
, oldval
)
2096 Lisp_Object value
, oldval
;
2098 unsigned long pixel
;
2100 if (STRINGP (value
))
2101 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2105 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2106 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2108 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2109 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2111 /* Remove all scroll bars because they have wrong colors. */
2112 if (condemn_scroll_bars_hook
)
2113 (*condemn_scroll_bars_hook
) (f
);
2114 if (judge_scroll_bars_hook
)
2115 (*judge_scroll_bars_hook
) (f
);
2117 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2123 /* Set the background color for scroll bars on frame F to VALUE VALUE
2124 should be a string, a color name. If it isn't a string or isn't a
2125 valid color name, do nothing. OLDVAL is the old value of the frame
2129 x_set_scroll_bar_background (f
, value
, oldval
)
2131 Lisp_Object value
, oldval
;
2133 unsigned long pixel
;
2135 if (STRINGP (value
))
2136 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2140 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2141 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2143 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2144 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2146 /* Remove all scroll bars because they have wrong colors. */
2147 if (condemn_scroll_bars_hook
)
2148 (*condemn_scroll_bars_hook
) (f
);
2149 if (judge_scroll_bars_hook
)
2150 (*judge_scroll_bars_hook
) (f
);
2152 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2158 /* Encode Lisp string STRING as a text in a format appropriate for
2159 XICCC (X Inter Client Communication Conventions).
2161 If STRING contains only ASCII characters, do no conversion and
2162 return the string data of STRING. Otherwise, encode the text by
2163 CODING_SYSTEM, and return a newly allocated memory area which
2164 should be freed by `xfree' by a caller.
2166 Store the byte length of resulting text in *TEXT_BYTES.
2168 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2169 which means that the `encoding' of the result can be `STRING'.
2170 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2171 the result should be `COMPOUND_TEXT'. */
2174 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2175 Lisp_Object string
, coding_system
;
2176 int *text_bytes
, *stringp
;
2178 unsigned char *str
= XSTRING (string
)->data
;
2179 int chars
= XSTRING (string
)->size
;
2180 int bytes
= STRING_BYTES (XSTRING (string
));
2184 struct coding_system coding
;
2186 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2187 if (charset_info
== 0)
2189 /* No multibyte character in OBJ. We need not encode it. */
2190 *text_bytes
= bytes
;
2195 setup_coding_system (coding_system
, &coding
);
2196 coding
.src_multibyte
= 1;
2197 coding
.dst_multibyte
= 0;
2198 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2199 if (coding
.type
== coding_type_iso2022
)
2200 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2201 /* We suppress producing escape sequences for composition. */
2202 coding
.composing
= COMPOSITION_DISABLED
;
2203 bufsize
= encoding_buffer_size (&coding
, bytes
);
2204 buf
= (unsigned char *) xmalloc (bufsize
);
2205 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2206 *text_bytes
= coding
.produced
;
2207 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2212 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2215 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2216 name; if NAME is a string, set F's name to NAME and set
2217 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2219 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2220 suggesting a new name, which lisp code should override; if
2221 F->explicit_name is set, ignore the new name; otherwise, set it. */
2224 x_set_name (f
, name
, explicit)
2229 /* Make sure that requests from lisp code override requests from
2230 Emacs redisplay code. */
2233 /* If we're switching from explicit to implicit, we had better
2234 update the mode lines and thereby update the title. */
2235 if (f
->explicit_name
&& NILP (name
))
2236 update_mode_lines
= 1;
2238 f
->explicit_name
= ! NILP (name
);
2240 else if (f
->explicit_name
)
2243 /* If NAME is nil, set the name to the x_id_name. */
2246 /* Check for no change needed in this very common case
2247 before we do any consing. */
2248 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2249 XSTRING (f
->name
)->data
))
2251 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2254 CHECK_STRING (name
, 0);
2256 /* Don't change the name if it's already NAME. */
2257 if (! NILP (Fstring_equal (name
, f
->name
)))
2262 /* For setting the frame title, the title parameter should override
2263 the name parameter. */
2264 if (! NILP (f
->title
))
2267 if (FRAME_X_WINDOW (f
))
2272 XTextProperty text
, icon
;
2274 Lisp_Object coding_system
;
2276 coding_system
= Vlocale_coding_system
;
2277 if (NILP (coding_system
))
2278 coding_system
= Qcompound_text
;
2279 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2280 text
.encoding
= (stringp
? XA_STRING
2281 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2283 text
.nitems
= bytes
;
2285 if (NILP (f
->icon_name
))
2291 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2293 icon
.encoding
= (stringp
? XA_STRING
2294 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2296 icon
.nitems
= bytes
;
2298 #ifdef USE_X_TOOLKIT
2299 XSetWMName (FRAME_X_DISPLAY (f
),
2300 XtWindow (f
->output_data
.x
->widget
), &text
);
2301 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2303 #else /* not USE_X_TOOLKIT */
2304 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2305 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2306 #endif /* not USE_X_TOOLKIT */
2307 if (!NILP (f
->icon_name
)
2308 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2310 if (text
.value
!= XSTRING (name
)->data
)
2313 #else /* not HAVE_X11R4 */
2314 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2315 XSTRING (name
)->data
);
2316 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2317 XSTRING (name
)->data
);
2318 #endif /* not HAVE_X11R4 */
2323 /* This function should be called when the user's lisp code has
2324 specified a name for the frame; the name will override any set by the
2327 x_explicitly_set_name (f
, arg
, oldval
)
2329 Lisp_Object arg
, oldval
;
2331 x_set_name (f
, arg
, 1);
2334 /* This function should be called by Emacs redisplay code to set the
2335 name; names set this way will never override names set by the user's
2338 x_implicitly_set_name (f
, arg
, oldval
)
2340 Lisp_Object arg
, oldval
;
2342 x_set_name (f
, arg
, 0);
2345 /* Change the title of frame F to NAME.
2346 If NAME is nil, use the frame name as the title.
2348 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2349 name; if NAME is a string, set F's name to NAME and set
2350 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2352 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2353 suggesting a new name, which lisp code should override; if
2354 F->explicit_name is set, ignore the new name; otherwise, set it. */
2357 x_set_title (f
, name
, old_name
)
2359 Lisp_Object name
, old_name
;
2361 /* Don't change the title if it's already NAME. */
2362 if (EQ (name
, f
->title
))
2365 update_mode_lines
= 1;
2372 CHECK_STRING (name
, 0);
2374 if (FRAME_X_WINDOW (f
))
2379 XTextProperty text
, icon
;
2381 Lisp_Object coding_system
;
2383 coding_system
= Vlocale_coding_system
;
2384 if (NILP (coding_system
))
2385 coding_system
= Qcompound_text
;
2386 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2387 text
.encoding
= (stringp
? XA_STRING
2388 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2390 text
.nitems
= bytes
;
2392 if (NILP (f
->icon_name
))
2398 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2400 icon
.encoding
= (stringp
? XA_STRING
2401 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2403 icon
.nitems
= bytes
;
2405 #ifdef USE_X_TOOLKIT
2406 XSetWMName (FRAME_X_DISPLAY (f
),
2407 XtWindow (f
->output_data
.x
->widget
), &text
);
2408 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2410 #else /* not USE_X_TOOLKIT */
2411 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2412 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2413 #endif /* not USE_X_TOOLKIT */
2414 if (!NILP (f
->icon_name
)
2415 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2417 if (text
.value
!= XSTRING (name
)->data
)
2420 #else /* not HAVE_X11R4 */
2421 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2422 XSTRING (name
)->data
);
2423 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2424 XSTRING (name
)->data
);
2425 #endif /* not HAVE_X11R4 */
2431 x_set_autoraise (f
, arg
, oldval
)
2433 Lisp_Object arg
, oldval
;
2435 f
->auto_raise
= !EQ (Qnil
, arg
);
2439 x_set_autolower (f
, arg
, oldval
)
2441 Lisp_Object arg
, oldval
;
2443 f
->auto_lower
= !EQ (Qnil
, arg
);
2447 x_set_unsplittable (f
, arg
, oldval
)
2449 Lisp_Object arg
, oldval
;
2451 f
->no_split
= !NILP (arg
);
2455 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2457 Lisp_Object arg
, oldval
;
2459 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2460 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2461 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2462 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2464 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2466 ? vertical_scroll_bar_none
2468 ? vertical_scroll_bar_right
2469 : vertical_scroll_bar_left
);
2471 /* We set this parameter before creating the X window for the
2472 frame, so we can get the geometry right from the start.
2473 However, if the window hasn't been created yet, we shouldn't
2474 call x_set_window_size. */
2475 if (FRAME_X_WINDOW (f
))
2476 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2477 do_pending_window_change (0);
2482 x_set_scroll_bar_width (f
, arg
, oldval
)
2484 Lisp_Object arg
, oldval
;
2486 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2490 #ifdef USE_TOOLKIT_SCROLL_BARS
2491 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2492 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2493 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2494 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2496 /* Make the actual width at least 14 pixels and a multiple of a
2498 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2500 /* Use all of that space (aside from required margins) for the
2502 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2505 if (FRAME_X_WINDOW (f
))
2506 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2507 do_pending_window_change (0);
2509 else if (INTEGERP (arg
) && XINT (arg
) > 0
2510 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2512 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2513 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2515 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2516 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2517 if (FRAME_X_WINDOW (f
))
2518 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2521 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2522 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2523 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2528 /* Subroutines of creating an X frame. */
2530 /* Make sure that Vx_resource_name is set to a reasonable value.
2531 Fix it up, or set it to `emacs' if it is too hopeless. */
2534 validate_x_resource_name ()
2537 /* Number of valid characters in the resource name. */
2539 /* Number of invalid characters in the resource name. */
2544 if (!STRINGP (Vx_resource_class
))
2545 Vx_resource_class
= build_string (EMACS_CLASS
);
2547 if (STRINGP (Vx_resource_name
))
2549 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2552 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2554 /* Only letters, digits, - and _ are valid in resource names.
2555 Count the valid characters and count the invalid ones. */
2556 for (i
= 0; i
< len
; i
++)
2559 if (! ((c
>= 'a' && c
<= 'z')
2560 || (c
>= 'A' && c
<= 'Z')
2561 || (c
>= '0' && c
<= '9')
2562 || c
== '-' || c
== '_'))
2569 /* Not a string => completely invalid. */
2570 bad_count
= 5, good_count
= 0;
2572 /* If name is valid already, return. */
2576 /* If name is entirely invalid, or nearly so, use `emacs'. */
2578 || (good_count
== 1 && bad_count
> 0))
2580 Vx_resource_name
= build_string ("emacs");
2584 /* Name is partly valid. Copy it and replace the invalid characters
2585 with underscores. */
2587 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2589 for (i
= 0; i
< len
; i
++)
2591 int c
= XSTRING (new)->data
[i
];
2592 if (! ((c
>= 'a' && c
<= 'z')
2593 || (c
>= 'A' && c
<= 'Z')
2594 || (c
>= '0' && c
<= '9')
2595 || c
== '-' || c
== '_'))
2596 XSTRING (new)->data
[i
] = '_';
2601 extern char *x_get_string_resource ();
2603 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2604 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2605 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2606 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2607 the name specified by the `-name' or `-rn' command-line arguments.\n\
2609 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2610 class, respectively. You must specify both of them or neither.\n\
2611 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2612 and the class is `Emacs.CLASS.SUBCLASS'.")
2613 (attribute
, class, component
, subclass
)
2614 Lisp_Object attribute
, class, component
, subclass
;
2616 register char *value
;
2622 CHECK_STRING (attribute
, 0);
2623 CHECK_STRING (class, 0);
2625 if (!NILP (component
))
2626 CHECK_STRING (component
, 1);
2627 if (!NILP (subclass
))
2628 CHECK_STRING (subclass
, 2);
2629 if (NILP (component
) != NILP (subclass
))
2630 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2632 validate_x_resource_name ();
2634 /* Allocate space for the components, the dots which separate them,
2635 and the final '\0'. Make them big enough for the worst case. */
2636 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2637 + (STRINGP (component
)
2638 ? STRING_BYTES (XSTRING (component
)) : 0)
2639 + STRING_BYTES (XSTRING (attribute
))
2642 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2643 + STRING_BYTES (XSTRING (class))
2644 + (STRINGP (subclass
)
2645 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2648 /* Start with emacs.FRAMENAME for the name (the specific one)
2649 and with `Emacs' for the class key (the general one). */
2650 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2651 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2653 strcat (class_key
, ".");
2654 strcat (class_key
, XSTRING (class)->data
);
2656 if (!NILP (component
))
2658 strcat (class_key
, ".");
2659 strcat (class_key
, XSTRING (subclass
)->data
);
2661 strcat (name_key
, ".");
2662 strcat (name_key
, XSTRING (component
)->data
);
2665 strcat (name_key
, ".");
2666 strcat (name_key
, XSTRING (attribute
)->data
);
2668 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2669 name_key
, class_key
);
2671 if (value
!= (char *) 0)
2672 return build_string (value
);
2677 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2680 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2681 struct x_display_info
*dpyinfo
;
2682 Lisp_Object attribute
, class, component
, subclass
;
2684 register char *value
;
2688 CHECK_STRING (attribute
, 0);
2689 CHECK_STRING (class, 0);
2691 if (!NILP (component
))
2692 CHECK_STRING (component
, 1);
2693 if (!NILP (subclass
))
2694 CHECK_STRING (subclass
, 2);
2695 if (NILP (component
) != NILP (subclass
))
2696 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2698 validate_x_resource_name ();
2700 /* Allocate space for the components, the dots which separate them,
2701 and the final '\0'. Make them big enough for the worst case. */
2702 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2703 + (STRINGP (component
)
2704 ? STRING_BYTES (XSTRING (component
)) : 0)
2705 + STRING_BYTES (XSTRING (attribute
))
2708 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2709 + STRING_BYTES (XSTRING (class))
2710 + (STRINGP (subclass
)
2711 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2714 /* Start with emacs.FRAMENAME for the name (the specific one)
2715 and with `Emacs' for the class key (the general one). */
2716 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2717 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2719 strcat (class_key
, ".");
2720 strcat (class_key
, XSTRING (class)->data
);
2722 if (!NILP (component
))
2724 strcat (class_key
, ".");
2725 strcat (class_key
, XSTRING (subclass
)->data
);
2727 strcat (name_key
, ".");
2728 strcat (name_key
, XSTRING (component
)->data
);
2731 strcat (name_key
, ".");
2732 strcat (name_key
, XSTRING (attribute
)->data
);
2734 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2736 if (value
!= (char *) 0)
2737 return build_string (value
);
2742 /* Used when C code wants a resource value. */
2745 x_get_resource_string (attribute
, class)
2746 char *attribute
, *class;
2750 struct frame
*sf
= SELECTED_FRAME ();
2752 /* Allocate space for the components, the dots which separate them,
2753 and the final '\0'. */
2754 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2755 + strlen (attribute
) + 2);
2756 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2757 + strlen (class) + 2);
2759 sprintf (name_key
, "%s.%s",
2760 XSTRING (Vinvocation_name
)->data
,
2762 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2764 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2765 name_key
, class_key
);
2768 /* Types we might convert a resource string into. */
2778 /* Return the value of parameter PARAM.
2780 First search ALIST, then Vdefault_frame_alist, then the X defaults
2781 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2783 Convert the resource to the type specified by desired_type.
2785 If no default is specified, return Qunbound. If you call
2786 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2787 and don't let it get stored in any Lisp-visible variables! */
2790 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2791 struct x_display_info
*dpyinfo
;
2792 Lisp_Object alist
, param
;
2795 enum resource_types type
;
2797 register Lisp_Object tem
;
2799 tem
= Fassq (param
, alist
);
2801 tem
= Fassq (param
, Vdefault_frame_alist
);
2807 tem
= display_x_get_resource (dpyinfo
,
2808 build_string (attribute
),
2809 build_string (class),
2817 case RES_TYPE_NUMBER
:
2818 return make_number (atoi (XSTRING (tem
)->data
));
2820 case RES_TYPE_FLOAT
:
2821 return make_float (atof (XSTRING (tem
)->data
));
2823 case RES_TYPE_BOOLEAN
:
2824 tem
= Fdowncase (tem
);
2825 if (!strcmp (XSTRING (tem
)->data
, "on")
2826 || !strcmp (XSTRING (tem
)->data
, "true"))
2831 case RES_TYPE_STRING
:
2834 case RES_TYPE_SYMBOL
:
2835 /* As a special case, we map the values `true' and `on'
2836 to Qt, and `false' and `off' to Qnil. */
2839 lower
= Fdowncase (tem
);
2840 if (!strcmp (XSTRING (lower
)->data
, "on")
2841 || !strcmp (XSTRING (lower
)->data
, "true"))
2843 else if (!strcmp (XSTRING (lower
)->data
, "off")
2844 || !strcmp (XSTRING (lower
)->data
, "false"))
2847 return Fintern (tem
, Qnil
);
2860 /* Like x_get_arg, but also record the value in f->param_alist. */
2863 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2865 Lisp_Object alist
, param
;
2868 enum resource_types type
;
2872 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2873 attribute
, class, type
);
2875 store_frame_param (f
, param
, value
);
2880 /* Record in frame F the specified or default value according to ALIST
2881 of the parameter named PROP (a Lisp symbol).
2882 If no value is specified for PROP, look for an X default for XPROP
2883 on the frame named NAME.
2884 If that is not found either, use the value DEFLT. */
2887 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2894 enum resource_types type
;
2898 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2899 if (EQ (tem
, Qunbound
))
2901 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2906 /* Record in frame F the specified or default value according to ALIST
2907 of the parameter named PROP (a Lisp symbol). If no value is
2908 specified for PROP, look for an X default for XPROP on the frame
2909 named NAME. If that is not found either, use the value DEFLT. */
2912 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2921 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2924 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2925 if (EQ (tem
, Qunbound
))
2927 #ifdef USE_TOOLKIT_SCROLL_BARS
2929 /* See if an X resource for the scroll bar color has been
2931 tem
= display_x_get_resource (dpyinfo
,
2932 build_string (foreground_p
2936 build_string ("verticalScrollBar"),
2940 /* If nothing has been specified, scroll bars will use a
2941 toolkit-dependent default. Because these defaults are
2942 difficult to get at without actually creating a scroll
2943 bar, use nil to indicate that no color has been
2948 #else /* not USE_TOOLKIT_SCROLL_BARS */
2952 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2955 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2961 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2962 "Parse an X-style geometry string STRING.\n\
2963 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2964 The properties returned may include `top', `left', `height', and `width'.\n\
2965 The value of `left' or `top' may be an integer,\n\
2966 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2967 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2972 unsigned int width
, height
;
2975 CHECK_STRING (string
, 0);
2977 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2978 &x
, &y
, &width
, &height
);
2981 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2982 error ("Must specify both x and y position, or neither");
2986 if (geometry
& XValue
)
2988 Lisp_Object element
;
2990 if (x
>= 0 && (geometry
& XNegative
))
2991 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2992 else if (x
< 0 && ! (geometry
& XNegative
))
2993 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2995 element
= Fcons (Qleft
, make_number (x
));
2996 result
= Fcons (element
, result
);
2999 if (geometry
& YValue
)
3001 Lisp_Object element
;
3003 if (y
>= 0 && (geometry
& YNegative
))
3004 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3005 else if (y
< 0 && ! (geometry
& YNegative
))
3006 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3008 element
= Fcons (Qtop
, make_number (y
));
3009 result
= Fcons (element
, result
);
3012 if (geometry
& WidthValue
)
3013 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3014 if (geometry
& HeightValue
)
3015 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3020 /* Calculate the desired size and position of this window,
3021 and return the flags saying which aspects were specified.
3023 This function does not make the coordinates positive. */
3025 #define DEFAULT_ROWS 40
3026 #define DEFAULT_COLS 80
3029 x_figure_window_size (f
, parms
)
3033 register Lisp_Object tem0
, tem1
, tem2
;
3034 long window_prompting
= 0;
3035 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3037 /* Default values if we fall through.
3038 Actually, if that happens we should get
3039 window manager prompting. */
3040 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3041 f
->height
= DEFAULT_ROWS
;
3042 /* Window managers expect that if program-specified
3043 positions are not (0,0), they're intentional, not defaults. */
3044 f
->output_data
.x
->top_pos
= 0;
3045 f
->output_data
.x
->left_pos
= 0;
3047 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3048 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3049 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3050 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3052 if (!EQ (tem0
, Qunbound
))
3054 CHECK_NUMBER (tem0
, 0);
3055 f
->height
= XINT (tem0
);
3057 if (!EQ (tem1
, Qunbound
))
3059 CHECK_NUMBER (tem1
, 0);
3060 SET_FRAME_WIDTH (f
, XINT (tem1
));
3062 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3063 window_prompting
|= USSize
;
3065 window_prompting
|= PSize
;
3068 f
->output_data
.x
->vertical_scroll_bar_extra
3069 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3071 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3072 f
->output_data
.x
->flags_areas_extra
3073 = FRAME_FLAGS_AREA_WIDTH (f
);
3074 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3075 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3077 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3078 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3079 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3080 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3082 if (EQ (tem0
, Qminus
))
3084 f
->output_data
.x
->top_pos
= 0;
3085 window_prompting
|= YNegative
;
3087 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3088 && CONSP (XCDR (tem0
))
3089 && INTEGERP (XCAR (XCDR (tem0
))))
3091 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3092 window_prompting
|= YNegative
;
3094 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3095 && CONSP (XCDR (tem0
))
3096 && INTEGERP (XCAR (XCDR (tem0
))))
3098 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3100 else if (EQ (tem0
, Qunbound
))
3101 f
->output_data
.x
->top_pos
= 0;
3104 CHECK_NUMBER (tem0
, 0);
3105 f
->output_data
.x
->top_pos
= XINT (tem0
);
3106 if (f
->output_data
.x
->top_pos
< 0)
3107 window_prompting
|= YNegative
;
3110 if (EQ (tem1
, Qminus
))
3112 f
->output_data
.x
->left_pos
= 0;
3113 window_prompting
|= XNegative
;
3115 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3116 && CONSP (XCDR (tem1
))
3117 && INTEGERP (XCAR (XCDR (tem1
))))
3119 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3120 window_prompting
|= XNegative
;
3122 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3123 && CONSP (XCDR (tem1
))
3124 && INTEGERP (XCAR (XCDR (tem1
))))
3126 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3128 else if (EQ (tem1
, Qunbound
))
3129 f
->output_data
.x
->left_pos
= 0;
3132 CHECK_NUMBER (tem1
, 0);
3133 f
->output_data
.x
->left_pos
= XINT (tem1
);
3134 if (f
->output_data
.x
->left_pos
< 0)
3135 window_prompting
|= XNegative
;
3138 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3139 window_prompting
|= USPosition
;
3141 window_prompting
|= PPosition
;
3144 return window_prompting
;
3147 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3150 XSetWMProtocols (dpy
, w
, protocols
, count
)
3157 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3158 if (prop
== None
) return False
;
3159 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3160 (unsigned char *) protocols
, count
);
3163 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3165 #ifdef USE_X_TOOLKIT
3167 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3168 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3169 already be present because of the toolkit (Motif adds some of them,
3170 for example, but Xt doesn't). */
3173 hack_wm_protocols (f
, widget
)
3177 Display
*dpy
= XtDisplay (widget
);
3178 Window w
= XtWindow (widget
);
3179 int need_delete
= 1;
3185 Atom type
, *atoms
= 0;
3187 unsigned long nitems
= 0;
3188 unsigned long bytes_after
;
3190 if ((XGetWindowProperty (dpy
, w
,
3191 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3192 (long)0, (long)100, False
, XA_ATOM
,
3193 &type
, &format
, &nitems
, &bytes_after
,
3194 (unsigned char **) &atoms
)
3196 && format
== 32 && type
== XA_ATOM
)
3200 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3202 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3204 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3207 if (atoms
) XFree ((char *) atoms
);
3213 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3215 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3217 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3219 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3220 XA_ATOM
, 32, PropModeAppend
,
3221 (unsigned char *) props
, count
);
3229 /* Support routines for XIC (X Input Context). */
3233 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3234 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3237 /* Supported XIM styles, ordered by preferenc. */
3239 static XIMStyle supported_xim_styles
[] =
3241 XIMPreeditPosition
| XIMStatusArea
,
3242 XIMPreeditPosition
| XIMStatusNothing
,
3243 XIMPreeditPosition
| XIMStatusNone
,
3244 XIMPreeditNothing
| XIMStatusArea
,
3245 XIMPreeditNothing
| XIMStatusNothing
,
3246 XIMPreeditNothing
| XIMStatusNone
,
3247 XIMPreeditNone
| XIMStatusArea
,
3248 XIMPreeditNone
| XIMStatusNothing
,
3249 XIMPreeditNone
| XIMStatusNone
,
3254 /* Create an X fontset on frame F with base font name
3258 xic_create_xfontset (f
, base_fontname
)
3260 char *base_fontname
;
3263 char **missing_list
;
3267 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3268 base_fontname
, &missing_list
,
3269 &missing_count
, &def_string
);
3271 XFreeStringList (missing_list
);
3273 /* No need to free def_string. */
3278 /* Value is the best input style, given user preferences USER (already
3279 checked to be supported by Emacs), and styles supported by the
3280 input method XIM. */
3283 best_xim_style (user
, xim
)
3289 for (i
= 0; i
< user
->count_styles
; ++i
)
3290 for (j
= 0; j
< xim
->count_styles
; ++j
)
3291 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3292 return user
->supported_styles
[i
];
3294 /* Return the default style. */
3295 return XIMPreeditNothing
| XIMStatusNothing
;
3298 /* Create XIC for frame F. */
3300 static XIMStyle xic_style
;
3303 create_frame_xic (f
)
3308 XFontSet xfs
= NULL
;
3313 xim
= FRAME_X_XIM (f
);
3318 XVaNestedList preedit_attr
;
3319 XVaNestedList status_attr
;
3320 char *base_fontname
;
3323 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3324 spot
.x
= 0; spot
.y
= 1;
3325 /* Create X fontset. */
3326 fontset
= FRAME_FONTSET (f
);
3328 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3331 /* Determine the base fontname from the ASCII font name of
3333 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3334 char *p
= ascii_font
;
3337 for (i
= 0; *p
; p
++)
3340 /* As the font name doesn't conform to XLFD, we can't
3341 modify it to get a suitable base fontname for the
3343 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3346 int len
= strlen (ascii_font
) + 1;
3349 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3358 base_fontname
= (char *) alloca (len
);
3359 bzero (base_fontname
, len
);
3360 strcpy (base_fontname
, "-*-*-");
3361 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3362 strcat (base_fontname
, "*-*-*-*-*-*-*");
3365 xfs
= xic_create_xfontset (f
, base_fontname
);
3367 /* Determine XIC style. */
3370 XIMStyles supported_list
;
3371 supported_list
.count_styles
= (sizeof supported_xim_styles
3372 / sizeof supported_xim_styles
[0]);
3373 supported_list
.supported_styles
= supported_xim_styles
;
3374 xic_style
= best_xim_style (&supported_list
,
3375 FRAME_X_XIM_STYLES (f
));
3378 preedit_attr
= XVaCreateNestedList (0,
3381 FRAME_FOREGROUND_PIXEL (f
),
3383 FRAME_BACKGROUND_PIXEL (f
),
3384 (xic_style
& XIMPreeditPosition
3389 status_attr
= XVaCreateNestedList (0,
3395 FRAME_FOREGROUND_PIXEL (f
),
3397 FRAME_BACKGROUND_PIXEL (f
),
3400 xic
= XCreateIC (xim
,
3401 XNInputStyle
, xic_style
,
3402 XNClientWindow
, FRAME_X_WINDOW(f
),
3403 XNFocusWindow
, FRAME_X_WINDOW(f
),
3404 XNStatusAttributes
, status_attr
,
3405 XNPreeditAttributes
, preedit_attr
,
3407 XFree (preedit_attr
);
3408 XFree (status_attr
);
3411 FRAME_XIC (f
) = xic
;
3412 FRAME_XIC_STYLE (f
) = xic_style
;
3413 FRAME_XIC_FONTSET (f
) = xfs
;
3417 /* Destroy XIC and free XIC fontset of frame F, if any. */
3423 if (FRAME_XIC (f
) == NULL
)
3426 XDestroyIC (FRAME_XIC (f
));
3427 if (FRAME_XIC_FONTSET (f
))
3428 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3430 FRAME_XIC (f
) = NULL
;
3431 FRAME_XIC_FONTSET (f
) = NULL
;
3435 /* Place preedit area for XIC of window W's frame to specified
3436 pixel position X/Y. X and Y are relative to window W. */
3439 xic_set_preeditarea (w
, x
, y
)
3443 struct frame
*f
= XFRAME (w
->frame
);
3447 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3448 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3449 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3450 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3455 /* Place status area for XIC in bottom right corner of frame F.. */
3458 xic_set_statusarea (f
)
3461 XIC xic
= FRAME_XIC (f
);
3466 /* Negotiate geometry of status area. If input method has existing
3467 status area, use its current size. */
3468 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3469 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3470 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3473 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3474 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3477 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3479 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3480 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3484 area
.width
= needed
->width
;
3485 area
.height
= needed
->height
;
3486 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3487 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3488 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3491 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3492 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3497 /* Set X fontset for XIC of frame F, using base font name
3498 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3501 xic_set_xfontset (f
, base_fontname
)
3503 char *base_fontname
;
3508 xfs
= xic_create_xfontset (f
, base_fontname
);
3510 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3511 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3512 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3513 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3514 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3517 if (FRAME_XIC_FONTSET (f
))
3518 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3519 FRAME_XIC_FONTSET (f
) = xfs
;
3522 #endif /* HAVE_X_I18N */
3526 #ifdef USE_X_TOOLKIT
3528 /* Create and set up the X widget for frame F. */
3531 x_window (f
, window_prompting
, minibuffer_only
)
3533 long window_prompting
;
3534 int minibuffer_only
;
3536 XClassHint class_hints
;
3537 XSetWindowAttributes attributes
;
3538 unsigned long attribute_mask
;
3539 Widget shell_widget
;
3541 Widget frame_widget
;
3547 /* Use the resource name as the top-level widget name
3548 for looking up resources. Make a non-Lisp copy
3549 for the window manager, so GC relocation won't bother it.
3551 Elsewhere we specify the window name for the window manager. */
3554 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3555 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3556 strcpy (f
->namebuf
, str
);
3560 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3561 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3562 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3563 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3564 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3565 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3566 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3567 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3568 applicationShellWidgetClass
,
3569 FRAME_X_DISPLAY (f
), al
, ac
);
3571 f
->output_data
.x
->widget
= shell_widget
;
3572 /* maybe_set_screen_title_format (shell_widget); */
3574 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3575 (widget_value
*) NULL
,
3576 shell_widget
, False
,
3580 (lw_callback
) NULL
);
3583 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3584 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3585 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3586 XtSetValues (pane_widget
, al
, ac
);
3587 f
->output_data
.x
->column_widget
= pane_widget
;
3589 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3590 the emacs screen when changing menubar. This reduces flickering. */
3593 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3594 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3595 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3596 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3597 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3598 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3599 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3600 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3601 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3604 f
->output_data
.x
->edit_widget
= frame_widget
;
3606 XtManageChild (frame_widget
);
3608 /* Do some needed geometry management. */
3611 char *tem
, shell_position
[32];
3614 int extra_borders
= 0;
3616 = (f
->output_data
.x
->menubar_widget
3617 ? (f
->output_data
.x
->menubar_widget
->core
.height
3618 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3621 #if 0 /* Experimentally, we now get the right results
3622 for -geometry -0-0 without this. 24 Aug 96, rms. */
3623 if (FRAME_EXTERNAL_MENU_BAR (f
))
3626 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3627 menubar_size
+= ibw
;
3631 f
->output_data
.x
->menubar_height
= menubar_size
;
3634 /* Motif seems to need this amount added to the sizes
3635 specified for the shell widget. The Athena/Lucid widgets don't.
3636 Both conclusions reached experimentally. -- rms. */
3637 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3638 &extra_borders
, NULL
);
3642 /* Convert our geometry parameters into a geometry string
3644 Note that we do not specify here whether the position
3645 is a user-specified or program-specified one.
3646 We pass that information later, in x_wm_set_size_hints. */
3648 int left
= f
->output_data
.x
->left_pos
;
3649 int xneg
= window_prompting
& XNegative
;
3650 int top
= f
->output_data
.x
->top_pos
;
3651 int yneg
= window_prompting
& YNegative
;
3657 if (window_prompting
& USPosition
)
3658 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3659 PIXEL_WIDTH (f
) + extra_borders
,
3660 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3661 (xneg
? '-' : '+'), left
,
3662 (yneg
? '-' : '+'), top
);
3664 sprintf (shell_position
, "=%dx%d",
3665 PIXEL_WIDTH (f
) + extra_borders
,
3666 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3669 len
= strlen (shell_position
) + 1;
3670 /* We don't free this because we don't know whether
3671 it is safe to free it while the frame exists.
3672 It isn't worth the trouble of arranging to free it
3673 when the frame is deleted. */
3674 tem
= (char *) xmalloc (len
);
3675 strncpy (tem
, shell_position
, len
);
3676 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3677 XtSetValues (shell_widget
, al
, ac
);
3680 XtManageChild (pane_widget
);
3681 XtRealizeWidget (shell_widget
);
3683 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3685 validate_x_resource_name ();
3687 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3688 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3689 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3692 FRAME_XIC (f
) = NULL
;
3694 create_frame_xic (f
);
3698 f
->output_data
.x
->wm_hints
.input
= True
;
3699 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3700 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3701 &f
->output_data
.x
->wm_hints
);
3703 hack_wm_protocols (f
, shell_widget
);
3706 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3709 /* Do a stupid property change to force the server to generate a
3710 PropertyNotify event so that the event_stream server timestamp will
3711 be initialized to something relevant to the time we created the window.
3713 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3714 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3715 XA_ATOM
, 32, PropModeAppend
,
3716 (unsigned char*) NULL
, 0);
3718 /* Make all the standard events reach the Emacs frame. */
3719 attributes
.event_mask
= STANDARD_EVENT_SET
;
3724 /* XIM server might require some X events. */
3725 unsigned long fevent
= NoEventMask
;
3726 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3727 attributes
.event_mask
|= fevent
;
3729 #endif /* HAVE_X_I18N */
3731 attribute_mask
= CWEventMask
;
3732 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3733 attribute_mask
, &attributes
);
3735 XtMapWidget (frame_widget
);
3737 /* x_set_name normally ignores requests to set the name if the
3738 requested name is the same as the current name. This is the one
3739 place where that assumption isn't correct; f->name is set, but
3740 the X server hasn't been told. */
3743 int explicit = f
->explicit_name
;
3745 f
->explicit_name
= 0;
3748 x_set_name (f
, name
, explicit);
3751 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3752 f
->output_data
.x
->text_cursor
);
3756 /* This is a no-op, except under Motif. Make sure main areas are
3757 set to something reasonable, in case we get an error later. */
3758 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3761 #else /* not USE_X_TOOLKIT */
3763 /* Create and set up the X window for frame F. */
3770 XClassHint class_hints
;
3771 XSetWindowAttributes attributes
;
3772 unsigned long attribute_mask
;
3774 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3775 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3776 attributes
.bit_gravity
= StaticGravity
;
3777 attributes
.backing_store
= NotUseful
;
3778 attributes
.save_under
= True
;
3779 attributes
.event_mask
= STANDARD_EVENT_SET
;
3780 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3781 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3786 = XCreateWindow (FRAME_X_DISPLAY (f
),
3787 f
->output_data
.x
->parent_desc
,
3788 f
->output_data
.x
->left_pos
,
3789 f
->output_data
.x
->top_pos
,
3790 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3791 f
->output_data
.x
->border_width
,
3792 CopyFromParent
, /* depth */
3793 InputOutput
, /* class */
3795 attribute_mask
, &attributes
);
3799 create_frame_xic (f
);
3802 /* XIM server might require some X events. */
3803 unsigned long fevent
= NoEventMask
;
3804 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3805 attributes
.event_mask
|= fevent
;
3806 attribute_mask
= CWEventMask
;
3807 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3808 attribute_mask
, &attributes
);
3811 #endif /* HAVE_X_I18N */
3813 validate_x_resource_name ();
3815 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3816 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3817 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3819 /* The menubar is part of the ordinary display;
3820 it does not count in addition to the height of the window. */
3821 f
->output_data
.x
->menubar_height
= 0;
3823 /* This indicates that we use the "Passive Input" input model.
3824 Unless we do this, we don't get the Focus{In,Out} events that we
3825 need to draw the cursor correctly. Accursed bureaucrats.
3826 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3828 f
->output_data
.x
->wm_hints
.input
= True
;
3829 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3830 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3831 &f
->output_data
.x
->wm_hints
);
3832 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3834 /* Request "save yourself" and "delete window" commands from wm. */
3837 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3838 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3839 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3842 /* x_set_name normally ignores requests to set the name if the
3843 requested name is the same as the current name. This is the one
3844 place where that assumption isn't correct; f->name is set, but
3845 the X server hasn't been told. */
3848 int explicit = f
->explicit_name
;
3850 f
->explicit_name
= 0;
3853 x_set_name (f
, name
, explicit);
3856 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3857 f
->output_data
.x
->text_cursor
);
3861 if (FRAME_X_WINDOW (f
) == 0)
3862 error ("Unable to create window");
3865 #endif /* not USE_X_TOOLKIT */
3867 /* Handle the icon stuff for this window. Perhaps later we might
3868 want an x_set_icon_position which can be called interactively as
3876 Lisp_Object icon_x
, icon_y
;
3877 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3879 /* Set the position of the icon. Note that twm groups all
3880 icons in an icon window. */
3881 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3882 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3883 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3885 CHECK_NUMBER (icon_x
, 0);
3886 CHECK_NUMBER (icon_y
, 0);
3888 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3889 error ("Both left and top icon corners of icon must be specified");
3893 if (! EQ (icon_x
, Qunbound
))
3894 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3896 /* Start up iconic or window? */
3897 x_wm_set_window_state
3898 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3903 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3910 /* Make the GCs needed for this window, setting the
3911 background, border and mouse colors; also create the
3912 mouse cursor and the gray border tile. */
3914 static char cursor_bits
[] =
3916 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3917 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3918 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3919 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3926 XGCValues gc_values
;
3930 /* Create the GCs of this frame.
3931 Note that many default values are used. */
3934 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3935 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3936 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3937 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3938 f
->output_data
.x
->normal_gc
3939 = XCreateGC (FRAME_X_DISPLAY (f
),
3941 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
3944 /* Reverse video style. */
3945 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3946 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3947 f
->output_data
.x
->reverse_gc
3948 = XCreateGC (FRAME_X_DISPLAY (f
),
3950 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
3953 /* Cursor has cursor-color background, background-color foreground. */
3954 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3955 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3956 gc_values
.fill_style
= FillOpaqueStippled
;
3958 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3959 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3960 cursor_bits
, 16, 16);
3961 f
->output_data
.x
->cursor_gc
3962 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3963 (GCFont
| GCForeground
| GCBackground
3964 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3968 f
->output_data
.x
->white_relief
.gc
= 0;
3969 f
->output_data
.x
->black_relief
.gc
= 0;
3971 /* Create the gray border tile used when the pointer is not in
3972 the frame. Since this depends on the frame's pixel values,
3973 this must be done on a per-frame basis. */
3974 f
->output_data
.x
->border_tile
3975 = (XCreatePixmapFromBitmapData
3976 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3977 gray_bits
, gray_width
, gray_height
,
3978 f
->output_data
.x
->foreground_pixel
,
3979 f
->output_data
.x
->background_pixel
,
3980 DefaultDepth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
))));
3986 /* Free what was was allocated in x_make_gc. */
3992 Display
*dpy
= FRAME_X_DISPLAY (f
);
3996 if (f
->output_data
.x
->normal_gc
)
3998 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
3999 f
->output_data
.x
->normal_gc
= 0;
4002 if (f
->output_data
.x
->reverse_gc
)
4004 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4005 f
->output_data
.x
->reverse_gc
= 0;
4008 if (f
->output_data
.x
->cursor_gc
)
4010 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4011 f
->output_data
.x
->cursor_gc
= 0;
4014 if (f
->output_data
.x
->border_tile
)
4016 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4017 f
->output_data
.x
->border_tile
= 0;
4024 /* Handler for signals raised during x_create_frame and
4025 x_create_top_frame. FRAME is the frame which is partially
4029 unwind_create_frame (frame
)
4032 struct frame
*f
= XFRAME (frame
);
4034 /* If frame is ``official'', nothing to do. */
4035 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4038 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4041 x_free_frame_resources (f
);
4043 /* Check that reference counts are indeed correct. */
4044 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4045 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4053 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4055 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
4056 Returns an Emacs frame object.\n\
4057 ALIST is an alist of frame parameters.\n\
4058 If the parameters specify that the frame should not have a minibuffer,\n\
4059 and do not specify a specific minibuffer window to use,\n\
4060 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4061 be shared by the new frame.\n\
4063 This function is an internal primitive--use `make-frame' instead.")
4068 Lisp_Object frame
, tem
;
4070 int minibuffer_only
= 0;
4071 long window_prompting
= 0;
4073 int count
= BINDING_STACK_SIZE ();
4074 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4075 Lisp_Object display
;
4076 struct x_display_info
*dpyinfo
= NULL
;
4082 /* Use this general default value to start with
4083 until we know if this frame has a specified name. */
4084 Vx_resource_name
= Vinvocation_name
;
4086 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4087 if (EQ (display
, Qunbound
))
4089 dpyinfo
= check_x_display_info (display
);
4091 kb
= dpyinfo
->kboard
;
4093 kb
= &the_only_kboard
;
4096 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4098 && ! EQ (name
, Qunbound
)
4100 error ("Invalid frame name--not a string or nil");
4103 Vx_resource_name
= name
;
4105 /* See if parent window is specified. */
4106 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4107 if (EQ (parent
, Qunbound
))
4109 if (! NILP (parent
))
4110 CHECK_NUMBER (parent
, 0);
4112 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4113 /* No need to protect DISPLAY because that's not used after passing
4114 it to make_frame_without_minibuffer. */
4116 GCPRO4 (parms
, parent
, name
, frame
);
4117 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4119 if (EQ (tem
, Qnone
) || NILP (tem
))
4120 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4121 else if (EQ (tem
, Qonly
))
4123 f
= make_minibuffer_frame ();
4124 minibuffer_only
= 1;
4126 else if (WINDOWP (tem
))
4127 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4131 XSETFRAME (frame
, f
);
4133 /* Note that X Windows does support scroll bars. */
4134 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4136 f
->output_method
= output_x_window
;
4137 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4138 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4139 f
->output_data
.x
->icon_bitmap
= -1;
4140 f
->output_data
.x
->fontset
= -1;
4141 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4142 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4143 record_unwind_protect (unwind_create_frame
, frame
);
4146 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4148 if (! STRINGP (f
->icon_name
))
4149 f
->icon_name
= Qnil
;
4151 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4153 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4154 dpyinfo_refcount
= dpyinfo
->reference_count
;
4155 #endif /* GLYPH_DEBUG */
4157 FRAME_KBOARD (f
) = kb
;
4160 /* These colors will be set anyway later, but it's important
4161 to get the color reference counts right, so initialize them! */
4164 struct gcpro gcpro1
;
4166 black
= build_string ("black");
4168 f
->output_data
.x
->foreground_pixel
4169 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4170 f
->output_data
.x
->background_pixel
4171 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4172 f
->output_data
.x
->cursor_pixel
4173 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4174 f
->output_data
.x
->cursor_foreground_pixel
4175 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4176 f
->output_data
.x
->border_pixel
4177 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4178 f
->output_data
.x
->mouse_pixel
4179 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4183 /* Specify the parent under which to make this X window. */
4187 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4188 f
->output_data
.x
->explicit_parent
= 1;
4192 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4193 f
->output_data
.x
->explicit_parent
= 0;
4196 /* Set the name; the functions to which we pass f expect the name to
4198 if (EQ (name
, Qunbound
) || NILP (name
))
4200 f
->name
= build_string (dpyinfo
->x_id_name
);
4201 f
->explicit_name
= 0;
4206 f
->explicit_name
= 1;
4207 /* use the frame's title when getting resources for this frame. */
4208 specbind (Qx_resource_name
, name
);
4211 /* Extract the window parameters from the supplied values
4212 that are needed to determine window geometry. */
4216 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4219 /* First, try whatever font the caller has specified. */
4222 tem
= Fquery_fontset (font
, Qnil
);
4224 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4226 font
= x_new_font (f
, XSTRING (font
)->data
);
4229 /* Try out a font which we hope has bold and italic variations. */
4230 if (!STRINGP (font
))
4231 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4232 if (!STRINGP (font
))
4233 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4234 if (! STRINGP (font
))
4235 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4236 if (! STRINGP (font
))
4237 /* This was formerly the first thing tried, but it finds too many fonts
4238 and takes too long. */
4239 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4240 /* If those didn't work, look for something which will at least work. */
4241 if (! STRINGP (font
))
4242 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4244 if (! STRINGP (font
))
4245 font
= build_string ("fixed");
4247 x_default_parameter (f
, parms
, Qfont
, font
,
4248 "font", "Font", RES_TYPE_STRING
);
4252 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4253 whereby it fails to get any font. */
4254 xlwmenu_default_font
= f
->output_data
.x
->font
;
4257 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4258 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4260 /* This defaults to 2 in order to match xterm. We recognize either
4261 internalBorderWidth or internalBorder (which is what xterm calls
4263 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4267 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4268 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4269 if (! EQ (value
, Qunbound
))
4270 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4273 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4274 "internalBorderWidth", "internalBorderWidth",
4276 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4277 "verticalScrollBars", "ScrollBars",
4280 /* Also do the stuff which must be set before the window exists. */
4281 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4282 "foreground", "Foreground", RES_TYPE_STRING
);
4283 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4284 "background", "Background", RES_TYPE_STRING
);
4285 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4286 "pointerColor", "Foreground", RES_TYPE_STRING
);
4287 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4288 "cursorColor", "Foreground", RES_TYPE_STRING
);
4289 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4290 "borderColor", "BorderColor", RES_TYPE_STRING
);
4291 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4292 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4293 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4294 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4296 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4297 "scrollBarForeground",
4298 "ScrollBarForeground", 1);
4299 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4300 "scrollBarBackground",
4301 "ScrollBarBackground", 0);
4303 /* Init faces before x_default_parameter is called for scroll-bar
4304 parameters because that function calls x_set_scroll_bar_width,
4305 which calls change_frame_size, which calls Fset_window_buffer,
4306 which runs hooks, which call Fvertical_motion. At the end, we
4307 end up in init_iterator with a null face cache, which should not
4309 init_frame_faces (f
);
4311 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4312 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4313 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4314 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4315 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4316 "bufferPredicate", "BufferPredicate",
4318 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4319 "title", "Title", RES_TYPE_STRING
);
4321 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4323 /* Add the tool-bar height to the initial frame height so that the
4324 user gets a text display area of the size he specified with -g or
4325 via .Xdefaults. Later changes of the tool-bar height don't
4326 change the frame size. This is done so that users can create
4327 tall Emacs frames without having to guess how tall the tool-bar
4329 if (FRAME_TOOL_BAR_LINES (f
))
4331 int margin
, relief
, bar_height
;
4333 relief
= (tool_bar_button_relief
> 0
4334 ? tool_bar_button_relief
4335 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4337 if (INTEGERP (Vtool_bar_button_margin
)
4338 && XINT (Vtool_bar_button_margin
) > 0)
4339 margin
= XFASTINT (Vtool_bar_button_margin
);
4340 else if (CONSP (Vtool_bar_button_margin
)
4341 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4342 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4343 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4347 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4348 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4351 /* Compute the size of the X window. */
4352 window_prompting
= x_figure_window_size (f
, parms
);
4354 if (window_prompting
& XNegative
)
4356 if (window_prompting
& YNegative
)
4357 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4359 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4363 if (window_prompting
& YNegative
)
4364 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4366 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4369 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4371 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4372 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4374 /* Create the X widget or window. */
4375 #ifdef USE_X_TOOLKIT
4376 x_window (f
, window_prompting
, minibuffer_only
);
4384 /* Now consider the frame official. */
4385 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4386 Vframe_list
= Fcons (frame
, Vframe_list
);
4388 /* We need to do this after creating the X window, so that the
4389 icon-creation functions can say whose icon they're describing. */
4390 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4391 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4393 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4394 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4395 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4396 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4397 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4398 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4399 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4400 "scrollBarWidth", "ScrollBarWidth",
4403 /* Dimensions, especially f->height, must be done via change_frame_size.
4404 Change will not be effected unless different from the current
4410 SET_FRAME_WIDTH (f
, 0);
4411 change_frame_size (f
, height
, width
, 1, 0, 0);
4413 /* Set up faces after all frame parameters are known. This call
4414 also merges in face attributes specified for new frames. If we
4415 don't do this, the `menu' face for instance won't have the right
4416 colors, and the menu bar won't appear in the specified colors for
4418 call1 (Qface_set_after_frame_default
, frame
);
4420 #ifdef USE_X_TOOLKIT
4421 /* Create the menu bar. */
4422 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4424 /* If this signals an error, we haven't set size hints for the
4425 frame and we didn't make it visible. */
4426 initialize_frame_menubar (f
);
4428 /* This is a no-op, except under Motif where it arranges the
4429 main window for the widgets on it. */
4430 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4431 f
->output_data
.x
->menubar_widget
,
4432 f
->output_data
.x
->edit_widget
);
4434 #endif /* USE_X_TOOLKIT */
4436 /* Tell the server what size and position, etc, we want, and how
4437 badly we want them. This should be done after we have the menu
4438 bar so that its size can be taken into account. */
4440 x_wm_set_size_hint (f
, window_prompting
, 0);
4443 /* Make the window appear on the frame and enable display, unless
4444 the caller says not to. However, with explicit parent, Emacs
4445 cannot control visibility, so don't try. */
4446 if (! f
->output_data
.x
->explicit_parent
)
4448 Lisp_Object visibility
;
4450 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4452 if (EQ (visibility
, Qunbound
))
4455 if (EQ (visibility
, Qicon
))
4456 x_iconify_frame (f
);
4457 else if (! NILP (visibility
))
4458 x_make_frame_visible (f
);
4460 /* Must have been Qnil. */
4466 /* Make sure windows on this frame appear in calls to next-window
4467 and similar functions. */
4468 Vwindow_list
= Qnil
;
4470 return unbind_to (count
, frame
);
4474 /* FRAME is used only to get a handle on the X display. We don't pass the
4475 display info directly because we're called from frame.c, which doesn't
4476 know about that structure. */
4479 x_get_focus_frame (frame
)
4480 struct frame
*frame
;
4482 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4484 if (! dpyinfo
->x_focus_frame
)
4487 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4492 /* In certain situations, when the window manager follows a
4493 click-to-focus policy, there seems to be no way around calling
4494 XSetInputFocus to give another frame the input focus .
4496 In an ideal world, XSetInputFocus should generally be avoided so
4497 that applications don't interfere with the window manager's focus
4498 policy. But I think it's okay to use when it's clearly done
4499 following a user-command. */
4501 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4502 "Set the input focus to FRAME.\n\
4503 FRAME nil means use the selected frame.")
4507 struct frame
*f
= check_x_frame (frame
);
4508 Display
*dpy
= FRAME_X_DISPLAY (f
);
4512 count
= x_catch_errors (dpy
);
4513 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4514 RevertToParent
, CurrentTime
);
4515 x_uncatch_errors (dpy
, count
);
4522 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4523 "Internal function called by `color-defined-p', which see.")
4525 Lisp_Object color
, frame
;
4528 FRAME_PTR f
= check_x_frame (frame
);
4530 CHECK_STRING (color
, 1);
4532 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4538 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4539 "Internal function called by `color-values', which see.")
4541 Lisp_Object color
, frame
;
4544 FRAME_PTR f
= check_x_frame (frame
);
4546 CHECK_STRING (color
, 1);
4548 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4552 rgb
[0] = make_number (foo
.red
);
4553 rgb
[1] = make_number (foo
.green
);
4554 rgb
[2] = make_number (foo
.blue
);
4555 return Flist (3, rgb
);
4561 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4562 "Internal function called by `display-color-p', which see.")
4564 Lisp_Object display
;
4566 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4568 if (dpyinfo
->n_planes
<= 2)
4571 switch (dpyinfo
->visual
->class)
4584 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4586 "Return t if the X display supports shades of gray.\n\
4587 Note that color displays do support shades of gray.\n\
4588 The optional argument DISPLAY specifies which display to ask about.\n\
4589 DISPLAY should be either a frame or a display name (a string).\n\
4590 If omitted or nil, that stands for the selected frame's display.")
4592 Lisp_Object display
;
4594 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4596 if (dpyinfo
->n_planes
<= 1)
4599 switch (dpyinfo
->visual
->class)
4614 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4616 "Returns the width in pixels of the X display DISPLAY.\n\
4617 The optional argument DISPLAY specifies which display to ask about.\n\
4618 DISPLAY should be either a frame or a display name (a string).\n\
4619 If omitted or nil, that stands for the selected frame's display.")
4621 Lisp_Object display
;
4623 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4625 return make_number (dpyinfo
->width
);
4628 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4629 Sx_display_pixel_height
, 0, 1, 0,
4630 "Returns the height in pixels of the X display DISPLAY.\n\
4631 The optional argument DISPLAY specifies which display to ask about.\n\
4632 DISPLAY should be either a frame or a display name (a string).\n\
4633 If omitted or nil, that stands for the selected frame's display.")
4635 Lisp_Object display
;
4637 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4639 return make_number (dpyinfo
->height
);
4642 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4644 "Returns the number of bitplanes of the X display DISPLAY.\n\
4645 The optional argument DISPLAY specifies which display to ask about.\n\
4646 DISPLAY should be either a frame or a display name (a string).\n\
4647 If omitted or nil, that stands for the selected frame's display.")
4649 Lisp_Object display
;
4651 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4653 return make_number (dpyinfo
->n_planes
);
4656 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4658 "Returns the number of color cells of the X display DISPLAY.\n\
4659 The optional argument DISPLAY specifies which display to ask about.\n\
4660 DISPLAY should be either a frame or a display name (a string).\n\
4661 If omitted or nil, that stands for the selected frame's display.")
4663 Lisp_Object display
;
4665 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4667 return make_number (DisplayCells (dpyinfo
->display
,
4668 XScreenNumberOfScreen (dpyinfo
->screen
)));
4671 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4672 Sx_server_max_request_size
,
4674 "Returns the maximum request size of the X server of display DISPLAY.\n\
4675 The optional argument DISPLAY specifies which display to ask about.\n\
4676 DISPLAY should be either a frame or a display name (a string).\n\
4677 If omitted or nil, that stands for the selected frame's display.")
4679 Lisp_Object display
;
4681 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4683 return make_number (MAXREQUEST (dpyinfo
->display
));
4686 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4687 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4688 The optional argument DISPLAY specifies which display to ask about.\n\
4689 DISPLAY should be either a frame or a display name (a string).\n\
4690 If omitted or nil, that stands for the selected frame's display.")
4692 Lisp_Object display
;
4694 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4695 char *vendor
= ServerVendor (dpyinfo
->display
);
4697 if (! vendor
) vendor
= "";
4698 return build_string (vendor
);
4701 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4702 "Returns the version numbers of the X server of display DISPLAY.\n\
4703 The value is a list of three integers: the major and minor\n\
4704 version numbers of the X Protocol in use, and the vendor-specific release\n\
4705 number. See also the function `x-server-vendor'.\n\n\
4706 The optional argument DISPLAY specifies which display to ask about.\n\
4707 DISPLAY should be either a frame or a display name (a string).\n\
4708 If omitted or nil, that stands for the selected frame's display.")
4710 Lisp_Object display
;
4712 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4713 Display
*dpy
= dpyinfo
->display
;
4715 return Fcons (make_number (ProtocolVersion (dpy
)),
4716 Fcons (make_number (ProtocolRevision (dpy
)),
4717 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4720 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4721 "Returns the number of screens on the X server of display DISPLAY.\n\
4722 The optional argument DISPLAY specifies which display to ask about.\n\
4723 DISPLAY should be either a frame or a display name (a string).\n\
4724 If omitted or nil, that stands for the selected frame's display.")
4726 Lisp_Object display
;
4728 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4730 return make_number (ScreenCount (dpyinfo
->display
));
4733 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4734 "Returns the height in millimeters of the X display DISPLAY.\n\
4735 The optional argument DISPLAY specifies which display to ask about.\n\
4736 DISPLAY should be either a frame or a display name (a string).\n\
4737 If omitted or nil, that stands for the selected frame's display.")
4739 Lisp_Object display
;
4741 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4743 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4746 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4747 "Returns the width in millimeters of the X display DISPLAY.\n\
4748 The optional argument DISPLAY specifies which display to ask about.\n\
4749 DISPLAY should be either a frame or a display name (a string).\n\
4750 If omitted or nil, that stands for the selected frame's display.")
4752 Lisp_Object display
;
4754 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4756 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4759 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4760 Sx_display_backing_store
, 0, 1, 0,
4761 "Returns an indication of whether X display DISPLAY does backing store.\n\
4762 The value may be `always', `when-mapped', or `not-useful'.\n\
4763 The optional argument DISPLAY specifies which display to ask about.\n\
4764 DISPLAY should be either a frame or a display name (a string).\n\
4765 If omitted or nil, that stands for the selected frame's display.")
4767 Lisp_Object display
;
4769 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4772 switch (DoesBackingStore (dpyinfo
->screen
))
4775 result
= intern ("always");
4779 result
= intern ("when-mapped");
4783 result
= intern ("not-useful");
4787 error ("Strange value for BackingStore parameter of screen");
4794 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4795 Sx_display_visual_class
, 0, 1, 0,
4796 "Returns the visual class of the X display DISPLAY.\n\
4797 The value is one of the symbols `static-gray', `gray-scale',\n\
4798 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4799 The optional argument DISPLAY specifies which display to ask about.\n\
4800 DISPLAY should be either a frame or a display name (a string).\n\
4801 If omitted or nil, that stands for the selected frame's display.")
4803 Lisp_Object display
;
4805 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4808 switch (dpyinfo
->visual
->class)
4811 result
= intern ("static-gray");
4814 result
= intern ("gray-scale");
4817 result
= intern ("static-color");
4820 result
= intern ("pseudo-color");
4823 result
= intern ("true-color");
4826 result
= intern ("direct-color");
4829 error ("Display has an unknown visual class");
4836 DEFUN ("x-display-save-under", Fx_display_save_under
,
4837 Sx_display_save_under
, 0, 1, 0,
4838 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4839 The optional argument DISPLAY specifies which display to ask about.\n\
4840 DISPLAY should be either a frame or a display name (a string).\n\
4841 If omitted or nil, that stands for the selected frame's display.")
4843 Lisp_Object display
;
4845 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4847 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4855 register struct frame
*f
;
4857 return PIXEL_WIDTH (f
);
4862 register struct frame
*f
;
4864 return PIXEL_HEIGHT (f
);
4869 register struct frame
*f
;
4871 return FONT_WIDTH (f
->output_data
.x
->font
);
4876 register struct frame
*f
;
4878 return f
->output_data
.x
->line_height
;
4883 register struct frame
*f
;
4885 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4890 /************************************************************************
4892 ************************************************************************/
4895 /* Mapping visual names to visuals. */
4897 static struct visual_class
4904 {"StaticGray", StaticGray
},
4905 {"GrayScale", GrayScale
},
4906 {"StaticColor", StaticColor
},
4907 {"PseudoColor", PseudoColor
},
4908 {"TrueColor", TrueColor
},
4909 {"DirectColor", DirectColor
},
4914 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4916 /* Value is the screen number of screen SCR. This is a substitute for
4917 the X function with the same name when that doesn't exist. */
4920 XScreenNumberOfScreen (scr
)
4921 register Screen
*scr
;
4923 Display
*dpy
= scr
->display
;
4926 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4927 if (scr
== dpy
->screens
[i
])
4933 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4936 /* Select the visual that should be used on display DPYINFO. Set
4937 members of DPYINFO appropriately. Called from x_term_init. */
4940 select_visual (dpyinfo
)
4941 struct x_display_info
*dpyinfo
;
4943 Display
*dpy
= dpyinfo
->display
;
4944 Screen
*screen
= dpyinfo
->screen
;
4947 /* See if a visual is specified. */
4948 value
= display_x_get_resource (dpyinfo
,
4949 build_string ("visualClass"),
4950 build_string ("VisualClass"),
4952 if (STRINGP (value
))
4954 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4955 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4956 depth, a decimal number. NAME is compared with case ignored. */
4957 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4962 strcpy (s
, XSTRING (value
)->data
);
4963 dash
= index (s
, '-');
4966 dpyinfo
->n_planes
= atoi (dash
+ 1);
4970 /* We won't find a matching visual with depth 0, so that
4971 an error will be printed below. */
4972 dpyinfo
->n_planes
= 0;
4974 /* Determine the visual class. */
4975 for (i
= 0; visual_classes
[i
].name
; ++i
)
4976 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4978 class = visual_classes
[i
].class;
4982 /* Look up a matching visual for the specified class. */
4984 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4985 dpyinfo
->n_planes
, class, &vinfo
))
4986 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4988 dpyinfo
->visual
= vinfo
.visual
;
4993 XVisualInfo
*vinfo
, vinfo_template
;
4995 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
4998 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
5000 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
5002 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5003 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
5004 &vinfo_template
, &n_visuals
);
5006 fatal ("Can't get proper X visual info");
5008 dpyinfo
->n_planes
= vinfo
->depth
;
5009 XFree ((char *) vinfo
);
5014 /* Return the X display structure for the display named NAME.
5015 Open a new connection if necessary. */
5017 struct x_display_info
*
5018 x_display_info_for_name (name
)
5022 struct x_display_info
*dpyinfo
;
5024 CHECK_STRING (name
, 0);
5026 if (! EQ (Vwindow_system
, intern ("x")))
5027 error ("Not using X Windows");
5029 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5031 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5034 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5039 /* Use this general default value to start with. */
5040 Vx_resource_name
= Vinvocation_name
;
5042 validate_x_resource_name ();
5044 dpyinfo
= x_term_init (name
, (char *)0,
5045 (char *) XSTRING (Vx_resource_name
)->data
);
5048 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5051 XSETFASTINT (Vwindow_system_version
, 11);
5057 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5058 1, 3, 0, "Open a connection to an X server.\n\
5059 DISPLAY is the name of the display to connect to.\n\
5060 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5061 If the optional third arg MUST-SUCCEED is non-nil,\n\
5062 terminate Emacs if we can't open the connection.")
5063 (display
, xrm_string
, must_succeed
)
5064 Lisp_Object display
, xrm_string
, must_succeed
;
5066 unsigned char *xrm_option
;
5067 struct x_display_info
*dpyinfo
;
5069 CHECK_STRING (display
, 0);
5070 if (! NILP (xrm_string
))
5071 CHECK_STRING (xrm_string
, 1);
5073 if (! EQ (Vwindow_system
, intern ("x")))
5074 error ("Not using X Windows");
5076 if (! NILP (xrm_string
))
5077 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5079 xrm_option
= (unsigned char *) 0;
5081 validate_x_resource_name ();
5083 /* This is what opens the connection and sets x_current_display.
5084 This also initializes many symbols, such as those used for input. */
5085 dpyinfo
= x_term_init (display
, xrm_option
,
5086 (char *) XSTRING (Vx_resource_name
)->data
);
5090 if (!NILP (must_succeed
))
5091 fatal ("Cannot connect to X server %s.\n\
5092 Check the DISPLAY environment variable or use `-d'.\n\
5093 Also use the `xhost' program to verify that it is set to permit\n\
5094 connections from your machine.\n",
5095 XSTRING (display
)->data
);
5097 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5102 XSETFASTINT (Vwindow_system_version
, 11);
5106 DEFUN ("x-close-connection", Fx_close_connection
,
5107 Sx_close_connection
, 1, 1, 0,
5108 "Close the connection to DISPLAY's X server.\n\
5109 For DISPLAY, specify either a frame or a display name (a string).\n\
5110 If DISPLAY is nil, that stands for the selected frame's display.")
5112 Lisp_Object display
;
5114 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5117 if (dpyinfo
->reference_count
> 0)
5118 error ("Display still has frames on it");
5121 /* Free the fonts in the font table. */
5122 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5123 if (dpyinfo
->font_table
[i
].name
)
5125 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5126 xfree (dpyinfo
->font_table
[i
].full_name
);
5127 xfree (dpyinfo
->font_table
[i
].name
);
5128 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5131 x_destroy_all_bitmaps (dpyinfo
);
5132 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5134 #ifdef USE_X_TOOLKIT
5135 XtCloseDisplay (dpyinfo
->display
);
5137 XCloseDisplay (dpyinfo
->display
);
5140 x_delete_display (dpyinfo
);
5146 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5147 "Return the list of display names that Emacs has connections to.")
5150 Lisp_Object tail
, result
;
5153 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5154 result
= Fcons (XCAR (XCAR (tail
)), result
);
5159 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5160 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5161 If ON is nil, allow buffering of requests.\n\
5162 Turning on synchronization prohibits the Xlib routines from buffering\n\
5163 requests and seriously degrades performance, but makes debugging much\n\
5165 The optional second argument DISPLAY specifies which display to act on.\n\
5166 DISPLAY should be either a frame or a display name (a string).\n\
5167 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5169 Lisp_Object display
, on
;
5171 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5173 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5178 /* Wait for responses to all X commands issued so far for frame F. */
5185 XSync (FRAME_X_DISPLAY (f
), False
);
5190 /***********************************************************************
5192 ***********************************************************************/
5194 /* Value is the number of elements of vector VECTOR. */
5196 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5198 /* List of supported image types. Use define_image_type to add new
5199 types. Use lookup_image_type to find a type for a given symbol. */
5201 static struct image_type
*image_types
;
5203 /* The symbol `image' which is the car of the lists used to represent
5206 extern Lisp_Object Qimage
;
5208 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5214 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5215 extern Lisp_Object QCdata
;
5216 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5217 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5218 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5220 /* Other symbols. */
5222 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5224 /* Time in seconds after which images should be removed from the cache
5225 if not displayed. */
5227 Lisp_Object Vimage_cache_eviction_delay
;
5229 /* Function prototypes. */
5231 static void define_image_type
P_ ((struct image_type
*type
));
5232 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5233 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5234 static void x_laplace
P_ ((struct frame
*, struct image
*));
5235 static void x_emboss
P_ ((struct frame
*, struct image
*));
5236 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5240 /* Define a new image type from TYPE. This adds a copy of TYPE to
5241 image_types and adds the symbol *TYPE->type to Vimage_types. */
5244 define_image_type (type
)
5245 struct image_type
*type
;
5247 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5248 The initialized data segment is read-only. */
5249 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5250 bcopy (type
, p
, sizeof *p
);
5251 p
->next
= image_types
;
5253 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5257 /* Look up image type SYMBOL, and return a pointer to its image_type
5258 structure. Value is null if SYMBOL is not a known image type. */
5260 static INLINE
struct image_type
*
5261 lookup_image_type (symbol
)
5264 struct image_type
*type
;
5266 for (type
= image_types
; type
; type
= type
->next
)
5267 if (EQ (symbol
, *type
->type
))
5274 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5275 valid image specification is a list whose car is the symbol
5276 `image', and whose rest is a property list. The property list must
5277 contain a value for key `:type'. That value must be the name of a
5278 supported image type. The rest of the property list depends on the
5282 valid_image_p (object
)
5287 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5289 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5290 struct image_type
*type
= lookup_image_type (symbol
);
5293 valid_p
= type
->valid_p (object
);
5300 /* Log error message with format string FORMAT and argument ARG.
5301 Signaling an error, e.g. when an image cannot be loaded, is not a
5302 good idea because this would interrupt redisplay, and the error
5303 message display would lead to another redisplay. This function
5304 therefore simply displays a message. */
5307 image_error (format
, arg1
, arg2
)
5309 Lisp_Object arg1
, arg2
;
5311 add_to_log (format
, arg1
, arg2
);
5316 /***********************************************************************
5317 Image specifications
5318 ***********************************************************************/
5320 enum image_value_type
5322 IMAGE_DONT_CHECK_VALUE_TYPE
,
5325 IMAGE_POSITIVE_INTEGER_VALUE
,
5326 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5327 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5329 IMAGE_INTEGER_VALUE
,
5330 IMAGE_FUNCTION_VALUE
,
5335 /* Structure used when parsing image specifications. */
5337 struct image_keyword
5339 /* Name of keyword. */
5342 /* The type of value allowed. */
5343 enum image_value_type type
;
5345 /* Non-zero means key must be present. */
5348 /* Used to recognize duplicate keywords in a property list. */
5351 /* The value that was found. */
5356 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5358 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5361 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5362 has the format (image KEYWORD VALUE ...). One of the keyword/
5363 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5364 image_keywords structures of size NKEYWORDS describing other
5365 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5368 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5370 struct image_keyword
*keywords
;
5377 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5380 plist
= XCDR (spec
);
5381 while (CONSP (plist
))
5383 Lisp_Object key
, value
;
5385 /* First element of a pair must be a symbol. */
5387 plist
= XCDR (plist
);
5391 /* There must follow a value. */
5394 value
= XCAR (plist
);
5395 plist
= XCDR (plist
);
5397 /* Find key in KEYWORDS. Error if not found. */
5398 for (i
= 0; i
< nkeywords
; ++i
)
5399 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5405 /* Record that we recognized the keyword. If a keywords
5406 was found more than once, it's an error. */
5407 keywords
[i
].value
= value
;
5408 ++keywords
[i
].count
;
5410 if (keywords
[i
].count
> 1)
5413 /* Check type of value against allowed type. */
5414 switch (keywords
[i
].type
)
5416 case IMAGE_STRING_VALUE
:
5417 if (!STRINGP (value
))
5421 case IMAGE_SYMBOL_VALUE
:
5422 if (!SYMBOLP (value
))
5426 case IMAGE_POSITIVE_INTEGER_VALUE
:
5427 if (!INTEGERP (value
) || XINT (value
) <= 0)
5431 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5432 if (INTEGERP (value
) && XINT (value
) >= 0)
5435 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5436 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5440 case IMAGE_ASCENT_VALUE
:
5441 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5443 else if (INTEGERP (value
)
5444 && XINT (value
) >= 0
5445 && XINT (value
) <= 100)
5449 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5450 if (!INTEGERP (value
) || XINT (value
) < 0)
5454 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5457 case IMAGE_FUNCTION_VALUE
:
5458 value
= indirect_function (value
);
5460 || COMPILEDP (value
)
5461 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5465 case IMAGE_NUMBER_VALUE
:
5466 if (!INTEGERP (value
) && !FLOATP (value
))
5470 case IMAGE_INTEGER_VALUE
:
5471 if (!INTEGERP (value
))
5475 case IMAGE_BOOL_VALUE
:
5476 if (!NILP (value
) && !EQ (value
, Qt
))
5485 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5489 /* Check that all mandatory fields are present. */
5490 for (i
= 0; i
< nkeywords
; ++i
)
5491 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5494 return NILP (plist
);
5498 /* Return the value of KEY in image specification SPEC. Value is nil
5499 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5500 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5503 image_spec_value (spec
, key
, found
)
5504 Lisp_Object spec
, key
;
5509 xassert (valid_image_p (spec
));
5511 for (tail
= XCDR (spec
);
5512 CONSP (tail
) && CONSP (XCDR (tail
));
5513 tail
= XCDR (XCDR (tail
)))
5515 if (EQ (XCAR (tail
), key
))
5519 return XCAR (XCDR (tail
));
5529 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5530 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5531 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5532 size in canonical character units.\n\
5533 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5534 or omitted means use the selected frame.")
5535 (spec
, pixels
, frame
)
5536 Lisp_Object spec
, pixels
, frame
;
5541 if (valid_image_p (spec
))
5543 struct frame
*f
= check_x_frame (frame
);
5544 int id
= lookup_image (f
, spec
);
5545 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5546 int width
= img
->width
+ 2 * img
->hmargin
;
5547 int height
= img
->height
+ 2 * img
->vmargin
;
5550 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5551 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5553 size
= Fcons (make_number (width
), make_number (height
));
5556 error ("Invalid image specification");
5562 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5563 "Return t if image SPEC has a mask bitmap.\n\
5564 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5565 or omitted means use the selected frame.")
5567 Lisp_Object spec
, frame
;
5572 if (valid_image_p (spec
))
5574 struct frame
*f
= check_x_frame (frame
);
5575 int id
= lookup_image (f
, spec
);
5576 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5581 error ("Invalid image specification");
5588 /***********************************************************************
5589 Image type independent image structures
5590 ***********************************************************************/
5592 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5593 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5596 /* Allocate and return a new image structure for image specification
5597 SPEC. SPEC has a hash value of HASH. */
5599 static struct image
*
5600 make_image (spec
, hash
)
5604 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5606 xassert (valid_image_p (spec
));
5607 bzero (img
, sizeof *img
);
5608 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5609 xassert (img
->type
!= NULL
);
5611 img
->data
.lisp_val
= Qnil
;
5612 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5618 /* Free image IMG which was used on frame F, including its resources. */
5627 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5629 /* Remove IMG from the hash table of its cache. */
5631 img
->prev
->next
= img
->next
;
5633 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5636 img
->next
->prev
= img
->prev
;
5638 c
->images
[img
->id
] = NULL
;
5640 /* Free resources, then free IMG. */
5641 img
->type
->free (f
, img
);
5647 /* Prepare image IMG for display on frame F. Must be called before
5648 drawing an image. */
5651 prepare_image_for_display (f
, img
)
5657 /* We're about to display IMG, so set its timestamp to `now'. */
5659 img
->timestamp
= EMACS_SECS (t
);
5661 /* If IMG doesn't have a pixmap yet, load it now, using the image
5662 type dependent loader function. */
5663 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5664 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5668 /* Value is the number of pixels for the ascent of image IMG when
5669 drawn in face FACE. */
5672 image_ascent (img
, face
)
5676 int height
= img
->height
+ img
->vmargin
;
5679 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5682 /* This expression is arranged so that if the image can't be
5683 exactly centered, it will be moved slightly up. This is
5684 because a typical font is `top-heavy' (due to the presence
5685 uppercase letters), so the image placement should err towards
5686 being top-heavy too. It also just generally looks better. */
5687 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5689 ascent
= height
/ 2;
5692 ascent
= height
* img
->ascent
/ 100.0;
5699 /***********************************************************************
5700 Helper functions for X image types
5701 ***********************************************************************/
5703 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5705 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5706 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5708 Lisp_Object color_name
,
5709 unsigned long dflt
));
5712 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5713 free the pixmap if any. MASK_P non-zero means clear the mask
5714 pixmap if any. COLORS_P non-zero means free colors allocated for
5715 the image, if any. */
5718 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5721 int pixmap_p
, mask_p
, colors_p
;
5723 if (pixmap_p
&& img
->pixmap
)
5725 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5729 if (mask_p
&& img
->mask
)
5731 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5735 if (colors_p
&& img
->ncolors
)
5737 x_free_colors (f
, img
->colors
, img
->ncolors
);
5738 xfree (img
->colors
);
5744 /* Free X resources of image IMG which is used on frame F. */
5747 x_clear_image (f
, img
)
5752 x_clear_image_1 (f
, img
, 1, 1, 1);
5757 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5758 cannot be allocated, use DFLT. Add a newly allocated color to
5759 IMG->colors, so that it can be freed again. Value is the pixel
5762 static unsigned long
5763 x_alloc_image_color (f
, img
, color_name
, dflt
)
5766 Lisp_Object color_name
;
5770 unsigned long result
;
5772 xassert (STRINGP (color_name
));
5774 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5776 /* This isn't called frequently so we get away with simply
5777 reallocating the color vector to the needed size, here. */
5780 (unsigned long *) xrealloc (img
->colors
,
5781 img
->ncolors
* sizeof *img
->colors
);
5782 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5783 result
= color
.pixel
;
5793 /***********************************************************************
5795 ***********************************************************************/
5797 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5798 static void postprocess_image
P_ ((struct frame
*, struct image
*));
5801 /* Return a new, initialized image cache that is allocated from the
5802 heap. Call free_image_cache to free an image cache. */
5804 struct image_cache
*
5807 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5810 bzero (c
, sizeof *c
);
5812 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5813 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5814 c
->buckets
= (struct image
**) xmalloc (size
);
5815 bzero (c
->buckets
, size
);
5820 /* Free image cache of frame F. Be aware that X frames share images
5824 free_image_cache (f
)
5827 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5832 /* Cache should not be referenced by any frame when freed. */
5833 xassert (c
->refcount
== 0);
5835 for (i
= 0; i
< c
->used
; ++i
)
5836 free_image (f
, c
->images
[i
]);
5840 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5845 /* Clear image cache of frame F. FORCE_P non-zero means free all
5846 images. FORCE_P zero means clear only images that haven't been
5847 displayed for some time. Should be called from time to time to
5848 reduce the number of loaded images. If image-eviction-seconds is
5849 non-nil, this frees images in the cache which weren't displayed for
5850 at least that many seconds. */
5853 clear_image_cache (f
, force_p
)
5857 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5859 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5866 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5868 /* Block input so that we won't be interrupted by a SIGIO
5869 while being in an inconsistent state. */
5872 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5874 struct image
*img
= c
->images
[i
];
5876 && (force_p
|| img
->timestamp
< old
))
5878 free_image (f
, img
);
5883 /* We may be clearing the image cache because, for example,
5884 Emacs was iconified for a longer period of time. In that
5885 case, current matrices may still contain references to
5886 images freed above. So, clear these matrices. */
5889 Lisp_Object tail
, frame
;
5891 FOR_EACH_FRAME (tail
, frame
)
5893 struct frame
*f
= XFRAME (frame
);
5895 && FRAME_X_IMAGE_CACHE (f
) == c
)
5896 clear_current_matrices (f
);
5899 ++windows_or_buffers_changed
;
5907 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5909 "Clear the image cache of FRAME.\n\
5910 FRAME nil or omitted means use the selected frame.\n\
5911 FRAME t means clear the image caches of all frames.")
5919 FOR_EACH_FRAME (tail
, frame
)
5920 if (FRAME_X_P (XFRAME (frame
)))
5921 clear_image_cache (XFRAME (frame
), 1);
5924 clear_image_cache (check_x_frame (frame
), 1);
5930 /* Compute masks and transform image IMG on frame F, as specified
5931 by the image's specification, */
5934 postprocess_image (f
, img
)
5938 /* Manipulation of the image's mask. */
5941 Lisp_Object conversion
, spec
;
5946 /* `:heuristic-mask t'
5948 means build a mask heuristically.
5949 `:heuristic-mask (R G B)'
5950 `:mask (heuristic (R G B))'
5951 means build a mask from color (R G B) in the
5954 means remove a mask, if any. */
5956 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
5958 x_build_heuristic_mask (f
, img
, mask
);
5963 mask
= image_spec_value (spec
, QCmask
, &found_p
);
5965 if (EQ (mask
, Qheuristic
))
5966 x_build_heuristic_mask (f
, img
, Qt
);
5967 else if (CONSP (mask
)
5968 && EQ (XCAR (mask
), Qheuristic
))
5970 if (CONSP (XCDR (mask
)))
5971 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
5973 x_build_heuristic_mask (f
, img
, XCDR (mask
));
5975 else if (NILP (mask
) && found_p
&& img
->mask
)
5977 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5983 /* Should we apply an image transformation algorithm? */
5984 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
5985 if (EQ (conversion
, Qdisabled
))
5986 x_disable_image (f
, img
);
5987 else if (EQ (conversion
, Qlaplace
))
5989 else if (EQ (conversion
, Qemboss
))
5991 else if (CONSP (conversion
)
5992 && EQ (XCAR (conversion
), Qedge_detection
))
5995 tem
= XCDR (conversion
);
5997 x_edge_detection (f
, img
,
5998 Fplist_get (tem
, QCmatrix
),
5999 Fplist_get (tem
, QCcolor_adjustment
));
6005 /* Return the id of image with Lisp specification SPEC on frame F.
6006 SPEC must be a valid Lisp image specification (see valid_image_p). */
6009 lookup_image (f
, spec
)
6013 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6017 struct gcpro gcpro1
;
6020 /* F must be a window-system frame, and SPEC must be a valid image
6022 xassert (FRAME_WINDOW_P (f
));
6023 xassert (valid_image_p (spec
));
6027 /* Look up SPEC in the hash table of the image cache. */
6028 hash
= sxhash (spec
, 0);
6029 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6031 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6032 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6035 /* If not found, create a new image and cache it. */
6038 extern Lisp_Object Qpostscript
;
6041 img
= make_image (spec
, hash
);
6042 cache_image (f
, img
);
6043 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6045 /* If we can't load the image, and we don't have a width and
6046 height, use some arbitrary width and height so that we can
6047 draw a rectangle for it. */
6048 if (img
->load_failed_p
)
6052 value
= image_spec_value (spec
, QCwidth
, NULL
);
6053 img
->width
= (INTEGERP (value
)
6054 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6055 value
= image_spec_value (spec
, QCheight
, NULL
);
6056 img
->height
= (INTEGERP (value
)
6057 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6061 /* Handle image type independent image attributes
6062 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
6063 Lisp_Object ascent
, margin
, relief
;
6065 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6066 if (INTEGERP (ascent
))
6067 img
->ascent
= XFASTINT (ascent
);
6068 else if (EQ (ascent
, Qcenter
))
6069 img
->ascent
= CENTERED_IMAGE_ASCENT
;
6071 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6072 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6073 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
6074 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
6075 && INTEGERP (XCDR (margin
)))
6077 if (XINT (XCAR (margin
)) > 0)
6078 img
->hmargin
= XFASTINT (XCAR (margin
));
6079 if (XINT (XCDR (margin
)) > 0)
6080 img
->vmargin
= XFASTINT (XCDR (margin
));
6083 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6084 if (INTEGERP (relief
))
6086 img
->relief
= XINT (relief
);
6087 img
->hmargin
+= abs (img
->relief
);
6088 img
->vmargin
+= abs (img
->relief
);
6091 /* Do image transformations and compute masks, unless we
6092 don't have the image yet. */
6093 if (!EQ (*img
->type
->type
, Qpostscript
))
6094 postprocess_image (f
, img
);
6098 xassert (!interrupt_input_blocked
);
6101 /* We're using IMG, so set its timestamp to `now'. */
6102 EMACS_GET_TIME (now
);
6103 img
->timestamp
= EMACS_SECS (now
);
6107 /* Value is the image id. */
6112 /* Cache image IMG in the image cache of frame F. */
6115 cache_image (f
, img
)
6119 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6122 /* Find a free slot in c->images. */
6123 for (i
= 0; i
< c
->used
; ++i
)
6124 if (c
->images
[i
] == NULL
)
6127 /* If no free slot found, maybe enlarge c->images. */
6128 if (i
== c
->used
&& c
->used
== c
->size
)
6131 c
->images
= (struct image
**) xrealloc (c
->images
,
6132 c
->size
* sizeof *c
->images
);
6135 /* Add IMG to c->images, and assign IMG an id. */
6141 /* Add IMG to the cache's hash table. */
6142 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6143 img
->next
= c
->buckets
[i
];
6145 img
->next
->prev
= img
;
6147 c
->buckets
[i
] = img
;
6151 /* Call FN on every image in the image cache of frame F. Used to mark
6152 Lisp Objects in the image cache. */
6155 forall_images_in_image_cache (f
, fn
)
6157 void (*fn
) P_ ((struct image
*img
));
6159 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6161 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6165 for (i
= 0; i
< c
->used
; ++i
)
6174 /***********************************************************************
6176 ***********************************************************************/
6178 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6179 XImage
**, Pixmap
*));
6180 static void x_destroy_x_image
P_ ((XImage
*));
6181 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6184 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6185 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6186 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6187 via xmalloc. Print error messages via image_error if an error
6188 occurs. Value is non-zero if successful. */
6191 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6193 int width
, height
, depth
;
6197 Display
*display
= FRAME_X_DISPLAY (f
);
6198 Screen
*screen
= FRAME_X_SCREEN (f
);
6199 Window window
= FRAME_X_WINDOW (f
);
6201 xassert (interrupt_input_blocked
);
6204 depth
= DefaultDepthOfScreen (screen
);
6205 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6206 depth
, ZPixmap
, 0, NULL
, width
, height
,
6207 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6210 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6214 /* Allocate image raster. */
6215 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6217 /* Allocate a pixmap of the same size. */
6218 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6219 if (*pixmap
== None
)
6221 x_destroy_x_image (*ximg
);
6223 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6231 /* Destroy XImage XIMG. Free XIMG->data. */
6234 x_destroy_x_image (ximg
)
6237 xassert (interrupt_input_blocked
);
6242 XDestroyImage (ximg
);
6247 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6248 are width and height of both the image and pixmap. */
6251 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6258 xassert (interrupt_input_blocked
);
6259 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6260 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6261 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6266 /***********************************************************************
6268 ***********************************************************************/
6270 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6271 static char *slurp_file
P_ ((char *, int *));
6274 /* Find image file FILE. Look in data-directory, then
6275 x-bitmap-file-path. Value is the full name of the file found, or
6276 nil if not found. */
6279 x_find_image_file (file
)
6282 Lisp_Object file_found
, search_path
;
6283 struct gcpro gcpro1
, gcpro2
;
6287 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6288 GCPRO2 (file_found
, search_path
);
6290 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6291 fd
= openp (search_path
, file
, "", &file_found
, 0);
6303 /* Read FILE into memory. Value is a pointer to a buffer allocated
6304 with xmalloc holding FILE's contents. Value is null if an error
6305 occurred. *SIZE is set to the size of the file. */
6308 slurp_file (file
, size
)
6316 if (stat (file
, &st
) == 0
6317 && (fp
= fopen (file
, "r")) != NULL
6318 && (buf
= (char *) xmalloc (st
.st_size
),
6319 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6340 /***********************************************************************
6342 ***********************************************************************/
6344 static int xbm_scan
P_ ((char **, char *, char *, int *));
6345 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6346 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6348 static int xbm_image_p
P_ ((Lisp_Object object
));
6349 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6351 static int xbm_file_p
P_ ((Lisp_Object
));
6354 /* Indices of image specification fields in xbm_format, below. */
6356 enum xbm_keyword_index
6374 /* Vector of image_keyword structures describing the format
6375 of valid XBM image specifications. */
6377 static struct image_keyword xbm_format
[XBM_LAST
] =
6379 {":type", IMAGE_SYMBOL_VALUE
, 1},
6380 {":file", IMAGE_STRING_VALUE
, 0},
6381 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6382 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6383 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6384 {":foreground", IMAGE_STRING_VALUE
, 0},
6385 {":background", IMAGE_STRING_VALUE
, 0},
6386 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6387 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6388 {":relief", IMAGE_INTEGER_VALUE
, 0},
6389 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6390 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6391 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6394 /* Structure describing the image type XBM. */
6396 static struct image_type xbm_type
=
6405 /* Tokens returned from xbm_scan. */
6414 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6415 A valid specification is a list starting with the symbol `image'
6416 The rest of the list is a property list which must contain an
6419 If the specification specifies a file to load, it must contain
6420 an entry `:file FILENAME' where FILENAME is a string.
6422 If the specification is for a bitmap loaded from memory it must
6423 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6424 WIDTH and HEIGHT are integers > 0. DATA may be:
6426 1. a string large enough to hold the bitmap data, i.e. it must
6427 have a size >= (WIDTH + 7) / 8 * HEIGHT
6429 2. a bool-vector of size >= WIDTH * HEIGHT
6431 3. a vector of strings or bool-vectors, one for each line of the
6434 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6435 may not be specified in this case because they are defined in the
6438 Both the file and data forms may contain the additional entries
6439 `:background COLOR' and `:foreground COLOR'. If not present,
6440 foreground and background of the frame on which the image is
6441 displayed is used. */
6444 xbm_image_p (object
)
6447 struct image_keyword kw
[XBM_LAST
];
6449 bcopy (xbm_format
, kw
, sizeof kw
);
6450 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6453 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6455 if (kw
[XBM_FILE
].count
)
6457 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6460 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6462 /* In-memory XBM file. */
6463 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6471 /* Entries for `:width', `:height' and `:data' must be present. */
6472 if (!kw
[XBM_WIDTH
].count
6473 || !kw
[XBM_HEIGHT
].count
6474 || !kw
[XBM_DATA
].count
)
6477 data
= kw
[XBM_DATA
].value
;
6478 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6479 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6481 /* Check type of data, and width and height against contents of
6487 /* Number of elements of the vector must be >= height. */
6488 if (XVECTOR (data
)->size
< height
)
6491 /* Each string or bool-vector in data must be large enough
6492 for one line of the image. */
6493 for (i
= 0; i
< height
; ++i
)
6495 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6499 if (XSTRING (elt
)->size
6500 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6503 else if (BOOL_VECTOR_P (elt
))
6505 if (XBOOL_VECTOR (elt
)->size
< width
)
6512 else if (STRINGP (data
))
6514 if (XSTRING (data
)->size
6515 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6518 else if (BOOL_VECTOR_P (data
))
6520 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6531 /* Scan a bitmap file. FP is the stream to read from. Value is
6532 either an enumerator from enum xbm_token, or a character for a
6533 single-character token, or 0 at end of file. If scanning an
6534 identifier, store the lexeme of the identifier in SVAL. If
6535 scanning a number, store its value in *IVAL. */
6538 xbm_scan (s
, end
, sval
, ival
)
6547 /* Skip white space. */
6548 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6553 else if (isdigit (c
))
6555 int value
= 0, digit
;
6557 if (c
== '0' && *s
< end
)
6560 if (c
== 'x' || c
== 'X')
6567 else if (c
>= 'a' && c
<= 'f')
6568 digit
= c
- 'a' + 10;
6569 else if (c
>= 'A' && c
<= 'F')
6570 digit
= c
- 'A' + 10;
6573 value
= 16 * value
+ digit
;
6576 else if (isdigit (c
))
6580 && (c
= *(*s
)++, isdigit (c
)))
6581 value
= 8 * value
+ c
- '0';
6588 && (c
= *(*s
)++, isdigit (c
)))
6589 value
= 10 * value
+ c
- '0';
6597 else if (isalpha (c
) || c
== '_')
6601 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6608 else if (c
== '/' && **s
== '*')
6610 /* C-style comment. */
6612 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6625 /* Replacement for XReadBitmapFileData which isn't available under old
6626 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6627 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6628 the image. Return in *DATA the bitmap data allocated with xmalloc.
6629 Value is non-zero if successful. DATA null means just test if
6630 CONTENTS looks like an in-memory XBM file. */
6633 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6634 char *contents
, *end
;
6635 int *width
, *height
;
6636 unsigned char **data
;
6639 char buffer
[BUFSIZ
];
6642 int bytes_per_line
, i
, nbytes
;
6648 LA1 = xbm_scan (&s, end, buffer, &value)
6650 #define expect(TOKEN) \
6651 if (LA1 != (TOKEN)) \
6656 #define expect_ident(IDENT) \
6657 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6662 *width
= *height
= -1;
6665 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6667 /* Parse defines for width, height and hot-spots. */
6671 expect_ident ("define");
6672 expect (XBM_TK_IDENT
);
6674 if (LA1
== XBM_TK_NUMBER
);
6676 char *p
= strrchr (buffer
, '_');
6677 p
= p
? p
+ 1 : buffer
;
6678 if (strcmp (p
, "width") == 0)
6680 else if (strcmp (p
, "height") == 0)
6683 expect (XBM_TK_NUMBER
);
6686 if (*width
< 0 || *height
< 0)
6688 else if (data
== NULL
)
6691 /* Parse bits. Must start with `static'. */
6692 expect_ident ("static");
6693 if (LA1
== XBM_TK_IDENT
)
6695 if (strcmp (buffer
, "unsigned") == 0)
6698 expect_ident ("char");
6700 else if (strcmp (buffer
, "short") == 0)
6704 if (*width
% 16 && *width
% 16 < 9)
6707 else if (strcmp (buffer
, "char") == 0)
6715 expect (XBM_TK_IDENT
);
6721 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6722 nbytes
= bytes_per_line
* *height
;
6723 p
= *data
= (char *) xmalloc (nbytes
);
6727 for (i
= 0; i
< nbytes
; i
+= 2)
6730 expect (XBM_TK_NUMBER
);
6733 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6736 if (LA1
== ',' || LA1
== '}')
6744 for (i
= 0; i
< nbytes
; ++i
)
6747 expect (XBM_TK_NUMBER
);
6751 if (LA1
== ',' || LA1
== '}')
6776 /* Load XBM image IMG which will be displayed on frame F from buffer
6777 CONTENTS. END is the end of the buffer. Value is non-zero if
6781 xbm_load_image (f
, img
, contents
, end
)
6784 char *contents
, *end
;
6787 unsigned char *data
;
6790 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6793 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6794 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6795 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6798 xassert (img
->width
> 0 && img
->height
> 0);
6800 /* Get foreground and background colors, maybe allocate colors. */
6801 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6803 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6805 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6807 background
= x_alloc_image_color (f
, img
, value
, background
);
6810 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6813 img
->width
, img
->height
,
6814 foreground
, background
,
6818 if (img
->pixmap
== None
)
6820 x_clear_image (f
, img
);
6821 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6827 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6833 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6840 return (STRINGP (data
)
6841 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6842 (XSTRING (data
)->data
6843 + STRING_BYTES (XSTRING (data
))),
6848 /* Fill image IMG which is used on frame F with pixmap data. Value is
6849 non-zero if successful. */
6857 Lisp_Object file_name
;
6859 xassert (xbm_image_p (img
->spec
));
6861 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6862 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6863 if (STRINGP (file_name
))
6868 struct gcpro gcpro1
;
6870 file
= x_find_image_file (file_name
);
6872 if (!STRINGP (file
))
6874 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6879 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6880 if (contents
== NULL
)
6882 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6887 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6892 struct image_keyword fmt
[XBM_LAST
];
6895 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6896 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6899 int in_memory_file_p
= 0;
6901 /* See if data looks like an in-memory XBM file. */
6902 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6903 in_memory_file_p
= xbm_file_p (data
);
6905 /* Parse the image specification. */
6906 bcopy (xbm_format
, fmt
, sizeof fmt
);
6907 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6910 /* Get specified width, and height. */
6911 if (!in_memory_file_p
)
6913 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6914 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6915 xassert (img
->width
> 0 && img
->height
> 0);
6918 /* Get foreground and background colors, maybe allocate colors. */
6919 if (fmt
[XBM_FOREGROUND
].count
)
6920 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6922 if (fmt
[XBM_BACKGROUND
].count
)
6923 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6926 if (in_memory_file_p
)
6927 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6928 (XSTRING (data
)->data
6929 + STRING_BYTES (XSTRING (data
))));
6936 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6938 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6939 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6941 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6943 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6945 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6948 else if (STRINGP (data
))
6949 bits
= XSTRING (data
)->data
;
6951 bits
= XBOOL_VECTOR (data
)->data
;
6953 /* Create the pixmap. */
6954 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6956 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6959 img
->width
, img
->height
,
6960 foreground
, background
,
6966 image_error ("Unable to create pixmap for XBM image `%s'",
6968 x_clear_image (f
, img
);
6978 /***********************************************************************
6980 ***********************************************************************/
6984 static int xpm_image_p
P_ ((Lisp_Object object
));
6985 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6986 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6988 #include "X11/xpm.h"
6990 /* The symbol `xpm' identifying XPM-format images. */
6994 /* Indices of image specification fields in xpm_format, below. */
6996 enum xpm_keyword_index
7011 /* Vector of image_keyword structures describing the format
7012 of valid XPM image specifications. */
7014 static struct image_keyword xpm_format
[XPM_LAST
] =
7016 {":type", IMAGE_SYMBOL_VALUE
, 1},
7017 {":file", IMAGE_STRING_VALUE
, 0},
7018 {":data", IMAGE_STRING_VALUE
, 0},
7019 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7020 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7021 {":relief", IMAGE_INTEGER_VALUE
, 0},
7022 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7023 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7024 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7025 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7028 /* Structure describing the image type XBM. */
7030 static struct image_type xpm_type
=
7040 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7041 functions for allocating image colors. Our own functions handle
7042 color allocation failures more gracefully than the ones on the XPM
7045 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7046 #define ALLOC_XPM_COLORS
7049 #ifdef ALLOC_XPM_COLORS
7051 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7052 static void xpm_free_color_cache
P_ ((void));
7053 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7054 static int xpm_color_bucket
P_ ((char *));
7055 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7058 /* An entry in a hash table used to cache color definitions of named
7059 colors. This cache is necessary to speed up XPM image loading in
7060 case we do color allocations ourselves. Without it, we would need
7061 a call to XParseColor per pixel in the image. */
7063 struct xpm_cached_color
7065 /* Next in collision chain. */
7066 struct xpm_cached_color
*next
;
7068 /* Color definition (RGB and pixel color). */
7075 /* The hash table used for the color cache, and its bucket vector
7078 #define XPM_COLOR_CACHE_BUCKETS 1001
7079 struct xpm_cached_color
**xpm_color_cache
;
7081 /* Initialize the color cache. */
7084 xpm_init_color_cache (f
, attrs
)
7086 XpmAttributes
*attrs
;
7088 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7089 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7090 memset (xpm_color_cache
, 0, nbytes
);
7091 init_color_table ();
7093 if (attrs
->valuemask
& XpmColorSymbols
)
7098 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7099 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7100 attrs
->colorsymbols
[i
].value
, &color
))
7102 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7104 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7110 /* Free the color cache. */
7113 xpm_free_color_cache ()
7115 struct xpm_cached_color
*p
, *next
;
7118 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7119 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7125 xfree (xpm_color_cache
);
7126 xpm_color_cache
= NULL
;
7127 free_color_table ();
7131 /* Return the bucket index for color named COLOR_NAME in the color
7135 xpm_color_bucket (color_name
)
7141 for (s
= color_name
; *s
; ++s
)
7143 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7147 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7148 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7151 static struct xpm_cached_color
*
7152 xpm_cache_color (f
, color_name
, color
, bucket
)
7159 struct xpm_cached_color
*p
;
7162 bucket
= xpm_color_bucket (color_name
);
7164 nbytes
= sizeof *p
+ strlen (color_name
);
7165 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7166 strcpy (p
->name
, color_name
);
7168 p
->next
= xpm_color_cache
[bucket
];
7169 xpm_color_cache
[bucket
] = p
;
7174 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7175 return the cached definition in *COLOR. Otherwise, make a new
7176 entry in the cache and allocate the color. Value is zero if color
7177 allocation failed. */
7180 xpm_lookup_color (f
, color_name
, color
)
7185 struct xpm_cached_color
*p
;
7186 int h
= xpm_color_bucket (color_name
);
7188 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7189 if (strcmp (p
->name
, color_name
) == 0)
7194 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7197 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7199 p
= xpm_cache_color (f
, color_name
, color
, h
);
7206 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7207 CLOSURE is a pointer to the frame on which we allocate the
7208 color. Return in *COLOR the allocated color. Value is non-zero
7212 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7219 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7223 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7224 is a pointer to the frame on which we allocate the color. Value is
7225 non-zero if successful. */
7228 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7238 #endif /* ALLOC_XPM_COLORS */
7241 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7242 for XPM images. Such a list must consist of conses whose car and
7246 xpm_valid_color_symbols_p (color_symbols
)
7247 Lisp_Object color_symbols
;
7249 while (CONSP (color_symbols
))
7251 Lisp_Object sym
= XCAR (color_symbols
);
7253 || !STRINGP (XCAR (sym
))
7254 || !STRINGP (XCDR (sym
)))
7256 color_symbols
= XCDR (color_symbols
);
7259 return NILP (color_symbols
);
7263 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7266 xpm_image_p (object
)
7269 struct image_keyword fmt
[XPM_LAST
];
7270 bcopy (xpm_format
, fmt
, sizeof fmt
);
7271 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7272 /* Either `:file' or `:data' must be present. */
7273 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7274 /* Either no `:color-symbols' or it's a list of conses
7275 whose car and cdr are strings. */
7276 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7277 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7281 /* Load image IMG which will be displayed on frame F. Value is
7282 non-zero if successful. */
7290 XpmAttributes attrs
;
7291 Lisp_Object specified_file
, color_symbols
;
7293 /* Configure the XPM lib. Use the visual of frame F. Allocate
7294 close colors. Return colors allocated. */
7295 bzero (&attrs
, sizeof attrs
);
7296 attrs
.visual
= FRAME_X_VISUAL (f
);
7297 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7298 attrs
.valuemask
|= XpmVisual
;
7299 attrs
.valuemask
|= XpmColormap
;
7301 #ifdef ALLOC_XPM_COLORS
7302 /* Allocate colors with our own functions which handle
7303 failing color allocation more gracefully. */
7304 attrs
.color_closure
= f
;
7305 attrs
.alloc_color
= xpm_alloc_color
;
7306 attrs
.free_colors
= xpm_free_colors
;
7307 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7308 #else /* not ALLOC_XPM_COLORS */
7309 /* Let the XPM lib allocate colors. */
7310 attrs
.valuemask
|= XpmReturnAllocPixels
;
7311 #ifdef XpmAllocCloseColors
7312 attrs
.alloc_close_colors
= 1;
7313 attrs
.valuemask
|= XpmAllocCloseColors
;
7314 #else /* not XpmAllocCloseColors */
7315 attrs
.closeness
= 600;
7316 attrs
.valuemask
|= XpmCloseness
;
7317 #endif /* not XpmAllocCloseColors */
7318 #endif /* ALLOC_XPM_COLORS */
7320 /* If image specification contains symbolic color definitions, add
7321 these to `attrs'. */
7322 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7323 if (CONSP (color_symbols
))
7326 XpmColorSymbol
*xpm_syms
;
7329 attrs
.valuemask
|= XpmColorSymbols
;
7331 /* Count number of symbols. */
7332 attrs
.numsymbols
= 0;
7333 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7336 /* Allocate an XpmColorSymbol array. */
7337 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7338 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7339 bzero (xpm_syms
, size
);
7340 attrs
.colorsymbols
= xpm_syms
;
7342 /* Fill the color symbol array. */
7343 for (tail
= color_symbols
, i
= 0;
7345 ++i
, tail
= XCDR (tail
))
7347 Lisp_Object name
= XCAR (XCAR (tail
));
7348 Lisp_Object color
= XCDR (XCAR (tail
));
7349 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7350 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7351 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7352 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7356 /* Create a pixmap for the image, either from a file, or from a
7357 string buffer containing data in the same format as an XPM file. */
7358 #ifdef ALLOC_XPM_COLORS
7359 xpm_init_color_cache (f
, &attrs
);
7362 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7363 if (STRINGP (specified_file
))
7365 Lisp_Object file
= x_find_image_file (specified_file
);
7366 if (!STRINGP (file
))
7368 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7372 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7373 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7378 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7379 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7380 XSTRING (buffer
)->data
,
7381 &img
->pixmap
, &img
->mask
,
7385 if (rc
== XpmSuccess
)
7387 #ifdef ALLOC_XPM_COLORS
7388 img
->colors
= colors_in_color_table (&img
->ncolors
);
7389 #else /* not ALLOC_XPM_COLORS */
7392 img
->ncolors
= attrs
.nalloc_pixels
;
7393 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7394 * sizeof *img
->colors
);
7395 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7397 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7398 #ifdef DEBUG_X_COLORS
7399 register_color (img
->colors
[i
]);
7402 #endif /* not ALLOC_XPM_COLORS */
7404 img
->width
= attrs
.width
;
7405 img
->height
= attrs
.height
;
7406 xassert (img
->width
> 0 && img
->height
> 0);
7408 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7409 XpmFreeAttributes (&attrs
);
7416 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7419 case XpmFileInvalid
:
7420 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7424 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7427 case XpmColorFailed
:
7428 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7432 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7437 #ifdef ALLOC_XPM_COLORS
7438 xpm_free_color_cache ();
7440 return rc
== XpmSuccess
;
7443 #endif /* HAVE_XPM != 0 */
7446 /***********************************************************************
7448 ***********************************************************************/
7450 /* An entry in the color table mapping an RGB color to a pixel color. */
7455 unsigned long pixel
;
7457 /* Next in color table collision list. */
7458 struct ct_color
*next
;
7461 /* The bucket vector size to use. Must be prime. */
7465 /* Value is a hash of the RGB color given by R, G, and B. */
7467 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7469 /* The color hash table. */
7471 struct ct_color
**ct_table
;
7473 /* Number of entries in the color table. */
7475 int ct_colors_allocated
;
7477 /* Initialize the color table. */
7482 int size
= CT_SIZE
* sizeof (*ct_table
);
7483 ct_table
= (struct ct_color
**) xmalloc (size
);
7484 bzero (ct_table
, size
);
7485 ct_colors_allocated
= 0;
7489 /* Free memory associated with the color table. */
7495 struct ct_color
*p
, *next
;
7497 for (i
= 0; i
< CT_SIZE
; ++i
)
7498 for (p
= ct_table
[i
]; p
; p
= next
)
7509 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7510 entry for that color already is in the color table, return the
7511 pixel color of that entry. Otherwise, allocate a new color for R,
7512 G, B, and make an entry in the color table. */
7514 static unsigned long
7515 lookup_rgb_color (f
, r
, g
, b
)
7519 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7520 int i
= hash
% CT_SIZE
;
7523 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7524 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7537 cmap
= FRAME_X_COLORMAP (f
);
7538 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7542 ++ct_colors_allocated
;
7544 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7548 p
->pixel
= color
.pixel
;
7549 p
->next
= ct_table
[i
];
7553 return FRAME_FOREGROUND_PIXEL (f
);
7560 /* Look up pixel color PIXEL which is used on frame F in the color
7561 table. If not already present, allocate it. Value is PIXEL. */
7563 static unsigned long
7564 lookup_pixel_color (f
, pixel
)
7566 unsigned long pixel
;
7568 int i
= pixel
% CT_SIZE
;
7571 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7572 if (p
->pixel
== pixel
)
7581 cmap
= FRAME_X_COLORMAP (f
);
7582 color
.pixel
= pixel
;
7583 x_query_color (f
, &color
);
7584 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7588 ++ct_colors_allocated
;
7590 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7595 p
->next
= ct_table
[i
];
7599 return FRAME_FOREGROUND_PIXEL (f
);
7606 /* Value is a vector of all pixel colors contained in the color table,
7607 allocated via xmalloc. Set *N to the number of colors. */
7609 static unsigned long *
7610 colors_in_color_table (n
)
7615 unsigned long *colors
;
7617 if (ct_colors_allocated
== 0)
7624 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7626 *n
= ct_colors_allocated
;
7628 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7629 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7630 colors
[j
++] = p
->pixel
;
7638 /***********************************************************************
7640 ***********************************************************************/
7642 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7643 int, XImage
*, int));
7644 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7645 XColor
*, int, XImage
*, int));
7646 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7647 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7648 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7650 /* Non-zero means draw a cross on images having `:conversion
7653 int cross_disabled_images
;
7655 /* Edge detection matrices for different edge-detection
7658 static int emboss_matrix
[9] = {
7660 2, -1, 0, /* y - 1 */
7662 0, 1, -2 /* y + 1 */
7665 static int laplace_matrix
[9] = {
7667 1, 0, 0, /* y - 1 */
7669 0, 0, -1 /* y + 1 */
7672 /* Value is the intensity of the color whose red/green/blue values
7675 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7678 /* On frame F, return an array of XColor structures describing image
7679 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7680 non-zero means also fill the red/green/blue members of the XColor
7681 structures. Value is a pointer to the array of XColors structures,
7682 allocated with xmalloc; it must be freed by the caller. */
7685 x_to_xcolors (f
, img
, rgb_p
)
7694 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7696 /* Get the X image IMG->pixmap. */
7697 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7698 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7700 /* Fill the `pixel' members of the XColor array. I wished there
7701 were an easy and portable way to circumvent XGetPixel. */
7703 for (y
= 0; y
< img
->height
; ++y
)
7707 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7708 p
->pixel
= XGetPixel (ximg
, x
, y
);
7711 x_query_colors (f
, row
, img
->width
);
7714 XDestroyImage (ximg
);
7719 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7720 RGB members are set. F is the frame on which this all happens.
7721 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7724 x_from_xcolors (f
, img
, colors
)
7734 init_color_table ();
7736 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7739 for (y
= 0; y
< img
->height
; ++y
)
7740 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7742 unsigned long pixel
;
7743 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7744 XPutPixel (oimg
, x
, y
, pixel
);
7748 x_clear_image_1 (f
, img
, 1, 0, 1);
7750 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7751 x_destroy_x_image (oimg
);
7752 img
->pixmap
= pixmap
;
7753 img
->colors
= colors_in_color_table (&img
->ncolors
);
7754 free_color_table ();
7758 /* On frame F, perform edge-detection on image IMG.
7760 MATRIX is a nine-element array specifying the transformation
7761 matrix. See emboss_matrix for an example.
7763 COLOR_ADJUST is a color adjustment added to each pixel of the
7767 x_detect_edges (f
, img
, matrix
, color_adjust
)
7770 int matrix
[9], color_adjust
;
7772 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7776 for (i
= sum
= 0; i
< 9; ++i
)
7777 sum
+= abs (matrix
[i
]);
7779 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7781 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7783 for (y
= 0; y
< img
->height
; ++y
)
7785 p
= COLOR (new, 0, y
);
7786 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7787 p
= COLOR (new, img
->width
- 1, y
);
7788 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7791 for (x
= 1; x
< img
->width
- 1; ++x
)
7793 p
= COLOR (new, x
, 0);
7794 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7795 p
= COLOR (new, x
, img
->height
- 1);
7796 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7799 for (y
= 1; y
< img
->height
- 1; ++y
)
7801 p
= COLOR (new, 1, y
);
7803 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7805 int r
, g
, b
, y1
, x1
;
7808 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7809 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7812 XColor
*t
= COLOR (colors
, x1
, y1
);
7813 r
+= matrix
[i
] * t
->red
;
7814 g
+= matrix
[i
] * t
->green
;
7815 b
+= matrix
[i
] * t
->blue
;
7818 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7819 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7820 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7821 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7826 x_from_xcolors (f
, img
, new);
7832 /* Perform the pre-defined `emboss' edge-detection on image IMG
7840 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7844 /* Perform the pre-defined `laplace' edge-detection on image IMG
7852 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7856 /* Perform edge-detection on image IMG on frame F, with specified
7857 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7859 MATRIX must be either
7861 - a list of at least 9 numbers in row-major form
7862 - a vector of at least 9 numbers
7864 COLOR_ADJUST nil means use a default; otherwise it must be a
7868 x_edge_detection (f
, img
, matrix
, color_adjust
)
7871 Lisp_Object matrix
, color_adjust
;
7879 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7880 ++i
, matrix
= XCDR (matrix
))
7881 trans
[i
] = XFLOATINT (XCAR (matrix
));
7883 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7885 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7886 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7889 if (NILP (color_adjust
))
7890 color_adjust
= make_number (0xffff / 2);
7892 if (i
== 9 && NUMBERP (color_adjust
))
7893 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7897 /* Transform image IMG on frame F so that it looks disabled. */
7900 x_disable_image (f
, img
)
7904 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7906 if (dpyinfo
->n_planes
>= 2)
7908 /* Color (or grayscale). Convert to gray, and equalize. Just
7909 drawing such images with a stipple can look very odd, so
7910 we're using this method instead. */
7911 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7913 const int h
= 15000;
7914 const int l
= 30000;
7916 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7920 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7921 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7922 p
->red
= p
->green
= p
->blue
= i2
;
7925 x_from_xcolors (f
, img
, colors
);
7928 /* Draw a cross over the disabled image, if we must or if we
7930 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
7932 Display
*dpy
= FRAME_X_DISPLAY (f
);
7935 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
7936 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
7937 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
7938 img
->width
- 1, img
->height
- 1);
7939 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
7945 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
7946 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
7947 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
7948 img
->width
- 1, img
->height
- 1);
7949 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
7957 /* Build a mask for image IMG which is used on frame F. FILE is the
7958 name of an image file, for error messages. HOW determines how to
7959 determine the background color of IMG. If it is a list '(R G B)',
7960 with R, G, and B being integers >= 0, take that as the color of the
7961 background. Otherwise, determine the background color of IMG
7962 heuristically. Value is non-zero if successful. */
7965 x_build_heuristic_mask (f
, img
, how
)
7970 Display
*dpy
= FRAME_X_DISPLAY (f
);
7971 XImage
*ximg
, *mask_img
;
7972 int x
, y
, rc
, look_at_corners_p
;
7973 unsigned long bg
= 0;
7977 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
7981 /* Create an image and pixmap serving as mask. */
7982 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7983 &mask_img
, &img
->mask
);
7987 /* Get the X image of IMG->pixmap. */
7988 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7991 /* Determine the background color of ximg. If HOW is `(R G B)'
7992 take that as color. Otherwise, try to determine the color
7994 look_at_corners_p
= 1;
8002 && NATNUMP (XCAR (how
)))
8004 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
8008 if (i
== 3 && NILP (how
))
8010 char color_name
[30];
8011 XColor exact
, color
;
8014 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
8016 cmap
= FRAME_X_COLORMAP (f
);
8017 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
8020 look_at_corners_p
= 0;
8025 if (look_at_corners_p
)
8027 unsigned long corners
[4];
8030 /* Get the colors at the corners of ximg. */
8031 corners
[0] = XGetPixel (ximg
, 0, 0);
8032 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
8033 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
8034 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
8036 /* Choose the most frequently found color as background. */
8037 for (i
= best_count
= 0; i
< 4; ++i
)
8041 for (j
= n
= 0; j
< 4; ++j
)
8042 if (corners
[i
] == corners
[j
])
8046 bg
= corners
[i
], best_count
= n
;
8050 /* Set all bits in mask_img to 1 whose color in ximg is different
8051 from the background color bg. */
8052 for (y
= 0; y
< img
->height
; ++y
)
8053 for (x
= 0; x
< img
->width
; ++x
)
8054 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8056 /* Put mask_img into img->mask. */
8057 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8058 x_destroy_x_image (mask_img
);
8059 XDestroyImage (ximg
);
8066 /***********************************************************************
8067 PBM (mono, gray, color)
8068 ***********************************************************************/
8070 static int pbm_image_p
P_ ((Lisp_Object object
));
8071 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8072 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8074 /* The symbol `pbm' identifying images of this type. */
8078 /* Indices of image specification fields in gs_format, below. */
8080 enum pbm_keyword_index
8096 /* Vector of image_keyword structures describing the format
8097 of valid user-defined image specifications. */
8099 static struct image_keyword pbm_format
[PBM_LAST
] =
8101 {":type", IMAGE_SYMBOL_VALUE
, 1},
8102 {":file", IMAGE_STRING_VALUE
, 0},
8103 {":data", IMAGE_STRING_VALUE
, 0},
8104 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8105 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8106 {":relief", IMAGE_INTEGER_VALUE
, 0},
8107 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8108 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8109 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8110 {":foreground", IMAGE_STRING_VALUE
, 0},
8111 {":background", IMAGE_STRING_VALUE
, 0}
8114 /* Structure describing the image type `pbm'. */
8116 static struct image_type pbm_type
=
8126 /* Return non-zero if OBJECT is a valid PBM image specification. */
8129 pbm_image_p (object
)
8132 struct image_keyword fmt
[PBM_LAST
];
8134 bcopy (pbm_format
, fmt
, sizeof fmt
);
8136 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8139 /* Must specify either :data or :file. */
8140 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8144 /* Scan a decimal number from *S and return it. Advance *S while
8145 reading the number. END is the end of the string. Value is -1 at
8149 pbm_scan_number (s
, end
)
8150 unsigned char **s
, *end
;
8152 int c
= 0, val
= -1;
8156 /* Skip white-space. */
8157 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8162 /* Skip comment to end of line. */
8163 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8166 else if (isdigit (c
))
8168 /* Read decimal number. */
8170 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8171 val
= 10 * val
+ c
- '0';
8182 /* Load PBM image IMG for use on frame F. */
8190 int width
, height
, max_color_idx
= 0;
8192 Lisp_Object file
, specified_file
;
8193 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8194 struct gcpro gcpro1
;
8195 unsigned char *contents
= NULL
;
8196 unsigned char *end
, *p
;
8199 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8203 if (STRINGP (specified_file
))
8205 file
= x_find_image_file (specified_file
);
8206 if (!STRINGP (file
))
8208 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8213 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8214 if (contents
== NULL
)
8216 image_error ("Error reading `%s'", file
, Qnil
);
8222 end
= contents
+ size
;
8227 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8228 p
= XSTRING (data
)->data
;
8229 end
= p
+ STRING_BYTES (XSTRING (data
));
8232 /* Check magic number. */
8233 if (end
- p
< 2 || *p
++ != 'P')
8235 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8245 raw_p
= 0, type
= PBM_MONO
;
8249 raw_p
= 0, type
= PBM_GRAY
;
8253 raw_p
= 0, type
= PBM_COLOR
;
8257 raw_p
= 1, type
= PBM_MONO
;
8261 raw_p
= 1, type
= PBM_GRAY
;
8265 raw_p
= 1, type
= PBM_COLOR
;
8269 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8273 /* Read width, height, maximum color-component. Characters
8274 starting with `#' up to the end of a line are ignored. */
8275 width
= pbm_scan_number (&p
, end
);
8276 height
= pbm_scan_number (&p
, end
);
8278 if (type
!= PBM_MONO
)
8280 max_color_idx
= pbm_scan_number (&p
, end
);
8281 if (raw_p
&& max_color_idx
> 255)
8282 max_color_idx
= 255;
8287 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8290 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8291 &ximg
, &img
->pixmap
))
8294 /* Initialize the color hash table. */
8295 init_color_table ();
8297 if (type
== PBM_MONO
)
8300 struct image_keyword fmt
[PBM_LAST
];
8301 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8302 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8304 /* Parse the image specification. */
8305 bcopy (pbm_format
, fmt
, sizeof fmt
);
8306 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8308 /* Get foreground and background colors, maybe allocate colors. */
8309 if (fmt
[PBM_FOREGROUND
].count
)
8310 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8311 if (fmt
[PBM_BACKGROUND
].count
)
8312 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8314 for (y
= 0; y
< height
; ++y
)
8315 for (x
= 0; x
< width
; ++x
)
8325 g
= pbm_scan_number (&p
, end
);
8327 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8332 for (y
= 0; y
< height
; ++y
)
8333 for (x
= 0; x
< width
; ++x
)
8337 if (type
== PBM_GRAY
)
8338 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8347 r
= pbm_scan_number (&p
, end
);
8348 g
= pbm_scan_number (&p
, end
);
8349 b
= pbm_scan_number (&p
, end
);
8352 if (r
< 0 || g
< 0 || b
< 0)
8356 XDestroyImage (ximg
);
8357 image_error ("Invalid pixel value in image `%s'",
8362 /* RGB values are now in the range 0..max_color_idx.
8363 Scale this to the range 0..0xffff supported by X. */
8364 r
= (double) r
* 65535 / max_color_idx
;
8365 g
= (double) g
* 65535 / max_color_idx
;
8366 b
= (double) b
* 65535 / max_color_idx
;
8367 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8371 /* Store in IMG->colors the colors allocated for the image, and
8372 free the color table. */
8373 img
->colors
= colors_in_color_table (&img
->ncolors
);
8374 free_color_table ();
8376 /* Put the image into a pixmap. */
8377 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8378 x_destroy_x_image (ximg
);
8381 img
->height
= height
;
8390 /***********************************************************************
8392 ***********************************************************************/
8398 /* Function prototypes. */
8400 static int png_image_p
P_ ((Lisp_Object object
));
8401 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8403 /* The symbol `png' identifying images of this type. */
8407 /* Indices of image specification fields in png_format, below. */
8409 enum png_keyword_index
8423 /* Vector of image_keyword structures describing the format
8424 of valid user-defined image specifications. */
8426 static struct image_keyword png_format
[PNG_LAST
] =
8428 {":type", IMAGE_SYMBOL_VALUE
, 1},
8429 {":data", IMAGE_STRING_VALUE
, 0},
8430 {":file", IMAGE_STRING_VALUE
, 0},
8431 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8432 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8433 {":relief", IMAGE_INTEGER_VALUE
, 0},
8434 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8435 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8436 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8439 /* Structure describing the image type `png'. */
8441 static struct image_type png_type
=
8451 /* Return non-zero if OBJECT is a valid PNG image specification. */
8454 png_image_p (object
)
8457 struct image_keyword fmt
[PNG_LAST
];
8458 bcopy (png_format
, fmt
, sizeof fmt
);
8460 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8463 /* Must specify either the :data or :file keyword. */
8464 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8468 /* Error and warning handlers installed when the PNG library
8472 my_png_error (png_ptr
, msg
)
8473 png_struct
*png_ptr
;
8476 xassert (png_ptr
!= NULL
);
8477 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8478 longjmp (png_ptr
->jmpbuf
, 1);
8483 my_png_warning (png_ptr
, msg
)
8484 png_struct
*png_ptr
;
8487 xassert (png_ptr
!= NULL
);
8488 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8491 /* Memory source for PNG decoding. */
8493 struct png_memory_storage
8495 unsigned char *bytes
; /* The data */
8496 size_t len
; /* How big is it? */
8497 int index
; /* Where are we? */
8501 /* Function set as reader function when reading PNG image from memory.
8502 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8503 bytes from the input to DATA. */
8506 png_read_from_memory (png_ptr
, data
, length
)
8507 png_structp png_ptr
;
8511 struct png_memory_storage
*tbr
8512 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8514 if (length
> tbr
->len
- tbr
->index
)
8515 png_error (png_ptr
, "Read error");
8517 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8518 tbr
->index
= tbr
->index
+ length
;
8521 /* Load PNG image IMG for use on frame F. Value is non-zero if
8529 Lisp_Object file
, specified_file
;
8530 Lisp_Object specified_data
;
8532 XImage
*ximg
, *mask_img
= NULL
;
8533 struct gcpro gcpro1
;
8534 png_struct
*png_ptr
= NULL
;
8535 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8536 FILE *volatile fp
= NULL
;
8538 png_byte
* volatile pixels
= NULL
;
8539 png_byte
** volatile rows
= NULL
;
8540 png_uint_32 width
, height
;
8541 int bit_depth
, color_type
, interlace_type
;
8543 png_uint_32 row_bytes
;
8546 double screen_gamma
, image_gamma
;
8548 struct png_memory_storage tbr
; /* Data to be read */
8550 /* Find out what file to load. */
8551 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8552 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8556 if (NILP (specified_data
))
8558 file
= x_find_image_file (specified_file
);
8559 if (!STRINGP (file
))
8561 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8566 /* Open the image file. */
8567 fp
= fopen (XSTRING (file
)->data
, "rb");
8570 image_error ("Cannot open image file `%s'", file
, Qnil
);
8576 /* Check PNG signature. */
8577 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8578 || !png_check_sig (sig
, sizeof sig
))
8580 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8588 /* Read from memory. */
8589 tbr
.bytes
= XSTRING (specified_data
)->data
;
8590 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8593 /* Check PNG signature. */
8594 if (tbr
.len
< sizeof sig
8595 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8597 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8602 /* Need to skip past the signature. */
8603 tbr
.bytes
+= sizeof (sig
);
8606 /* Initialize read and info structs for PNG lib. */
8607 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8608 my_png_error
, my_png_warning
);
8611 if (fp
) fclose (fp
);
8616 info_ptr
= png_create_info_struct (png_ptr
);
8619 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8620 if (fp
) fclose (fp
);
8625 end_info
= png_create_info_struct (png_ptr
);
8628 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8629 if (fp
) fclose (fp
);
8634 /* Set error jump-back. We come back here when the PNG library
8635 detects an error. */
8636 if (setjmp (png_ptr
->jmpbuf
))
8640 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8643 if (fp
) fclose (fp
);
8648 /* Read image info. */
8649 if (!NILP (specified_data
))
8650 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8652 png_init_io (png_ptr
, fp
);
8654 png_set_sig_bytes (png_ptr
, sizeof sig
);
8655 png_read_info (png_ptr
, info_ptr
);
8656 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8657 &interlace_type
, NULL
, NULL
);
8659 /* If image contains simply transparency data, we prefer to
8660 construct a clipping mask. */
8661 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8666 /* This function is easier to write if we only have to handle
8667 one data format: RGB or RGBA with 8 bits per channel. Let's
8668 transform other formats into that format. */
8670 /* Strip more than 8 bits per channel. */
8671 if (bit_depth
== 16)
8672 png_set_strip_16 (png_ptr
);
8674 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8676 png_set_expand (png_ptr
);
8678 /* Convert grayscale images to RGB. */
8679 if (color_type
== PNG_COLOR_TYPE_GRAY
8680 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8681 png_set_gray_to_rgb (png_ptr
);
8683 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8684 gamma_str
= getenv ("SCREEN_GAMMA");
8685 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8687 /* Tell the PNG lib to handle gamma correction for us. */
8689 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8690 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8691 /* There is a special chunk in the image specifying the gamma. */
8692 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8695 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8696 /* Image contains gamma information. */
8697 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8699 /* Use a default of 0.5 for the image gamma. */
8700 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8702 /* Handle alpha channel by combining the image with a background
8703 color. Do this only if a real alpha channel is supplied. For
8704 simple transparency, we prefer a clipping mask. */
8707 png_color_16
*image_background
;
8709 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8710 /* Image contains a background color with which to
8711 combine the image. */
8712 png_set_background (png_ptr
, image_background
,
8713 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8716 /* Image does not contain a background color with which
8717 to combine the image data via an alpha channel. Use
8718 the frame's background instead. */
8721 png_color_16 frame_background
;
8723 cmap
= FRAME_X_COLORMAP (f
);
8724 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8725 x_query_color (f
, &color
);
8727 bzero (&frame_background
, sizeof frame_background
);
8728 frame_background
.red
= color
.red
;
8729 frame_background
.green
= color
.green
;
8730 frame_background
.blue
= color
.blue
;
8732 png_set_background (png_ptr
, &frame_background
,
8733 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8737 /* Update info structure. */
8738 png_read_update_info (png_ptr
, info_ptr
);
8740 /* Get number of channels. Valid values are 1 for grayscale images
8741 and images with a palette, 2 for grayscale images with transparency
8742 information (alpha channel), 3 for RGB images, and 4 for RGB
8743 images with alpha channel, i.e. RGBA. If conversions above were
8744 sufficient we should only have 3 or 4 channels here. */
8745 channels
= png_get_channels (png_ptr
, info_ptr
);
8746 xassert (channels
== 3 || channels
== 4);
8748 /* Number of bytes needed for one row of the image. */
8749 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8751 /* Allocate memory for the image. */
8752 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8753 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8754 for (i
= 0; i
< height
; ++i
)
8755 rows
[i
] = pixels
+ i
* row_bytes
;
8757 /* Read the entire image. */
8758 png_read_image (png_ptr
, rows
);
8759 png_read_end (png_ptr
, info_ptr
);
8766 /* Create the X image and pixmap. */
8767 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8771 /* Create an image and pixmap serving as mask if the PNG image
8772 contains an alpha channel. */
8775 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8776 &mask_img
, &img
->mask
))
8778 x_destroy_x_image (ximg
);
8779 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8784 /* Fill the X image and mask from PNG data. */
8785 init_color_table ();
8787 for (y
= 0; y
< height
; ++y
)
8789 png_byte
*p
= rows
[y
];
8791 for (x
= 0; x
< width
; ++x
)
8798 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8800 /* An alpha channel, aka mask channel, associates variable
8801 transparency with an image. Where other image formats
8802 support binary transparency---fully transparent or fully
8803 opaque---PNG allows up to 254 levels of partial transparency.
8804 The PNG library implements partial transparency by combining
8805 the image with a specified background color.
8807 I'm not sure how to handle this here nicely: because the
8808 background on which the image is displayed may change, for
8809 real alpha channel support, it would be necessary to create
8810 a new image for each possible background.
8812 What I'm doing now is that a mask is created if we have
8813 boolean transparency information. Otherwise I'm using
8814 the frame's background color to combine the image with. */
8819 XPutPixel (mask_img
, x
, y
, *p
> 0);
8825 /* Remember colors allocated for this image. */
8826 img
->colors
= colors_in_color_table (&img
->ncolors
);
8827 free_color_table ();
8830 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8835 img
->height
= height
;
8837 /* Put the image into the pixmap, then free the X image and its buffer. */
8838 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8839 x_destroy_x_image (ximg
);
8841 /* Same for the mask. */
8844 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8845 x_destroy_x_image (mask_img
);
8852 #endif /* HAVE_PNG != 0 */
8856 /***********************************************************************
8858 ***********************************************************************/
8862 /* Work around a warning about HAVE_STDLIB_H being redefined in
8864 #ifdef HAVE_STDLIB_H
8865 #define HAVE_STDLIB_H_1
8866 #undef HAVE_STDLIB_H
8867 #endif /* HAVE_STLIB_H */
8869 #include <jpeglib.h>
8873 #ifdef HAVE_STLIB_H_1
8874 #define HAVE_STDLIB_H 1
8877 static int jpeg_image_p
P_ ((Lisp_Object object
));
8878 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8880 /* The symbol `jpeg' identifying images of this type. */
8884 /* Indices of image specification fields in gs_format, below. */
8886 enum jpeg_keyword_index
8895 JPEG_HEURISTIC_MASK
,
8900 /* Vector of image_keyword structures describing the format
8901 of valid user-defined image specifications. */
8903 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8905 {":type", IMAGE_SYMBOL_VALUE
, 1},
8906 {":data", IMAGE_STRING_VALUE
, 0},
8907 {":file", IMAGE_STRING_VALUE
, 0},
8908 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8909 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8910 {":relief", IMAGE_INTEGER_VALUE
, 0},
8911 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8912 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8913 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8916 /* Structure describing the image type `jpeg'. */
8918 static struct image_type jpeg_type
=
8928 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8931 jpeg_image_p (object
)
8934 struct image_keyword fmt
[JPEG_LAST
];
8936 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8938 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8941 /* Must specify either the :data or :file keyword. */
8942 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8946 struct my_jpeg_error_mgr
8948 struct jpeg_error_mgr pub
;
8949 jmp_buf setjmp_buffer
;
8954 my_error_exit (cinfo
)
8957 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8958 longjmp (mgr
->setjmp_buffer
, 1);
8962 /* Init source method for JPEG data source manager. Called by
8963 jpeg_read_header() before any data is actually read. See
8964 libjpeg.doc from the JPEG lib distribution. */
8967 our_init_source (cinfo
)
8968 j_decompress_ptr cinfo
;
8973 /* Fill input buffer method for JPEG data source manager. Called
8974 whenever more data is needed. We read the whole image in one step,
8975 so this only adds a fake end of input marker at the end. */
8978 our_fill_input_buffer (cinfo
)
8979 j_decompress_ptr cinfo
;
8981 /* Insert a fake EOI marker. */
8982 struct jpeg_source_mgr
*src
= cinfo
->src
;
8983 static JOCTET buffer
[2];
8985 buffer
[0] = (JOCTET
) 0xFF;
8986 buffer
[1] = (JOCTET
) JPEG_EOI
;
8988 src
->next_input_byte
= buffer
;
8989 src
->bytes_in_buffer
= 2;
8994 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8995 is the JPEG data source manager. */
8998 our_skip_input_data (cinfo
, num_bytes
)
8999 j_decompress_ptr cinfo
;
9002 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9006 if (num_bytes
> src
->bytes_in_buffer
)
9007 ERREXIT (cinfo
, JERR_INPUT_EOF
);
9009 src
->bytes_in_buffer
-= num_bytes
;
9010 src
->next_input_byte
+= num_bytes
;
9015 /* Method to terminate data source. Called by
9016 jpeg_finish_decompress() after all data has been processed. */
9019 our_term_source (cinfo
)
9020 j_decompress_ptr cinfo
;
9025 /* Set up the JPEG lib for reading an image from DATA which contains
9026 LEN bytes. CINFO is the decompression info structure created for
9027 reading the image. */
9030 jpeg_memory_src (cinfo
, data
, len
)
9031 j_decompress_ptr cinfo
;
9035 struct jpeg_source_mgr
*src
;
9037 if (cinfo
->src
== NULL
)
9039 /* First time for this JPEG object? */
9040 cinfo
->src
= (struct jpeg_source_mgr
*)
9041 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9042 sizeof (struct jpeg_source_mgr
));
9043 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9044 src
->next_input_byte
= data
;
9047 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9048 src
->init_source
= our_init_source
;
9049 src
->fill_input_buffer
= our_fill_input_buffer
;
9050 src
->skip_input_data
= our_skip_input_data
;
9051 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9052 src
->term_source
= our_term_source
;
9053 src
->bytes_in_buffer
= len
;
9054 src
->next_input_byte
= data
;
9058 /* Load image IMG for use on frame F. Patterned after example.c
9059 from the JPEG lib. */
9066 struct jpeg_decompress_struct cinfo
;
9067 struct my_jpeg_error_mgr mgr
;
9068 Lisp_Object file
, specified_file
;
9069 Lisp_Object specified_data
;
9070 FILE * volatile fp
= NULL
;
9072 int row_stride
, x
, y
;
9073 XImage
*ximg
= NULL
;
9075 unsigned long *colors
;
9077 struct gcpro gcpro1
;
9079 /* Open the JPEG file. */
9080 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9081 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9085 if (NILP (specified_data
))
9087 file
= x_find_image_file (specified_file
);
9088 if (!STRINGP (file
))
9090 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9095 fp
= fopen (XSTRING (file
)->data
, "r");
9098 image_error ("Cannot open `%s'", file
, Qnil
);
9104 /* Customize libjpeg's error handling to call my_error_exit when an
9105 error is detected. This function will perform a longjmp. */
9106 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9107 mgr
.pub
.error_exit
= my_error_exit
;
9109 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9113 /* Called from my_error_exit. Display a JPEG error. */
9114 char buffer
[JMSG_LENGTH_MAX
];
9115 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9116 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9117 build_string (buffer
));
9120 /* Close the input file and destroy the JPEG object. */
9122 fclose ((FILE *) fp
);
9123 jpeg_destroy_decompress (&cinfo
);
9125 /* If we already have an XImage, free that. */
9126 x_destroy_x_image (ximg
);
9128 /* Free pixmap and colors. */
9129 x_clear_image (f
, img
);
9135 /* Create the JPEG decompression object. Let it read from fp.
9136 Read the JPEG image header. */
9137 jpeg_create_decompress (&cinfo
);
9139 if (NILP (specified_data
))
9140 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9142 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9143 STRING_BYTES (XSTRING (specified_data
)));
9145 jpeg_read_header (&cinfo
, TRUE
);
9147 /* Customize decompression so that color quantization will be used.
9148 Start decompression. */
9149 cinfo
.quantize_colors
= TRUE
;
9150 jpeg_start_decompress (&cinfo
);
9151 width
= img
->width
= cinfo
.output_width
;
9152 height
= img
->height
= cinfo
.output_height
;
9154 /* Create X image and pixmap. */
9155 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9156 longjmp (mgr
.setjmp_buffer
, 2);
9158 /* Allocate colors. When color quantization is used,
9159 cinfo.actual_number_of_colors has been set with the number of
9160 colors generated, and cinfo.colormap is a two-dimensional array
9161 of color indices in the range 0..cinfo.actual_number_of_colors.
9162 No more than 255 colors will be generated. */
9166 if (cinfo
.out_color_components
> 2)
9167 ir
= 0, ig
= 1, ib
= 2;
9168 else if (cinfo
.out_color_components
> 1)
9169 ir
= 0, ig
= 1, ib
= 0;
9171 ir
= 0, ig
= 0, ib
= 0;
9173 /* Use the color table mechanism because it handles colors that
9174 cannot be allocated nicely. Such colors will be replaced with
9175 a default color, and we don't have to care about which colors
9176 can be freed safely, and which can't. */
9177 init_color_table ();
9178 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9181 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9183 /* Multiply RGB values with 255 because X expects RGB values
9184 in the range 0..0xffff. */
9185 int r
= cinfo
.colormap
[ir
][i
] << 8;
9186 int g
= cinfo
.colormap
[ig
][i
] << 8;
9187 int b
= cinfo
.colormap
[ib
][i
] << 8;
9188 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9191 /* Remember those colors actually allocated. */
9192 img
->colors
= colors_in_color_table (&img
->ncolors
);
9193 free_color_table ();
9197 row_stride
= width
* cinfo
.output_components
;
9198 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9200 for (y
= 0; y
< height
; ++y
)
9202 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9203 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9204 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9208 jpeg_finish_decompress (&cinfo
);
9209 jpeg_destroy_decompress (&cinfo
);
9211 fclose ((FILE *) fp
);
9213 /* Put the image into the pixmap. */
9214 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9215 x_destroy_x_image (ximg
);
9220 #endif /* HAVE_JPEG */
9224 /***********************************************************************
9226 ***********************************************************************/
9232 static int tiff_image_p
P_ ((Lisp_Object object
));
9233 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9235 /* The symbol `tiff' identifying images of this type. */
9239 /* Indices of image specification fields in tiff_format, below. */
9241 enum tiff_keyword_index
9250 TIFF_HEURISTIC_MASK
,
9255 /* Vector of image_keyword structures describing the format
9256 of valid user-defined image specifications. */
9258 static struct image_keyword tiff_format
[TIFF_LAST
] =
9260 {":type", IMAGE_SYMBOL_VALUE
, 1},
9261 {":data", IMAGE_STRING_VALUE
, 0},
9262 {":file", IMAGE_STRING_VALUE
, 0},
9263 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9264 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9265 {":relief", IMAGE_INTEGER_VALUE
, 0},
9266 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9267 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9268 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9271 /* Structure describing the image type `tiff'. */
9273 static struct image_type tiff_type
=
9283 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9286 tiff_image_p (object
)
9289 struct image_keyword fmt
[TIFF_LAST
];
9290 bcopy (tiff_format
, fmt
, sizeof fmt
);
9292 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9295 /* Must specify either the :data or :file keyword. */
9296 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9300 /* Reading from a memory buffer for TIFF images Based on the PNG
9301 memory source, but we have to provide a lot of extra functions.
9304 We really only need to implement read and seek, but I am not
9305 convinced that the TIFF library is smart enough not to destroy
9306 itself if we only hand it the function pointers we need to
9311 unsigned char *bytes
;
9319 tiff_read_from_memory (data
, buf
, size
)
9324 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9326 if (size
> src
->len
- src
->index
)
9328 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9335 tiff_write_from_memory (data
, buf
, size
)
9345 tiff_seek_in_memory (data
, off
, whence
)
9350 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9355 case SEEK_SET
: /* Go from beginning of source. */
9359 case SEEK_END
: /* Go from end of source. */
9360 idx
= src
->len
+ off
;
9363 case SEEK_CUR
: /* Go from current position. */
9364 idx
= src
->index
+ off
;
9367 default: /* Invalid `whence'. */
9371 if (idx
> src
->len
|| idx
< 0)
9380 tiff_close_memory (data
)
9389 tiff_mmap_memory (data
, pbase
, psize
)
9394 /* It is already _IN_ memory. */
9400 tiff_unmap_memory (data
, base
, size
)
9405 /* We don't need to do this. */
9410 tiff_size_of_memory (data
)
9413 return ((tiff_memory_source
*) data
)->len
;
9417 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9425 Lisp_Object file
, specified_file
;
9426 Lisp_Object specified_data
;
9428 int width
, height
, x
, y
;
9432 struct gcpro gcpro1
;
9433 tiff_memory_source memsrc
;
9435 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9436 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9440 if (NILP (specified_data
))
9442 /* Read from a file */
9443 file
= x_find_image_file (specified_file
);
9444 if (!STRINGP (file
))
9446 image_error ("Cannot find image file `%s'", file
, Qnil
);
9451 /* Try to open the image file. */
9452 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9455 image_error ("Cannot open `%s'", file
, Qnil
);
9462 /* Memory source! */
9463 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9464 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9467 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9468 (TIFFReadWriteProc
) tiff_read_from_memory
,
9469 (TIFFReadWriteProc
) tiff_write_from_memory
,
9470 tiff_seek_in_memory
,
9472 tiff_size_of_memory
,
9478 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9484 /* Get width and height of the image, and allocate a raster buffer
9485 of width x height 32-bit values. */
9486 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9487 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9488 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9490 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9494 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9500 /* Create the X image and pixmap. */
9501 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9508 /* Initialize the color table. */
9509 init_color_table ();
9511 /* Process the pixel raster. Origin is in the lower-left corner. */
9512 for (y
= 0; y
< height
; ++y
)
9514 uint32
*row
= buf
+ y
* width
;
9516 for (x
= 0; x
< width
; ++x
)
9518 uint32 abgr
= row
[x
];
9519 int r
= TIFFGetR (abgr
) << 8;
9520 int g
= TIFFGetG (abgr
) << 8;
9521 int b
= TIFFGetB (abgr
) << 8;
9522 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9526 /* Remember the colors allocated for the image. Free the color table. */
9527 img
->colors
= colors_in_color_table (&img
->ncolors
);
9528 free_color_table ();
9530 /* Put the image into the pixmap, then free the X image and its buffer. */
9531 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9532 x_destroy_x_image (ximg
);
9536 img
->height
= height
;
9542 #endif /* HAVE_TIFF != 0 */
9546 /***********************************************************************
9548 ***********************************************************************/
9552 #include <gif_lib.h>
9554 static int gif_image_p
P_ ((Lisp_Object object
));
9555 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9557 /* The symbol `gif' identifying images of this type. */
9561 /* Indices of image specification fields in gif_format, below. */
9563 enum gif_keyword_index
9578 /* Vector of image_keyword structures describing the format
9579 of valid user-defined image specifications. */
9581 static struct image_keyword gif_format
[GIF_LAST
] =
9583 {":type", IMAGE_SYMBOL_VALUE
, 1},
9584 {":data", IMAGE_STRING_VALUE
, 0},
9585 {":file", IMAGE_STRING_VALUE
, 0},
9586 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9587 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9588 {":relief", IMAGE_INTEGER_VALUE
, 0},
9589 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9590 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9591 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9592 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9595 /* Structure describing the image type `gif'. */
9597 static struct image_type gif_type
=
9607 /* Return non-zero if OBJECT is a valid GIF image specification. */
9610 gif_image_p (object
)
9613 struct image_keyword fmt
[GIF_LAST
];
9614 bcopy (gif_format
, fmt
, sizeof fmt
);
9616 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9619 /* Must specify either the :data or :file keyword. */
9620 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9624 /* Reading a GIF image from memory
9625 Based on the PNG memory stuff to a certain extent. */
9629 unsigned char *bytes
;
9636 /* Make the current memory source available to gif_read_from_memory.
9637 It's done this way because not all versions of libungif support
9638 a UserData field in the GifFileType structure. */
9639 static gif_memory_source
*current_gif_memory_src
;
9642 gif_read_from_memory (file
, buf
, len
)
9647 gif_memory_source
*src
= current_gif_memory_src
;
9649 if (len
> src
->len
- src
->index
)
9652 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9658 /* Load GIF image IMG for use on frame F. Value is non-zero if
9666 Lisp_Object file
, specified_file
;
9667 Lisp_Object specified_data
;
9668 int rc
, width
, height
, x
, y
, i
;
9670 ColorMapObject
*gif_color_map
;
9671 unsigned long pixel_colors
[256];
9673 struct gcpro gcpro1
;
9675 int ino
, image_left
, image_top
, image_width
, image_height
;
9676 gif_memory_source memsrc
;
9677 unsigned char *raster
;
9679 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9680 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9684 if (NILP (specified_data
))
9686 file
= x_find_image_file (specified_file
);
9687 if (!STRINGP (file
))
9689 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9694 /* Open the GIF file. */
9695 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9698 image_error ("Cannot open `%s'", file
, Qnil
);
9705 /* Read from memory! */
9706 current_gif_memory_src
= &memsrc
;
9707 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9708 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9711 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9714 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9720 /* Read entire contents. */
9721 rc
= DGifSlurp (gif
);
9722 if (rc
== GIF_ERROR
)
9724 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9725 DGifCloseFile (gif
);
9730 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9731 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9732 if (ino
>= gif
->ImageCount
)
9734 image_error ("Invalid image number `%s' in image `%s'",
9736 DGifCloseFile (gif
);
9741 width
= img
->width
= gif
->SWidth
;
9742 height
= img
->height
= gif
->SHeight
;
9744 /* Create the X image and pixmap. */
9745 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9747 DGifCloseFile (gif
);
9752 /* Allocate colors. */
9753 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9755 gif_color_map
= gif
->SColorMap
;
9756 init_color_table ();
9757 bzero (pixel_colors
, sizeof pixel_colors
);
9759 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9761 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9762 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9763 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9764 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9767 img
->colors
= colors_in_color_table (&img
->ncolors
);
9768 free_color_table ();
9770 /* Clear the part of the screen image that are not covered by
9771 the image from the GIF file. Full animated GIF support
9772 requires more than can be done here (see the gif89 spec,
9773 disposal methods). Let's simply assume that the part
9774 not covered by a sub-image is in the frame's background color. */
9775 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9776 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9777 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9778 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9780 for (y
= 0; y
< image_top
; ++y
)
9781 for (x
= 0; x
< width
; ++x
)
9782 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9784 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9785 for (x
= 0; x
< width
; ++x
)
9786 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9788 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9790 for (x
= 0; x
< image_left
; ++x
)
9791 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9792 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9793 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9796 /* Read the GIF image into the X image. We use a local variable
9797 `raster' here because RasterBits below is a char *, and invites
9798 problems with bytes >= 0x80. */
9799 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9801 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9803 static int interlace_start
[] = {0, 4, 2, 1};
9804 static int interlace_increment
[] = {8, 8, 4, 2};
9806 int row
= interlace_start
[0];
9810 for (y
= 0; y
< image_height
; y
++)
9812 if (row
>= image_height
)
9814 row
= interlace_start
[++pass
];
9815 while (row
>= image_height
)
9816 row
= interlace_start
[++pass
];
9819 for (x
= 0; x
< image_width
; x
++)
9821 int i
= raster
[(y
* image_width
) + x
];
9822 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9826 row
+= interlace_increment
[pass
];
9831 for (y
= 0; y
< image_height
; ++y
)
9832 for (x
= 0; x
< image_width
; ++x
)
9834 int i
= raster
[y
* image_width
+ x
];
9835 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9839 DGifCloseFile (gif
);
9841 /* Put the image into the pixmap, then free the X image and its buffer. */
9842 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9843 x_destroy_x_image (ximg
);
9849 #endif /* HAVE_GIF != 0 */
9853 /***********************************************************************
9855 ***********************************************************************/
9857 static int gs_image_p
P_ ((Lisp_Object object
));
9858 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9859 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9861 /* The symbol `postscript' identifying images of this type. */
9863 Lisp_Object Qpostscript
;
9865 /* Keyword symbols. */
9867 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9869 /* Indices of image specification fields in gs_format, below. */
9871 enum gs_keyword_index
9888 /* Vector of image_keyword structures describing the format
9889 of valid user-defined image specifications. */
9891 static struct image_keyword gs_format
[GS_LAST
] =
9893 {":type", IMAGE_SYMBOL_VALUE
, 1},
9894 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9895 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9896 {":file", IMAGE_STRING_VALUE
, 1},
9897 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9898 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9899 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9900 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9901 {":relief", IMAGE_INTEGER_VALUE
, 0},
9902 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9903 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9904 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9907 /* Structure describing the image type `ghostscript'. */
9909 static struct image_type gs_type
=
9919 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9922 gs_clear_image (f
, img
)
9926 /* IMG->data.ptr_val may contain a recorded colormap. */
9927 xfree (img
->data
.ptr_val
);
9928 x_clear_image (f
, img
);
9932 /* Return non-zero if OBJECT is a valid Ghostscript image
9939 struct image_keyword fmt
[GS_LAST
];
9943 bcopy (gs_format
, fmt
, sizeof fmt
);
9945 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
9948 /* Bounding box must be a list or vector containing 4 integers. */
9949 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9952 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9953 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9958 else if (VECTORP (tem
))
9960 if (XVECTOR (tem
)->size
!= 4)
9962 for (i
= 0; i
< 4; ++i
)
9963 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9973 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9982 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9983 struct gcpro gcpro1
, gcpro2
;
9985 double in_width
, in_height
;
9986 Lisp_Object pixel_colors
= Qnil
;
9988 /* Compute pixel size of pixmap needed from the given size in the
9989 image specification. Sizes in the specification are in pt. 1 pt
9990 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9992 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9993 in_width
= XFASTINT (pt_width
) / 72.0;
9994 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9995 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9996 in_height
= XFASTINT (pt_height
) / 72.0;
9997 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9999 /* Create the pixmap. */
10000 xassert (img
->pixmap
== None
);
10001 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10002 img
->width
, img
->height
,
10003 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
10007 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
10011 /* Call the loader to fill the pixmap. It returns a process object
10012 if successful. We do not record_unwind_protect here because
10013 other places in redisplay like calling window scroll functions
10014 don't either. Let the Lisp loader use `unwind-protect' instead. */
10015 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
10017 sprintf (buffer
, "%lu %lu",
10018 (unsigned long) FRAME_X_WINDOW (f
),
10019 (unsigned long) img
->pixmap
);
10020 window_and_pixmap_id
= build_string (buffer
);
10022 sprintf (buffer
, "%lu %lu",
10023 FRAME_FOREGROUND_PIXEL (f
),
10024 FRAME_BACKGROUND_PIXEL (f
));
10025 pixel_colors
= build_string (buffer
);
10027 XSETFRAME (frame
, f
);
10028 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
10030 loader
= intern ("gs-load-image");
10032 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10033 make_number (img
->width
),
10034 make_number (img
->height
),
10035 window_and_pixmap_id
,
10038 return PROCESSP (img
->data
.lisp_val
);
10042 /* Kill the Ghostscript process that was started to fill PIXMAP on
10043 frame F. Called from XTread_socket when receiving an event
10044 telling Emacs that Ghostscript has finished drawing. */
10047 x_kill_gs_process (pixmap
, f
)
10051 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10055 /* Find the image containing PIXMAP. */
10056 for (i
= 0; i
< c
->used
; ++i
)
10057 if (c
->images
[i
]->pixmap
== pixmap
)
10060 /* Kill the GS process. We should have found PIXMAP in the image
10061 cache and its image should contain a process object. */
10062 xassert (i
< c
->used
);
10063 img
= c
->images
[i
];
10064 xassert (PROCESSP (img
->data
.lisp_val
));
10065 Fkill_process (img
->data
.lisp_val
, Qnil
);
10066 img
->data
.lisp_val
= Qnil
;
10068 /* On displays with a mutable colormap, figure out the colors
10069 allocated for the image by looking at the pixels of an XImage for
10071 class = FRAME_X_VISUAL (f
)->class;
10072 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10078 /* Try to get an XImage for img->pixmep. */
10079 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10080 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10085 /* Initialize the color table. */
10086 init_color_table ();
10088 /* For each pixel of the image, look its color up in the
10089 color table. After having done so, the color table will
10090 contain an entry for each color used by the image. */
10091 for (y
= 0; y
< img
->height
; ++y
)
10092 for (x
= 0; x
< img
->width
; ++x
)
10094 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10095 lookup_pixel_color (f
, pixel
);
10098 /* Record colors in the image. Free color table and XImage. */
10099 img
->colors
= colors_in_color_table (&img
->ncolors
);
10100 free_color_table ();
10101 XDestroyImage (ximg
);
10103 #if 0 /* This doesn't seem to be the case. If we free the colors
10104 here, we get a BadAccess later in x_clear_image when
10105 freeing the colors. */
10106 /* We have allocated colors once, but Ghostscript has also
10107 allocated colors on behalf of us. So, to get the
10108 reference counts right, free them once. */
10110 x_free_colors (f
, img
->colors
, img
->ncolors
);
10114 image_error ("Cannot get X image of `%s'; colors will not be freed",
10120 /* Now that we have the pixmap, compute mask and transform the
10121 image if requested. */
10123 postprocess_image (f
, img
);
10129 /***********************************************************************
10131 ***********************************************************************/
10133 DEFUN ("x-change-window-property", Fx_change_window_property
,
10134 Sx_change_window_property
, 2, 3, 0,
10135 "Change window property PROP to VALUE on the X window of FRAME.\n\
10136 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
10137 selected frame. Value is VALUE.")
10138 (prop
, value
, frame
)
10139 Lisp_Object frame
, prop
, value
;
10141 struct frame
*f
= check_x_frame (frame
);
10144 CHECK_STRING (prop
, 1);
10145 CHECK_STRING (value
, 2);
10148 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10149 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10150 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10151 XSTRING (value
)->data
, XSTRING (value
)->size
);
10153 /* Make sure the property is set when we return. */
10154 XFlush (FRAME_X_DISPLAY (f
));
10161 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10162 Sx_delete_window_property
, 1, 2, 0,
10163 "Remove window property PROP from X window of FRAME.\n\
10164 FRAME nil or omitted means use the selected frame. Value is PROP.")
10166 Lisp_Object prop
, frame
;
10168 struct frame
*f
= check_x_frame (frame
);
10171 CHECK_STRING (prop
, 1);
10173 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10174 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10176 /* Make sure the property is removed when we return. */
10177 XFlush (FRAME_X_DISPLAY (f
));
10184 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10186 "Value is the value of window property PROP on FRAME.\n\
10187 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10188 if FRAME hasn't a property with name PROP or if PROP has no string\n\
10191 Lisp_Object prop
, frame
;
10193 struct frame
*f
= check_x_frame (frame
);
10196 Lisp_Object prop_value
= Qnil
;
10197 char *tmp_data
= NULL
;
10200 unsigned long actual_size
, bytes_remaining
;
10202 CHECK_STRING (prop
, 1);
10204 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10205 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10206 prop_atom
, 0, 0, False
, XA_STRING
,
10207 &actual_type
, &actual_format
, &actual_size
,
10208 &bytes_remaining
, (unsigned char **) &tmp_data
);
10211 int size
= bytes_remaining
;
10216 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10217 prop_atom
, 0, bytes_remaining
,
10219 &actual_type
, &actual_format
,
10220 &actual_size
, &bytes_remaining
,
10221 (unsigned char **) &tmp_data
);
10223 prop_value
= make_string (tmp_data
, size
);
10234 /***********************************************************************
10236 ***********************************************************************/
10238 /* If non-null, an asynchronous timer that, when it expires, displays
10239 an hourglass cursor on all frames. */
10241 static struct atimer
*hourglass_atimer
;
10243 /* Non-zero means an hourglass cursor is currently shown. */
10245 static int hourglass_shown_p
;
10247 /* Number of seconds to wait before displaying an hourglass cursor. */
10249 static Lisp_Object Vhourglass_delay
;
10251 /* Default number of seconds to wait before displaying an hourglass
10254 #define DEFAULT_HOURGLASS_DELAY 1
10256 /* Function prototypes. */
10258 static void show_hourglass
P_ ((struct atimer
*));
10259 static void hide_hourglass
P_ ((void));
10262 /* Cancel a currently active hourglass timer, and start a new one. */
10268 int secs
, usecs
= 0;
10270 cancel_hourglass ();
10272 if (INTEGERP (Vhourglass_delay
)
10273 && XINT (Vhourglass_delay
) > 0)
10274 secs
= XFASTINT (Vhourglass_delay
);
10275 else if (FLOATP (Vhourglass_delay
)
10276 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10279 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10280 secs
= XFASTINT (tem
);
10281 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10284 secs
= DEFAULT_HOURGLASS_DELAY
;
10286 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10287 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10288 show_hourglass
, NULL
);
10292 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10296 cancel_hourglass ()
10298 if (hourglass_atimer
)
10300 cancel_atimer (hourglass_atimer
);
10301 hourglass_atimer
= NULL
;
10304 if (hourglass_shown_p
)
10309 /* Timer function of hourglass_atimer. TIMER is equal to
10312 Display an hourglass pointer on all frames by mapping the frames'
10313 hourglass_window. Set the hourglass_p flag in the frames'
10314 output_data.x structure to indicate that an hourglass cursor is
10315 shown on the frames. */
10318 show_hourglass (timer
)
10319 struct atimer
*timer
;
10321 /* The timer implementation will cancel this timer automatically
10322 after this function has run. Set hourglass_atimer to null
10323 so that we know the timer doesn't have to be canceled. */
10324 hourglass_atimer
= NULL
;
10326 if (!hourglass_shown_p
)
10328 Lisp_Object rest
, frame
;
10332 FOR_EACH_FRAME (rest
, frame
)
10334 struct frame
*f
= XFRAME (frame
);
10336 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10338 Display
*dpy
= FRAME_X_DISPLAY (f
);
10340 #ifdef USE_X_TOOLKIT
10341 if (f
->output_data
.x
->widget
)
10343 if (FRAME_OUTER_WINDOW (f
))
10346 f
->output_data
.x
->hourglass_p
= 1;
10348 if (!f
->output_data
.x
->hourglass_window
)
10350 unsigned long mask
= CWCursor
;
10351 XSetWindowAttributes attrs
;
10353 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10355 f
->output_data
.x
->hourglass_window
10356 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10357 0, 0, 32000, 32000, 0, 0,
10363 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10369 hourglass_shown_p
= 1;
10375 /* Hide the hourglass pointer on all frames, if it is currently
10381 if (hourglass_shown_p
)
10383 Lisp_Object rest
, frame
;
10386 FOR_EACH_FRAME (rest
, frame
)
10388 struct frame
*f
= XFRAME (frame
);
10391 /* Watch out for newly created frames. */
10392 && f
->output_data
.x
->hourglass_window
)
10394 XUnmapWindow (FRAME_X_DISPLAY (f
),
10395 f
->output_data
.x
->hourglass_window
);
10396 /* Sync here because XTread_socket looks at the
10397 hourglass_p flag that is reset to zero below. */
10398 XSync (FRAME_X_DISPLAY (f
), False
);
10399 f
->output_data
.x
->hourglass_p
= 0;
10403 hourglass_shown_p
= 0;
10410 /***********************************************************************
10412 ***********************************************************************/
10414 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10415 Lisp_Object
, Lisp_Object
));
10416 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10417 Lisp_Object
, int, int, int *, int *));
10419 /* The frame of a currently visible tooltip. */
10421 Lisp_Object tip_frame
;
10423 /* If non-nil, a timer started that hides the last tooltip when it
10426 Lisp_Object tip_timer
;
10429 /* If non-nil, a vector of 3 elements containing the last args
10430 with which x-show-tip was called. See there. */
10432 Lisp_Object last_show_tip_args
;
10436 unwind_create_tip_frame (frame
)
10439 Lisp_Object deleted
;
10441 deleted
= unwind_create_frame (frame
);
10442 if (EQ (deleted
, Qt
))
10452 /* Create a frame for a tooltip on the display described by DPYINFO.
10453 PARMS is a list of frame parameters. TEXT is the string to
10454 display in the tip frame. Value is the frame.
10456 Note that functions called here, esp. x_default_parameter can
10457 signal errors, for instance when a specified color name is
10458 undefined. We have to make sure that we're in a consistent state
10459 when this happens. */
10462 x_create_tip_frame (dpyinfo
, parms
, text
)
10463 struct x_display_info
*dpyinfo
;
10464 Lisp_Object parms
, text
;
10467 Lisp_Object frame
, tem
;
10469 long window_prompting
= 0;
10471 int count
= BINDING_STACK_SIZE ();
10472 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10474 int face_change_count_before
= face_change_count
;
10475 Lisp_Object buffer
;
10476 struct buffer
*old_buffer
;
10480 /* Use this general default value to start with until we know if
10481 this frame has a specified name. */
10482 Vx_resource_name
= Vinvocation_name
;
10484 #ifdef MULTI_KBOARD
10485 kb
= dpyinfo
->kboard
;
10487 kb
= &the_only_kboard
;
10490 /* Get the name of the frame to use for resource lookup. */
10491 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10492 if (!STRINGP (name
)
10493 && !EQ (name
, Qunbound
)
10495 error ("Invalid frame name--not a string or nil");
10496 Vx_resource_name
= name
;
10499 GCPRO3 (parms
, name
, frame
);
10500 f
= make_frame (1);
10501 XSETFRAME (frame
, f
);
10503 buffer
= Fget_buffer_create (build_string (" *tip*"));
10504 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10505 old_buffer
= current_buffer
;
10506 set_buffer_internal_1 (XBUFFER (buffer
));
10508 Finsert (1, &text
);
10509 set_buffer_internal_1 (old_buffer
);
10511 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10512 record_unwind_protect (unwind_create_tip_frame
, frame
);
10514 /* By setting the output method, we're essentially saying that
10515 the frame is live, as per FRAME_LIVE_P. If we get a signal
10516 from this point on, x_destroy_window might screw up reference
10518 f
->output_method
= output_x_window
;
10519 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10520 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10521 f
->output_data
.x
->icon_bitmap
= -1;
10522 f
->output_data
.x
->fontset
= -1;
10523 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10524 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10525 f
->icon_name
= Qnil
;
10526 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10528 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10529 dpyinfo_refcount
= dpyinfo
->reference_count
;
10530 #endif /* GLYPH_DEBUG */
10531 #ifdef MULTI_KBOARD
10532 FRAME_KBOARD (f
) = kb
;
10534 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10535 f
->output_data
.x
->explicit_parent
= 0;
10537 /* These colors will be set anyway later, but it's important
10538 to get the color reference counts right, so initialize them! */
10541 struct gcpro gcpro1
;
10543 black
= build_string ("black");
10545 f
->output_data
.x
->foreground_pixel
10546 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10547 f
->output_data
.x
->background_pixel
10548 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10549 f
->output_data
.x
->cursor_pixel
10550 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10551 f
->output_data
.x
->cursor_foreground_pixel
10552 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10553 f
->output_data
.x
->border_pixel
10554 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10555 f
->output_data
.x
->mouse_pixel
10556 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10560 /* Set the name; the functions to which we pass f expect the name to
10562 if (EQ (name
, Qunbound
) || NILP (name
))
10564 f
->name
= build_string (dpyinfo
->x_id_name
);
10565 f
->explicit_name
= 0;
10570 f
->explicit_name
= 1;
10571 /* use the frame's title when getting resources for this frame. */
10572 specbind (Qx_resource_name
, name
);
10575 /* Extract the window parameters from the supplied values that are
10576 needed to determine window geometry. */
10580 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10583 /* First, try whatever font the caller has specified. */
10584 if (STRINGP (font
))
10586 tem
= Fquery_fontset (font
, Qnil
);
10588 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10590 font
= x_new_font (f
, XSTRING (font
)->data
);
10593 /* Try out a font which we hope has bold and italic variations. */
10594 if (!STRINGP (font
))
10595 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10596 if (!STRINGP (font
))
10597 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10598 if (! STRINGP (font
))
10599 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10600 if (! STRINGP (font
))
10601 /* This was formerly the first thing tried, but it finds too many fonts
10602 and takes too long. */
10603 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10604 /* If those didn't work, look for something which will at least work. */
10605 if (! STRINGP (font
))
10606 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10608 if (! STRINGP (font
))
10609 font
= build_string ("fixed");
10611 x_default_parameter (f
, parms
, Qfont
, font
,
10612 "font", "Font", RES_TYPE_STRING
);
10615 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10616 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10618 /* This defaults to 2 in order to match xterm. We recognize either
10619 internalBorderWidth or internalBorder (which is what xterm calls
10621 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10625 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10626 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10627 if (! EQ (value
, Qunbound
))
10628 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10632 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10633 "internalBorderWidth", "internalBorderWidth",
10636 /* Also do the stuff which must be set before the window exists. */
10637 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10638 "foreground", "Foreground", RES_TYPE_STRING
);
10639 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10640 "background", "Background", RES_TYPE_STRING
);
10641 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10642 "pointerColor", "Foreground", RES_TYPE_STRING
);
10643 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10644 "cursorColor", "Foreground", RES_TYPE_STRING
);
10645 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10646 "borderColor", "BorderColor", RES_TYPE_STRING
);
10648 /* Init faces before x_default_parameter is called for scroll-bar
10649 parameters because that function calls x_set_scroll_bar_width,
10650 which calls change_frame_size, which calls Fset_window_buffer,
10651 which runs hooks, which call Fvertical_motion. At the end, we
10652 end up in init_iterator with a null face cache, which should not
10654 init_frame_faces (f
);
10656 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10657 window_prompting
= x_figure_window_size (f
, parms
);
10659 if (window_prompting
& XNegative
)
10661 if (window_prompting
& YNegative
)
10662 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10664 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10668 if (window_prompting
& YNegative
)
10669 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10671 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10674 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10676 XSetWindowAttributes attrs
;
10677 unsigned long mask
;
10680 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10681 if (DoesSaveUnders (dpyinfo
->screen
))
10682 mask
|= CWSaveUnder
;
10684 /* Window managers look at the override-redirect flag to determine
10685 whether or net to give windows a decoration (Xlib spec, chapter
10687 attrs
.override_redirect
= True
;
10688 attrs
.save_under
= True
;
10689 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10690 /* Arrange for getting MapNotify and UnmapNotify events. */
10691 attrs
.event_mask
= StructureNotifyMask
;
10693 = FRAME_X_WINDOW (f
)
10694 = XCreateWindow (FRAME_X_DISPLAY (f
),
10695 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10696 /* x, y, width, height */
10700 CopyFromParent
, InputOutput
, CopyFromParent
,
10707 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10708 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10709 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10710 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10711 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10712 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10714 /* Dimensions, especially f->height, must be done via change_frame_size.
10715 Change will not be effected unless different from the current
10718 height
= f
->height
;
10720 SET_FRAME_WIDTH (f
, 0);
10721 change_frame_size (f
, height
, width
, 1, 0, 0);
10723 /* Set up faces after all frame parameters are known. This call
10724 also merges in face attributes specified for new frames.
10726 Frame parameters may be changed if .Xdefaults contains
10727 specifications for the default font. For example, if there is an
10728 `Emacs.default.attributeBackground: pink', the `background-color'
10729 attribute of the frame get's set, which let's the internal border
10730 of the tooltip frame appear in pink. Prevent this. */
10732 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
10734 /* Set tip_frame here, so that */
10736 call1 (Qface_set_after_frame_default
, frame
);
10738 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
10739 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
10747 /* It is now ok to make the frame official even if we get an error
10748 below. And the frame needs to be on Vframe_list or making it
10749 visible won't work. */
10750 Vframe_list
= Fcons (frame
, Vframe_list
);
10752 /* Now that the frame is official, it counts as a reference to
10754 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10756 /* Setting attributes of faces of the tooltip frame from resources
10757 and similar will increment face_change_count, which leads to the
10758 clearing of all current matrices. Since this isn't necessary
10759 here, avoid it by resetting face_change_count to the value it
10760 had before we created the tip frame. */
10761 face_change_count
= face_change_count_before
;
10763 /* Discard the unwind_protect. */
10764 return unbind_to (count
, frame
);
10768 /* Compute where to display tip frame F. PARMS is the list of frame
10769 parameters for F. DX and DY are specified offsets from the current
10770 location of the mouse. WIDTH and HEIGHT are the width and height
10771 of the tooltip. Return coordinates relative to the root window of
10772 the display in *ROOT_X, and *ROOT_Y. */
10775 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
10777 Lisp_Object parms
, dx
, dy
;
10779 int *root_x
, *root_y
;
10781 Lisp_Object left
, top
;
10783 Window root
, child
;
10786 /* User-specified position? */
10787 left
= Fcdr (Fassq (Qleft
, parms
));
10788 top
= Fcdr (Fassq (Qtop
, parms
));
10790 /* Move the tooltip window where the mouse pointer is. Resize and
10792 if (!INTEGERP (left
) && !INTEGERP (top
))
10795 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10796 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
10800 if (INTEGERP (top
))
10801 *root_y
= XINT (top
);
10802 else if (*root_y
+ XINT (dy
) - height
< 0)
10803 *root_y
-= XINT (dy
);
10807 *root_y
+= XINT (dy
);
10810 if (INTEGERP (left
))
10811 *root_x
= XINT (left
);
10812 else if (*root_x
+ XINT (dx
) + width
> FRAME_X_DISPLAY_INFO (f
)->width
)
10813 *root_x
-= width
+ XINT (dx
);
10815 *root_x
+= XINT (dx
);
10819 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10820 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10821 A tooltip window is a small X window displaying a string.\n\
10823 FRAME nil or omitted means use the selected frame.\n\
10825 PARMS is an optional list of frame parameters which can be\n\
10826 used to change the tooltip's appearance.\n\
10828 Automatically hide the tooltip after TIMEOUT seconds.\n\
10829 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10831 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10832 the tooltip is displayed at that x-position. Otherwise it is\n\
10833 displayed at the mouse position, with offset DX added (default is 5 if\n\
10834 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10835 parameter is specified, it determines the y-position of the tooltip\n\
10836 window, otherwise it is displayed at the mouse position, with offset\n\
10837 DY added (default is -10).")
10838 (string
, frame
, parms
, timeout
, dx
, dy
)
10839 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10843 Lisp_Object buffer
, top
, left
;
10844 int root_x
, root_y
;
10845 struct buffer
*old_buffer
;
10846 struct text_pos pos
;
10847 int i
, width
, height
;
10848 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10849 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10850 int count
= BINDING_STACK_SIZE ();
10852 specbind (Qinhibit_redisplay
, Qt
);
10854 GCPRO4 (string
, parms
, frame
, timeout
);
10856 CHECK_STRING (string
, 0);
10857 f
= check_x_frame (frame
);
10858 if (NILP (timeout
))
10859 timeout
= make_number (5);
10861 CHECK_NATNUM (timeout
, 2);
10864 dx
= make_number (5);
10866 CHECK_NUMBER (dx
, 5);
10869 dy
= make_number (-10);
10871 CHECK_NUMBER (dy
, 6);
10873 if (NILP (last_show_tip_args
))
10874 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
10876 if (!NILP (tip_frame
))
10878 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
10879 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
10880 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
10882 if (EQ (frame
, last_frame
)
10883 && !NILP (Fequal (last_string
, string
))
10884 && !NILP (Fequal (last_parms
, parms
)))
10886 struct frame
*f
= XFRAME (tip_frame
);
10888 /* Only DX and DY have changed. */
10889 if (!NILP (tip_timer
))
10891 Lisp_Object timer
= tip_timer
;
10893 call1 (Qcancel_timer
, timer
);
10897 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
10898 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
10899 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10906 /* Hide a previous tip, if any. */
10909 ASET (last_show_tip_args
, 0, string
);
10910 ASET (last_show_tip_args
, 1, frame
);
10911 ASET (last_show_tip_args
, 2, parms
);
10913 /* Add default values to frame parameters. */
10914 if (NILP (Fassq (Qname
, parms
)))
10915 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10916 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10917 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10918 if (NILP (Fassq (Qborder_width
, parms
)))
10919 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10920 if (NILP (Fassq (Qborder_color
, parms
)))
10921 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10922 if (NILP (Fassq (Qbackground_color
, parms
)))
10923 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10926 /* Create a frame for the tooltip, and record it in the global
10927 variable tip_frame. */
10928 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
, string
);
10929 f
= XFRAME (frame
);
10931 /* Set up the frame's root window. Currently we use a size of 80
10932 columns x 40 lines. If someone wants to show a larger tip, he
10933 will loose. I don't think this is a realistic case. */
10934 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10935 w
->left
= w
->top
= make_number (0);
10936 w
->width
= make_number (80);
10937 w
->height
= make_number (40);
10939 w
->pseudo_window_p
= 1;
10941 /* Display the tooltip text in a temporary buffer. */
10942 old_buffer
= current_buffer
;
10943 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
10944 clear_glyph_matrix (w
->desired_matrix
);
10945 clear_glyph_matrix (w
->current_matrix
);
10946 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10947 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10949 /* Compute width and height of the tooltip. */
10950 width
= height
= 0;
10951 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10953 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10954 struct glyph
*last
;
10957 /* Stop at the first empty row at the end. */
10958 if (!row
->enabled_p
|| !row
->displays_text_p
)
10961 /* Let the row go over the full width of the frame. */
10962 row
->full_width_p
= 1;
10964 /* There's a glyph at the end of rows that is used to place
10965 the cursor there. Don't include the width of this glyph. */
10966 if (row
->used
[TEXT_AREA
])
10968 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10969 row_width
= row
->pixel_width
- last
->pixel_width
;
10972 row_width
= row
->pixel_width
;
10974 height
+= row
->height
;
10975 width
= max (width
, row_width
);
10978 /* Add the frame's internal border to the width and height the X
10979 window should have. */
10980 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10981 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10983 /* Move the tooltip window where the mouse pointer is. Resize and
10985 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
10988 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10989 root_x
, root_y
, width
, height
);
10990 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10993 /* Draw into the window. */
10994 w
->must_be_updated_p
= 1;
10995 update_single_window (w
, 1);
10997 /* Restore original current buffer. */
10998 set_buffer_internal_1 (old_buffer
);
10999 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
11002 /* Let the tip disappear after timeout seconds. */
11003 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
11004 intern ("x-hide-tip"));
11007 return unbind_to (count
, Qnil
);
11011 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
11012 "Hide the current tooltip window, if there is any.\n\
11013 Value is t is tooltip was open, nil otherwise.")
11017 Lisp_Object deleted
, frame
, timer
;
11018 struct gcpro gcpro1
, gcpro2
;
11020 /* Return quickly if nothing to do. */
11021 if (NILP (tip_timer
) && NILP (tip_frame
))
11026 GCPRO2 (frame
, timer
);
11027 tip_frame
= tip_timer
= deleted
= Qnil
;
11029 count
= BINDING_STACK_SIZE ();
11030 specbind (Qinhibit_redisplay
, Qt
);
11031 specbind (Qinhibit_quit
, Qt
);
11034 call1 (Qcancel_timer
, timer
);
11036 if (FRAMEP (frame
))
11038 Fdelete_frame (frame
, Qnil
);
11042 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11043 redisplay procedure is not called when a tip frame over menu
11044 items is unmapped. Redisplay the menu manually... */
11046 struct frame
*f
= SELECTED_FRAME ();
11047 Widget w
= f
->output_data
.x
->menubar_widget
;
11048 extern void xlwmenu_redisplay
P_ ((Widget
));
11050 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
11054 xlwmenu_redisplay (w
);
11058 #endif /* USE_LUCID */
11062 return unbind_to (count
, deleted
);
11067 /***********************************************************************
11068 File selection dialog
11069 ***********************************************************************/
11073 /* Callback for "OK" and "Cancel" on file selection dialog. */
11076 file_dialog_cb (widget
, client_data
, call_data
)
11078 XtPointer call_data
, client_data
;
11080 int *result
= (int *) client_data
;
11081 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11082 *result
= cb
->reason
;
11086 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11087 "Read file name, prompting with PROMPT in directory DIR.\n\
11088 Use a file selection dialog.\n\
11089 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
11090 specified. Don't let the user enter a file name in the file\n\
11091 selection dialog's entry field, if MUSTMATCH is non-nil.")
11092 (prompt
, dir
, default_filename
, mustmatch
)
11093 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11096 struct frame
*f
= SELECTED_FRAME ();
11097 Lisp_Object file
= Qnil
;
11098 Widget dialog
, text
, list
, help
;
11101 extern XtAppContext Xt_app_con
;
11103 XmString dir_xmstring
, pattern_xmstring
;
11104 int popup_activated_flag
;
11105 int count
= specpdl_ptr
- specpdl
;
11106 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11108 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11109 CHECK_STRING (prompt
, 0);
11110 CHECK_STRING (dir
, 1);
11112 /* Prevent redisplay. */
11113 specbind (Qinhibit_redisplay
, Qt
);
11117 /* Create the dialog with PROMPT as title, using DIR as initial
11118 directory and using "*" as pattern. */
11119 dir
= Fexpand_file_name (dir
, Qnil
);
11120 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11121 pattern_xmstring
= XmStringCreateLocalized ("*");
11123 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11124 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11125 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11126 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11127 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11128 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11130 XmStringFree (dir_xmstring
);
11131 XmStringFree (pattern_xmstring
);
11133 /* Add callbacks for OK and Cancel. */
11134 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11135 (XtPointer
) &result
);
11136 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11137 (XtPointer
) &result
);
11139 /* Disable the help button since we can't display help. */
11140 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11141 XtSetSensitive (help
, False
);
11143 /* Mark OK button as default. */
11144 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11145 XmNshowAsDefault
, True
, NULL
);
11147 /* If MUSTMATCH is non-nil, disable the file entry field of the
11148 dialog, so that the user must select a file from the files list
11149 box. We can't remove it because we wouldn't have a way to get at
11150 the result file name, then. */
11151 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11152 if (!NILP (mustmatch
))
11155 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11156 XtSetSensitive (text
, False
);
11157 XtSetSensitive (label
, False
);
11160 /* Manage the dialog, so that list boxes get filled. */
11161 XtManageChild (dialog
);
11163 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11164 must include the path for this to work. */
11165 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11166 if (STRINGP (default_filename
))
11168 XmString default_xmstring
;
11172 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11174 if (!XmListItemExists (list
, default_xmstring
))
11176 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11177 XmListAddItem (list
, default_xmstring
, 0);
11181 item_pos
= XmListItemPos (list
, default_xmstring
);
11182 XmStringFree (default_xmstring
);
11184 /* Select the item and scroll it into view. */
11185 XmListSelectPos (list
, item_pos
, True
);
11186 XmListSetPos (list
, item_pos
);
11189 /* Process events until the user presses Cancel or OK. */
11191 while (result
== 0 || XtAppPending (Xt_app_con
))
11192 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11194 /* Get the result. */
11195 if (result
== XmCR_OK
)
11200 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11201 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11202 XmStringFree (text
);
11203 file
= build_string (data
);
11210 XtUnmanageChild (dialog
);
11211 XtDestroyWidget (dialog
);
11215 /* Make "Cancel" equivalent to C-g. */
11217 Fsignal (Qquit
, Qnil
);
11219 return unbind_to (count
, file
);
11222 #endif /* USE_MOTIF */
11226 /***********************************************************************
11228 ***********************************************************************/
11230 #ifdef HAVE_XKBGETKEYBOARD
11231 #include <X11/XKBlib.h>
11232 #include <X11/keysym.h>
11235 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11236 Sx_backspace_delete_keys_p
, 0, 1, 0,
11237 "Check if both Backspace and Delete keys are on the keyboard of FRAME.\n\
11238 FRAME nil means use the selected frame.\n\
11239 Value is t if we know that both keys are present, and are mapped to the\n\
11244 #ifdef HAVE_XKBGETKEYBOARD
11246 struct frame
*f
= check_x_frame (frame
);
11247 Display
*dpy
= FRAME_X_DISPLAY (f
);
11248 Lisp_Object have_keys
;
11249 int major
, minor
, op
, event
, error
;
11253 /* Check library version in case we're dynamically linked. */
11254 major
= XkbMajorVersion
;
11255 minor
= XkbMinorVersion
;
11256 if (!XkbLibraryVersion (&major
, &minor
))
11262 /* Check that the server supports XKB. */
11263 major
= XkbMajorVersion
;
11264 minor
= XkbMinorVersion
;
11265 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11272 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11275 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11277 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11279 for (i
= kb
->min_key_code
;
11280 (i
< kb
->max_key_code
11281 && (delete_keycode
== 0 || backspace_keycode
== 0));
11284 /* The XKB symbolic key names can be seen most easily
11285 in the PS file generated by `xkbprint -label name $DISPLAY'. */
11286 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11287 delete_keycode
= i
;
11288 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11289 backspace_keycode
= i
;
11292 XkbFreeNames (kb
, 0, True
);
11295 XkbFreeClientMap (kb
, 0, True
);
11298 && backspace_keycode
11299 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11300 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11305 #else /* not HAVE_XKBGETKEYBOARD */
11307 #endif /* not HAVE_XKBGETKEYBOARD */
11312 /***********************************************************************
11314 ***********************************************************************/
11319 /* This is zero if not using X windows. */
11322 /* The section below is built by the lisp expression at the top of the file,
11323 just above where these variables are declared. */
11324 /*&&& init symbols here &&&*/
11325 Qauto_raise
= intern ("auto-raise");
11326 staticpro (&Qauto_raise
);
11327 Qauto_lower
= intern ("auto-lower");
11328 staticpro (&Qauto_lower
);
11329 Qbar
= intern ("bar");
11331 Qborder_color
= intern ("border-color");
11332 staticpro (&Qborder_color
);
11333 Qborder_width
= intern ("border-width");
11334 staticpro (&Qborder_width
);
11335 Qbox
= intern ("box");
11337 Qcursor_color
= intern ("cursor-color");
11338 staticpro (&Qcursor_color
);
11339 Qcursor_type
= intern ("cursor-type");
11340 staticpro (&Qcursor_type
);
11341 Qgeometry
= intern ("geometry");
11342 staticpro (&Qgeometry
);
11343 Qicon_left
= intern ("icon-left");
11344 staticpro (&Qicon_left
);
11345 Qicon_top
= intern ("icon-top");
11346 staticpro (&Qicon_top
);
11347 Qicon_type
= intern ("icon-type");
11348 staticpro (&Qicon_type
);
11349 Qicon_name
= intern ("icon-name");
11350 staticpro (&Qicon_name
);
11351 Qinternal_border_width
= intern ("internal-border-width");
11352 staticpro (&Qinternal_border_width
);
11353 Qleft
= intern ("left");
11354 staticpro (&Qleft
);
11355 Qright
= intern ("right");
11356 staticpro (&Qright
);
11357 Qmouse_color
= intern ("mouse-color");
11358 staticpro (&Qmouse_color
);
11359 Qnone
= intern ("none");
11360 staticpro (&Qnone
);
11361 Qparent_id
= intern ("parent-id");
11362 staticpro (&Qparent_id
);
11363 Qscroll_bar_width
= intern ("scroll-bar-width");
11364 staticpro (&Qscroll_bar_width
);
11365 Qsuppress_icon
= intern ("suppress-icon");
11366 staticpro (&Qsuppress_icon
);
11367 Qundefined_color
= intern ("undefined-color");
11368 staticpro (&Qundefined_color
);
11369 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11370 staticpro (&Qvertical_scroll_bars
);
11371 Qvisibility
= intern ("visibility");
11372 staticpro (&Qvisibility
);
11373 Qwindow_id
= intern ("window-id");
11374 staticpro (&Qwindow_id
);
11375 Qouter_window_id
= intern ("outer-window-id");
11376 staticpro (&Qouter_window_id
);
11377 Qx_frame_parameter
= intern ("x-frame-parameter");
11378 staticpro (&Qx_frame_parameter
);
11379 Qx_resource_name
= intern ("x-resource-name");
11380 staticpro (&Qx_resource_name
);
11381 Quser_position
= intern ("user-position");
11382 staticpro (&Quser_position
);
11383 Quser_size
= intern ("user-size");
11384 staticpro (&Quser_size
);
11385 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11386 staticpro (&Qscroll_bar_foreground
);
11387 Qscroll_bar_background
= intern ("scroll-bar-background");
11388 staticpro (&Qscroll_bar_background
);
11389 Qscreen_gamma
= intern ("screen-gamma");
11390 staticpro (&Qscreen_gamma
);
11391 Qline_spacing
= intern ("line-spacing");
11392 staticpro (&Qline_spacing
);
11393 Qcenter
= intern ("center");
11394 staticpro (&Qcenter
);
11395 Qcompound_text
= intern ("compound-text");
11396 staticpro (&Qcompound_text
);
11397 Qcancel_timer
= intern ("cancel-timer");
11398 staticpro (&Qcancel_timer
);
11399 /* This is the end of symbol initialization. */
11401 /* Text property `display' should be nonsticky by default. */
11402 Vtext_property_default_nonsticky
11403 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11406 Qlaplace
= intern ("laplace");
11407 staticpro (&Qlaplace
);
11408 Qemboss
= intern ("emboss");
11409 staticpro (&Qemboss
);
11410 Qedge_detection
= intern ("edge-detection");
11411 staticpro (&Qedge_detection
);
11412 Qheuristic
= intern ("heuristic");
11413 staticpro (&Qheuristic
);
11414 QCmatrix
= intern (":matrix");
11415 staticpro (&QCmatrix
);
11416 QCcolor_adjustment
= intern (":color-adjustment");
11417 staticpro (&QCcolor_adjustment
);
11418 QCmask
= intern (":mask");
11419 staticpro (&QCmask
);
11421 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11422 staticpro (&Qface_set_after_frame_default
);
11424 Fput (Qundefined_color
, Qerror_conditions
,
11425 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11426 Fput (Qundefined_color
, Qerror_message
,
11427 build_string ("Undefined color"));
11429 init_x_parm_symbols ();
11431 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11432 "Non-nil means always draw a cross over disabled images.\n\
11433 Disabled images are those having an `:conversion disabled' property.\n\
11434 A cross is always drawn on black & white displays.");
11435 cross_disabled_images
= 0;
11437 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11438 "List of directories to search for bitmap files for X.");
11439 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11441 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11442 "The shape of the pointer when over text.\n\
11443 Changing the value does not affect existing frames\n\
11444 unless you set the mouse color.");
11445 Vx_pointer_shape
= Qnil
;
11447 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11448 "The name Emacs uses to look up X resources.\n\
11449 `x-get-resource' uses this as the first component of the instance name\n\
11450 when requesting resource values.\n\
11451 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
11452 was invoked, or to the value specified with the `-name' or `-rn'\n\
11453 switches, if present.\n\
11455 It may be useful to bind this variable locally around a call\n\
11456 to `x-get-resource'. See also the variable `x-resource-class'.");
11457 Vx_resource_name
= Qnil
;
11459 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11460 "The class Emacs uses to look up X resources.\n\
11461 `x-get-resource' uses this as the first component of the instance class\n\
11462 when requesting resource values.\n\
11463 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
11465 Setting this variable permanently is not a reasonable thing to do,\n\
11466 but binding this variable locally around a call to `x-get-resource'\n\
11467 is a reasonable practice. See also the variable `x-resource-name'.");
11468 Vx_resource_class
= build_string (EMACS_CLASS
);
11470 #if 0 /* This doesn't really do anything. */
11471 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11472 "The shape of the pointer when not over text.\n\
11473 This variable takes effect when you create a new frame\n\
11474 or when you set the mouse color.");
11476 Vx_nontext_pointer_shape
= Qnil
;
11478 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
11479 "The shape of the pointer when Emacs is busy.\n\
11480 This variable takes effect when you create a new frame\n\
11481 or when you set the mouse color.");
11482 Vx_hourglass_pointer_shape
= Qnil
;
11484 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
11485 "Non-zero means Emacs displays an hourglass pointer on window systems.");
11486 display_hourglass_p
= 1;
11488 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
11489 "*Seconds to wait before displaying an hourglass pointer.\n\
11490 Value must be an integer or float.");
11491 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
11493 #if 0 /* This doesn't really do anything. */
11494 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11495 "The shape of the pointer when over the mode line.\n\
11496 This variable takes effect when you create a new frame\n\
11497 or when you set the mouse color.");
11499 Vx_mode_pointer_shape
= Qnil
;
11501 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11502 &Vx_sensitive_text_pointer_shape
,
11503 "The shape of the pointer when over mouse-sensitive text.\n\
11504 This variable takes effect when you create a new frame\n\
11505 or when you set the mouse color.");
11506 Vx_sensitive_text_pointer_shape
= Qnil
;
11508 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11509 &Vx_window_horizontal_drag_shape
,
11510 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
11511 This variable takes effect when you create a new frame\n\
11512 or when you set the mouse color.");
11513 Vx_window_horizontal_drag_shape
= Qnil
;
11515 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11516 "A string indicating the foreground color of the cursor box.");
11517 Vx_cursor_fore_pixel
= Qnil
;
11519 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11520 "Non-nil if no X window manager is in use.\n\
11521 Emacs doesn't try to figure this out; this is always nil\n\
11522 unless you set it to something else.");
11523 /* We don't have any way to find this out, so set it to nil
11524 and maybe the user would like to set it to t. */
11525 Vx_no_window_manager
= Qnil
;
11527 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11528 &Vx_pixel_size_width_font_regexp
,
11529 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11531 Since Emacs gets width of a font matching with this regexp from\n\
11532 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11533 such a font. This is especially effective for such large fonts as\n\
11534 Chinese, Japanese, and Korean.");
11535 Vx_pixel_size_width_font_regexp
= Qnil
;
11537 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11538 "Time after which cached images are removed from the cache.\n\
11539 When an image has not been displayed this many seconds, remove it\n\
11540 from the image cache. Value must be an integer or nil with nil\n\
11541 meaning don't clear the cache.");
11542 Vimage_cache_eviction_delay
= make_number (30 * 60);
11544 #ifdef USE_X_TOOLKIT
11545 Fprovide (intern ("x-toolkit"));
11548 Fprovide (intern ("motif"));
11550 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string
,
11551 "Version info for LessTif/Motif.");
11552 Vmotif_version_string
= build_string (XmVERSION_STRING
);
11553 #endif /* USE_MOTIF */
11554 #endif /* USE_X_TOOLKIT */
11556 defsubr (&Sx_get_resource
);
11558 /* X window properties. */
11559 defsubr (&Sx_change_window_property
);
11560 defsubr (&Sx_delete_window_property
);
11561 defsubr (&Sx_window_property
);
11563 defsubr (&Sxw_display_color_p
);
11564 defsubr (&Sx_display_grayscale_p
);
11565 defsubr (&Sxw_color_defined_p
);
11566 defsubr (&Sxw_color_values
);
11567 defsubr (&Sx_server_max_request_size
);
11568 defsubr (&Sx_server_vendor
);
11569 defsubr (&Sx_server_version
);
11570 defsubr (&Sx_display_pixel_width
);
11571 defsubr (&Sx_display_pixel_height
);
11572 defsubr (&Sx_display_mm_width
);
11573 defsubr (&Sx_display_mm_height
);
11574 defsubr (&Sx_display_screens
);
11575 defsubr (&Sx_display_planes
);
11576 defsubr (&Sx_display_color_cells
);
11577 defsubr (&Sx_display_visual_class
);
11578 defsubr (&Sx_display_backing_store
);
11579 defsubr (&Sx_display_save_under
);
11580 defsubr (&Sx_parse_geometry
);
11581 defsubr (&Sx_create_frame
);
11582 defsubr (&Sx_open_connection
);
11583 defsubr (&Sx_close_connection
);
11584 defsubr (&Sx_display_list
);
11585 defsubr (&Sx_synchronize
);
11586 defsubr (&Sx_focus_frame
);
11587 defsubr (&Sx_backspace_delete_keys_p
);
11589 /* Setting callback functions for fontset handler. */
11590 get_font_info_func
= x_get_font_info
;
11592 #if 0 /* This function pointer doesn't seem to be used anywhere.
11593 And the pointer assigned has the wrong type, anyway. */
11594 list_fonts_func
= x_list_fonts
;
11597 load_font_func
= x_load_font
;
11598 find_ccl_program_func
= x_find_ccl_program
;
11599 query_font_func
= x_query_font
;
11600 set_frame_fontset_func
= x_set_font
;
11601 check_window_system_func
= check_x
;
11604 Qxbm
= intern ("xbm");
11606 QCtype
= intern (":type");
11607 staticpro (&QCtype
);
11608 QCconversion
= intern (":conversion");
11609 staticpro (&QCconversion
);
11610 QCheuristic_mask
= intern (":heuristic-mask");
11611 staticpro (&QCheuristic_mask
);
11612 QCcolor_symbols
= intern (":color-symbols");
11613 staticpro (&QCcolor_symbols
);
11614 QCascent
= intern (":ascent");
11615 staticpro (&QCascent
);
11616 QCmargin
= intern (":margin");
11617 staticpro (&QCmargin
);
11618 QCrelief
= intern (":relief");
11619 staticpro (&QCrelief
);
11620 Qpostscript
= intern ("postscript");
11621 staticpro (&Qpostscript
);
11622 QCloader
= intern (":loader");
11623 staticpro (&QCloader
);
11624 QCbounding_box
= intern (":bounding-box");
11625 staticpro (&QCbounding_box
);
11626 QCpt_width
= intern (":pt-width");
11627 staticpro (&QCpt_width
);
11628 QCpt_height
= intern (":pt-height");
11629 staticpro (&QCpt_height
);
11630 QCindex
= intern (":index");
11631 staticpro (&QCindex
);
11632 Qpbm
= intern ("pbm");
11636 Qxpm
= intern ("xpm");
11641 Qjpeg
= intern ("jpeg");
11642 staticpro (&Qjpeg
);
11646 Qtiff
= intern ("tiff");
11647 staticpro (&Qtiff
);
11651 Qgif
= intern ("gif");
11656 Qpng
= intern ("png");
11660 defsubr (&Sclear_image_cache
);
11661 defsubr (&Simage_size
);
11662 defsubr (&Simage_mask_p
);
11664 hourglass_atimer
= NULL
;
11665 hourglass_shown_p
= 0;
11667 defsubr (&Sx_show_tip
);
11668 defsubr (&Sx_hide_tip
);
11670 staticpro (&tip_timer
);
11672 staticpro (&tip_frame
);
11674 last_show_tip_args
= Qnil
;
11675 staticpro (&last_show_tip_args
);
11678 defsubr (&Sx_file_dialog
);
11686 image_types
= NULL
;
11687 Vimage_types
= Qnil
;
11689 define_image_type (&xbm_type
);
11690 define_image_type (&gs_type
);
11691 define_image_type (&pbm_type
);
11694 define_image_type (&xpm_type
);
11698 define_image_type (&jpeg_type
);
11702 define_image_type (&tiff_type
);
11706 define_image_type (&gif_type
);
11710 define_image_type (&png_type
);
11714 #endif /* HAVE_X_WINDOWS */