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
),
3981 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3987 /* Free what was was allocated in x_make_gc. */
3993 Display
*dpy
= FRAME_X_DISPLAY (f
);
3997 if (f
->output_data
.x
->normal_gc
)
3999 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
4000 f
->output_data
.x
->normal_gc
= 0;
4003 if (f
->output_data
.x
->reverse_gc
)
4005 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4006 f
->output_data
.x
->reverse_gc
= 0;
4009 if (f
->output_data
.x
->cursor_gc
)
4011 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4012 f
->output_data
.x
->cursor_gc
= 0;
4015 if (f
->output_data
.x
->border_tile
)
4017 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4018 f
->output_data
.x
->border_tile
= 0;
4025 /* Handler for signals raised during x_create_frame and
4026 x_create_top_frame. FRAME is the frame which is partially
4030 unwind_create_frame (frame
)
4033 struct frame
*f
= XFRAME (frame
);
4035 /* If frame is ``official'', nothing to do. */
4036 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4039 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4042 x_free_frame_resources (f
);
4044 /* Check that reference counts are indeed correct. */
4045 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4046 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4054 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4056 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
4057 Returns an Emacs frame object.\n\
4058 ALIST is an alist of frame parameters.\n\
4059 If the parameters specify that the frame should not have a minibuffer,\n\
4060 and do not specify a specific minibuffer window to use,\n\
4061 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4062 be shared by the new frame.\n\
4064 This function is an internal primitive--use `make-frame' instead.")
4069 Lisp_Object frame
, tem
;
4071 int minibuffer_only
= 0;
4072 long window_prompting
= 0;
4074 int count
= BINDING_STACK_SIZE ();
4075 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4076 Lisp_Object display
;
4077 struct x_display_info
*dpyinfo
= NULL
;
4083 /* Use this general default value to start with
4084 until we know if this frame has a specified name. */
4085 Vx_resource_name
= Vinvocation_name
;
4087 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4088 if (EQ (display
, Qunbound
))
4090 dpyinfo
= check_x_display_info (display
);
4092 kb
= dpyinfo
->kboard
;
4094 kb
= &the_only_kboard
;
4097 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4099 && ! EQ (name
, Qunbound
)
4101 error ("Invalid frame name--not a string or nil");
4104 Vx_resource_name
= name
;
4106 /* See if parent window is specified. */
4107 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4108 if (EQ (parent
, Qunbound
))
4110 if (! NILP (parent
))
4111 CHECK_NUMBER (parent
, 0);
4113 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4114 /* No need to protect DISPLAY because that's not used after passing
4115 it to make_frame_without_minibuffer. */
4117 GCPRO4 (parms
, parent
, name
, frame
);
4118 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4120 if (EQ (tem
, Qnone
) || NILP (tem
))
4121 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4122 else if (EQ (tem
, Qonly
))
4124 f
= make_minibuffer_frame ();
4125 minibuffer_only
= 1;
4127 else if (WINDOWP (tem
))
4128 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4132 XSETFRAME (frame
, f
);
4134 /* Note that X Windows does support scroll bars. */
4135 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4137 f
->output_method
= output_x_window
;
4138 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4139 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4140 f
->output_data
.x
->icon_bitmap
= -1;
4141 f
->output_data
.x
->fontset
= -1;
4142 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4143 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4144 record_unwind_protect (unwind_create_frame
, frame
);
4147 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4149 if (! STRINGP (f
->icon_name
))
4150 f
->icon_name
= Qnil
;
4152 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4154 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4155 dpyinfo_refcount
= dpyinfo
->reference_count
;
4156 #endif /* GLYPH_DEBUG */
4158 FRAME_KBOARD (f
) = kb
;
4161 /* These colors will be set anyway later, but it's important
4162 to get the color reference counts right, so initialize them! */
4165 struct gcpro gcpro1
;
4167 black
= build_string ("black");
4169 f
->output_data
.x
->foreground_pixel
4170 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4171 f
->output_data
.x
->background_pixel
4172 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4173 f
->output_data
.x
->cursor_pixel
4174 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4175 f
->output_data
.x
->cursor_foreground_pixel
4176 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4177 f
->output_data
.x
->border_pixel
4178 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4179 f
->output_data
.x
->mouse_pixel
4180 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4184 /* Specify the parent under which to make this X window. */
4188 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4189 f
->output_data
.x
->explicit_parent
= 1;
4193 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4194 f
->output_data
.x
->explicit_parent
= 0;
4197 /* Set the name; the functions to which we pass f expect the name to
4199 if (EQ (name
, Qunbound
) || NILP (name
))
4201 f
->name
= build_string (dpyinfo
->x_id_name
);
4202 f
->explicit_name
= 0;
4207 f
->explicit_name
= 1;
4208 /* use the frame's title when getting resources for this frame. */
4209 specbind (Qx_resource_name
, name
);
4212 /* Extract the window parameters from the supplied values
4213 that are needed to determine window geometry. */
4217 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4220 /* First, try whatever font the caller has specified. */
4223 tem
= Fquery_fontset (font
, Qnil
);
4225 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4227 font
= x_new_font (f
, XSTRING (font
)->data
);
4230 /* Try out a font which we hope has bold and italic variations. */
4231 if (!STRINGP (font
))
4232 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4233 if (!STRINGP (font
))
4234 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4235 if (! STRINGP (font
))
4236 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4237 if (! STRINGP (font
))
4238 /* This was formerly the first thing tried, but it finds too many fonts
4239 and takes too long. */
4240 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4241 /* If those didn't work, look for something which will at least work. */
4242 if (! STRINGP (font
))
4243 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4245 if (! STRINGP (font
))
4246 font
= build_string ("fixed");
4248 x_default_parameter (f
, parms
, Qfont
, font
,
4249 "font", "Font", RES_TYPE_STRING
);
4253 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4254 whereby it fails to get any font. */
4255 xlwmenu_default_font
= f
->output_data
.x
->font
;
4258 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4259 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4261 /* This defaults to 2 in order to match xterm. We recognize either
4262 internalBorderWidth or internalBorder (which is what xterm calls
4264 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4268 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4269 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4270 if (! EQ (value
, Qunbound
))
4271 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4274 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4275 "internalBorderWidth", "internalBorderWidth",
4277 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4278 "verticalScrollBars", "ScrollBars",
4281 /* Also do the stuff which must be set before the window exists. */
4282 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4283 "foreground", "Foreground", RES_TYPE_STRING
);
4284 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4285 "background", "Background", RES_TYPE_STRING
);
4286 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4287 "pointerColor", "Foreground", RES_TYPE_STRING
);
4288 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4289 "cursorColor", "Foreground", RES_TYPE_STRING
);
4290 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4291 "borderColor", "BorderColor", RES_TYPE_STRING
);
4292 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4293 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4294 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4295 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4297 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4298 "scrollBarForeground",
4299 "ScrollBarForeground", 1);
4300 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4301 "scrollBarBackground",
4302 "ScrollBarBackground", 0);
4304 /* Init faces before x_default_parameter is called for scroll-bar
4305 parameters because that function calls x_set_scroll_bar_width,
4306 which calls change_frame_size, which calls Fset_window_buffer,
4307 which runs hooks, which call Fvertical_motion. At the end, we
4308 end up in init_iterator with a null face cache, which should not
4310 init_frame_faces (f
);
4312 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4313 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4314 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4315 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4316 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4317 "bufferPredicate", "BufferPredicate",
4319 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4320 "title", "Title", RES_TYPE_STRING
);
4322 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4324 /* Add the tool-bar height to the initial frame height so that the
4325 user gets a text display area of the size he specified with -g or
4326 via .Xdefaults. Later changes of the tool-bar height don't
4327 change the frame size. This is done so that users can create
4328 tall Emacs frames without having to guess how tall the tool-bar
4330 if (FRAME_TOOL_BAR_LINES (f
))
4332 int margin
, relief
, bar_height
;
4334 relief
= (tool_bar_button_relief
> 0
4335 ? tool_bar_button_relief
4336 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4338 if (INTEGERP (Vtool_bar_button_margin
)
4339 && XINT (Vtool_bar_button_margin
) > 0)
4340 margin
= XFASTINT (Vtool_bar_button_margin
);
4341 else if (CONSP (Vtool_bar_button_margin
)
4342 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4343 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4344 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4348 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4349 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4352 /* Compute the size of the X window. */
4353 window_prompting
= x_figure_window_size (f
, parms
);
4355 if (window_prompting
& XNegative
)
4357 if (window_prompting
& YNegative
)
4358 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4360 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4364 if (window_prompting
& YNegative
)
4365 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4367 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4370 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4372 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4373 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4375 /* Create the X widget or window. */
4376 #ifdef USE_X_TOOLKIT
4377 x_window (f
, window_prompting
, minibuffer_only
);
4385 /* Now consider the frame official. */
4386 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4387 Vframe_list
= Fcons (frame
, Vframe_list
);
4389 /* We need to do this after creating the X window, so that the
4390 icon-creation functions can say whose icon they're describing. */
4391 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4392 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4394 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4395 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4396 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4397 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4398 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4399 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4400 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4401 "scrollBarWidth", "ScrollBarWidth",
4404 /* Dimensions, especially f->height, must be done via change_frame_size.
4405 Change will not be effected unless different from the current
4411 SET_FRAME_WIDTH (f
, 0);
4412 change_frame_size (f
, height
, width
, 1, 0, 0);
4414 /* Set up faces after all frame parameters are known. This call
4415 also merges in face attributes specified for new frames. If we
4416 don't do this, the `menu' face for instance won't have the right
4417 colors, and the menu bar won't appear in the specified colors for
4419 call1 (Qface_set_after_frame_default
, frame
);
4421 #ifdef USE_X_TOOLKIT
4422 /* Create the menu bar. */
4423 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4425 /* If this signals an error, we haven't set size hints for the
4426 frame and we didn't make it visible. */
4427 initialize_frame_menubar (f
);
4429 /* This is a no-op, except under Motif where it arranges the
4430 main window for the widgets on it. */
4431 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4432 f
->output_data
.x
->menubar_widget
,
4433 f
->output_data
.x
->edit_widget
);
4435 #endif /* USE_X_TOOLKIT */
4437 /* Tell the server what size and position, etc, we want, and how
4438 badly we want them. This should be done after we have the menu
4439 bar so that its size can be taken into account. */
4441 x_wm_set_size_hint (f
, window_prompting
, 0);
4444 /* Make the window appear on the frame and enable display, unless
4445 the caller says not to. However, with explicit parent, Emacs
4446 cannot control visibility, so don't try. */
4447 if (! f
->output_data
.x
->explicit_parent
)
4449 Lisp_Object visibility
;
4451 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4453 if (EQ (visibility
, Qunbound
))
4456 if (EQ (visibility
, Qicon
))
4457 x_iconify_frame (f
);
4458 else if (! NILP (visibility
))
4459 x_make_frame_visible (f
);
4461 /* Must have been Qnil. */
4467 /* Make sure windows on this frame appear in calls to next-window
4468 and similar functions. */
4469 Vwindow_list
= Qnil
;
4471 return unbind_to (count
, frame
);
4475 /* FRAME is used only to get a handle on the X display. We don't pass the
4476 display info directly because we're called from frame.c, which doesn't
4477 know about that structure. */
4480 x_get_focus_frame (frame
)
4481 struct frame
*frame
;
4483 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4485 if (! dpyinfo
->x_focus_frame
)
4488 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4493 /* In certain situations, when the window manager follows a
4494 click-to-focus policy, there seems to be no way around calling
4495 XSetInputFocus to give another frame the input focus .
4497 In an ideal world, XSetInputFocus should generally be avoided so
4498 that applications don't interfere with the window manager's focus
4499 policy. But I think it's okay to use when it's clearly done
4500 following a user-command. */
4502 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4503 "Set the input focus to FRAME.\n\
4504 FRAME nil means use the selected frame.")
4508 struct frame
*f
= check_x_frame (frame
);
4509 Display
*dpy
= FRAME_X_DISPLAY (f
);
4513 count
= x_catch_errors (dpy
);
4514 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4515 RevertToParent
, CurrentTime
);
4516 x_uncatch_errors (dpy
, count
);
4523 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4524 "Internal function called by `color-defined-p', which see.")
4526 Lisp_Object color
, frame
;
4529 FRAME_PTR f
= check_x_frame (frame
);
4531 CHECK_STRING (color
, 1);
4533 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4539 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4540 "Internal function called by `color-values', which see.")
4542 Lisp_Object color
, frame
;
4545 FRAME_PTR f
= check_x_frame (frame
);
4547 CHECK_STRING (color
, 1);
4549 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4553 rgb
[0] = make_number (foo
.red
);
4554 rgb
[1] = make_number (foo
.green
);
4555 rgb
[2] = make_number (foo
.blue
);
4556 return Flist (3, rgb
);
4562 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4563 "Internal function called by `display-color-p', which see.")
4565 Lisp_Object display
;
4567 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4569 if (dpyinfo
->n_planes
<= 2)
4572 switch (dpyinfo
->visual
->class)
4585 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4587 "Return t if the X display supports shades of gray.\n\
4588 Note that color displays do support shades of gray.\n\
4589 The optional argument DISPLAY specifies which display to ask about.\n\
4590 DISPLAY should be either a frame or a display name (a string).\n\
4591 If omitted or nil, that stands for the selected frame's display.")
4593 Lisp_Object display
;
4595 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4597 if (dpyinfo
->n_planes
<= 1)
4600 switch (dpyinfo
->visual
->class)
4615 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4617 "Returns the width in pixels of the X display DISPLAY.\n\
4618 The optional argument DISPLAY specifies which display to ask about.\n\
4619 DISPLAY should be either a frame or a display name (a string).\n\
4620 If omitted or nil, that stands for the selected frame's display.")
4622 Lisp_Object display
;
4624 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4626 return make_number (dpyinfo
->width
);
4629 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4630 Sx_display_pixel_height
, 0, 1, 0,
4631 "Returns the height in pixels of the X display DISPLAY.\n\
4632 The optional argument DISPLAY specifies which display to ask about.\n\
4633 DISPLAY should be either a frame or a display name (a string).\n\
4634 If omitted or nil, that stands for the selected frame's display.")
4636 Lisp_Object display
;
4638 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4640 return make_number (dpyinfo
->height
);
4643 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4645 "Returns the number of bitplanes of the X display DISPLAY.\n\
4646 The optional argument DISPLAY specifies which display to ask about.\n\
4647 DISPLAY should be either a frame or a display name (a string).\n\
4648 If omitted or nil, that stands for the selected frame's display.")
4650 Lisp_Object display
;
4652 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4654 return make_number (dpyinfo
->n_planes
);
4657 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4659 "Returns the number of color cells of the X display DISPLAY.\n\
4660 The optional argument DISPLAY specifies which display to ask about.\n\
4661 DISPLAY should be either a frame or a display name (a string).\n\
4662 If omitted or nil, that stands for the selected frame's display.")
4664 Lisp_Object display
;
4666 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4668 return make_number (DisplayCells (dpyinfo
->display
,
4669 XScreenNumberOfScreen (dpyinfo
->screen
)));
4672 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4673 Sx_server_max_request_size
,
4675 "Returns the maximum request size of the X server of display DISPLAY.\n\
4676 The optional argument DISPLAY specifies which display to ask about.\n\
4677 DISPLAY should be either a frame or a display name (a string).\n\
4678 If omitted or nil, that stands for the selected frame's display.")
4680 Lisp_Object display
;
4682 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4684 return make_number (MAXREQUEST (dpyinfo
->display
));
4687 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4688 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4689 The optional argument DISPLAY specifies which display to ask about.\n\
4690 DISPLAY should be either a frame or a display name (a string).\n\
4691 If omitted or nil, that stands for the selected frame's display.")
4693 Lisp_Object display
;
4695 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4696 char *vendor
= ServerVendor (dpyinfo
->display
);
4698 if (! vendor
) vendor
= "";
4699 return build_string (vendor
);
4702 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4703 "Returns the version numbers of the X server of display DISPLAY.\n\
4704 The value is a list of three integers: the major and minor\n\
4705 version numbers of the X Protocol in use, and the vendor-specific release\n\
4706 number. See also the function `x-server-vendor'.\n\n\
4707 The optional argument DISPLAY specifies which display to ask about.\n\
4708 DISPLAY should be either a frame or a display name (a string).\n\
4709 If omitted or nil, that stands for the selected frame's display.")
4711 Lisp_Object display
;
4713 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4714 Display
*dpy
= dpyinfo
->display
;
4716 return Fcons (make_number (ProtocolVersion (dpy
)),
4717 Fcons (make_number (ProtocolRevision (dpy
)),
4718 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4721 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4722 "Returns the number of screens on the X server of display DISPLAY.\n\
4723 The optional argument DISPLAY specifies which display to ask about.\n\
4724 DISPLAY should be either a frame or a display name (a string).\n\
4725 If omitted or nil, that stands for the selected frame's display.")
4727 Lisp_Object display
;
4729 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4731 return make_number (ScreenCount (dpyinfo
->display
));
4734 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4735 "Returns the height in millimeters of the X display DISPLAY.\n\
4736 The optional argument DISPLAY specifies which display to ask about.\n\
4737 DISPLAY should be either a frame or a display name (a string).\n\
4738 If omitted or nil, that stands for the selected frame's display.")
4740 Lisp_Object display
;
4742 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4744 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4747 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4748 "Returns the width in millimeters of the X display DISPLAY.\n\
4749 The optional argument DISPLAY specifies which display to ask about.\n\
4750 DISPLAY should be either a frame or a display name (a string).\n\
4751 If omitted or nil, that stands for the selected frame's display.")
4753 Lisp_Object display
;
4755 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4757 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4760 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4761 Sx_display_backing_store
, 0, 1, 0,
4762 "Returns an indication of whether X display DISPLAY does backing store.\n\
4763 The value may be `always', `when-mapped', or `not-useful'.\n\
4764 The optional argument DISPLAY specifies which display to ask about.\n\
4765 DISPLAY should be either a frame or a display name (a string).\n\
4766 If omitted or nil, that stands for the selected frame's display.")
4768 Lisp_Object display
;
4770 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4773 switch (DoesBackingStore (dpyinfo
->screen
))
4776 result
= intern ("always");
4780 result
= intern ("when-mapped");
4784 result
= intern ("not-useful");
4788 error ("Strange value for BackingStore parameter of screen");
4795 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4796 Sx_display_visual_class
, 0, 1, 0,
4797 "Returns the visual class of the X display DISPLAY.\n\
4798 The value is one of the symbols `static-gray', `gray-scale',\n\
4799 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4800 The optional argument DISPLAY specifies which display to ask about.\n\
4801 DISPLAY should be either a frame or a display name (a string).\n\
4802 If omitted or nil, that stands for the selected frame's display.")
4804 Lisp_Object display
;
4806 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4809 switch (dpyinfo
->visual
->class)
4812 result
= intern ("static-gray");
4815 result
= intern ("gray-scale");
4818 result
= intern ("static-color");
4821 result
= intern ("pseudo-color");
4824 result
= intern ("true-color");
4827 result
= intern ("direct-color");
4830 error ("Display has an unknown visual class");
4837 DEFUN ("x-display-save-under", Fx_display_save_under
,
4838 Sx_display_save_under
, 0, 1, 0,
4839 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4840 The optional argument DISPLAY specifies which display to ask about.\n\
4841 DISPLAY should be either a frame or a display name (a string).\n\
4842 If omitted or nil, that stands for the selected frame's display.")
4844 Lisp_Object display
;
4846 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4848 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4856 register struct frame
*f
;
4858 return PIXEL_WIDTH (f
);
4863 register struct frame
*f
;
4865 return PIXEL_HEIGHT (f
);
4870 register struct frame
*f
;
4872 return FONT_WIDTH (f
->output_data
.x
->font
);
4877 register struct frame
*f
;
4879 return f
->output_data
.x
->line_height
;
4884 register struct frame
*f
;
4886 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4891 /************************************************************************
4893 ************************************************************************/
4896 /* Mapping visual names to visuals. */
4898 static struct visual_class
4905 {"StaticGray", StaticGray
},
4906 {"GrayScale", GrayScale
},
4907 {"StaticColor", StaticColor
},
4908 {"PseudoColor", PseudoColor
},
4909 {"TrueColor", TrueColor
},
4910 {"DirectColor", DirectColor
},
4915 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4917 /* Value is the screen number of screen SCR. This is a substitute for
4918 the X function with the same name when that doesn't exist. */
4921 XScreenNumberOfScreen (scr
)
4922 register Screen
*scr
;
4924 Display
*dpy
= scr
->display
;
4927 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4928 if (scr
== dpy
->screens
[i
])
4934 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4937 /* Select the visual that should be used on display DPYINFO. Set
4938 members of DPYINFO appropriately. Called from x_term_init. */
4941 select_visual (dpyinfo
)
4942 struct x_display_info
*dpyinfo
;
4944 Display
*dpy
= dpyinfo
->display
;
4945 Screen
*screen
= dpyinfo
->screen
;
4948 /* See if a visual is specified. */
4949 value
= display_x_get_resource (dpyinfo
,
4950 build_string ("visualClass"),
4951 build_string ("VisualClass"),
4953 if (STRINGP (value
))
4955 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4956 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4957 depth, a decimal number. NAME is compared with case ignored. */
4958 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4963 strcpy (s
, XSTRING (value
)->data
);
4964 dash
= index (s
, '-');
4967 dpyinfo
->n_planes
= atoi (dash
+ 1);
4971 /* We won't find a matching visual with depth 0, so that
4972 an error will be printed below. */
4973 dpyinfo
->n_planes
= 0;
4975 /* Determine the visual class. */
4976 for (i
= 0; visual_classes
[i
].name
; ++i
)
4977 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4979 class = visual_classes
[i
].class;
4983 /* Look up a matching visual for the specified class. */
4985 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4986 dpyinfo
->n_planes
, class, &vinfo
))
4987 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4989 dpyinfo
->visual
= vinfo
.visual
;
4994 XVisualInfo
*vinfo
, vinfo_template
;
4996 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
4999 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
5001 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
5003 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5004 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
5005 &vinfo_template
, &n_visuals
);
5007 fatal ("Can't get proper X visual info");
5009 dpyinfo
->n_planes
= vinfo
->depth
;
5010 XFree ((char *) vinfo
);
5015 /* Return the X display structure for the display named NAME.
5016 Open a new connection if necessary. */
5018 struct x_display_info
*
5019 x_display_info_for_name (name
)
5023 struct x_display_info
*dpyinfo
;
5025 CHECK_STRING (name
, 0);
5027 if (! EQ (Vwindow_system
, intern ("x")))
5028 error ("Not using X Windows");
5030 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5032 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5035 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5040 /* Use this general default value to start with. */
5041 Vx_resource_name
= Vinvocation_name
;
5043 validate_x_resource_name ();
5045 dpyinfo
= x_term_init (name
, (char *)0,
5046 (char *) XSTRING (Vx_resource_name
)->data
);
5049 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5052 XSETFASTINT (Vwindow_system_version
, 11);
5058 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5059 1, 3, 0, "Open a connection to an X server.\n\
5060 DISPLAY is the name of the display to connect to.\n\
5061 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5062 If the optional third arg MUST-SUCCEED is non-nil,\n\
5063 terminate Emacs if we can't open the connection.")
5064 (display
, xrm_string
, must_succeed
)
5065 Lisp_Object display
, xrm_string
, must_succeed
;
5067 unsigned char *xrm_option
;
5068 struct x_display_info
*dpyinfo
;
5070 CHECK_STRING (display
, 0);
5071 if (! NILP (xrm_string
))
5072 CHECK_STRING (xrm_string
, 1);
5074 if (! EQ (Vwindow_system
, intern ("x")))
5075 error ("Not using X Windows");
5077 if (! NILP (xrm_string
))
5078 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5080 xrm_option
= (unsigned char *) 0;
5082 validate_x_resource_name ();
5084 /* This is what opens the connection and sets x_current_display.
5085 This also initializes many symbols, such as those used for input. */
5086 dpyinfo
= x_term_init (display
, xrm_option
,
5087 (char *) XSTRING (Vx_resource_name
)->data
);
5091 if (!NILP (must_succeed
))
5092 fatal ("Cannot connect to X server %s.\n\
5093 Check the DISPLAY environment variable or use `-d'.\n\
5094 Also use the `xhost' program to verify that it is set to permit\n\
5095 connections from your machine.\n",
5096 XSTRING (display
)->data
);
5098 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5103 XSETFASTINT (Vwindow_system_version
, 11);
5107 DEFUN ("x-close-connection", Fx_close_connection
,
5108 Sx_close_connection
, 1, 1, 0,
5109 "Close the connection to DISPLAY's X server.\n\
5110 For DISPLAY, specify either a frame or a display name (a string).\n\
5111 If DISPLAY is nil, that stands for the selected frame's display.")
5113 Lisp_Object display
;
5115 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5118 if (dpyinfo
->reference_count
> 0)
5119 error ("Display still has frames on it");
5122 /* Free the fonts in the font table. */
5123 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5124 if (dpyinfo
->font_table
[i
].name
)
5126 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5127 xfree (dpyinfo
->font_table
[i
].full_name
);
5128 xfree (dpyinfo
->font_table
[i
].name
);
5129 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5132 x_destroy_all_bitmaps (dpyinfo
);
5133 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5135 #ifdef USE_X_TOOLKIT
5136 XtCloseDisplay (dpyinfo
->display
);
5138 XCloseDisplay (dpyinfo
->display
);
5141 x_delete_display (dpyinfo
);
5147 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5148 "Return the list of display names that Emacs has connections to.")
5151 Lisp_Object tail
, result
;
5154 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5155 result
= Fcons (XCAR (XCAR (tail
)), result
);
5160 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5161 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5162 If ON is nil, allow buffering of requests.\n\
5163 Turning on synchronization prohibits the Xlib routines from buffering\n\
5164 requests and seriously degrades performance, but makes debugging much\n\
5166 The optional second argument DISPLAY specifies which display to act on.\n\
5167 DISPLAY should be either a frame or a display name (a string).\n\
5168 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5170 Lisp_Object display
, on
;
5172 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5174 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5179 /* Wait for responses to all X commands issued so far for frame F. */
5186 XSync (FRAME_X_DISPLAY (f
), False
);
5191 /***********************************************************************
5193 ***********************************************************************/
5195 /* Value is the number of elements of vector VECTOR. */
5197 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5199 /* List of supported image types. Use define_image_type to add new
5200 types. Use lookup_image_type to find a type for a given symbol. */
5202 static struct image_type
*image_types
;
5204 /* The symbol `image' which is the car of the lists used to represent
5207 extern Lisp_Object Qimage
;
5209 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5215 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5216 extern Lisp_Object QCdata
;
5217 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5218 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5219 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5221 /* Other symbols. */
5223 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5225 /* Time in seconds after which images should be removed from the cache
5226 if not displayed. */
5228 Lisp_Object Vimage_cache_eviction_delay
;
5230 /* Function prototypes. */
5232 static void define_image_type
P_ ((struct image_type
*type
));
5233 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5234 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5235 static void x_laplace
P_ ((struct frame
*, struct image
*));
5236 static void x_emboss
P_ ((struct frame
*, struct image
*));
5237 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5241 /* Define a new image type from TYPE. This adds a copy of TYPE to
5242 image_types and adds the symbol *TYPE->type to Vimage_types. */
5245 define_image_type (type
)
5246 struct image_type
*type
;
5248 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5249 The initialized data segment is read-only. */
5250 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5251 bcopy (type
, p
, sizeof *p
);
5252 p
->next
= image_types
;
5254 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5258 /* Look up image type SYMBOL, and return a pointer to its image_type
5259 structure. Value is null if SYMBOL is not a known image type. */
5261 static INLINE
struct image_type
*
5262 lookup_image_type (symbol
)
5265 struct image_type
*type
;
5267 for (type
= image_types
; type
; type
= type
->next
)
5268 if (EQ (symbol
, *type
->type
))
5275 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5276 valid image specification is a list whose car is the symbol
5277 `image', and whose rest is a property list. The property list must
5278 contain a value for key `:type'. That value must be the name of a
5279 supported image type. The rest of the property list depends on the
5283 valid_image_p (object
)
5288 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5290 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5291 struct image_type
*type
= lookup_image_type (symbol
);
5294 valid_p
= type
->valid_p (object
);
5301 /* Log error message with format string FORMAT and argument ARG.
5302 Signaling an error, e.g. when an image cannot be loaded, is not a
5303 good idea because this would interrupt redisplay, and the error
5304 message display would lead to another redisplay. This function
5305 therefore simply displays a message. */
5308 image_error (format
, arg1
, arg2
)
5310 Lisp_Object arg1
, arg2
;
5312 add_to_log (format
, arg1
, arg2
);
5317 /***********************************************************************
5318 Image specifications
5319 ***********************************************************************/
5321 enum image_value_type
5323 IMAGE_DONT_CHECK_VALUE_TYPE
,
5326 IMAGE_POSITIVE_INTEGER_VALUE
,
5327 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5328 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5330 IMAGE_INTEGER_VALUE
,
5331 IMAGE_FUNCTION_VALUE
,
5336 /* Structure used when parsing image specifications. */
5338 struct image_keyword
5340 /* Name of keyword. */
5343 /* The type of value allowed. */
5344 enum image_value_type type
;
5346 /* Non-zero means key must be present. */
5349 /* Used to recognize duplicate keywords in a property list. */
5352 /* The value that was found. */
5357 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5359 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5362 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5363 has the format (image KEYWORD VALUE ...). One of the keyword/
5364 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5365 image_keywords structures of size NKEYWORDS describing other
5366 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5369 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5371 struct image_keyword
*keywords
;
5378 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5381 plist
= XCDR (spec
);
5382 while (CONSP (plist
))
5384 Lisp_Object key
, value
;
5386 /* First element of a pair must be a symbol. */
5388 plist
= XCDR (plist
);
5392 /* There must follow a value. */
5395 value
= XCAR (plist
);
5396 plist
= XCDR (plist
);
5398 /* Find key in KEYWORDS. Error if not found. */
5399 for (i
= 0; i
< nkeywords
; ++i
)
5400 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5406 /* Record that we recognized the keyword. If a keywords
5407 was found more than once, it's an error. */
5408 keywords
[i
].value
= value
;
5409 ++keywords
[i
].count
;
5411 if (keywords
[i
].count
> 1)
5414 /* Check type of value against allowed type. */
5415 switch (keywords
[i
].type
)
5417 case IMAGE_STRING_VALUE
:
5418 if (!STRINGP (value
))
5422 case IMAGE_SYMBOL_VALUE
:
5423 if (!SYMBOLP (value
))
5427 case IMAGE_POSITIVE_INTEGER_VALUE
:
5428 if (!INTEGERP (value
) || XINT (value
) <= 0)
5432 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5433 if (INTEGERP (value
) && XINT (value
) >= 0)
5436 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5437 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5441 case IMAGE_ASCENT_VALUE
:
5442 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5444 else if (INTEGERP (value
)
5445 && XINT (value
) >= 0
5446 && XINT (value
) <= 100)
5450 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5451 if (!INTEGERP (value
) || XINT (value
) < 0)
5455 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5458 case IMAGE_FUNCTION_VALUE
:
5459 value
= indirect_function (value
);
5461 || COMPILEDP (value
)
5462 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5466 case IMAGE_NUMBER_VALUE
:
5467 if (!INTEGERP (value
) && !FLOATP (value
))
5471 case IMAGE_INTEGER_VALUE
:
5472 if (!INTEGERP (value
))
5476 case IMAGE_BOOL_VALUE
:
5477 if (!NILP (value
) && !EQ (value
, Qt
))
5486 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5490 /* Check that all mandatory fields are present. */
5491 for (i
= 0; i
< nkeywords
; ++i
)
5492 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5495 return NILP (plist
);
5499 /* Return the value of KEY in image specification SPEC. Value is nil
5500 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5501 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5504 image_spec_value (spec
, key
, found
)
5505 Lisp_Object spec
, key
;
5510 xassert (valid_image_p (spec
));
5512 for (tail
= XCDR (spec
);
5513 CONSP (tail
) && CONSP (XCDR (tail
));
5514 tail
= XCDR (XCDR (tail
)))
5516 if (EQ (XCAR (tail
), key
))
5520 return XCAR (XCDR (tail
));
5530 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5531 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5532 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5533 size in canonical character units.\n\
5534 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5535 or omitted means use the selected frame.")
5536 (spec
, pixels
, frame
)
5537 Lisp_Object spec
, pixels
, frame
;
5542 if (valid_image_p (spec
))
5544 struct frame
*f
= check_x_frame (frame
);
5545 int id
= lookup_image (f
, spec
);
5546 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5547 int width
= img
->width
+ 2 * img
->hmargin
;
5548 int height
= img
->height
+ 2 * img
->vmargin
;
5551 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5552 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5554 size
= Fcons (make_number (width
), make_number (height
));
5557 error ("Invalid image specification");
5563 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5564 "Return t if image SPEC has a mask bitmap.\n\
5565 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5566 or omitted means use the selected frame.")
5568 Lisp_Object spec
, frame
;
5573 if (valid_image_p (spec
))
5575 struct frame
*f
= check_x_frame (frame
);
5576 int id
= lookup_image (f
, spec
);
5577 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5582 error ("Invalid image specification");
5589 /***********************************************************************
5590 Image type independent image structures
5591 ***********************************************************************/
5593 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5594 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5597 /* Allocate and return a new image structure for image specification
5598 SPEC. SPEC has a hash value of HASH. */
5600 static struct image
*
5601 make_image (spec
, hash
)
5605 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5607 xassert (valid_image_p (spec
));
5608 bzero (img
, sizeof *img
);
5609 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5610 xassert (img
->type
!= NULL
);
5612 img
->data
.lisp_val
= Qnil
;
5613 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5619 /* Free image IMG which was used on frame F, including its resources. */
5628 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5630 /* Remove IMG from the hash table of its cache. */
5632 img
->prev
->next
= img
->next
;
5634 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5637 img
->next
->prev
= img
->prev
;
5639 c
->images
[img
->id
] = NULL
;
5641 /* Free resources, then free IMG. */
5642 img
->type
->free (f
, img
);
5648 /* Prepare image IMG for display on frame F. Must be called before
5649 drawing an image. */
5652 prepare_image_for_display (f
, img
)
5658 /* We're about to display IMG, so set its timestamp to `now'. */
5660 img
->timestamp
= EMACS_SECS (t
);
5662 /* If IMG doesn't have a pixmap yet, load it now, using the image
5663 type dependent loader function. */
5664 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5665 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5669 /* Value is the number of pixels for the ascent of image IMG when
5670 drawn in face FACE. */
5673 image_ascent (img
, face
)
5677 int height
= img
->height
+ img
->vmargin
;
5680 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5683 /* This expression is arranged so that if the image can't be
5684 exactly centered, it will be moved slightly up. This is
5685 because a typical font is `top-heavy' (due to the presence
5686 uppercase letters), so the image placement should err towards
5687 being top-heavy too. It also just generally looks better. */
5688 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5690 ascent
= height
/ 2;
5693 ascent
= height
* img
->ascent
/ 100.0;
5700 /***********************************************************************
5701 Helper functions for X image types
5702 ***********************************************************************/
5704 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5706 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5707 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5709 Lisp_Object color_name
,
5710 unsigned long dflt
));
5713 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5714 free the pixmap if any. MASK_P non-zero means clear the mask
5715 pixmap if any. COLORS_P non-zero means free colors allocated for
5716 the image, if any. */
5719 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5722 int pixmap_p
, mask_p
, colors_p
;
5724 if (pixmap_p
&& img
->pixmap
)
5726 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5730 if (mask_p
&& img
->mask
)
5732 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5736 if (colors_p
&& img
->ncolors
)
5738 x_free_colors (f
, img
->colors
, img
->ncolors
);
5739 xfree (img
->colors
);
5745 /* Free X resources of image IMG which is used on frame F. */
5748 x_clear_image (f
, img
)
5753 x_clear_image_1 (f
, img
, 1, 1, 1);
5758 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5759 cannot be allocated, use DFLT. Add a newly allocated color to
5760 IMG->colors, so that it can be freed again. Value is the pixel
5763 static unsigned long
5764 x_alloc_image_color (f
, img
, color_name
, dflt
)
5767 Lisp_Object color_name
;
5771 unsigned long result
;
5773 xassert (STRINGP (color_name
));
5775 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5777 /* This isn't called frequently so we get away with simply
5778 reallocating the color vector to the needed size, here. */
5781 (unsigned long *) xrealloc (img
->colors
,
5782 img
->ncolors
* sizeof *img
->colors
);
5783 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5784 result
= color
.pixel
;
5794 /***********************************************************************
5796 ***********************************************************************/
5798 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5799 static void postprocess_image
P_ ((struct frame
*, struct image
*));
5802 /* Return a new, initialized image cache that is allocated from the
5803 heap. Call free_image_cache to free an image cache. */
5805 struct image_cache
*
5808 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5811 bzero (c
, sizeof *c
);
5813 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5814 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5815 c
->buckets
= (struct image
**) xmalloc (size
);
5816 bzero (c
->buckets
, size
);
5821 /* Free image cache of frame F. Be aware that X frames share images
5825 free_image_cache (f
)
5828 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5833 /* Cache should not be referenced by any frame when freed. */
5834 xassert (c
->refcount
== 0);
5836 for (i
= 0; i
< c
->used
; ++i
)
5837 free_image (f
, c
->images
[i
]);
5841 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5846 /* Clear image cache of frame F. FORCE_P non-zero means free all
5847 images. FORCE_P zero means clear only images that haven't been
5848 displayed for some time. Should be called from time to time to
5849 reduce the number of loaded images. If image-eviction-seconds is
5850 non-nil, this frees images in the cache which weren't displayed for
5851 at least that many seconds. */
5854 clear_image_cache (f
, force_p
)
5858 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5860 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5867 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5869 /* Block input so that we won't be interrupted by a SIGIO
5870 while being in an inconsistent state. */
5873 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5875 struct image
*img
= c
->images
[i
];
5877 && (force_p
|| img
->timestamp
< old
))
5879 free_image (f
, img
);
5884 /* We may be clearing the image cache because, for example,
5885 Emacs was iconified for a longer period of time. In that
5886 case, current matrices may still contain references to
5887 images freed above. So, clear these matrices. */
5890 Lisp_Object tail
, frame
;
5892 FOR_EACH_FRAME (tail
, frame
)
5894 struct frame
*f
= XFRAME (frame
);
5896 && FRAME_X_IMAGE_CACHE (f
) == c
)
5897 clear_current_matrices (f
);
5900 ++windows_or_buffers_changed
;
5908 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5910 "Clear the image cache of FRAME.\n\
5911 FRAME nil or omitted means use the selected frame.\n\
5912 FRAME t means clear the image caches of all frames.")
5920 FOR_EACH_FRAME (tail
, frame
)
5921 if (FRAME_X_P (XFRAME (frame
)))
5922 clear_image_cache (XFRAME (frame
), 1);
5925 clear_image_cache (check_x_frame (frame
), 1);
5931 /* Compute masks and transform image IMG on frame F, as specified
5932 by the image's specification, */
5935 postprocess_image (f
, img
)
5939 /* Manipulation of the image's mask. */
5942 Lisp_Object conversion
, spec
;
5947 /* `:heuristic-mask t'
5949 means build a mask heuristically.
5950 `:heuristic-mask (R G B)'
5951 `:mask (heuristic (R G B))'
5952 means build a mask from color (R G B) in the
5955 means remove a mask, if any. */
5957 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
5959 x_build_heuristic_mask (f
, img
, mask
);
5964 mask
= image_spec_value (spec
, QCmask
, &found_p
);
5966 if (EQ (mask
, Qheuristic
))
5967 x_build_heuristic_mask (f
, img
, Qt
);
5968 else if (CONSP (mask
)
5969 && EQ (XCAR (mask
), Qheuristic
))
5971 if (CONSP (XCDR (mask
)))
5972 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
5974 x_build_heuristic_mask (f
, img
, XCDR (mask
));
5976 else if (NILP (mask
) && found_p
&& img
->mask
)
5978 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5984 /* Should we apply an image transformation algorithm? */
5985 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
5986 if (EQ (conversion
, Qdisabled
))
5987 x_disable_image (f
, img
);
5988 else if (EQ (conversion
, Qlaplace
))
5990 else if (EQ (conversion
, Qemboss
))
5992 else if (CONSP (conversion
)
5993 && EQ (XCAR (conversion
), Qedge_detection
))
5996 tem
= XCDR (conversion
);
5998 x_edge_detection (f
, img
,
5999 Fplist_get (tem
, QCmatrix
),
6000 Fplist_get (tem
, QCcolor_adjustment
));
6006 /* Return the id of image with Lisp specification SPEC on frame F.
6007 SPEC must be a valid Lisp image specification (see valid_image_p). */
6010 lookup_image (f
, spec
)
6014 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6018 struct gcpro gcpro1
;
6021 /* F must be a window-system frame, and SPEC must be a valid image
6023 xassert (FRAME_WINDOW_P (f
));
6024 xassert (valid_image_p (spec
));
6028 /* Look up SPEC in the hash table of the image cache. */
6029 hash
= sxhash (spec
, 0);
6030 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6032 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6033 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6036 /* If not found, create a new image and cache it. */
6039 extern Lisp_Object Qpostscript
;
6042 img
= make_image (spec
, hash
);
6043 cache_image (f
, img
);
6044 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6046 /* If we can't load the image, and we don't have a width and
6047 height, use some arbitrary width and height so that we can
6048 draw a rectangle for it. */
6049 if (img
->load_failed_p
)
6053 value
= image_spec_value (spec
, QCwidth
, NULL
);
6054 img
->width
= (INTEGERP (value
)
6055 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6056 value
= image_spec_value (spec
, QCheight
, NULL
);
6057 img
->height
= (INTEGERP (value
)
6058 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6062 /* Handle image type independent image attributes
6063 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
6064 Lisp_Object ascent
, margin
, relief
;
6066 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6067 if (INTEGERP (ascent
))
6068 img
->ascent
= XFASTINT (ascent
);
6069 else if (EQ (ascent
, Qcenter
))
6070 img
->ascent
= CENTERED_IMAGE_ASCENT
;
6072 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6073 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6074 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
6075 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
6076 && INTEGERP (XCDR (margin
)))
6078 if (XINT (XCAR (margin
)) > 0)
6079 img
->hmargin
= XFASTINT (XCAR (margin
));
6080 if (XINT (XCDR (margin
)) > 0)
6081 img
->vmargin
= XFASTINT (XCDR (margin
));
6084 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6085 if (INTEGERP (relief
))
6087 img
->relief
= XINT (relief
);
6088 img
->hmargin
+= abs (img
->relief
);
6089 img
->vmargin
+= abs (img
->relief
);
6092 /* Do image transformations and compute masks, unless we
6093 don't have the image yet. */
6094 if (!EQ (*img
->type
->type
, Qpostscript
))
6095 postprocess_image (f
, img
);
6099 xassert (!interrupt_input_blocked
);
6102 /* We're using IMG, so set its timestamp to `now'. */
6103 EMACS_GET_TIME (now
);
6104 img
->timestamp
= EMACS_SECS (now
);
6108 /* Value is the image id. */
6113 /* Cache image IMG in the image cache of frame F. */
6116 cache_image (f
, img
)
6120 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6123 /* Find a free slot in c->images. */
6124 for (i
= 0; i
< c
->used
; ++i
)
6125 if (c
->images
[i
] == NULL
)
6128 /* If no free slot found, maybe enlarge c->images. */
6129 if (i
== c
->used
&& c
->used
== c
->size
)
6132 c
->images
= (struct image
**) xrealloc (c
->images
,
6133 c
->size
* sizeof *c
->images
);
6136 /* Add IMG to c->images, and assign IMG an id. */
6142 /* Add IMG to the cache's hash table. */
6143 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6144 img
->next
= c
->buckets
[i
];
6146 img
->next
->prev
= img
;
6148 c
->buckets
[i
] = img
;
6152 /* Call FN on every image in the image cache of frame F. Used to mark
6153 Lisp Objects in the image cache. */
6156 forall_images_in_image_cache (f
, fn
)
6158 void (*fn
) P_ ((struct image
*img
));
6160 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6162 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6166 for (i
= 0; i
< c
->used
; ++i
)
6175 /***********************************************************************
6177 ***********************************************************************/
6179 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6180 XImage
**, Pixmap
*));
6181 static void x_destroy_x_image
P_ ((XImage
*));
6182 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6185 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6186 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6187 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6188 via xmalloc. Print error messages via image_error if an error
6189 occurs. Value is non-zero if successful. */
6192 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6194 int width
, height
, depth
;
6198 Display
*display
= FRAME_X_DISPLAY (f
);
6199 Screen
*screen
= FRAME_X_SCREEN (f
);
6200 Window window
= FRAME_X_WINDOW (f
);
6202 xassert (interrupt_input_blocked
);
6205 depth
= DefaultDepthOfScreen (screen
);
6206 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6207 depth
, ZPixmap
, 0, NULL
, width
, height
,
6208 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6211 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6215 /* Allocate image raster. */
6216 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6218 /* Allocate a pixmap of the same size. */
6219 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6220 if (*pixmap
== None
)
6222 x_destroy_x_image (*ximg
);
6224 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6232 /* Destroy XImage XIMG. Free XIMG->data. */
6235 x_destroy_x_image (ximg
)
6238 xassert (interrupt_input_blocked
);
6243 XDestroyImage (ximg
);
6248 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6249 are width and height of both the image and pixmap. */
6252 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6259 xassert (interrupt_input_blocked
);
6260 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6261 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6262 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6267 /***********************************************************************
6269 ***********************************************************************/
6271 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6272 static char *slurp_file
P_ ((char *, int *));
6275 /* Find image file FILE. Look in data-directory, then
6276 x-bitmap-file-path. Value is the full name of the file found, or
6277 nil if not found. */
6280 x_find_image_file (file
)
6283 Lisp_Object file_found
, search_path
;
6284 struct gcpro gcpro1
, gcpro2
;
6288 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6289 GCPRO2 (file_found
, search_path
);
6291 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6292 fd
= openp (search_path
, file
, "", &file_found
, 0);
6304 /* Read FILE into memory. Value is a pointer to a buffer allocated
6305 with xmalloc holding FILE's contents. Value is null if an error
6306 occurred. *SIZE is set to the size of the file. */
6309 slurp_file (file
, size
)
6317 if (stat (file
, &st
) == 0
6318 && (fp
= fopen (file
, "r")) != NULL
6319 && (buf
= (char *) xmalloc (st
.st_size
),
6320 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6341 /***********************************************************************
6343 ***********************************************************************/
6345 static int xbm_scan
P_ ((char **, char *, char *, int *));
6346 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6347 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6349 static int xbm_image_p
P_ ((Lisp_Object object
));
6350 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6352 static int xbm_file_p
P_ ((Lisp_Object
));
6355 /* Indices of image specification fields in xbm_format, below. */
6357 enum xbm_keyword_index
6375 /* Vector of image_keyword structures describing the format
6376 of valid XBM image specifications. */
6378 static struct image_keyword xbm_format
[XBM_LAST
] =
6380 {":type", IMAGE_SYMBOL_VALUE
, 1},
6381 {":file", IMAGE_STRING_VALUE
, 0},
6382 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6383 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6384 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6385 {":foreground", IMAGE_STRING_VALUE
, 0},
6386 {":background", IMAGE_STRING_VALUE
, 0},
6387 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6388 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6389 {":relief", IMAGE_INTEGER_VALUE
, 0},
6390 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6391 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6392 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6395 /* Structure describing the image type XBM. */
6397 static struct image_type xbm_type
=
6406 /* Tokens returned from xbm_scan. */
6415 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6416 A valid specification is a list starting with the symbol `image'
6417 The rest of the list is a property list which must contain an
6420 If the specification specifies a file to load, it must contain
6421 an entry `:file FILENAME' where FILENAME is a string.
6423 If the specification is for a bitmap loaded from memory it must
6424 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6425 WIDTH and HEIGHT are integers > 0. DATA may be:
6427 1. a string large enough to hold the bitmap data, i.e. it must
6428 have a size >= (WIDTH + 7) / 8 * HEIGHT
6430 2. a bool-vector of size >= WIDTH * HEIGHT
6432 3. a vector of strings or bool-vectors, one for each line of the
6435 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6436 may not be specified in this case because they are defined in the
6439 Both the file and data forms may contain the additional entries
6440 `:background COLOR' and `:foreground COLOR'. If not present,
6441 foreground and background of the frame on which the image is
6442 displayed is used. */
6445 xbm_image_p (object
)
6448 struct image_keyword kw
[XBM_LAST
];
6450 bcopy (xbm_format
, kw
, sizeof kw
);
6451 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6454 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6456 if (kw
[XBM_FILE
].count
)
6458 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6461 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6463 /* In-memory XBM file. */
6464 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6472 /* Entries for `:width', `:height' and `:data' must be present. */
6473 if (!kw
[XBM_WIDTH
].count
6474 || !kw
[XBM_HEIGHT
].count
6475 || !kw
[XBM_DATA
].count
)
6478 data
= kw
[XBM_DATA
].value
;
6479 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6480 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6482 /* Check type of data, and width and height against contents of
6488 /* Number of elements of the vector must be >= height. */
6489 if (XVECTOR (data
)->size
< height
)
6492 /* Each string or bool-vector in data must be large enough
6493 for one line of the image. */
6494 for (i
= 0; i
< height
; ++i
)
6496 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6500 if (XSTRING (elt
)->size
6501 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6504 else if (BOOL_VECTOR_P (elt
))
6506 if (XBOOL_VECTOR (elt
)->size
< width
)
6513 else if (STRINGP (data
))
6515 if (XSTRING (data
)->size
6516 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6519 else if (BOOL_VECTOR_P (data
))
6521 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6532 /* Scan a bitmap file. FP is the stream to read from. Value is
6533 either an enumerator from enum xbm_token, or a character for a
6534 single-character token, or 0 at end of file. If scanning an
6535 identifier, store the lexeme of the identifier in SVAL. If
6536 scanning a number, store its value in *IVAL. */
6539 xbm_scan (s
, end
, sval
, ival
)
6548 /* Skip white space. */
6549 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6554 else if (isdigit (c
))
6556 int value
= 0, digit
;
6558 if (c
== '0' && *s
< end
)
6561 if (c
== 'x' || c
== 'X')
6568 else if (c
>= 'a' && c
<= 'f')
6569 digit
= c
- 'a' + 10;
6570 else if (c
>= 'A' && c
<= 'F')
6571 digit
= c
- 'A' + 10;
6574 value
= 16 * value
+ digit
;
6577 else if (isdigit (c
))
6581 && (c
= *(*s
)++, isdigit (c
)))
6582 value
= 8 * value
+ c
- '0';
6589 && (c
= *(*s
)++, isdigit (c
)))
6590 value
= 10 * value
+ c
- '0';
6598 else if (isalpha (c
) || c
== '_')
6602 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6609 else if (c
== '/' && **s
== '*')
6611 /* C-style comment. */
6613 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6626 /* Replacement for XReadBitmapFileData which isn't available under old
6627 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6628 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6629 the image. Return in *DATA the bitmap data allocated with xmalloc.
6630 Value is non-zero if successful. DATA null means just test if
6631 CONTENTS looks like an in-memory XBM file. */
6634 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6635 char *contents
, *end
;
6636 int *width
, *height
;
6637 unsigned char **data
;
6640 char buffer
[BUFSIZ
];
6643 int bytes_per_line
, i
, nbytes
;
6649 LA1 = xbm_scan (&s, end, buffer, &value)
6651 #define expect(TOKEN) \
6652 if (LA1 != (TOKEN)) \
6657 #define expect_ident(IDENT) \
6658 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6663 *width
= *height
= -1;
6666 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6668 /* Parse defines for width, height and hot-spots. */
6672 expect_ident ("define");
6673 expect (XBM_TK_IDENT
);
6675 if (LA1
== XBM_TK_NUMBER
);
6677 char *p
= strrchr (buffer
, '_');
6678 p
= p
? p
+ 1 : buffer
;
6679 if (strcmp (p
, "width") == 0)
6681 else if (strcmp (p
, "height") == 0)
6684 expect (XBM_TK_NUMBER
);
6687 if (*width
< 0 || *height
< 0)
6689 else if (data
== NULL
)
6692 /* Parse bits. Must start with `static'. */
6693 expect_ident ("static");
6694 if (LA1
== XBM_TK_IDENT
)
6696 if (strcmp (buffer
, "unsigned") == 0)
6699 expect_ident ("char");
6701 else if (strcmp (buffer
, "short") == 0)
6705 if (*width
% 16 && *width
% 16 < 9)
6708 else if (strcmp (buffer
, "char") == 0)
6716 expect (XBM_TK_IDENT
);
6722 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6723 nbytes
= bytes_per_line
* *height
;
6724 p
= *data
= (char *) xmalloc (nbytes
);
6728 for (i
= 0; i
< nbytes
; i
+= 2)
6731 expect (XBM_TK_NUMBER
);
6734 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6737 if (LA1
== ',' || LA1
== '}')
6745 for (i
= 0; i
< nbytes
; ++i
)
6748 expect (XBM_TK_NUMBER
);
6752 if (LA1
== ',' || LA1
== '}')
6777 /* Load XBM image IMG which will be displayed on frame F from buffer
6778 CONTENTS. END is the end of the buffer. Value is non-zero if
6782 xbm_load_image (f
, img
, contents
, end
)
6785 char *contents
, *end
;
6788 unsigned char *data
;
6791 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6794 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6795 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6796 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6799 xassert (img
->width
> 0 && img
->height
> 0);
6801 /* Get foreground and background colors, maybe allocate colors. */
6802 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6804 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6806 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6808 background
= x_alloc_image_color (f
, img
, value
, background
);
6811 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6814 img
->width
, img
->height
,
6815 foreground
, background
,
6819 if (img
->pixmap
== None
)
6821 x_clear_image (f
, img
);
6822 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6828 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6834 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6841 return (STRINGP (data
)
6842 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6843 (XSTRING (data
)->data
6844 + STRING_BYTES (XSTRING (data
))),
6849 /* Fill image IMG which is used on frame F with pixmap data. Value is
6850 non-zero if successful. */
6858 Lisp_Object file_name
;
6860 xassert (xbm_image_p (img
->spec
));
6862 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6863 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6864 if (STRINGP (file_name
))
6869 struct gcpro gcpro1
;
6871 file
= x_find_image_file (file_name
);
6873 if (!STRINGP (file
))
6875 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6880 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6881 if (contents
== NULL
)
6883 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6888 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6893 struct image_keyword fmt
[XBM_LAST
];
6896 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6897 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6900 int in_memory_file_p
= 0;
6902 /* See if data looks like an in-memory XBM file. */
6903 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6904 in_memory_file_p
= xbm_file_p (data
);
6906 /* Parse the image specification. */
6907 bcopy (xbm_format
, fmt
, sizeof fmt
);
6908 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6911 /* Get specified width, and height. */
6912 if (!in_memory_file_p
)
6914 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6915 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6916 xassert (img
->width
> 0 && img
->height
> 0);
6919 /* Get foreground and background colors, maybe allocate colors. */
6920 if (fmt
[XBM_FOREGROUND
].count
)
6921 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6923 if (fmt
[XBM_BACKGROUND
].count
)
6924 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6927 if (in_memory_file_p
)
6928 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6929 (XSTRING (data
)->data
6930 + STRING_BYTES (XSTRING (data
))));
6937 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6939 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6940 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6942 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6944 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6946 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6949 else if (STRINGP (data
))
6950 bits
= XSTRING (data
)->data
;
6952 bits
= XBOOL_VECTOR (data
)->data
;
6954 /* Create the pixmap. */
6955 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6957 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6960 img
->width
, img
->height
,
6961 foreground
, background
,
6967 image_error ("Unable to create pixmap for XBM image `%s'",
6969 x_clear_image (f
, img
);
6979 /***********************************************************************
6981 ***********************************************************************/
6985 static int xpm_image_p
P_ ((Lisp_Object object
));
6986 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6987 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6989 #include "X11/xpm.h"
6991 /* The symbol `xpm' identifying XPM-format images. */
6995 /* Indices of image specification fields in xpm_format, below. */
6997 enum xpm_keyword_index
7012 /* Vector of image_keyword structures describing the format
7013 of valid XPM image specifications. */
7015 static struct image_keyword xpm_format
[XPM_LAST
] =
7017 {":type", IMAGE_SYMBOL_VALUE
, 1},
7018 {":file", IMAGE_STRING_VALUE
, 0},
7019 {":data", IMAGE_STRING_VALUE
, 0},
7020 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7021 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7022 {":relief", IMAGE_INTEGER_VALUE
, 0},
7023 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7024 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7025 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7026 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7029 /* Structure describing the image type XBM. */
7031 static struct image_type xpm_type
=
7041 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7042 functions for allocating image colors. Our own functions handle
7043 color allocation failures more gracefully than the ones on the XPM
7046 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7047 #define ALLOC_XPM_COLORS
7050 #ifdef ALLOC_XPM_COLORS
7052 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7053 static void xpm_free_color_cache
P_ ((void));
7054 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7055 static int xpm_color_bucket
P_ ((char *));
7056 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7059 /* An entry in a hash table used to cache color definitions of named
7060 colors. This cache is necessary to speed up XPM image loading in
7061 case we do color allocations ourselves. Without it, we would need
7062 a call to XParseColor per pixel in the image. */
7064 struct xpm_cached_color
7066 /* Next in collision chain. */
7067 struct xpm_cached_color
*next
;
7069 /* Color definition (RGB and pixel color). */
7076 /* The hash table used for the color cache, and its bucket vector
7079 #define XPM_COLOR_CACHE_BUCKETS 1001
7080 struct xpm_cached_color
**xpm_color_cache
;
7082 /* Initialize the color cache. */
7085 xpm_init_color_cache (f
, attrs
)
7087 XpmAttributes
*attrs
;
7089 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7090 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7091 memset (xpm_color_cache
, 0, nbytes
);
7092 init_color_table ();
7094 if (attrs
->valuemask
& XpmColorSymbols
)
7099 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7100 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7101 attrs
->colorsymbols
[i
].value
, &color
))
7103 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7105 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7111 /* Free the color cache. */
7114 xpm_free_color_cache ()
7116 struct xpm_cached_color
*p
, *next
;
7119 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7120 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7126 xfree (xpm_color_cache
);
7127 xpm_color_cache
= NULL
;
7128 free_color_table ();
7132 /* Return the bucket index for color named COLOR_NAME in the color
7136 xpm_color_bucket (color_name
)
7142 for (s
= color_name
; *s
; ++s
)
7144 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7148 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7149 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7152 static struct xpm_cached_color
*
7153 xpm_cache_color (f
, color_name
, color
, bucket
)
7160 struct xpm_cached_color
*p
;
7163 bucket
= xpm_color_bucket (color_name
);
7165 nbytes
= sizeof *p
+ strlen (color_name
);
7166 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7167 strcpy (p
->name
, color_name
);
7169 p
->next
= xpm_color_cache
[bucket
];
7170 xpm_color_cache
[bucket
] = p
;
7175 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7176 return the cached definition in *COLOR. Otherwise, make a new
7177 entry in the cache and allocate the color. Value is zero if color
7178 allocation failed. */
7181 xpm_lookup_color (f
, color_name
, color
)
7186 struct xpm_cached_color
*p
;
7187 int h
= xpm_color_bucket (color_name
);
7189 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7190 if (strcmp (p
->name
, color_name
) == 0)
7195 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7198 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7200 p
= xpm_cache_color (f
, color_name
, color
, h
);
7207 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7208 CLOSURE is a pointer to the frame on which we allocate the
7209 color. Return in *COLOR the allocated color. Value is non-zero
7213 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7220 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7224 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7225 is a pointer to the frame on which we allocate the color. Value is
7226 non-zero if successful. */
7229 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7239 #endif /* ALLOC_XPM_COLORS */
7242 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7243 for XPM images. Such a list must consist of conses whose car and
7247 xpm_valid_color_symbols_p (color_symbols
)
7248 Lisp_Object color_symbols
;
7250 while (CONSP (color_symbols
))
7252 Lisp_Object sym
= XCAR (color_symbols
);
7254 || !STRINGP (XCAR (sym
))
7255 || !STRINGP (XCDR (sym
)))
7257 color_symbols
= XCDR (color_symbols
);
7260 return NILP (color_symbols
);
7264 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7267 xpm_image_p (object
)
7270 struct image_keyword fmt
[XPM_LAST
];
7271 bcopy (xpm_format
, fmt
, sizeof fmt
);
7272 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7273 /* Either `:file' or `:data' must be present. */
7274 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7275 /* Either no `:color-symbols' or it's a list of conses
7276 whose car and cdr are strings. */
7277 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7278 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7282 /* Load image IMG which will be displayed on frame F. Value is
7283 non-zero if successful. */
7291 XpmAttributes attrs
;
7292 Lisp_Object specified_file
, color_symbols
;
7294 /* Configure the XPM lib. Use the visual of frame F. Allocate
7295 close colors. Return colors allocated. */
7296 bzero (&attrs
, sizeof attrs
);
7297 attrs
.visual
= FRAME_X_VISUAL (f
);
7298 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7299 attrs
.valuemask
|= XpmVisual
;
7300 attrs
.valuemask
|= XpmColormap
;
7302 #ifdef ALLOC_XPM_COLORS
7303 /* Allocate colors with our own functions which handle
7304 failing color allocation more gracefully. */
7305 attrs
.color_closure
= f
;
7306 attrs
.alloc_color
= xpm_alloc_color
;
7307 attrs
.free_colors
= xpm_free_colors
;
7308 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7309 #else /* not ALLOC_XPM_COLORS */
7310 /* Let the XPM lib allocate colors. */
7311 attrs
.valuemask
|= XpmReturnAllocPixels
;
7312 #ifdef XpmAllocCloseColors
7313 attrs
.alloc_close_colors
= 1;
7314 attrs
.valuemask
|= XpmAllocCloseColors
;
7315 #else /* not XpmAllocCloseColors */
7316 attrs
.closeness
= 600;
7317 attrs
.valuemask
|= XpmCloseness
;
7318 #endif /* not XpmAllocCloseColors */
7319 #endif /* ALLOC_XPM_COLORS */
7321 /* If image specification contains symbolic color definitions, add
7322 these to `attrs'. */
7323 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7324 if (CONSP (color_symbols
))
7327 XpmColorSymbol
*xpm_syms
;
7330 attrs
.valuemask
|= XpmColorSymbols
;
7332 /* Count number of symbols. */
7333 attrs
.numsymbols
= 0;
7334 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7337 /* Allocate an XpmColorSymbol array. */
7338 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7339 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7340 bzero (xpm_syms
, size
);
7341 attrs
.colorsymbols
= xpm_syms
;
7343 /* Fill the color symbol array. */
7344 for (tail
= color_symbols
, i
= 0;
7346 ++i
, tail
= XCDR (tail
))
7348 Lisp_Object name
= XCAR (XCAR (tail
));
7349 Lisp_Object color
= XCDR (XCAR (tail
));
7350 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7351 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7352 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7353 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7357 /* Create a pixmap for the image, either from a file, or from a
7358 string buffer containing data in the same format as an XPM file. */
7359 #ifdef ALLOC_XPM_COLORS
7360 xpm_init_color_cache (f
, &attrs
);
7363 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7364 if (STRINGP (specified_file
))
7366 Lisp_Object file
= x_find_image_file (specified_file
);
7367 if (!STRINGP (file
))
7369 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7373 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7374 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7379 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7380 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7381 XSTRING (buffer
)->data
,
7382 &img
->pixmap
, &img
->mask
,
7386 if (rc
== XpmSuccess
)
7388 #ifdef ALLOC_XPM_COLORS
7389 img
->colors
= colors_in_color_table (&img
->ncolors
);
7390 #else /* not ALLOC_XPM_COLORS */
7393 img
->ncolors
= attrs
.nalloc_pixels
;
7394 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7395 * sizeof *img
->colors
);
7396 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7398 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7399 #ifdef DEBUG_X_COLORS
7400 register_color (img
->colors
[i
]);
7403 #endif /* not ALLOC_XPM_COLORS */
7405 img
->width
= attrs
.width
;
7406 img
->height
= attrs
.height
;
7407 xassert (img
->width
> 0 && img
->height
> 0);
7409 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7410 XpmFreeAttributes (&attrs
);
7417 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7420 case XpmFileInvalid
:
7421 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7425 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7428 case XpmColorFailed
:
7429 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7433 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7438 #ifdef ALLOC_XPM_COLORS
7439 xpm_free_color_cache ();
7441 return rc
== XpmSuccess
;
7444 #endif /* HAVE_XPM != 0 */
7447 /***********************************************************************
7449 ***********************************************************************/
7451 /* An entry in the color table mapping an RGB color to a pixel color. */
7456 unsigned long pixel
;
7458 /* Next in color table collision list. */
7459 struct ct_color
*next
;
7462 /* The bucket vector size to use. Must be prime. */
7466 /* Value is a hash of the RGB color given by R, G, and B. */
7468 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7470 /* The color hash table. */
7472 struct ct_color
**ct_table
;
7474 /* Number of entries in the color table. */
7476 int ct_colors_allocated
;
7478 /* Initialize the color table. */
7483 int size
= CT_SIZE
* sizeof (*ct_table
);
7484 ct_table
= (struct ct_color
**) xmalloc (size
);
7485 bzero (ct_table
, size
);
7486 ct_colors_allocated
= 0;
7490 /* Free memory associated with the color table. */
7496 struct ct_color
*p
, *next
;
7498 for (i
= 0; i
< CT_SIZE
; ++i
)
7499 for (p
= ct_table
[i
]; p
; p
= next
)
7510 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7511 entry for that color already is in the color table, return the
7512 pixel color of that entry. Otherwise, allocate a new color for R,
7513 G, B, and make an entry in the color table. */
7515 static unsigned long
7516 lookup_rgb_color (f
, r
, g
, b
)
7520 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7521 int i
= hash
% CT_SIZE
;
7524 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7525 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7538 cmap
= FRAME_X_COLORMAP (f
);
7539 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7543 ++ct_colors_allocated
;
7545 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7549 p
->pixel
= color
.pixel
;
7550 p
->next
= ct_table
[i
];
7554 return FRAME_FOREGROUND_PIXEL (f
);
7561 /* Look up pixel color PIXEL which is used on frame F in the color
7562 table. If not already present, allocate it. Value is PIXEL. */
7564 static unsigned long
7565 lookup_pixel_color (f
, pixel
)
7567 unsigned long pixel
;
7569 int i
= pixel
% CT_SIZE
;
7572 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7573 if (p
->pixel
== pixel
)
7582 cmap
= FRAME_X_COLORMAP (f
);
7583 color
.pixel
= pixel
;
7584 x_query_color (f
, &color
);
7585 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7589 ++ct_colors_allocated
;
7591 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7596 p
->next
= ct_table
[i
];
7600 return FRAME_FOREGROUND_PIXEL (f
);
7607 /* Value is a vector of all pixel colors contained in the color table,
7608 allocated via xmalloc. Set *N to the number of colors. */
7610 static unsigned long *
7611 colors_in_color_table (n
)
7616 unsigned long *colors
;
7618 if (ct_colors_allocated
== 0)
7625 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7627 *n
= ct_colors_allocated
;
7629 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7630 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7631 colors
[j
++] = p
->pixel
;
7639 /***********************************************************************
7641 ***********************************************************************/
7643 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7644 int, XImage
*, int));
7645 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7646 XColor
*, int, XImage
*, int));
7647 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7648 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7649 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7651 /* Non-zero means draw a cross on images having `:conversion
7654 int cross_disabled_images
;
7656 /* Edge detection matrices for different edge-detection
7659 static int emboss_matrix
[9] = {
7661 2, -1, 0, /* y - 1 */
7663 0, 1, -2 /* y + 1 */
7666 static int laplace_matrix
[9] = {
7668 1, 0, 0, /* y - 1 */
7670 0, 0, -1 /* y + 1 */
7673 /* Value is the intensity of the color whose red/green/blue values
7676 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7679 /* On frame F, return an array of XColor structures describing image
7680 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7681 non-zero means also fill the red/green/blue members of the XColor
7682 structures. Value is a pointer to the array of XColors structures,
7683 allocated with xmalloc; it must be freed by the caller. */
7686 x_to_xcolors (f
, img
, rgb_p
)
7695 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7697 /* Get the X image IMG->pixmap. */
7698 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7699 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7701 /* Fill the `pixel' members of the XColor array. I wished there
7702 were an easy and portable way to circumvent XGetPixel. */
7704 for (y
= 0; y
< img
->height
; ++y
)
7708 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7709 p
->pixel
= XGetPixel (ximg
, x
, y
);
7712 x_query_colors (f
, row
, img
->width
);
7715 XDestroyImage (ximg
);
7720 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7721 RGB members are set. F is the frame on which this all happens.
7722 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7725 x_from_xcolors (f
, img
, colors
)
7735 init_color_table ();
7737 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7740 for (y
= 0; y
< img
->height
; ++y
)
7741 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7743 unsigned long pixel
;
7744 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7745 XPutPixel (oimg
, x
, y
, pixel
);
7749 x_clear_image_1 (f
, img
, 1, 0, 1);
7751 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7752 x_destroy_x_image (oimg
);
7753 img
->pixmap
= pixmap
;
7754 img
->colors
= colors_in_color_table (&img
->ncolors
);
7755 free_color_table ();
7759 /* On frame F, perform edge-detection on image IMG.
7761 MATRIX is a nine-element array specifying the transformation
7762 matrix. See emboss_matrix for an example.
7764 COLOR_ADJUST is a color adjustment added to each pixel of the
7768 x_detect_edges (f
, img
, matrix
, color_adjust
)
7771 int matrix
[9], color_adjust
;
7773 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7777 for (i
= sum
= 0; i
< 9; ++i
)
7778 sum
+= abs (matrix
[i
]);
7780 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7782 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7784 for (y
= 0; y
< img
->height
; ++y
)
7786 p
= COLOR (new, 0, y
);
7787 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7788 p
= COLOR (new, img
->width
- 1, y
);
7789 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7792 for (x
= 1; x
< img
->width
- 1; ++x
)
7794 p
= COLOR (new, x
, 0);
7795 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7796 p
= COLOR (new, x
, img
->height
- 1);
7797 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7800 for (y
= 1; y
< img
->height
- 1; ++y
)
7802 p
= COLOR (new, 1, y
);
7804 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7806 int r
, g
, b
, y1
, x1
;
7809 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7810 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7813 XColor
*t
= COLOR (colors
, x1
, y1
);
7814 r
+= matrix
[i
] * t
->red
;
7815 g
+= matrix
[i
] * t
->green
;
7816 b
+= matrix
[i
] * t
->blue
;
7819 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7820 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7821 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7822 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7827 x_from_xcolors (f
, img
, new);
7833 /* Perform the pre-defined `emboss' edge-detection on image IMG
7841 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7845 /* Perform the pre-defined `laplace' edge-detection on image IMG
7853 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7857 /* Perform edge-detection on image IMG on frame F, with specified
7858 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7860 MATRIX must be either
7862 - a list of at least 9 numbers in row-major form
7863 - a vector of at least 9 numbers
7865 COLOR_ADJUST nil means use a default; otherwise it must be a
7869 x_edge_detection (f
, img
, matrix
, color_adjust
)
7872 Lisp_Object matrix
, color_adjust
;
7880 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7881 ++i
, matrix
= XCDR (matrix
))
7882 trans
[i
] = XFLOATINT (XCAR (matrix
));
7884 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7886 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7887 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7890 if (NILP (color_adjust
))
7891 color_adjust
= make_number (0xffff / 2);
7893 if (i
== 9 && NUMBERP (color_adjust
))
7894 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7898 /* Transform image IMG on frame F so that it looks disabled. */
7901 x_disable_image (f
, img
)
7905 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7907 if (dpyinfo
->n_planes
>= 2)
7909 /* Color (or grayscale). Convert to gray, and equalize. Just
7910 drawing such images with a stipple can look very odd, so
7911 we're using this method instead. */
7912 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7914 const int h
= 15000;
7915 const int l
= 30000;
7917 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7921 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7922 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7923 p
->red
= p
->green
= p
->blue
= i2
;
7926 x_from_xcolors (f
, img
, colors
);
7929 /* Draw a cross over the disabled image, if we must or if we
7931 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
7933 Display
*dpy
= FRAME_X_DISPLAY (f
);
7936 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
7937 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
7938 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
7939 img
->width
- 1, img
->height
- 1);
7940 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
7946 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
7947 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
7948 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
7949 img
->width
- 1, img
->height
- 1);
7950 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
7958 /* Build a mask for image IMG which is used on frame F. FILE is the
7959 name of an image file, for error messages. HOW determines how to
7960 determine the background color of IMG. If it is a list '(R G B)',
7961 with R, G, and B being integers >= 0, take that as the color of the
7962 background. Otherwise, determine the background color of IMG
7963 heuristically. Value is non-zero if successful. */
7966 x_build_heuristic_mask (f
, img
, how
)
7971 Display
*dpy
= FRAME_X_DISPLAY (f
);
7972 XImage
*ximg
, *mask_img
;
7973 int x
, y
, rc
, look_at_corners_p
;
7974 unsigned long bg
= 0;
7978 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
7982 /* Create an image and pixmap serving as mask. */
7983 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7984 &mask_img
, &img
->mask
);
7988 /* Get the X image of IMG->pixmap. */
7989 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7992 /* Determine the background color of ximg. If HOW is `(R G B)'
7993 take that as color. Otherwise, try to determine the color
7995 look_at_corners_p
= 1;
8003 && NATNUMP (XCAR (how
)))
8005 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
8009 if (i
== 3 && NILP (how
))
8011 char color_name
[30];
8012 XColor exact
, color
;
8015 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
8017 cmap
= FRAME_X_COLORMAP (f
);
8018 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
8021 look_at_corners_p
= 0;
8026 if (look_at_corners_p
)
8028 unsigned long corners
[4];
8031 /* Get the colors at the corners of ximg. */
8032 corners
[0] = XGetPixel (ximg
, 0, 0);
8033 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
8034 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
8035 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
8037 /* Choose the most frequently found color as background. */
8038 for (i
= best_count
= 0; i
< 4; ++i
)
8042 for (j
= n
= 0; j
< 4; ++j
)
8043 if (corners
[i
] == corners
[j
])
8047 bg
= corners
[i
], best_count
= n
;
8051 /* Set all bits in mask_img to 1 whose color in ximg is different
8052 from the background color bg. */
8053 for (y
= 0; y
< img
->height
; ++y
)
8054 for (x
= 0; x
< img
->width
; ++x
)
8055 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8057 /* Put mask_img into img->mask. */
8058 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8059 x_destroy_x_image (mask_img
);
8060 XDestroyImage (ximg
);
8067 /***********************************************************************
8068 PBM (mono, gray, color)
8069 ***********************************************************************/
8071 static int pbm_image_p
P_ ((Lisp_Object object
));
8072 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8073 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8075 /* The symbol `pbm' identifying images of this type. */
8079 /* Indices of image specification fields in gs_format, below. */
8081 enum pbm_keyword_index
8097 /* Vector of image_keyword structures describing the format
8098 of valid user-defined image specifications. */
8100 static struct image_keyword pbm_format
[PBM_LAST
] =
8102 {":type", IMAGE_SYMBOL_VALUE
, 1},
8103 {":file", IMAGE_STRING_VALUE
, 0},
8104 {":data", IMAGE_STRING_VALUE
, 0},
8105 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8106 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8107 {":relief", IMAGE_INTEGER_VALUE
, 0},
8108 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8109 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8110 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8111 {":foreground", IMAGE_STRING_VALUE
, 0},
8112 {":background", IMAGE_STRING_VALUE
, 0}
8115 /* Structure describing the image type `pbm'. */
8117 static struct image_type pbm_type
=
8127 /* Return non-zero if OBJECT is a valid PBM image specification. */
8130 pbm_image_p (object
)
8133 struct image_keyword fmt
[PBM_LAST
];
8135 bcopy (pbm_format
, fmt
, sizeof fmt
);
8137 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8140 /* Must specify either :data or :file. */
8141 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8145 /* Scan a decimal number from *S and return it. Advance *S while
8146 reading the number. END is the end of the string. Value is -1 at
8150 pbm_scan_number (s
, end
)
8151 unsigned char **s
, *end
;
8153 int c
= 0, val
= -1;
8157 /* Skip white-space. */
8158 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8163 /* Skip comment to end of line. */
8164 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8167 else if (isdigit (c
))
8169 /* Read decimal number. */
8171 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8172 val
= 10 * val
+ c
- '0';
8183 /* Load PBM image IMG for use on frame F. */
8191 int width
, height
, max_color_idx
= 0;
8193 Lisp_Object file
, specified_file
;
8194 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8195 struct gcpro gcpro1
;
8196 unsigned char *contents
= NULL
;
8197 unsigned char *end
, *p
;
8200 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8204 if (STRINGP (specified_file
))
8206 file
= x_find_image_file (specified_file
);
8207 if (!STRINGP (file
))
8209 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8214 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8215 if (contents
== NULL
)
8217 image_error ("Error reading `%s'", file
, Qnil
);
8223 end
= contents
+ size
;
8228 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8229 p
= XSTRING (data
)->data
;
8230 end
= p
+ STRING_BYTES (XSTRING (data
));
8233 /* Check magic number. */
8234 if (end
- p
< 2 || *p
++ != 'P')
8236 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8246 raw_p
= 0, type
= PBM_MONO
;
8250 raw_p
= 0, type
= PBM_GRAY
;
8254 raw_p
= 0, type
= PBM_COLOR
;
8258 raw_p
= 1, type
= PBM_MONO
;
8262 raw_p
= 1, type
= PBM_GRAY
;
8266 raw_p
= 1, type
= PBM_COLOR
;
8270 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8274 /* Read width, height, maximum color-component. Characters
8275 starting with `#' up to the end of a line are ignored. */
8276 width
= pbm_scan_number (&p
, end
);
8277 height
= pbm_scan_number (&p
, end
);
8279 if (type
!= PBM_MONO
)
8281 max_color_idx
= pbm_scan_number (&p
, end
);
8282 if (raw_p
&& max_color_idx
> 255)
8283 max_color_idx
= 255;
8288 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8291 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8292 &ximg
, &img
->pixmap
))
8295 /* Initialize the color hash table. */
8296 init_color_table ();
8298 if (type
== PBM_MONO
)
8301 struct image_keyword fmt
[PBM_LAST
];
8302 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8303 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8305 /* Parse the image specification. */
8306 bcopy (pbm_format
, fmt
, sizeof fmt
);
8307 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8309 /* Get foreground and background colors, maybe allocate colors. */
8310 if (fmt
[PBM_FOREGROUND
].count
)
8311 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8312 if (fmt
[PBM_BACKGROUND
].count
)
8313 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8315 for (y
= 0; y
< height
; ++y
)
8316 for (x
= 0; x
< width
; ++x
)
8326 g
= pbm_scan_number (&p
, end
);
8328 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8333 for (y
= 0; y
< height
; ++y
)
8334 for (x
= 0; x
< width
; ++x
)
8338 if (type
== PBM_GRAY
)
8339 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8348 r
= pbm_scan_number (&p
, end
);
8349 g
= pbm_scan_number (&p
, end
);
8350 b
= pbm_scan_number (&p
, end
);
8353 if (r
< 0 || g
< 0 || b
< 0)
8357 XDestroyImage (ximg
);
8358 image_error ("Invalid pixel value in image `%s'",
8363 /* RGB values are now in the range 0..max_color_idx.
8364 Scale this to the range 0..0xffff supported by X. */
8365 r
= (double) r
* 65535 / max_color_idx
;
8366 g
= (double) g
* 65535 / max_color_idx
;
8367 b
= (double) b
* 65535 / max_color_idx
;
8368 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8372 /* Store in IMG->colors the colors allocated for the image, and
8373 free the color table. */
8374 img
->colors
= colors_in_color_table (&img
->ncolors
);
8375 free_color_table ();
8377 /* Put the image into a pixmap. */
8378 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8379 x_destroy_x_image (ximg
);
8382 img
->height
= height
;
8391 /***********************************************************************
8393 ***********************************************************************/
8399 /* Function prototypes. */
8401 static int png_image_p
P_ ((Lisp_Object object
));
8402 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8404 /* The symbol `png' identifying images of this type. */
8408 /* Indices of image specification fields in png_format, below. */
8410 enum png_keyword_index
8424 /* Vector of image_keyword structures describing the format
8425 of valid user-defined image specifications. */
8427 static struct image_keyword png_format
[PNG_LAST
] =
8429 {":type", IMAGE_SYMBOL_VALUE
, 1},
8430 {":data", IMAGE_STRING_VALUE
, 0},
8431 {":file", IMAGE_STRING_VALUE
, 0},
8432 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8433 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8434 {":relief", IMAGE_INTEGER_VALUE
, 0},
8435 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8436 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8437 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8440 /* Structure describing the image type `png'. */
8442 static struct image_type png_type
=
8452 /* Return non-zero if OBJECT is a valid PNG image specification. */
8455 png_image_p (object
)
8458 struct image_keyword fmt
[PNG_LAST
];
8459 bcopy (png_format
, fmt
, sizeof fmt
);
8461 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8464 /* Must specify either the :data or :file keyword. */
8465 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8469 /* Error and warning handlers installed when the PNG library
8473 my_png_error (png_ptr
, msg
)
8474 png_struct
*png_ptr
;
8477 xassert (png_ptr
!= NULL
);
8478 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8479 longjmp (png_ptr
->jmpbuf
, 1);
8484 my_png_warning (png_ptr
, msg
)
8485 png_struct
*png_ptr
;
8488 xassert (png_ptr
!= NULL
);
8489 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8492 /* Memory source for PNG decoding. */
8494 struct png_memory_storage
8496 unsigned char *bytes
; /* The data */
8497 size_t len
; /* How big is it? */
8498 int index
; /* Where are we? */
8502 /* Function set as reader function when reading PNG image from memory.
8503 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8504 bytes from the input to DATA. */
8507 png_read_from_memory (png_ptr
, data
, length
)
8508 png_structp png_ptr
;
8512 struct png_memory_storage
*tbr
8513 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8515 if (length
> tbr
->len
- tbr
->index
)
8516 png_error (png_ptr
, "Read error");
8518 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8519 tbr
->index
= tbr
->index
+ length
;
8522 /* Load PNG image IMG for use on frame F. Value is non-zero if
8530 Lisp_Object file
, specified_file
;
8531 Lisp_Object specified_data
;
8533 XImage
*ximg
, *mask_img
= NULL
;
8534 struct gcpro gcpro1
;
8535 png_struct
*png_ptr
= NULL
;
8536 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8537 FILE *volatile fp
= NULL
;
8539 png_byte
* volatile pixels
= NULL
;
8540 png_byte
** volatile rows
= NULL
;
8541 png_uint_32 width
, height
;
8542 int bit_depth
, color_type
, interlace_type
;
8544 png_uint_32 row_bytes
;
8547 double screen_gamma
, image_gamma
;
8549 struct png_memory_storage tbr
; /* Data to be read */
8551 /* Find out what file to load. */
8552 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8553 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8557 if (NILP (specified_data
))
8559 file
= x_find_image_file (specified_file
);
8560 if (!STRINGP (file
))
8562 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8567 /* Open the image file. */
8568 fp
= fopen (XSTRING (file
)->data
, "rb");
8571 image_error ("Cannot open image file `%s'", file
, Qnil
);
8577 /* Check PNG signature. */
8578 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8579 || !png_check_sig (sig
, sizeof sig
))
8581 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8589 /* Read from memory. */
8590 tbr
.bytes
= XSTRING (specified_data
)->data
;
8591 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8594 /* Check PNG signature. */
8595 if (tbr
.len
< sizeof sig
8596 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8598 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8603 /* Need to skip past the signature. */
8604 tbr
.bytes
+= sizeof (sig
);
8607 /* Initialize read and info structs for PNG lib. */
8608 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8609 my_png_error
, my_png_warning
);
8612 if (fp
) fclose (fp
);
8617 info_ptr
= png_create_info_struct (png_ptr
);
8620 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8621 if (fp
) fclose (fp
);
8626 end_info
= png_create_info_struct (png_ptr
);
8629 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8630 if (fp
) fclose (fp
);
8635 /* Set error jump-back. We come back here when the PNG library
8636 detects an error. */
8637 if (setjmp (png_ptr
->jmpbuf
))
8641 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8644 if (fp
) fclose (fp
);
8649 /* Read image info. */
8650 if (!NILP (specified_data
))
8651 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8653 png_init_io (png_ptr
, fp
);
8655 png_set_sig_bytes (png_ptr
, sizeof sig
);
8656 png_read_info (png_ptr
, info_ptr
);
8657 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8658 &interlace_type
, NULL
, NULL
);
8660 /* If image contains simply transparency data, we prefer to
8661 construct a clipping mask. */
8662 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8667 /* This function is easier to write if we only have to handle
8668 one data format: RGB or RGBA with 8 bits per channel. Let's
8669 transform other formats into that format. */
8671 /* Strip more than 8 bits per channel. */
8672 if (bit_depth
== 16)
8673 png_set_strip_16 (png_ptr
);
8675 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8677 png_set_expand (png_ptr
);
8679 /* Convert grayscale images to RGB. */
8680 if (color_type
== PNG_COLOR_TYPE_GRAY
8681 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8682 png_set_gray_to_rgb (png_ptr
);
8684 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8685 gamma_str
= getenv ("SCREEN_GAMMA");
8686 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8688 /* Tell the PNG lib to handle gamma correction for us. */
8690 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8691 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8692 /* There is a special chunk in the image specifying the gamma. */
8693 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8696 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8697 /* Image contains gamma information. */
8698 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8700 /* Use a default of 0.5 for the image gamma. */
8701 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8703 /* Handle alpha channel by combining the image with a background
8704 color. Do this only if a real alpha channel is supplied. For
8705 simple transparency, we prefer a clipping mask. */
8708 png_color_16
*image_background
;
8710 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8711 /* Image contains a background color with which to
8712 combine the image. */
8713 png_set_background (png_ptr
, image_background
,
8714 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8717 /* Image does not contain a background color with which
8718 to combine the image data via an alpha channel. Use
8719 the frame's background instead. */
8722 png_color_16 frame_background
;
8724 cmap
= FRAME_X_COLORMAP (f
);
8725 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8726 x_query_color (f
, &color
);
8728 bzero (&frame_background
, sizeof frame_background
);
8729 frame_background
.red
= color
.red
;
8730 frame_background
.green
= color
.green
;
8731 frame_background
.blue
= color
.blue
;
8733 png_set_background (png_ptr
, &frame_background
,
8734 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8738 /* Update info structure. */
8739 png_read_update_info (png_ptr
, info_ptr
);
8741 /* Get number of channels. Valid values are 1 for grayscale images
8742 and images with a palette, 2 for grayscale images with transparency
8743 information (alpha channel), 3 for RGB images, and 4 for RGB
8744 images with alpha channel, i.e. RGBA. If conversions above were
8745 sufficient we should only have 3 or 4 channels here. */
8746 channels
= png_get_channels (png_ptr
, info_ptr
);
8747 xassert (channels
== 3 || channels
== 4);
8749 /* Number of bytes needed for one row of the image. */
8750 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8752 /* Allocate memory for the image. */
8753 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8754 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8755 for (i
= 0; i
< height
; ++i
)
8756 rows
[i
] = pixels
+ i
* row_bytes
;
8758 /* Read the entire image. */
8759 png_read_image (png_ptr
, rows
);
8760 png_read_end (png_ptr
, info_ptr
);
8767 /* Create the X image and pixmap. */
8768 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8772 /* Create an image and pixmap serving as mask if the PNG image
8773 contains an alpha channel. */
8776 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8777 &mask_img
, &img
->mask
))
8779 x_destroy_x_image (ximg
);
8780 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8785 /* Fill the X image and mask from PNG data. */
8786 init_color_table ();
8788 for (y
= 0; y
< height
; ++y
)
8790 png_byte
*p
= rows
[y
];
8792 for (x
= 0; x
< width
; ++x
)
8799 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8801 /* An alpha channel, aka mask channel, associates variable
8802 transparency with an image. Where other image formats
8803 support binary transparency---fully transparent or fully
8804 opaque---PNG allows up to 254 levels of partial transparency.
8805 The PNG library implements partial transparency by combining
8806 the image with a specified background color.
8808 I'm not sure how to handle this here nicely: because the
8809 background on which the image is displayed may change, for
8810 real alpha channel support, it would be necessary to create
8811 a new image for each possible background.
8813 What I'm doing now is that a mask is created if we have
8814 boolean transparency information. Otherwise I'm using
8815 the frame's background color to combine the image with. */
8820 XPutPixel (mask_img
, x
, y
, *p
> 0);
8826 /* Remember colors allocated for this image. */
8827 img
->colors
= colors_in_color_table (&img
->ncolors
);
8828 free_color_table ();
8831 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8836 img
->height
= height
;
8838 /* Put the image into the pixmap, then free the X image and its buffer. */
8839 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8840 x_destroy_x_image (ximg
);
8842 /* Same for the mask. */
8845 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8846 x_destroy_x_image (mask_img
);
8853 #endif /* HAVE_PNG != 0 */
8857 /***********************************************************************
8859 ***********************************************************************/
8863 /* Work around a warning about HAVE_STDLIB_H being redefined in
8865 #ifdef HAVE_STDLIB_H
8866 #define HAVE_STDLIB_H_1
8867 #undef HAVE_STDLIB_H
8868 #endif /* HAVE_STLIB_H */
8870 #include <jpeglib.h>
8874 #ifdef HAVE_STLIB_H_1
8875 #define HAVE_STDLIB_H 1
8878 static int jpeg_image_p
P_ ((Lisp_Object object
));
8879 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8881 /* The symbol `jpeg' identifying images of this type. */
8885 /* Indices of image specification fields in gs_format, below. */
8887 enum jpeg_keyword_index
8896 JPEG_HEURISTIC_MASK
,
8901 /* Vector of image_keyword structures describing the format
8902 of valid user-defined image specifications. */
8904 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8906 {":type", IMAGE_SYMBOL_VALUE
, 1},
8907 {":data", IMAGE_STRING_VALUE
, 0},
8908 {":file", IMAGE_STRING_VALUE
, 0},
8909 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8910 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8911 {":relief", IMAGE_INTEGER_VALUE
, 0},
8912 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8913 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8914 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8917 /* Structure describing the image type `jpeg'. */
8919 static struct image_type jpeg_type
=
8929 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8932 jpeg_image_p (object
)
8935 struct image_keyword fmt
[JPEG_LAST
];
8937 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8939 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8942 /* Must specify either the :data or :file keyword. */
8943 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8947 struct my_jpeg_error_mgr
8949 struct jpeg_error_mgr pub
;
8950 jmp_buf setjmp_buffer
;
8955 my_error_exit (cinfo
)
8958 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8959 longjmp (mgr
->setjmp_buffer
, 1);
8963 /* Init source method for JPEG data source manager. Called by
8964 jpeg_read_header() before any data is actually read. See
8965 libjpeg.doc from the JPEG lib distribution. */
8968 our_init_source (cinfo
)
8969 j_decompress_ptr cinfo
;
8974 /* Fill input buffer method for JPEG data source manager. Called
8975 whenever more data is needed. We read the whole image in one step,
8976 so this only adds a fake end of input marker at the end. */
8979 our_fill_input_buffer (cinfo
)
8980 j_decompress_ptr cinfo
;
8982 /* Insert a fake EOI marker. */
8983 struct jpeg_source_mgr
*src
= cinfo
->src
;
8984 static JOCTET buffer
[2];
8986 buffer
[0] = (JOCTET
) 0xFF;
8987 buffer
[1] = (JOCTET
) JPEG_EOI
;
8989 src
->next_input_byte
= buffer
;
8990 src
->bytes_in_buffer
= 2;
8995 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8996 is the JPEG data source manager. */
8999 our_skip_input_data (cinfo
, num_bytes
)
9000 j_decompress_ptr cinfo
;
9003 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9007 if (num_bytes
> src
->bytes_in_buffer
)
9008 ERREXIT (cinfo
, JERR_INPUT_EOF
);
9010 src
->bytes_in_buffer
-= num_bytes
;
9011 src
->next_input_byte
+= num_bytes
;
9016 /* Method to terminate data source. Called by
9017 jpeg_finish_decompress() after all data has been processed. */
9020 our_term_source (cinfo
)
9021 j_decompress_ptr cinfo
;
9026 /* Set up the JPEG lib for reading an image from DATA which contains
9027 LEN bytes. CINFO is the decompression info structure created for
9028 reading the image. */
9031 jpeg_memory_src (cinfo
, data
, len
)
9032 j_decompress_ptr cinfo
;
9036 struct jpeg_source_mgr
*src
;
9038 if (cinfo
->src
== NULL
)
9040 /* First time for this JPEG object? */
9041 cinfo
->src
= (struct jpeg_source_mgr
*)
9042 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9043 sizeof (struct jpeg_source_mgr
));
9044 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9045 src
->next_input_byte
= data
;
9048 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9049 src
->init_source
= our_init_source
;
9050 src
->fill_input_buffer
= our_fill_input_buffer
;
9051 src
->skip_input_data
= our_skip_input_data
;
9052 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9053 src
->term_source
= our_term_source
;
9054 src
->bytes_in_buffer
= len
;
9055 src
->next_input_byte
= data
;
9059 /* Load image IMG for use on frame F. Patterned after example.c
9060 from the JPEG lib. */
9067 struct jpeg_decompress_struct cinfo
;
9068 struct my_jpeg_error_mgr mgr
;
9069 Lisp_Object file
, specified_file
;
9070 Lisp_Object specified_data
;
9071 FILE * volatile fp
= NULL
;
9073 int row_stride
, x
, y
;
9074 XImage
*ximg
= NULL
;
9076 unsigned long *colors
;
9078 struct gcpro gcpro1
;
9080 /* Open the JPEG file. */
9081 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9082 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9086 if (NILP (specified_data
))
9088 file
= x_find_image_file (specified_file
);
9089 if (!STRINGP (file
))
9091 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9096 fp
= fopen (XSTRING (file
)->data
, "r");
9099 image_error ("Cannot open `%s'", file
, Qnil
);
9105 /* Customize libjpeg's error handling to call my_error_exit when an
9106 error is detected. This function will perform a longjmp. */
9107 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9108 mgr
.pub
.error_exit
= my_error_exit
;
9110 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9114 /* Called from my_error_exit. Display a JPEG error. */
9115 char buffer
[JMSG_LENGTH_MAX
];
9116 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9117 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9118 build_string (buffer
));
9121 /* Close the input file and destroy the JPEG object. */
9123 fclose ((FILE *) fp
);
9124 jpeg_destroy_decompress (&cinfo
);
9126 /* If we already have an XImage, free that. */
9127 x_destroy_x_image (ximg
);
9129 /* Free pixmap and colors. */
9130 x_clear_image (f
, img
);
9136 /* Create the JPEG decompression object. Let it read from fp.
9137 Read the JPEG image header. */
9138 jpeg_create_decompress (&cinfo
);
9140 if (NILP (specified_data
))
9141 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9143 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9144 STRING_BYTES (XSTRING (specified_data
)));
9146 jpeg_read_header (&cinfo
, TRUE
);
9148 /* Customize decompression so that color quantization will be used.
9149 Start decompression. */
9150 cinfo
.quantize_colors
= TRUE
;
9151 jpeg_start_decompress (&cinfo
);
9152 width
= img
->width
= cinfo
.output_width
;
9153 height
= img
->height
= cinfo
.output_height
;
9155 /* Create X image and pixmap. */
9156 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9157 longjmp (mgr
.setjmp_buffer
, 2);
9159 /* Allocate colors. When color quantization is used,
9160 cinfo.actual_number_of_colors has been set with the number of
9161 colors generated, and cinfo.colormap is a two-dimensional array
9162 of color indices in the range 0..cinfo.actual_number_of_colors.
9163 No more than 255 colors will be generated. */
9167 if (cinfo
.out_color_components
> 2)
9168 ir
= 0, ig
= 1, ib
= 2;
9169 else if (cinfo
.out_color_components
> 1)
9170 ir
= 0, ig
= 1, ib
= 0;
9172 ir
= 0, ig
= 0, ib
= 0;
9174 /* Use the color table mechanism because it handles colors that
9175 cannot be allocated nicely. Such colors will be replaced with
9176 a default color, and we don't have to care about which colors
9177 can be freed safely, and which can't. */
9178 init_color_table ();
9179 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9182 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9184 /* Multiply RGB values with 255 because X expects RGB values
9185 in the range 0..0xffff. */
9186 int r
= cinfo
.colormap
[ir
][i
] << 8;
9187 int g
= cinfo
.colormap
[ig
][i
] << 8;
9188 int b
= cinfo
.colormap
[ib
][i
] << 8;
9189 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9192 /* Remember those colors actually allocated. */
9193 img
->colors
= colors_in_color_table (&img
->ncolors
);
9194 free_color_table ();
9198 row_stride
= width
* cinfo
.output_components
;
9199 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9201 for (y
= 0; y
< height
; ++y
)
9203 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9204 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9205 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9209 jpeg_finish_decompress (&cinfo
);
9210 jpeg_destroy_decompress (&cinfo
);
9212 fclose ((FILE *) fp
);
9214 /* Put the image into the pixmap. */
9215 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9216 x_destroy_x_image (ximg
);
9221 #endif /* HAVE_JPEG */
9225 /***********************************************************************
9227 ***********************************************************************/
9233 static int tiff_image_p
P_ ((Lisp_Object object
));
9234 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9236 /* The symbol `tiff' identifying images of this type. */
9240 /* Indices of image specification fields in tiff_format, below. */
9242 enum tiff_keyword_index
9251 TIFF_HEURISTIC_MASK
,
9256 /* Vector of image_keyword structures describing the format
9257 of valid user-defined image specifications. */
9259 static struct image_keyword tiff_format
[TIFF_LAST
] =
9261 {":type", IMAGE_SYMBOL_VALUE
, 1},
9262 {":data", IMAGE_STRING_VALUE
, 0},
9263 {":file", IMAGE_STRING_VALUE
, 0},
9264 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9265 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9266 {":relief", IMAGE_INTEGER_VALUE
, 0},
9267 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9268 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9269 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9272 /* Structure describing the image type `tiff'. */
9274 static struct image_type tiff_type
=
9284 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9287 tiff_image_p (object
)
9290 struct image_keyword fmt
[TIFF_LAST
];
9291 bcopy (tiff_format
, fmt
, sizeof fmt
);
9293 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9296 /* Must specify either the :data or :file keyword. */
9297 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9301 /* Reading from a memory buffer for TIFF images Based on the PNG
9302 memory source, but we have to provide a lot of extra functions.
9305 We really only need to implement read and seek, but I am not
9306 convinced that the TIFF library is smart enough not to destroy
9307 itself if we only hand it the function pointers we need to
9312 unsigned char *bytes
;
9320 tiff_read_from_memory (data
, buf
, size
)
9325 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9327 if (size
> src
->len
- src
->index
)
9329 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9336 tiff_write_from_memory (data
, buf
, size
)
9346 tiff_seek_in_memory (data
, off
, whence
)
9351 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9356 case SEEK_SET
: /* Go from beginning of source. */
9360 case SEEK_END
: /* Go from end of source. */
9361 idx
= src
->len
+ off
;
9364 case SEEK_CUR
: /* Go from current position. */
9365 idx
= src
->index
+ off
;
9368 default: /* Invalid `whence'. */
9372 if (idx
> src
->len
|| idx
< 0)
9381 tiff_close_memory (data
)
9390 tiff_mmap_memory (data
, pbase
, psize
)
9395 /* It is already _IN_ memory. */
9401 tiff_unmap_memory (data
, base
, size
)
9406 /* We don't need to do this. */
9411 tiff_size_of_memory (data
)
9414 return ((tiff_memory_source
*) data
)->len
;
9418 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9426 Lisp_Object file
, specified_file
;
9427 Lisp_Object specified_data
;
9429 int width
, height
, x
, y
;
9433 struct gcpro gcpro1
;
9434 tiff_memory_source memsrc
;
9436 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9437 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9441 if (NILP (specified_data
))
9443 /* Read from a file */
9444 file
= x_find_image_file (specified_file
);
9445 if (!STRINGP (file
))
9447 image_error ("Cannot find image file `%s'", file
, Qnil
);
9452 /* Try to open the image file. */
9453 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9456 image_error ("Cannot open `%s'", file
, Qnil
);
9463 /* Memory source! */
9464 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9465 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9468 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9469 (TIFFReadWriteProc
) tiff_read_from_memory
,
9470 (TIFFReadWriteProc
) tiff_write_from_memory
,
9471 tiff_seek_in_memory
,
9473 tiff_size_of_memory
,
9479 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9485 /* Get width and height of the image, and allocate a raster buffer
9486 of width x height 32-bit values. */
9487 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9488 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9489 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9491 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9495 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9501 /* Create the X image and pixmap. */
9502 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9509 /* Initialize the color table. */
9510 init_color_table ();
9512 /* Process the pixel raster. Origin is in the lower-left corner. */
9513 for (y
= 0; y
< height
; ++y
)
9515 uint32
*row
= buf
+ y
* width
;
9517 for (x
= 0; x
< width
; ++x
)
9519 uint32 abgr
= row
[x
];
9520 int r
= TIFFGetR (abgr
) << 8;
9521 int g
= TIFFGetG (abgr
) << 8;
9522 int b
= TIFFGetB (abgr
) << 8;
9523 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9527 /* Remember the colors allocated for the image. Free the color table. */
9528 img
->colors
= colors_in_color_table (&img
->ncolors
);
9529 free_color_table ();
9531 /* Put the image into the pixmap, then free the X image and its buffer. */
9532 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9533 x_destroy_x_image (ximg
);
9537 img
->height
= height
;
9543 #endif /* HAVE_TIFF != 0 */
9547 /***********************************************************************
9549 ***********************************************************************/
9553 #include <gif_lib.h>
9555 static int gif_image_p
P_ ((Lisp_Object object
));
9556 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9558 /* The symbol `gif' identifying images of this type. */
9562 /* Indices of image specification fields in gif_format, below. */
9564 enum gif_keyword_index
9579 /* Vector of image_keyword structures describing the format
9580 of valid user-defined image specifications. */
9582 static struct image_keyword gif_format
[GIF_LAST
] =
9584 {":type", IMAGE_SYMBOL_VALUE
, 1},
9585 {":data", IMAGE_STRING_VALUE
, 0},
9586 {":file", IMAGE_STRING_VALUE
, 0},
9587 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9588 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9589 {":relief", IMAGE_INTEGER_VALUE
, 0},
9590 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9591 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9592 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9593 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9596 /* Structure describing the image type `gif'. */
9598 static struct image_type gif_type
=
9608 /* Return non-zero if OBJECT is a valid GIF image specification. */
9611 gif_image_p (object
)
9614 struct image_keyword fmt
[GIF_LAST
];
9615 bcopy (gif_format
, fmt
, sizeof fmt
);
9617 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9620 /* Must specify either the :data or :file keyword. */
9621 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9625 /* Reading a GIF image from memory
9626 Based on the PNG memory stuff to a certain extent. */
9630 unsigned char *bytes
;
9637 /* Make the current memory source available to gif_read_from_memory.
9638 It's done this way because not all versions of libungif support
9639 a UserData field in the GifFileType structure. */
9640 static gif_memory_source
*current_gif_memory_src
;
9643 gif_read_from_memory (file
, buf
, len
)
9648 gif_memory_source
*src
= current_gif_memory_src
;
9650 if (len
> src
->len
- src
->index
)
9653 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9659 /* Load GIF image IMG for use on frame F. Value is non-zero if
9667 Lisp_Object file
, specified_file
;
9668 Lisp_Object specified_data
;
9669 int rc
, width
, height
, x
, y
, i
;
9671 ColorMapObject
*gif_color_map
;
9672 unsigned long pixel_colors
[256];
9674 struct gcpro gcpro1
;
9676 int ino
, image_left
, image_top
, image_width
, image_height
;
9677 gif_memory_source memsrc
;
9678 unsigned char *raster
;
9680 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9681 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9685 if (NILP (specified_data
))
9687 file
= x_find_image_file (specified_file
);
9688 if (!STRINGP (file
))
9690 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9695 /* Open the GIF file. */
9696 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9699 image_error ("Cannot open `%s'", file
, Qnil
);
9706 /* Read from memory! */
9707 current_gif_memory_src
= &memsrc
;
9708 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9709 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9712 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9715 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9721 /* Read entire contents. */
9722 rc
= DGifSlurp (gif
);
9723 if (rc
== GIF_ERROR
)
9725 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9726 DGifCloseFile (gif
);
9731 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9732 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9733 if (ino
>= gif
->ImageCount
)
9735 image_error ("Invalid image number `%s' in image `%s'",
9737 DGifCloseFile (gif
);
9742 width
= img
->width
= gif
->SWidth
;
9743 height
= img
->height
= gif
->SHeight
;
9745 /* Create the X image and pixmap. */
9746 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9748 DGifCloseFile (gif
);
9753 /* Allocate colors. */
9754 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9756 gif_color_map
= gif
->SColorMap
;
9757 init_color_table ();
9758 bzero (pixel_colors
, sizeof pixel_colors
);
9760 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9762 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9763 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9764 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9765 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9768 img
->colors
= colors_in_color_table (&img
->ncolors
);
9769 free_color_table ();
9771 /* Clear the part of the screen image that are not covered by
9772 the image from the GIF file. Full animated GIF support
9773 requires more than can be done here (see the gif89 spec,
9774 disposal methods). Let's simply assume that the part
9775 not covered by a sub-image is in the frame's background color. */
9776 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9777 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9778 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9779 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9781 for (y
= 0; y
< image_top
; ++y
)
9782 for (x
= 0; x
< width
; ++x
)
9783 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9785 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9786 for (x
= 0; x
< width
; ++x
)
9787 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9789 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9791 for (x
= 0; x
< image_left
; ++x
)
9792 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9793 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9794 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9797 /* Read the GIF image into the X image. We use a local variable
9798 `raster' here because RasterBits below is a char *, and invites
9799 problems with bytes >= 0x80. */
9800 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9802 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9804 static int interlace_start
[] = {0, 4, 2, 1};
9805 static int interlace_increment
[] = {8, 8, 4, 2};
9807 int row
= interlace_start
[0];
9811 for (y
= 0; y
< image_height
; y
++)
9813 if (row
>= image_height
)
9815 row
= interlace_start
[++pass
];
9816 while (row
>= image_height
)
9817 row
= interlace_start
[++pass
];
9820 for (x
= 0; x
< image_width
; x
++)
9822 int i
= raster
[(y
* image_width
) + x
];
9823 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9827 row
+= interlace_increment
[pass
];
9832 for (y
= 0; y
< image_height
; ++y
)
9833 for (x
= 0; x
< image_width
; ++x
)
9835 int i
= raster
[y
* image_width
+ x
];
9836 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9840 DGifCloseFile (gif
);
9842 /* Put the image into the pixmap, then free the X image and its buffer. */
9843 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9844 x_destroy_x_image (ximg
);
9850 #endif /* HAVE_GIF != 0 */
9854 /***********************************************************************
9856 ***********************************************************************/
9858 static int gs_image_p
P_ ((Lisp_Object object
));
9859 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9860 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9862 /* The symbol `postscript' identifying images of this type. */
9864 Lisp_Object Qpostscript
;
9866 /* Keyword symbols. */
9868 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9870 /* Indices of image specification fields in gs_format, below. */
9872 enum gs_keyword_index
9889 /* Vector of image_keyword structures describing the format
9890 of valid user-defined image specifications. */
9892 static struct image_keyword gs_format
[GS_LAST
] =
9894 {":type", IMAGE_SYMBOL_VALUE
, 1},
9895 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9896 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9897 {":file", IMAGE_STRING_VALUE
, 1},
9898 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9899 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9900 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9901 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9902 {":relief", IMAGE_INTEGER_VALUE
, 0},
9903 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9904 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9905 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9908 /* Structure describing the image type `ghostscript'. */
9910 static struct image_type gs_type
=
9920 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9923 gs_clear_image (f
, img
)
9927 /* IMG->data.ptr_val may contain a recorded colormap. */
9928 xfree (img
->data
.ptr_val
);
9929 x_clear_image (f
, img
);
9933 /* Return non-zero if OBJECT is a valid Ghostscript image
9940 struct image_keyword fmt
[GS_LAST
];
9944 bcopy (gs_format
, fmt
, sizeof fmt
);
9946 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
9949 /* Bounding box must be a list or vector containing 4 integers. */
9950 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9953 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9954 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9959 else if (VECTORP (tem
))
9961 if (XVECTOR (tem
)->size
!= 4)
9963 for (i
= 0; i
< 4; ++i
)
9964 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9974 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9983 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9984 struct gcpro gcpro1
, gcpro2
;
9986 double in_width
, in_height
;
9987 Lisp_Object pixel_colors
= Qnil
;
9989 /* Compute pixel size of pixmap needed from the given size in the
9990 image specification. Sizes in the specification are in pt. 1 pt
9991 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9993 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9994 in_width
= XFASTINT (pt_width
) / 72.0;
9995 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9996 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9997 in_height
= XFASTINT (pt_height
) / 72.0;
9998 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
10000 /* Create the pixmap. */
10001 xassert (img
->pixmap
== None
);
10002 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10003 img
->width
, img
->height
,
10004 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
10008 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
10012 /* Call the loader to fill the pixmap. It returns a process object
10013 if successful. We do not record_unwind_protect here because
10014 other places in redisplay like calling window scroll functions
10015 don't either. Let the Lisp loader use `unwind-protect' instead. */
10016 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
10018 sprintf (buffer
, "%lu %lu",
10019 (unsigned long) FRAME_X_WINDOW (f
),
10020 (unsigned long) img
->pixmap
);
10021 window_and_pixmap_id
= build_string (buffer
);
10023 sprintf (buffer
, "%lu %lu",
10024 FRAME_FOREGROUND_PIXEL (f
),
10025 FRAME_BACKGROUND_PIXEL (f
));
10026 pixel_colors
= build_string (buffer
);
10028 XSETFRAME (frame
, f
);
10029 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
10031 loader
= intern ("gs-load-image");
10033 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10034 make_number (img
->width
),
10035 make_number (img
->height
),
10036 window_and_pixmap_id
,
10039 return PROCESSP (img
->data
.lisp_val
);
10043 /* Kill the Ghostscript process that was started to fill PIXMAP on
10044 frame F. Called from XTread_socket when receiving an event
10045 telling Emacs that Ghostscript has finished drawing. */
10048 x_kill_gs_process (pixmap
, f
)
10052 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10056 /* Find the image containing PIXMAP. */
10057 for (i
= 0; i
< c
->used
; ++i
)
10058 if (c
->images
[i
]->pixmap
== pixmap
)
10061 /* Kill the GS process. We should have found PIXMAP in the image
10062 cache and its image should contain a process object. */
10063 xassert (i
< c
->used
);
10064 img
= c
->images
[i
];
10065 xassert (PROCESSP (img
->data
.lisp_val
));
10066 Fkill_process (img
->data
.lisp_val
, Qnil
);
10067 img
->data
.lisp_val
= Qnil
;
10069 /* On displays with a mutable colormap, figure out the colors
10070 allocated for the image by looking at the pixels of an XImage for
10072 class = FRAME_X_VISUAL (f
)->class;
10073 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10079 /* Try to get an XImage for img->pixmep. */
10080 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10081 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10086 /* Initialize the color table. */
10087 init_color_table ();
10089 /* For each pixel of the image, look its color up in the
10090 color table. After having done so, the color table will
10091 contain an entry for each color used by the image. */
10092 for (y
= 0; y
< img
->height
; ++y
)
10093 for (x
= 0; x
< img
->width
; ++x
)
10095 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10096 lookup_pixel_color (f
, pixel
);
10099 /* Record colors in the image. Free color table and XImage. */
10100 img
->colors
= colors_in_color_table (&img
->ncolors
);
10101 free_color_table ();
10102 XDestroyImage (ximg
);
10104 #if 0 /* This doesn't seem to be the case. If we free the colors
10105 here, we get a BadAccess later in x_clear_image when
10106 freeing the colors. */
10107 /* We have allocated colors once, but Ghostscript has also
10108 allocated colors on behalf of us. So, to get the
10109 reference counts right, free them once. */
10111 x_free_colors (f
, img
->colors
, img
->ncolors
);
10115 image_error ("Cannot get X image of `%s'; colors will not be freed",
10121 /* Now that we have the pixmap, compute mask and transform the
10122 image if requested. */
10124 postprocess_image (f
, img
);
10130 /***********************************************************************
10132 ***********************************************************************/
10134 DEFUN ("x-change-window-property", Fx_change_window_property
,
10135 Sx_change_window_property
, 2, 3, 0,
10136 "Change window property PROP to VALUE on the X window of FRAME.\n\
10137 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
10138 selected frame. Value is VALUE.")
10139 (prop
, value
, frame
)
10140 Lisp_Object frame
, prop
, value
;
10142 struct frame
*f
= check_x_frame (frame
);
10145 CHECK_STRING (prop
, 1);
10146 CHECK_STRING (value
, 2);
10149 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10150 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10151 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10152 XSTRING (value
)->data
, XSTRING (value
)->size
);
10154 /* Make sure the property is set when we return. */
10155 XFlush (FRAME_X_DISPLAY (f
));
10162 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10163 Sx_delete_window_property
, 1, 2, 0,
10164 "Remove window property PROP from X window of FRAME.\n\
10165 FRAME nil or omitted means use the selected frame. Value is PROP.")
10167 Lisp_Object prop
, frame
;
10169 struct frame
*f
= check_x_frame (frame
);
10172 CHECK_STRING (prop
, 1);
10174 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10175 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10177 /* Make sure the property is removed when we return. */
10178 XFlush (FRAME_X_DISPLAY (f
));
10185 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10187 "Value is the value of window property PROP on FRAME.\n\
10188 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10189 if FRAME hasn't a property with name PROP or if PROP has no string\n\
10192 Lisp_Object prop
, frame
;
10194 struct frame
*f
= check_x_frame (frame
);
10197 Lisp_Object prop_value
= Qnil
;
10198 char *tmp_data
= NULL
;
10201 unsigned long actual_size
, bytes_remaining
;
10203 CHECK_STRING (prop
, 1);
10205 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10206 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10207 prop_atom
, 0, 0, False
, XA_STRING
,
10208 &actual_type
, &actual_format
, &actual_size
,
10209 &bytes_remaining
, (unsigned char **) &tmp_data
);
10212 int size
= bytes_remaining
;
10217 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10218 prop_atom
, 0, bytes_remaining
,
10220 &actual_type
, &actual_format
,
10221 &actual_size
, &bytes_remaining
,
10222 (unsigned char **) &tmp_data
);
10224 prop_value
= make_string (tmp_data
, size
);
10235 /***********************************************************************
10237 ***********************************************************************/
10239 /* If non-null, an asynchronous timer that, when it expires, displays
10240 an hourglass cursor on all frames. */
10242 static struct atimer
*hourglass_atimer
;
10244 /* Non-zero means an hourglass cursor is currently shown. */
10246 static int hourglass_shown_p
;
10248 /* Number of seconds to wait before displaying an hourglass cursor. */
10250 static Lisp_Object Vhourglass_delay
;
10252 /* Default number of seconds to wait before displaying an hourglass
10255 #define DEFAULT_HOURGLASS_DELAY 1
10257 /* Function prototypes. */
10259 static void show_hourglass
P_ ((struct atimer
*));
10260 static void hide_hourglass
P_ ((void));
10263 /* Cancel a currently active hourglass timer, and start a new one. */
10269 int secs
, usecs
= 0;
10271 cancel_hourglass ();
10273 if (INTEGERP (Vhourglass_delay
)
10274 && XINT (Vhourglass_delay
) > 0)
10275 secs
= XFASTINT (Vhourglass_delay
);
10276 else if (FLOATP (Vhourglass_delay
)
10277 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10280 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10281 secs
= XFASTINT (tem
);
10282 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10285 secs
= DEFAULT_HOURGLASS_DELAY
;
10287 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10288 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10289 show_hourglass
, NULL
);
10293 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10297 cancel_hourglass ()
10299 if (hourglass_atimer
)
10301 cancel_atimer (hourglass_atimer
);
10302 hourglass_atimer
= NULL
;
10305 if (hourglass_shown_p
)
10310 /* Timer function of hourglass_atimer. TIMER is equal to
10313 Display an hourglass pointer on all frames by mapping the frames'
10314 hourglass_window. Set the hourglass_p flag in the frames'
10315 output_data.x structure to indicate that an hourglass cursor is
10316 shown on the frames. */
10319 show_hourglass (timer
)
10320 struct atimer
*timer
;
10322 /* The timer implementation will cancel this timer automatically
10323 after this function has run. Set hourglass_atimer to null
10324 so that we know the timer doesn't have to be canceled. */
10325 hourglass_atimer
= NULL
;
10327 if (!hourglass_shown_p
)
10329 Lisp_Object rest
, frame
;
10333 FOR_EACH_FRAME (rest
, frame
)
10335 struct frame
*f
= XFRAME (frame
);
10337 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10339 Display
*dpy
= FRAME_X_DISPLAY (f
);
10341 #ifdef USE_X_TOOLKIT
10342 if (f
->output_data
.x
->widget
)
10344 if (FRAME_OUTER_WINDOW (f
))
10347 f
->output_data
.x
->hourglass_p
= 1;
10349 if (!f
->output_data
.x
->hourglass_window
)
10351 unsigned long mask
= CWCursor
;
10352 XSetWindowAttributes attrs
;
10354 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10356 f
->output_data
.x
->hourglass_window
10357 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10358 0, 0, 32000, 32000, 0, 0,
10364 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10370 hourglass_shown_p
= 1;
10376 /* Hide the hourglass pointer on all frames, if it is currently
10382 if (hourglass_shown_p
)
10384 Lisp_Object rest
, frame
;
10387 FOR_EACH_FRAME (rest
, frame
)
10389 struct frame
*f
= XFRAME (frame
);
10392 /* Watch out for newly created frames. */
10393 && f
->output_data
.x
->hourglass_window
)
10395 XUnmapWindow (FRAME_X_DISPLAY (f
),
10396 f
->output_data
.x
->hourglass_window
);
10397 /* Sync here because XTread_socket looks at the
10398 hourglass_p flag that is reset to zero below. */
10399 XSync (FRAME_X_DISPLAY (f
), False
);
10400 f
->output_data
.x
->hourglass_p
= 0;
10404 hourglass_shown_p
= 0;
10411 /***********************************************************************
10413 ***********************************************************************/
10415 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10416 Lisp_Object
, Lisp_Object
));
10417 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10418 Lisp_Object
, int *, int *));
10420 /* The frame of a currently visible tooltip. */
10422 Lisp_Object tip_frame
;
10424 /* If non-nil, a timer started that hides the last tooltip when it
10427 Lisp_Object tip_timer
;
10430 /* If non-nil, a vector of 3 elements containing the last args
10431 with which x-show-tip was called. See there. */
10433 Lisp_Object last_show_tip_args
;
10437 unwind_create_tip_frame (frame
)
10440 Lisp_Object deleted
;
10442 deleted
= unwind_create_frame (frame
);
10443 if (EQ (deleted
, Qt
))
10453 /* Create a frame for a tooltip on the display described by DPYINFO.
10454 PARMS is a list of frame parameters. TEXT is the string to
10455 display in the tip frame. Value is the frame.
10457 Note that functions called here, esp. x_default_parameter can
10458 signal errors, for instance when a specified color name is
10459 undefined. We have to make sure that we're in a consistent state
10460 when this happens. */
10463 x_create_tip_frame (dpyinfo
, parms
, text
)
10464 struct x_display_info
*dpyinfo
;
10465 Lisp_Object parms
, text
;
10468 Lisp_Object frame
, tem
;
10470 long window_prompting
= 0;
10472 int count
= BINDING_STACK_SIZE ();
10473 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10475 int face_change_count_before
= face_change_count
;
10476 Lisp_Object buffer
;
10477 struct buffer
*old_buffer
;
10481 /* Use this general default value to start with until we know if
10482 this frame has a specified name. */
10483 Vx_resource_name
= Vinvocation_name
;
10485 #ifdef MULTI_KBOARD
10486 kb
= dpyinfo
->kboard
;
10488 kb
= &the_only_kboard
;
10491 /* Get the name of the frame to use for resource lookup. */
10492 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10493 if (!STRINGP (name
)
10494 && !EQ (name
, Qunbound
)
10496 error ("Invalid frame name--not a string or nil");
10497 Vx_resource_name
= name
;
10500 GCPRO3 (parms
, name
, frame
);
10501 f
= make_frame (1);
10502 XSETFRAME (frame
, f
);
10504 buffer
= Fget_buffer_create (build_string (" *tip*"));
10505 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10506 old_buffer
= current_buffer
;
10507 set_buffer_internal_1 (XBUFFER (buffer
));
10509 Finsert (1, &text
);
10510 set_buffer_internal_1 (old_buffer
);
10512 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10513 record_unwind_protect (unwind_create_tip_frame
, frame
);
10515 /* By setting the output method, we're essentially saying that
10516 the frame is live, as per FRAME_LIVE_P. If we get a signal
10517 from this point on, x_destroy_window might screw up reference
10519 f
->output_method
= output_x_window
;
10520 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10521 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10522 f
->output_data
.x
->icon_bitmap
= -1;
10523 f
->output_data
.x
->fontset
= -1;
10524 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10525 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10526 f
->icon_name
= Qnil
;
10527 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10529 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10530 dpyinfo_refcount
= dpyinfo
->reference_count
;
10531 #endif /* GLYPH_DEBUG */
10532 #ifdef MULTI_KBOARD
10533 FRAME_KBOARD (f
) = kb
;
10535 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10536 f
->output_data
.x
->explicit_parent
= 0;
10538 /* These colors will be set anyway later, but it's important
10539 to get the color reference counts right, so initialize them! */
10542 struct gcpro gcpro1
;
10544 black
= build_string ("black");
10546 f
->output_data
.x
->foreground_pixel
10547 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10548 f
->output_data
.x
->background_pixel
10549 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10550 f
->output_data
.x
->cursor_pixel
10551 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10552 f
->output_data
.x
->cursor_foreground_pixel
10553 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10554 f
->output_data
.x
->border_pixel
10555 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10556 f
->output_data
.x
->mouse_pixel
10557 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10561 /* Set the name; the functions to which we pass f expect the name to
10563 if (EQ (name
, Qunbound
) || NILP (name
))
10565 f
->name
= build_string (dpyinfo
->x_id_name
);
10566 f
->explicit_name
= 0;
10571 f
->explicit_name
= 1;
10572 /* use the frame's title when getting resources for this frame. */
10573 specbind (Qx_resource_name
, name
);
10576 /* Extract the window parameters from the supplied values that are
10577 needed to determine window geometry. */
10581 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10584 /* First, try whatever font the caller has specified. */
10585 if (STRINGP (font
))
10587 tem
= Fquery_fontset (font
, Qnil
);
10589 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10591 font
= x_new_font (f
, XSTRING (font
)->data
);
10594 /* Try out a font which we hope has bold and italic variations. */
10595 if (!STRINGP (font
))
10596 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10597 if (!STRINGP (font
))
10598 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10599 if (! STRINGP (font
))
10600 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10601 if (! STRINGP (font
))
10602 /* This was formerly the first thing tried, but it finds too many fonts
10603 and takes too long. */
10604 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10605 /* If those didn't work, look for something which will at least work. */
10606 if (! STRINGP (font
))
10607 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10609 if (! STRINGP (font
))
10610 font
= build_string ("fixed");
10612 x_default_parameter (f
, parms
, Qfont
, font
,
10613 "font", "Font", RES_TYPE_STRING
);
10616 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10617 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10619 /* This defaults to 2 in order to match xterm. We recognize either
10620 internalBorderWidth or internalBorder (which is what xterm calls
10622 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10626 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10627 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10628 if (! EQ (value
, Qunbound
))
10629 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10633 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10634 "internalBorderWidth", "internalBorderWidth",
10637 /* Also do the stuff which must be set before the window exists. */
10638 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10639 "foreground", "Foreground", RES_TYPE_STRING
);
10640 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10641 "background", "Background", RES_TYPE_STRING
);
10642 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10643 "pointerColor", "Foreground", RES_TYPE_STRING
);
10644 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10645 "cursorColor", "Foreground", RES_TYPE_STRING
);
10646 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10647 "borderColor", "BorderColor", RES_TYPE_STRING
);
10649 /* Init faces before x_default_parameter is called for scroll-bar
10650 parameters because that function calls x_set_scroll_bar_width,
10651 which calls change_frame_size, which calls Fset_window_buffer,
10652 which runs hooks, which call Fvertical_motion. At the end, we
10653 end up in init_iterator with a null face cache, which should not
10655 init_frame_faces (f
);
10657 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10658 window_prompting
= x_figure_window_size (f
, parms
);
10660 if (window_prompting
& XNegative
)
10662 if (window_prompting
& YNegative
)
10663 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10665 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10669 if (window_prompting
& YNegative
)
10670 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10672 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10675 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10677 XSetWindowAttributes attrs
;
10678 unsigned long mask
;
10681 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10682 if (DoesSaveUnders (dpyinfo
->screen
))
10683 mask
|= CWSaveUnder
;
10685 /* Window managers look at the override-redirect flag to determine
10686 whether or net to give windows a decoration (Xlib spec, chapter
10688 attrs
.override_redirect
= True
;
10689 attrs
.save_under
= True
;
10690 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10691 /* Arrange for getting MapNotify and UnmapNotify events. */
10692 attrs
.event_mask
= StructureNotifyMask
;
10694 = FRAME_X_WINDOW (f
)
10695 = XCreateWindow (FRAME_X_DISPLAY (f
),
10696 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10697 /* x, y, width, height */
10701 CopyFromParent
, InputOutput
, CopyFromParent
,
10708 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10709 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10710 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10711 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10712 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10713 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10715 /* Dimensions, especially f->height, must be done via change_frame_size.
10716 Change will not be effected unless different from the current
10719 height
= f
->height
;
10721 SET_FRAME_WIDTH (f
, 0);
10722 change_frame_size (f
, height
, width
, 1, 0, 0);
10724 /* Set up faces after all frame parameters are known. This call
10725 also merges in face attributes specified for new frames.
10727 Frame parameters may be changed if .Xdefaults contains
10728 specifications for the default font. For example, if there is an
10729 `Emacs.default.attributeBackground: pink', the `background-color'
10730 attribute of the frame get's set, which let's the internal border
10731 of the tooltip frame appear in pink. Prevent this. */
10733 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
10735 /* Set tip_frame here, so that */
10737 call1 (Qface_set_after_frame_default
, frame
);
10739 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
10740 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
10748 /* It is now ok to make the frame official even if we get an error
10749 below. And the frame needs to be on Vframe_list or making it
10750 visible won't work. */
10751 Vframe_list
= Fcons (frame
, Vframe_list
);
10753 /* Now that the frame is official, it counts as a reference to
10755 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10757 /* Setting attributes of faces of the tooltip frame from resources
10758 and similar will increment face_change_count, which leads to the
10759 clearing of all current matrices. Since this isn't necessary
10760 here, avoid it by resetting face_change_count to the value it
10761 had before we created the tip frame. */
10762 face_change_count
= face_change_count_before
;
10764 /* Discard the unwind_protect. */
10765 return unbind_to (count
, frame
);
10769 /* Compute where to display tip frame F. PARMS is the list of frame
10770 parameters for F. DX and DY are specified offsets from the current
10771 location of the mouse. Return coordinates relative to the root
10772 window of the display in *ROOT_X, and *ROOT_Y. */
10775 compute_tip_xy (f
, parms
, dx
, dy
, root_x
, root_y
)
10777 Lisp_Object parms
, dx
, dy
;
10778 int *root_x
, *root_y
;
10780 Lisp_Object left
, top
;
10782 Window root
, child
;
10785 /* User-specified position? */
10786 left
= Fcdr (Fassq (Qleft
, parms
));
10787 top
= Fcdr (Fassq (Qtop
, parms
));
10789 /* Move the tooltip window where the mouse pointer is. Resize and
10792 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10793 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
10796 *root_x
+= XINT (dx
);
10797 *root_y
+= XINT (dy
);
10799 if (INTEGERP (left
))
10800 *root_x
= XINT (left
);
10801 if (INTEGERP (top
))
10802 *root_y
= XINT (top
);
10806 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10807 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10808 A tooltip window is a small X window displaying a string.\n\
10810 FRAME nil or omitted means use the selected frame.\n\
10812 PARMS is an optional list of frame parameters which can be\n\
10813 used to change the tooltip's appearance.\n\
10815 Automatically hide the tooltip after TIMEOUT seconds.\n\
10816 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10818 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10819 the tooltip is displayed at that x-position. Otherwise it is\n\
10820 displayed at the mouse position, with offset DX added (default is 5 if\n\
10821 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10822 parameter is specified, it determines the y-position of the tooltip\n\
10823 window, otherwise it is displayed at the mouse position, with offset\n\
10824 DY added (default is -10).")
10825 (string
, frame
, parms
, timeout
, dx
, dy
)
10826 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10830 Lisp_Object buffer
, top
, left
;
10831 int root_x
, root_y
;
10832 struct buffer
*old_buffer
;
10833 struct text_pos pos
;
10834 int i
, width
, height
;
10835 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10836 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10837 int count
= BINDING_STACK_SIZE ();
10839 specbind (Qinhibit_redisplay
, Qt
);
10841 GCPRO4 (string
, parms
, frame
, timeout
);
10843 CHECK_STRING (string
, 0);
10844 f
= check_x_frame (frame
);
10845 if (NILP (timeout
))
10846 timeout
= make_number (5);
10848 CHECK_NATNUM (timeout
, 2);
10851 dx
= make_number (5);
10853 CHECK_NUMBER (dx
, 5);
10856 dy
= make_number (-10);
10858 CHECK_NUMBER (dy
, 6);
10860 if (NILP (last_show_tip_args
))
10861 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
10863 if (!NILP (tip_frame
))
10865 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
10866 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
10867 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
10869 if (EQ (frame
, last_frame
)
10870 && !NILP (Fequal (last_string
, string
))
10871 && !NILP (Fequal (last_parms
, parms
)))
10873 struct frame
*f
= XFRAME (tip_frame
);
10875 /* Only DX and DY have changed. */
10876 if (!NILP (tip_timer
))
10878 Lisp_Object timer
= tip_timer
;
10880 call1 (Qcancel_timer
, timer
);
10884 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
10885 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10886 root_x
, root_y
- PIXEL_HEIGHT (f
));
10892 /* Hide a previous tip, if any. */
10895 ASET (last_show_tip_args
, 0, string
);
10896 ASET (last_show_tip_args
, 1, frame
);
10897 ASET (last_show_tip_args
, 2, parms
);
10899 /* Add default values to frame parameters. */
10900 if (NILP (Fassq (Qname
, parms
)))
10901 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10902 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10903 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10904 if (NILP (Fassq (Qborder_width
, parms
)))
10905 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10906 if (NILP (Fassq (Qborder_color
, parms
)))
10907 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10908 if (NILP (Fassq (Qbackground_color
, parms
)))
10909 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10912 /* Create a frame for the tooltip, and record it in the global
10913 variable tip_frame. */
10914 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
, string
);
10915 f
= XFRAME (frame
);
10917 /* Set up the frame's root window. Currently we use a size of 80
10918 columns x 40 lines. If someone wants to show a larger tip, he
10919 will loose. I don't think this is a realistic case. */
10920 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10921 w
->left
= w
->top
= make_number (0);
10922 w
->width
= make_number (80);
10923 w
->height
= make_number (40);
10925 w
->pseudo_window_p
= 1;
10927 /* Display the tooltip text in a temporary buffer. */
10928 old_buffer
= current_buffer
;
10929 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
10930 clear_glyph_matrix (w
->desired_matrix
);
10931 clear_glyph_matrix (w
->current_matrix
);
10932 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10933 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10935 /* Compute width and height of the tooltip. */
10936 width
= height
= 0;
10937 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10939 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10940 struct glyph
*last
;
10943 /* Stop at the first empty row at the end. */
10944 if (!row
->enabled_p
|| !row
->displays_text_p
)
10947 /* Let the row go over the full width of the frame. */
10948 row
->full_width_p
= 1;
10950 /* There's a glyph at the end of rows that is used to place
10951 the cursor there. Don't include the width of this glyph. */
10952 if (row
->used
[TEXT_AREA
])
10954 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10955 row_width
= row
->pixel_width
- last
->pixel_width
;
10958 row_width
= row
->pixel_width
;
10960 height
+= row
->height
;
10961 width
= max (width
, row_width
);
10964 /* Add the frame's internal border to the width and height the X
10965 window should have. */
10966 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10967 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10969 /* Move the tooltip window where the mouse pointer is. Resize and
10971 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
10974 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10975 root_x
, root_y
- height
, width
, height
);
10976 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10979 /* Draw into the window. */
10980 w
->must_be_updated_p
= 1;
10981 update_single_window (w
, 1);
10983 /* Restore original current buffer. */
10984 set_buffer_internal_1 (old_buffer
);
10985 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
10988 /* Let the tip disappear after timeout seconds. */
10989 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
10990 intern ("x-hide-tip"));
10993 return unbind_to (count
, Qnil
);
10997 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
10998 "Hide the current tooltip window, if there is any.\n\
10999 Value is t is tooltip was open, nil otherwise.")
11003 Lisp_Object deleted
, frame
, timer
;
11004 struct gcpro gcpro1
, gcpro2
;
11006 /* Return quickly if nothing to do. */
11007 if (NILP (tip_timer
) && NILP (tip_frame
))
11012 GCPRO2 (frame
, timer
);
11013 tip_frame
= tip_timer
= deleted
= Qnil
;
11015 count
= BINDING_STACK_SIZE ();
11016 specbind (Qinhibit_redisplay
, Qt
);
11017 specbind (Qinhibit_quit
, Qt
);
11020 call1 (Qcancel_timer
, timer
);
11022 if (FRAMEP (frame
))
11024 Fdelete_frame (frame
, Qnil
);
11028 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11029 redisplay procedure is not called when a tip frame over menu
11030 items is unmapped. Redisplay the menu manually... */
11032 struct frame
*f
= SELECTED_FRAME ();
11033 Widget w
= f
->output_data
.x
->menubar_widget
;
11034 extern void xlwmenu_redisplay
P_ ((Widget
));
11036 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
11040 xlwmenu_redisplay (w
);
11044 #endif /* USE_LUCID */
11048 return unbind_to (count
, deleted
);
11053 /***********************************************************************
11054 File selection dialog
11055 ***********************************************************************/
11059 /* Callback for "OK" and "Cancel" on file selection dialog. */
11062 file_dialog_cb (widget
, client_data
, call_data
)
11064 XtPointer call_data
, client_data
;
11066 int *result
= (int *) client_data
;
11067 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11068 *result
= cb
->reason
;
11072 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11073 "Read file name, prompting with PROMPT in directory DIR.\n\
11074 Use a file selection dialog.\n\
11075 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
11076 specified. Don't let the user enter a file name in the file\n\
11077 selection dialog's entry field, if MUSTMATCH is non-nil.")
11078 (prompt
, dir
, default_filename
, mustmatch
)
11079 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11082 struct frame
*f
= SELECTED_FRAME ();
11083 Lisp_Object file
= Qnil
;
11084 Widget dialog
, text
, list
, help
;
11087 extern XtAppContext Xt_app_con
;
11089 XmString dir_xmstring
, pattern_xmstring
;
11090 int popup_activated_flag
;
11091 int count
= specpdl_ptr
- specpdl
;
11092 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11094 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11095 CHECK_STRING (prompt
, 0);
11096 CHECK_STRING (dir
, 1);
11098 /* Prevent redisplay. */
11099 specbind (Qinhibit_redisplay
, Qt
);
11103 /* Create the dialog with PROMPT as title, using DIR as initial
11104 directory and using "*" as pattern. */
11105 dir
= Fexpand_file_name (dir
, Qnil
);
11106 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11107 pattern_xmstring
= XmStringCreateLocalized ("*");
11109 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11110 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11111 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11112 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11113 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11114 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11116 XmStringFree (dir_xmstring
);
11117 XmStringFree (pattern_xmstring
);
11119 /* Add callbacks for OK and Cancel. */
11120 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11121 (XtPointer
) &result
);
11122 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11123 (XtPointer
) &result
);
11125 /* Disable the help button since we can't display help. */
11126 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11127 XtSetSensitive (help
, False
);
11129 /* Mark OK button as default. */
11130 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11131 XmNshowAsDefault
, True
, NULL
);
11133 /* If MUSTMATCH is non-nil, disable the file entry field of the
11134 dialog, so that the user must select a file from the files list
11135 box. We can't remove it because we wouldn't have a way to get at
11136 the result file name, then. */
11137 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11138 if (!NILP (mustmatch
))
11141 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11142 XtSetSensitive (text
, False
);
11143 XtSetSensitive (label
, False
);
11146 /* Manage the dialog, so that list boxes get filled. */
11147 XtManageChild (dialog
);
11149 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11150 must include the path for this to work. */
11151 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11152 if (STRINGP (default_filename
))
11154 XmString default_xmstring
;
11158 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11160 if (!XmListItemExists (list
, default_xmstring
))
11162 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11163 XmListAddItem (list
, default_xmstring
, 0);
11167 item_pos
= XmListItemPos (list
, default_xmstring
);
11168 XmStringFree (default_xmstring
);
11170 /* Select the item and scroll it into view. */
11171 XmListSelectPos (list
, item_pos
, True
);
11172 XmListSetPos (list
, item_pos
);
11175 /* Process events until the user presses Cancel or OK. */
11177 while (result
== 0 || XtAppPending (Xt_app_con
))
11178 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11180 /* Get the result. */
11181 if (result
== XmCR_OK
)
11186 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11187 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11188 XmStringFree (text
);
11189 file
= build_string (data
);
11196 XtUnmanageChild (dialog
);
11197 XtDestroyWidget (dialog
);
11201 /* Make "Cancel" equivalent to C-g. */
11203 Fsignal (Qquit
, Qnil
);
11205 return unbind_to (count
, file
);
11208 #endif /* USE_MOTIF */
11212 /***********************************************************************
11214 ***********************************************************************/
11216 #ifdef HAVE_XKBGETKEYBOARD
11217 #include <X11/XKBlib.h>
11218 #include <X11/keysym.h>
11221 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11222 Sx_backspace_delete_keys_p
, 0, 1, 0,
11223 "Check if both Backspace and Delete keys are on the keyboard of FRAME.\n\
11224 FRAME nil means use the selected frame.\n\
11225 Value is t if we know that both keys are present, and are mapped to the\n\
11230 #ifdef HAVE_XKBGETKEYBOARD
11232 struct frame
*f
= check_x_frame (frame
);
11233 Display
*dpy
= FRAME_X_DISPLAY (f
);
11234 Lisp_Object have_keys
;
11235 int major
, minor
, op
, event
, error
;
11239 /* Check library version in case we're dynamically linked. */
11240 major
= XkbMajorVersion
;
11241 minor
= XkbMinorVersion
;
11242 if (!XkbLibraryVersion (&major
, &minor
))
11248 /* Check that the server supports XKB. */
11249 major
= XkbMajorVersion
;
11250 minor
= XkbMinorVersion
;
11251 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11258 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11261 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11263 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11265 for (i
= kb
->min_key_code
;
11266 (i
< kb
->max_key_code
11267 && (delete_keycode
== 0 || backspace_keycode
== 0));
11270 /* The XKB symbolic key names can be seen most easily
11271 in the PS file generated by `xkbprint -label name $DISPLAY'. */
11272 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11273 delete_keycode
= i
;
11274 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11275 backspace_keycode
= i
;
11278 XkbFreeNames (kb
, 0, True
);
11281 XkbFreeClientMap (kb
, 0, True
);
11284 && backspace_keycode
11285 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11286 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11291 #else /* not HAVE_XKBGETKEYBOARD */
11293 #endif /* not HAVE_XKBGETKEYBOARD */
11298 /***********************************************************************
11300 ***********************************************************************/
11305 /* This is zero if not using X windows. */
11308 /* The section below is built by the lisp expression at the top of the file,
11309 just above where these variables are declared. */
11310 /*&&& init symbols here &&&*/
11311 Qauto_raise
= intern ("auto-raise");
11312 staticpro (&Qauto_raise
);
11313 Qauto_lower
= intern ("auto-lower");
11314 staticpro (&Qauto_lower
);
11315 Qbar
= intern ("bar");
11317 Qborder_color
= intern ("border-color");
11318 staticpro (&Qborder_color
);
11319 Qborder_width
= intern ("border-width");
11320 staticpro (&Qborder_width
);
11321 Qbox
= intern ("box");
11323 Qcursor_color
= intern ("cursor-color");
11324 staticpro (&Qcursor_color
);
11325 Qcursor_type
= intern ("cursor-type");
11326 staticpro (&Qcursor_type
);
11327 Qgeometry
= intern ("geometry");
11328 staticpro (&Qgeometry
);
11329 Qicon_left
= intern ("icon-left");
11330 staticpro (&Qicon_left
);
11331 Qicon_top
= intern ("icon-top");
11332 staticpro (&Qicon_top
);
11333 Qicon_type
= intern ("icon-type");
11334 staticpro (&Qicon_type
);
11335 Qicon_name
= intern ("icon-name");
11336 staticpro (&Qicon_name
);
11337 Qinternal_border_width
= intern ("internal-border-width");
11338 staticpro (&Qinternal_border_width
);
11339 Qleft
= intern ("left");
11340 staticpro (&Qleft
);
11341 Qright
= intern ("right");
11342 staticpro (&Qright
);
11343 Qmouse_color
= intern ("mouse-color");
11344 staticpro (&Qmouse_color
);
11345 Qnone
= intern ("none");
11346 staticpro (&Qnone
);
11347 Qparent_id
= intern ("parent-id");
11348 staticpro (&Qparent_id
);
11349 Qscroll_bar_width
= intern ("scroll-bar-width");
11350 staticpro (&Qscroll_bar_width
);
11351 Qsuppress_icon
= intern ("suppress-icon");
11352 staticpro (&Qsuppress_icon
);
11353 Qundefined_color
= intern ("undefined-color");
11354 staticpro (&Qundefined_color
);
11355 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11356 staticpro (&Qvertical_scroll_bars
);
11357 Qvisibility
= intern ("visibility");
11358 staticpro (&Qvisibility
);
11359 Qwindow_id
= intern ("window-id");
11360 staticpro (&Qwindow_id
);
11361 Qouter_window_id
= intern ("outer-window-id");
11362 staticpro (&Qouter_window_id
);
11363 Qx_frame_parameter
= intern ("x-frame-parameter");
11364 staticpro (&Qx_frame_parameter
);
11365 Qx_resource_name
= intern ("x-resource-name");
11366 staticpro (&Qx_resource_name
);
11367 Quser_position
= intern ("user-position");
11368 staticpro (&Quser_position
);
11369 Quser_size
= intern ("user-size");
11370 staticpro (&Quser_size
);
11371 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11372 staticpro (&Qscroll_bar_foreground
);
11373 Qscroll_bar_background
= intern ("scroll-bar-background");
11374 staticpro (&Qscroll_bar_background
);
11375 Qscreen_gamma
= intern ("screen-gamma");
11376 staticpro (&Qscreen_gamma
);
11377 Qline_spacing
= intern ("line-spacing");
11378 staticpro (&Qline_spacing
);
11379 Qcenter
= intern ("center");
11380 staticpro (&Qcenter
);
11381 Qcompound_text
= intern ("compound-text");
11382 staticpro (&Qcompound_text
);
11383 Qcancel_timer
= intern ("cancel-timer");
11384 staticpro (&Qcancel_timer
);
11385 /* This is the end of symbol initialization. */
11387 /* Text property `display' should be nonsticky by default. */
11388 Vtext_property_default_nonsticky
11389 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11392 Qlaplace
= intern ("laplace");
11393 staticpro (&Qlaplace
);
11394 Qemboss
= intern ("emboss");
11395 staticpro (&Qemboss
);
11396 Qedge_detection
= intern ("edge-detection");
11397 staticpro (&Qedge_detection
);
11398 Qheuristic
= intern ("heuristic");
11399 staticpro (&Qheuristic
);
11400 QCmatrix
= intern (":matrix");
11401 staticpro (&QCmatrix
);
11402 QCcolor_adjustment
= intern (":color-adjustment");
11403 staticpro (&QCcolor_adjustment
);
11404 QCmask
= intern (":mask");
11405 staticpro (&QCmask
);
11407 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11408 staticpro (&Qface_set_after_frame_default
);
11410 Fput (Qundefined_color
, Qerror_conditions
,
11411 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11412 Fput (Qundefined_color
, Qerror_message
,
11413 build_string ("Undefined color"));
11415 init_x_parm_symbols ();
11417 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11418 "Non-nil means always draw a cross over disabled images.\n\
11419 Disabled images are those having an `:conversion disabled' property.\n\
11420 A cross is always drawn on black & white displays.");
11421 cross_disabled_images
= 0;
11423 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11424 "List of directories to search for bitmap files for X.");
11425 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11427 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11428 "The shape of the pointer when over text.\n\
11429 Changing the value does not affect existing frames\n\
11430 unless you set the mouse color.");
11431 Vx_pointer_shape
= Qnil
;
11433 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11434 "The name Emacs uses to look up X resources.\n\
11435 `x-get-resource' uses this as the first component of the instance name\n\
11436 when requesting resource values.\n\
11437 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
11438 was invoked, or to the value specified with the `-name' or `-rn'\n\
11439 switches, if present.\n\
11441 It may be useful to bind this variable locally around a call\n\
11442 to `x-get-resource'. See also the variable `x-resource-class'.");
11443 Vx_resource_name
= Qnil
;
11445 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11446 "The class Emacs uses to look up X resources.\n\
11447 `x-get-resource' uses this as the first component of the instance class\n\
11448 when requesting resource values.\n\
11449 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
11451 Setting this variable permanently is not a reasonable thing to do,\n\
11452 but binding this variable locally around a call to `x-get-resource'\n\
11453 is a reasonable practice. See also the variable `x-resource-name'.");
11454 Vx_resource_class
= build_string (EMACS_CLASS
);
11456 #if 0 /* This doesn't really do anything. */
11457 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11458 "The shape of the pointer when not over text.\n\
11459 This variable takes effect when you create a new frame\n\
11460 or when you set the mouse color.");
11462 Vx_nontext_pointer_shape
= Qnil
;
11464 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
11465 "The shape of the pointer when Emacs is busy.\n\
11466 This variable takes effect when you create a new frame\n\
11467 or when you set the mouse color.");
11468 Vx_hourglass_pointer_shape
= Qnil
;
11470 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
11471 "Non-zero means Emacs displays an hourglass pointer on window systems.");
11472 display_hourglass_p
= 1;
11474 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
11475 "*Seconds to wait before displaying an hourglass pointer.\n\
11476 Value must be an integer or float.");
11477 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
11479 #if 0 /* This doesn't really do anything. */
11480 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11481 "The shape of the pointer when over the mode line.\n\
11482 This variable takes effect when you create a new frame\n\
11483 or when you set the mouse color.");
11485 Vx_mode_pointer_shape
= Qnil
;
11487 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11488 &Vx_sensitive_text_pointer_shape
,
11489 "The shape of the pointer when over mouse-sensitive text.\n\
11490 This variable takes effect when you create a new frame\n\
11491 or when you set the mouse color.");
11492 Vx_sensitive_text_pointer_shape
= Qnil
;
11494 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11495 &Vx_window_horizontal_drag_shape
,
11496 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
11497 This variable takes effect when you create a new frame\n\
11498 or when you set the mouse color.");
11499 Vx_window_horizontal_drag_shape
= Qnil
;
11501 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11502 "A string indicating the foreground color of the cursor box.");
11503 Vx_cursor_fore_pixel
= Qnil
;
11505 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11506 "Non-nil if no X window manager is in use.\n\
11507 Emacs doesn't try to figure this out; this is always nil\n\
11508 unless you set it to something else.");
11509 /* We don't have any way to find this out, so set it to nil
11510 and maybe the user would like to set it to t. */
11511 Vx_no_window_manager
= Qnil
;
11513 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11514 &Vx_pixel_size_width_font_regexp
,
11515 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11517 Since Emacs gets width of a font matching with this regexp from\n\
11518 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11519 such a font. This is especially effective for such large fonts as\n\
11520 Chinese, Japanese, and Korean.");
11521 Vx_pixel_size_width_font_regexp
= Qnil
;
11523 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11524 "Time after which cached images are removed from the cache.\n\
11525 When an image has not been displayed this many seconds, remove it\n\
11526 from the image cache. Value must be an integer or nil with nil\n\
11527 meaning don't clear the cache.");
11528 Vimage_cache_eviction_delay
= make_number (30 * 60);
11530 #ifdef USE_X_TOOLKIT
11531 Fprovide (intern ("x-toolkit"));
11534 Fprovide (intern ("motif"));
11536 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string
,
11537 "Version info for LessTif/Motif.");
11538 Vmotif_version_string
= build_string (XmVERSION_STRING
);
11539 #endif /* USE_MOTIF */
11540 #endif /* USE_X_TOOLKIT */
11542 defsubr (&Sx_get_resource
);
11544 /* X window properties. */
11545 defsubr (&Sx_change_window_property
);
11546 defsubr (&Sx_delete_window_property
);
11547 defsubr (&Sx_window_property
);
11549 defsubr (&Sxw_display_color_p
);
11550 defsubr (&Sx_display_grayscale_p
);
11551 defsubr (&Sxw_color_defined_p
);
11552 defsubr (&Sxw_color_values
);
11553 defsubr (&Sx_server_max_request_size
);
11554 defsubr (&Sx_server_vendor
);
11555 defsubr (&Sx_server_version
);
11556 defsubr (&Sx_display_pixel_width
);
11557 defsubr (&Sx_display_pixel_height
);
11558 defsubr (&Sx_display_mm_width
);
11559 defsubr (&Sx_display_mm_height
);
11560 defsubr (&Sx_display_screens
);
11561 defsubr (&Sx_display_planes
);
11562 defsubr (&Sx_display_color_cells
);
11563 defsubr (&Sx_display_visual_class
);
11564 defsubr (&Sx_display_backing_store
);
11565 defsubr (&Sx_display_save_under
);
11566 defsubr (&Sx_parse_geometry
);
11567 defsubr (&Sx_create_frame
);
11568 defsubr (&Sx_open_connection
);
11569 defsubr (&Sx_close_connection
);
11570 defsubr (&Sx_display_list
);
11571 defsubr (&Sx_synchronize
);
11572 defsubr (&Sx_focus_frame
);
11573 defsubr (&Sx_backspace_delete_keys_p
);
11575 /* Setting callback functions for fontset handler. */
11576 get_font_info_func
= x_get_font_info
;
11578 #if 0 /* This function pointer doesn't seem to be used anywhere.
11579 And the pointer assigned has the wrong type, anyway. */
11580 list_fonts_func
= x_list_fonts
;
11583 load_font_func
= x_load_font
;
11584 find_ccl_program_func
= x_find_ccl_program
;
11585 query_font_func
= x_query_font
;
11586 set_frame_fontset_func
= x_set_font
;
11587 check_window_system_func
= check_x
;
11590 Qxbm
= intern ("xbm");
11592 QCtype
= intern (":type");
11593 staticpro (&QCtype
);
11594 QCconversion
= intern (":conversion");
11595 staticpro (&QCconversion
);
11596 QCheuristic_mask
= intern (":heuristic-mask");
11597 staticpro (&QCheuristic_mask
);
11598 QCcolor_symbols
= intern (":color-symbols");
11599 staticpro (&QCcolor_symbols
);
11600 QCascent
= intern (":ascent");
11601 staticpro (&QCascent
);
11602 QCmargin
= intern (":margin");
11603 staticpro (&QCmargin
);
11604 QCrelief
= intern (":relief");
11605 staticpro (&QCrelief
);
11606 Qpostscript
= intern ("postscript");
11607 staticpro (&Qpostscript
);
11608 QCloader
= intern (":loader");
11609 staticpro (&QCloader
);
11610 QCbounding_box
= intern (":bounding-box");
11611 staticpro (&QCbounding_box
);
11612 QCpt_width
= intern (":pt-width");
11613 staticpro (&QCpt_width
);
11614 QCpt_height
= intern (":pt-height");
11615 staticpro (&QCpt_height
);
11616 QCindex
= intern (":index");
11617 staticpro (&QCindex
);
11618 Qpbm
= intern ("pbm");
11622 Qxpm
= intern ("xpm");
11627 Qjpeg
= intern ("jpeg");
11628 staticpro (&Qjpeg
);
11632 Qtiff
= intern ("tiff");
11633 staticpro (&Qtiff
);
11637 Qgif
= intern ("gif");
11642 Qpng
= intern ("png");
11646 defsubr (&Sclear_image_cache
);
11647 defsubr (&Simage_size
);
11648 defsubr (&Simage_mask_p
);
11650 hourglass_atimer
= NULL
;
11651 hourglass_shown_p
= 0;
11653 defsubr (&Sx_show_tip
);
11654 defsubr (&Sx_hide_tip
);
11656 staticpro (&tip_timer
);
11658 staticpro (&tip_frame
);
11660 last_show_tip_args
= Qnil
;
11661 staticpro (&last_show_tip_args
);
11664 defsubr (&Sx_file_dialog
);
11672 image_types
= NULL
;
11673 Vimage_types
= Qnil
;
11675 define_image_type (&xbm_type
);
11676 define_image_type (&gs_type
);
11677 define_image_type (&pbm_type
);
11680 define_image_type (&xpm_type
);
11684 define_image_type (&jpeg_type
);
11688 define_image_type (&tiff_type
);
11692 define_image_type (&gif_type
);
11696 define_image_type (&png_type
);
11700 #endif /* HAVE_X_WINDOWS */