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 struct x_output
*x
= f
->output_data
.x
;
1350 unsigned long fg
, old_fg
;
1352 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1353 old_fg
= x
->foreground_pixel
;
1354 x
->foreground_pixel
= fg
;
1356 if (FRAME_X_WINDOW (f
) != 0)
1358 Display
*dpy
= FRAME_X_DISPLAY (f
);
1361 XSetForeground (dpy
, x
->normal_gc
, fg
);
1362 XSetBackground (dpy
, x
->reverse_gc
, fg
);
1364 if (x
->cursor_pixel
== old_fg
)
1366 unload_color (f
, x
->cursor_pixel
);
1367 x
->cursor_pixel
= x_copy_color (f
, fg
);
1368 XSetBackground (dpy
, x
->cursor_gc
, x
->cursor_pixel
);
1373 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1375 if (FRAME_VISIBLE_P (f
))
1379 unload_color (f
, old_fg
);
1383 x_set_background_color (f
, arg
, oldval
)
1385 Lisp_Object arg
, oldval
;
1387 struct x_output
*x
= f
->output_data
.x
;
1390 bg
= x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1391 unload_color (f
, x
->background_pixel
);
1392 x
->background_pixel
= bg
;
1394 if (FRAME_X_WINDOW (f
) != 0)
1396 Display
*dpy
= FRAME_X_DISPLAY (f
);
1400 XSetBackground (dpy
, x
->normal_gc
, bg
);
1401 XSetForeground (dpy
, x
->reverse_gc
, bg
);
1402 XSetWindowBackground (dpy
, FRAME_X_WINDOW (f
), bg
);
1403 XSetForeground (dpy
, x
->cursor_gc
, bg
);
1405 for (bar
= FRAME_SCROLL_BARS (f
);
1407 bar
= XSCROLL_BAR (bar
)->next
)
1409 Window window
= SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
));
1410 XSetWindowBackground (dpy
, window
, bg
);
1414 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1416 if (FRAME_VISIBLE_P (f
))
1422 x_set_mouse_color (f
, arg
, oldval
)
1424 Lisp_Object arg
, oldval
;
1426 struct x_output
*x
= f
->output_data
.x
;
1427 Display
*dpy
= FRAME_X_DISPLAY (f
);
1428 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1429 Cursor hourglass_cursor
, horizontal_drag_cursor
;
1431 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1432 unsigned long mask_color
= x
->background_pixel
;
1434 /* Don't let pointers be invisible. */
1435 if (mask_color
== pixel
)
1437 x_free_colors (f
, &pixel
, 1);
1438 pixel
= x_copy_color (f
, x
->foreground_pixel
);
1441 unload_color (f
, x
->mouse_pixel
);
1442 x
->mouse_pixel
= pixel
;
1446 /* It's not okay to crash if the user selects a screwy cursor. */
1447 count
= x_catch_errors (dpy
);
1449 if (!NILP (Vx_pointer_shape
))
1451 CHECK_NUMBER (Vx_pointer_shape
, 0);
1452 cursor
= XCreateFontCursor (dpy
, XINT (Vx_pointer_shape
));
1455 cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1456 x_check_errors (dpy
, "bad text pointer cursor: %s");
1458 if (!NILP (Vx_nontext_pointer_shape
))
1460 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1462 = XCreateFontCursor (dpy
, XINT (Vx_nontext_pointer_shape
));
1465 nontext_cursor
= XCreateFontCursor (dpy
, XC_left_ptr
);
1466 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1468 if (!NILP (Vx_hourglass_pointer_shape
))
1470 CHECK_NUMBER (Vx_hourglass_pointer_shape
, 0);
1472 = XCreateFontCursor (dpy
, XINT (Vx_hourglass_pointer_shape
));
1475 hourglass_cursor
= XCreateFontCursor (dpy
, XC_watch
);
1476 x_check_errors (dpy
, "bad hourglass pointer cursor: %s");
1478 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1479 if (!NILP (Vx_mode_pointer_shape
))
1481 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1482 mode_cursor
= XCreateFontCursor (dpy
, XINT (Vx_mode_pointer_shape
));
1485 mode_cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1486 x_check_errors (dpy
, "bad modeline pointer cursor: %s");
1488 if (!NILP (Vx_sensitive_text_pointer_shape
))
1490 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1492 = XCreateFontCursor (dpy
, XINT (Vx_sensitive_text_pointer_shape
));
1495 cross_cursor
= XCreateFontCursor (dpy
, XC_crosshair
);
1497 if (!NILP (Vx_window_horizontal_drag_shape
))
1499 CHECK_NUMBER (Vx_window_horizontal_drag_shape
, 0);
1500 horizontal_drag_cursor
1501 = XCreateFontCursor (dpy
, XINT (Vx_window_horizontal_drag_shape
));
1504 horizontal_drag_cursor
1505 = XCreateFontCursor (dpy
, XC_sb_h_double_arrow
);
1507 /* Check and report errors with the above calls. */
1508 x_check_errors (dpy
, "can't set cursor shape: %s");
1509 x_uncatch_errors (dpy
, count
);
1512 XColor fore_color
, back_color
;
1514 fore_color
.pixel
= x
->mouse_pixel
;
1515 x_query_color (f
, &fore_color
);
1516 back_color
.pixel
= mask_color
;
1517 x_query_color (f
, &back_color
);
1519 XRecolorCursor (dpy
, cursor
, &fore_color
, &back_color
);
1520 XRecolorCursor (dpy
, nontext_cursor
, &fore_color
, &back_color
);
1521 XRecolorCursor (dpy
, mode_cursor
, &fore_color
, &back_color
);
1522 XRecolorCursor (dpy
, cross_cursor
, &fore_color
, &back_color
);
1523 XRecolorCursor (dpy
, hourglass_cursor
, &fore_color
, &back_color
);
1524 XRecolorCursor (dpy
, horizontal_drag_cursor
, &fore_color
, &back_color
);
1527 if (FRAME_X_WINDOW (f
) != 0)
1528 XDefineCursor (dpy
, FRAME_X_WINDOW (f
), cursor
);
1530 if (cursor
!= x
->text_cursor
1531 && x
->text_cursor
!= 0)
1532 XFreeCursor (dpy
, x
->text_cursor
);
1533 x
->text_cursor
= cursor
;
1535 if (nontext_cursor
!= x
->nontext_cursor
1536 && x
->nontext_cursor
!= 0)
1537 XFreeCursor (dpy
, x
->nontext_cursor
);
1538 x
->nontext_cursor
= nontext_cursor
;
1540 if (hourglass_cursor
!= x
->hourglass_cursor
1541 && x
->hourglass_cursor
!= 0)
1542 XFreeCursor (dpy
, x
->hourglass_cursor
);
1543 x
->hourglass_cursor
= hourglass_cursor
;
1545 if (mode_cursor
!= x
->modeline_cursor
1546 && x
->modeline_cursor
!= 0)
1547 XFreeCursor (dpy
, f
->output_data
.x
->modeline_cursor
);
1548 x
->modeline_cursor
= mode_cursor
;
1550 if (cross_cursor
!= x
->cross_cursor
1551 && x
->cross_cursor
!= 0)
1552 XFreeCursor (dpy
, x
->cross_cursor
);
1553 x
->cross_cursor
= cross_cursor
;
1555 if (horizontal_drag_cursor
!= x
->horizontal_drag_cursor
1556 && x
->horizontal_drag_cursor
!= 0)
1557 XFreeCursor (dpy
, x
->horizontal_drag_cursor
);
1558 x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1563 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1567 x_set_cursor_color (f
, arg
, oldval
)
1569 Lisp_Object arg
, oldval
;
1571 unsigned long fore_pixel
, pixel
;
1572 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1573 struct x_output
*x
= f
->output_data
.x
;
1575 if (!NILP (Vx_cursor_fore_pixel
))
1577 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1578 WHITE_PIX_DEFAULT (f
));
1579 fore_pixel_allocated_p
= 1;
1582 fore_pixel
= x
->background_pixel
;
1584 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1585 pixel_allocated_p
= 1;
1587 /* Make sure that the cursor color differs from the background color. */
1588 if (pixel
== x
->background_pixel
)
1590 if (pixel_allocated_p
)
1592 x_free_colors (f
, &pixel
, 1);
1593 pixel_allocated_p
= 0;
1596 pixel
= x
->mouse_pixel
;
1597 if (pixel
== fore_pixel
)
1599 if (fore_pixel_allocated_p
)
1601 x_free_colors (f
, &fore_pixel
, 1);
1602 fore_pixel_allocated_p
= 0;
1604 fore_pixel
= x
->background_pixel
;
1608 unload_color (f
, x
->cursor_foreground_pixel
);
1609 if (!fore_pixel_allocated_p
)
1610 fore_pixel
= x_copy_color (f
, fore_pixel
);
1611 x
->cursor_foreground_pixel
= fore_pixel
;
1613 unload_color (f
, x
->cursor_pixel
);
1614 if (!pixel_allocated_p
)
1615 pixel
= x_copy_color (f
, pixel
);
1616 x
->cursor_pixel
= pixel
;
1618 if (FRAME_X_WINDOW (f
) != 0)
1621 XSetBackground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, x
->cursor_pixel
);
1622 XSetForeground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, fore_pixel
);
1625 if (FRAME_VISIBLE_P (f
))
1627 x_update_cursor (f
, 0);
1628 x_update_cursor (f
, 1);
1632 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1635 /* Set the border-color of frame F to value described by ARG.
1636 ARG can be a string naming a color.
1637 The border-color is used for the border that is drawn by the X server.
1638 Note that this does not fully take effect if done before
1639 F has an x-window; it must be redone when the window is created.
1641 Note: this is done in two routines because of the way X10 works.
1643 Note: under X11, this is normally the province of the window manager,
1644 and so emacs' border colors may be overridden. */
1647 x_set_border_color (f
, arg
, oldval
)
1649 Lisp_Object arg
, oldval
;
1653 CHECK_STRING (arg
, 0);
1654 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1655 x_set_border_pixel (f
, pix
);
1656 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1659 /* Set the border-color of frame F to pixel value PIX.
1660 Note that this does not fully take effect if done before
1661 F has an x-window. */
1664 x_set_border_pixel (f
, pix
)
1668 unload_color (f
, f
->output_data
.x
->border_pixel
);
1669 f
->output_data
.x
->border_pixel
= pix
;
1671 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1674 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1675 (unsigned long)pix
);
1678 if (FRAME_VISIBLE_P (f
))
1684 /* Value is the internal representation of the specified cursor type
1685 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1686 of the bar cursor. */
1688 enum text_cursor_kinds
1689 x_specified_cursor_type (arg
, width
)
1693 enum text_cursor_kinds type
;
1700 else if (CONSP (arg
)
1701 && EQ (XCAR (arg
), Qbar
)
1702 && INTEGERP (XCDR (arg
))
1703 && XINT (XCDR (arg
)) >= 0)
1706 *width
= XINT (XCDR (arg
));
1708 else if (NILP (arg
))
1711 /* Treat anything unknown as "box cursor".
1712 It was bad to signal an error; people have trouble fixing
1713 .Xdefaults with Emacs, when it has something bad in it. */
1714 type
= FILLED_BOX_CURSOR
;
1720 x_set_cursor_type (f
, arg
, oldval
)
1722 Lisp_Object arg
, oldval
;
1726 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1727 f
->output_data
.x
->cursor_width
= width
;
1729 /* Make sure the cursor gets redrawn. This is overkill, but how
1730 often do people change cursor types? */
1731 update_mode_lines
++;
1735 x_set_icon_type (f
, arg
, oldval
)
1737 Lisp_Object arg
, oldval
;
1743 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1746 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1751 result
= x_text_icon (f
,
1752 (char *) XSTRING ((!NILP (f
->icon_name
)
1756 result
= x_bitmap_icon (f
, arg
);
1761 error ("No icon window available");
1764 XFlush (FRAME_X_DISPLAY (f
));
1768 /* Return non-nil if frame F wants a bitmap icon. */
1776 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1784 x_set_icon_name (f
, arg
, oldval
)
1786 Lisp_Object arg
, oldval
;
1792 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1795 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1800 if (f
->output_data
.x
->icon_bitmap
!= 0)
1805 result
= x_text_icon (f
,
1806 (char *) XSTRING ((!NILP (f
->icon_name
)
1815 error ("No icon window available");
1818 XFlush (FRAME_X_DISPLAY (f
));
1823 x_set_font (f
, arg
, oldval
)
1825 Lisp_Object arg
, oldval
;
1828 Lisp_Object fontset_name
;
1830 int old_fontset
= f
->output_data
.x
->fontset
;
1832 CHECK_STRING (arg
, 1);
1834 fontset_name
= Fquery_fontset (arg
, Qnil
);
1837 result
= (STRINGP (fontset_name
)
1838 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1839 : x_new_font (f
, XSTRING (arg
)->data
));
1842 if (EQ (result
, Qnil
))
1843 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1844 else if (EQ (result
, Qt
))
1845 error ("The characters of the given font have varying widths");
1846 else if (STRINGP (result
))
1848 if (STRINGP (fontset_name
))
1850 /* Fontset names are built from ASCII font names, so the
1851 names may be equal despite there was a change. */
1852 if (old_fontset
== f
->output_data
.x
->fontset
)
1855 else if (!NILP (Fequal (result
, oldval
)))
1858 store_frame_param (f
, Qfont
, result
);
1859 recompute_basic_faces (f
);
1864 do_pending_window_change (0);
1866 /* Don't call `face-set-after-frame-default' when faces haven't been
1867 initialized yet. This is the case when called from
1868 Fx_create_frame. In that case, the X widget or window doesn't
1869 exist either, and we can end up in x_report_frame_params with a
1870 null widget which gives a segfault. */
1871 if (FRAME_FACE_CACHE (f
))
1873 XSETFRAME (frame
, f
);
1874 call1 (Qface_set_after_frame_default
, frame
);
1879 x_set_border_width (f
, arg
, oldval
)
1881 Lisp_Object arg
, oldval
;
1883 CHECK_NUMBER (arg
, 0);
1885 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1888 if (FRAME_X_WINDOW (f
) != 0)
1889 error ("Cannot change the border width of a window");
1891 f
->output_data
.x
->border_width
= XINT (arg
);
1895 x_set_internal_border_width (f
, arg
, oldval
)
1897 Lisp_Object arg
, oldval
;
1899 int old
= f
->output_data
.x
->internal_border_width
;
1901 CHECK_NUMBER (arg
, 0);
1902 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1903 if (f
->output_data
.x
->internal_border_width
< 0)
1904 f
->output_data
.x
->internal_border_width
= 0;
1906 #ifdef USE_X_TOOLKIT
1907 if (f
->output_data
.x
->edit_widget
)
1908 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1911 if (f
->output_data
.x
->internal_border_width
== old
)
1914 if (FRAME_X_WINDOW (f
) != 0)
1916 x_set_window_size (f
, 0, f
->width
, f
->height
);
1917 SET_FRAME_GARBAGED (f
);
1918 do_pending_window_change (0);
1923 x_set_visibility (f
, value
, oldval
)
1925 Lisp_Object value
, oldval
;
1928 XSETFRAME (frame
, f
);
1931 Fmake_frame_invisible (frame
, Qt
);
1932 else if (EQ (value
, Qicon
))
1933 Ficonify_frame (frame
);
1935 Fmake_frame_visible (frame
);
1939 /* Change window heights in windows rooted in WINDOW by N lines. */
1942 x_change_window_heights (window
, n
)
1946 struct window
*w
= XWINDOW (window
);
1948 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1949 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1951 if (INTEGERP (w
->orig_top
))
1952 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1953 if (INTEGERP (w
->orig_height
))
1954 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1956 /* Handle just the top child in a vertical split. */
1957 if (!NILP (w
->vchild
))
1958 x_change_window_heights (w
->vchild
, n
);
1960 /* Adjust all children in a horizontal split. */
1961 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1963 w
= XWINDOW (window
);
1964 x_change_window_heights (window
, n
);
1969 x_set_menu_bar_lines (f
, value
, oldval
)
1971 Lisp_Object value
, oldval
;
1974 #ifndef USE_X_TOOLKIT
1975 int olines
= FRAME_MENU_BAR_LINES (f
);
1978 /* Right now, menu bars don't work properly in minibuf-only frames;
1979 most of the commands try to apply themselves to the minibuffer
1980 frame itself, and get an error because you can't switch buffers
1981 in or split the minibuffer window. */
1982 if (FRAME_MINIBUF_ONLY_P (f
))
1985 if (INTEGERP (value
))
1986 nlines
= XINT (value
);
1990 /* Make sure we redisplay all windows in this frame. */
1991 windows_or_buffers_changed
++;
1993 #ifdef USE_X_TOOLKIT
1994 FRAME_MENU_BAR_LINES (f
) = 0;
1997 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1998 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1999 /* Make sure next redisplay shows the menu bar. */
2000 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2004 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2005 free_frame_menubar (f
);
2006 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2008 f
->output_data
.x
->menubar_widget
= 0;
2010 #else /* not USE_X_TOOLKIT */
2011 FRAME_MENU_BAR_LINES (f
) = nlines
;
2012 x_change_window_heights (f
->root_window
, nlines
- olines
);
2013 #endif /* not USE_X_TOOLKIT */
2018 /* Set the number of lines used for the tool bar of frame F to VALUE.
2019 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2020 is the old number of tool bar lines. This function changes the
2021 height of all windows on frame F to match the new tool bar height.
2022 The frame's height doesn't change. */
2025 x_set_tool_bar_lines (f
, value
, oldval
)
2027 Lisp_Object value
, oldval
;
2029 int delta
, nlines
, root_height
;
2030 Lisp_Object root_window
;
2032 /* Treat tool bars like menu bars. */
2033 if (FRAME_MINIBUF_ONLY_P (f
))
2036 /* Use VALUE only if an integer >= 0. */
2037 if (INTEGERP (value
) && XINT (value
) >= 0)
2038 nlines
= XFASTINT (value
);
2042 /* Make sure we redisplay all windows in this frame. */
2043 ++windows_or_buffers_changed
;
2045 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2047 /* Don't resize the tool-bar to more than we have room for. */
2048 root_window
= FRAME_ROOT_WINDOW (f
);
2049 root_height
= XINT (XWINDOW (root_window
)->height
);
2050 if (root_height
- delta
< 1)
2052 delta
= root_height
- 1;
2053 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2056 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2057 x_change_window_heights (root_window
, delta
);
2060 /* We also have to make sure that the internal border at the top of
2061 the frame, below the menu bar or tool bar, is redrawn when the
2062 tool bar disappears. This is so because the internal border is
2063 below the tool bar if one is displayed, but is below the menu bar
2064 if there isn't a tool bar. The tool bar draws into the area
2065 below the menu bar. */
2066 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2070 clear_current_matrices (f
);
2071 updating_frame
= NULL
;
2074 /* If the tool bar gets smaller, the internal border below it
2075 has to be cleared. It was formerly part of the display
2076 of the larger tool bar, and updating windows won't clear it. */
2079 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2080 int width
= PIXEL_WIDTH (f
);
2081 int y
= nlines
* CANON_Y_UNIT (f
);
2084 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2085 0, y
, width
, height
, False
);
2091 /* Set the foreground color for scroll bars on frame F to VALUE.
2092 VALUE should be a string, a color name. If it isn't a string or
2093 isn't a valid color name, do nothing. OLDVAL is the old value of
2094 the frame parameter. */
2097 x_set_scroll_bar_foreground (f
, value
, oldval
)
2099 Lisp_Object value
, oldval
;
2101 unsigned long pixel
;
2103 if (STRINGP (value
))
2104 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2108 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2109 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2111 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2112 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2114 /* Remove all scroll bars because they have wrong colors. */
2115 if (condemn_scroll_bars_hook
)
2116 (*condemn_scroll_bars_hook
) (f
);
2117 if (judge_scroll_bars_hook
)
2118 (*judge_scroll_bars_hook
) (f
);
2120 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2126 /* Set the background color for scroll bars on frame F to VALUE VALUE
2127 should be a string, a color name. If it isn't a string or isn't a
2128 valid color name, do nothing. OLDVAL is the old value of the frame
2132 x_set_scroll_bar_background (f
, value
, oldval
)
2134 Lisp_Object value
, oldval
;
2136 unsigned long pixel
;
2138 if (STRINGP (value
))
2139 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2143 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2144 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2146 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2147 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2149 /* Remove all scroll bars because they have wrong colors. */
2150 if (condemn_scroll_bars_hook
)
2151 (*condemn_scroll_bars_hook
) (f
);
2152 if (judge_scroll_bars_hook
)
2153 (*judge_scroll_bars_hook
) (f
);
2155 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2161 /* Encode Lisp string STRING as a text in a format appropriate for
2162 XICCC (X Inter Client Communication Conventions).
2164 If STRING contains only ASCII characters, do no conversion and
2165 return the string data of STRING. Otherwise, encode the text by
2166 CODING_SYSTEM, and return a newly allocated memory area which
2167 should be freed by `xfree' by a caller.
2169 Store the byte length of resulting text in *TEXT_BYTES.
2171 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2172 which means that the `encoding' of the result can be `STRING'.
2173 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2174 the result should be `COMPOUND_TEXT'. */
2177 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2178 Lisp_Object string
, coding_system
;
2179 int *text_bytes
, *stringp
;
2181 unsigned char *str
= XSTRING (string
)->data
;
2182 int chars
= XSTRING (string
)->size
;
2183 int bytes
= STRING_BYTES (XSTRING (string
));
2187 struct coding_system coding
;
2189 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2190 if (charset_info
== 0)
2192 /* No multibyte character in OBJ. We need not encode it. */
2193 *text_bytes
= bytes
;
2198 setup_coding_system (coding_system
, &coding
);
2199 coding
.src_multibyte
= 1;
2200 coding
.dst_multibyte
= 0;
2201 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2202 if (coding
.type
== coding_type_iso2022
)
2203 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2204 /* We suppress producing escape sequences for composition. */
2205 coding
.composing
= COMPOSITION_DISABLED
;
2206 bufsize
= encoding_buffer_size (&coding
, bytes
);
2207 buf
= (unsigned char *) xmalloc (bufsize
);
2208 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2209 *text_bytes
= coding
.produced
;
2210 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2215 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2218 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2219 name; if NAME is a string, set F's name to NAME and set
2220 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2222 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2223 suggesting a new name, which lisp code should override; if
2224 F->explicit_name is set, ignore the new name; otherwise, set it. */
2227 x_set_name (f
, name
, explicit)
2232 /* Make sure that requests from lisp code override requests from
2233 Emacs redisplay code. */
2236 /* If we're switching from explicit to implicit, we had better
2237 update the mode lines and thereby update the title. */
2238 if (f
->explicit_name
&& NILP (name
))
2239 update_mode_lines
= 1;
2241 f
->explicit_name
= ! NILP (name
);
2243 else if (f
->explicit_name
)
2246 /* If NAME is nil, set the name to the x_id_name. */
2249 /* Check for no change needed in this very common case
2250 before we do any consing. */
2251 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2252 XSTRING (f
->name
)->data
))
2254 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2257 CHECK_STRING (name
, 0);
2259 /* Don't change the name if it's already NAME. */
2260 if (! NILP (Fstring_equal (name
, f
->name
)))
2265 /* For setting the frame title, the title parameter should override
2266 the name parameter. */
2267 if (! NILP (f
->title
))
2270 if (FRAME_X_WINDOW (f
))
2275 XTextProperty text
, icon
;
2277 Lisp_Object coding_system
;
2279 coding_system
= Vlocale_coding_system
;
2280 if (NILP (coding_system
))
2281 coding_system
= Qcompound_text
;
2282 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2283 text
.encoding
= (stringp
? XA_STRING
2284 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2286 text
.nitems
= bytes
;
2288 if (NILP (f
->icon_name
))
2294 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2296 icon
.encoding
= (stringp
? XA_STRING
2297 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2299 icon
.nitems
= bytes
;
2301 #ifdef USE_X_TOOLKIT
2302 XSetWMName (FRAME_X_DISPLAY (f
),
2303 XtWindow (f
->output_data
.x
->widget
), &text
);
2304 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2306 #else /* not USE_X_TOOLKIT */
2307 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2308 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2309 #endif /* not USE_X_TOOLKIT */
2310 if (!NILP (f
->icon_name
)
2311 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2313 if (text
.value
!= XSTRING (name
)->data
)
2316 #else /* not HAVE_X11R4 */
2317 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2318 XSTRING (name
)->data
);
2319 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2320 XSTRING (name
)->data
);
2321 #endif /* not HAVE_X11R4 */
2326 /* This function should be called when the user's lisp code has
2327 specified a name for the frame; the name will override any set by the
2330 x_explicitly_set_name (f
, arg
, oldval
)
2332 Lisp_Object arg
, oldval
;
2334 x_set_name (f
, arg
, 1);
2337 /* This function should be called by Emacs redisplay code to set the
2338 name; names set this way will never override names set by the user's
2341 x_implicitly_set_name (f
, arg
, oldval
)
2343 Lisp_Object arg
, oldval
;
2345 x_set_name (f
, arg
, 0);
2348 /* Change the title of frame F to NAME.
2349 If NAME is nil, use the frame name as the title.
2351 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2352 name; if NAME is a string, set F's name to NAME and set
2353 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2355 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2356 suggesting a new name, which lisp code should override; if
2357 F->explicit_name is set, ignore the new name; otherwise, set it. */
2360 x_set_title (f
, name
, old_name
)
2362 Lisp_Object name
, old_name
;
2364 /* Don't change the title if it's already NAME. */
2365 if (EQ (name
, f
->title
))
2368 update_mode_lines
= 1;
2375 CHECK_STRING (name
, 0);
2377 if (FRAME_X_WINDOW (f
))
2382 XTextProperty text
, icon
;
2384 Lisp_Object coding_system
;
2386 coding_system
= Vlocale_coding_system
;
2387 if (NILP (coding_system
))
2388 coding_system
= Qcompound_text
;
2389 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2390 text
.encoding
= (stringp
? XA_STRING
2391 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2393 text
.nitems
= bytes
;
2395 if (NILP (f
->icon_name
))
2401 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2403 icon
.encoding
= (stringp
? XA_STRING
2404 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2406 icon
.nitems
= bytes
;
2408 #ifdef USE_X_TOOLKIT
2409 XSetWMName (FRAME_X_DISPLAY (f
),
2410 XtWindow (f
->output_data
.x
->widget
), &text
);
2411 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2413 #else /* not USE_X_TOOLKIT */
2414 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2415 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2416 #endif /* not USE_X_TOOLKIT */
2417 if (!NILP (f
->icon_name
)
2418 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2420 if (text
.value
!= XSTRING (name
)->data
)
2423 #else /* not HAVE_X11R4 */
2424 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2425 XSTRING (name
)->data
);
2426 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2427 XSTRING (name
)->data
);
2428 #endif /* not HAVE_X11R4 */
2434 x_set_autoraise (f
, arg
, oldval
)
2436 Lisp_Object arg
, oldval
;
2438 f
->auto_raise
= !EQ (Qnil
, arg
);
2442 x_set_autolower (f
, arg
, oldval
)
2444 Lisp_Object arg
, oldval
;
2446 f
->auto_lower
= !EQ (Qnil
, arg
);
2450 x_set_unsplittable (f
, arg
, oldval
)
2452 Lisp_Object arg
, oldval
;
2454 f
->no_split
= !NILP (arg
);
2458 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2460 Lisp_Object arg
, oldval
;
2462 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2463 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2464 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2465 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2467 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2469 ? vertical_scroll_bar_none
2471 ? vertical_scroll_bar_right
2472 : vertical_scroll_bar_left
);
2474 /* We set this parameter before creating the X window for the
2475 frame, so we can get the geometry right from the start.
2476 However, if the window hasn't been created yet, we shouldn't
2477 call x_set_window_size. */
2478 if (FRAME_X_WINDOW (f
))
2479 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2480 do_pending_window_change (0);
2485 x_set_scroll_bar_width (f
, arg
, oldval
)
2487 Lisp_Object arg
, oldval
;
2489 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2493 #ifdef USE_TOOLKIT_SCROLL_BARS
2494 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2495 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2496 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2497 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2499 /* Make the actual width at least 14 pixels and a multiple of a
2501 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2503 /* Use all of that space (aside from required margins) for the
2505 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2508 if (FRAME_X_WINDOW (f
))
2509 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2510 do_pending_window_change (0);
2512 else if (INTEGERP (arg
) && XINT (arg
) > 0
2513 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2515 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2516 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2518 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2519 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2520 if (FRAME_X_WINDOW (f
))
2521 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2524 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2525 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2526 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2531 /* Subroutines of creating an X frame. */
2533 /* Make sure that Vx_resource_name is set to a reasonable value.
2534 Fix it up, or set it to `emacs' if it is too hopeless. */
2537 validate_x_resource_name ()
2540 /* Number of valid characters in the resource name. */
2542 /* Number of invalid characters in the resource name. */
2547 if (!STRINGP (Vx_resource_class
))
2548 Vx_resource_class
= build_string (EMACS_CLASS
);
2550 if (STRINGP (Vx_resource_name
))
2552 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2555 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2557 /* Only letters, digits, - and _ are valid in resource names.
2558 Count the valid characters and count the invalid ones. */
2559 for (i
= 0; i
< len
; i
++)
2562 if (! ((c
>= 'a' && c
<= 'z')
2563 || (c
>= 'A' && c
<= 'Z')
2564 || (c
>= '0' && c
<= '9')
2565 || c
== '-' || c
== '_'))
2572 /* Not a string => completely invalid. */
2573 bad_count
= 5, good_count
= 0;
2575 /* If name is valid already, return. */
2579 /* If name is entirely invalid, or nearly so, use `emacs'. */
2581 || (good_count
== 1 && bad_count
> 0))
2583 Vx_resource_name
= build_string ("emacs");
2587 /* Name is partly valid. Copy it and replace the invalid characters
2588 with underscores. */
2590 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2592 for (i
= 0; i
< len
; i
++)
2594 int c
= XSTRING (new)->data
[i
];
2595 if (! ((c
>= 'a' && c
<= 'z')
2596 || (c
>= 'A' && c
<= 'Z')
2597 || (c
>= '0' && c
<= '9')
2598 || c
== '-' || c
== '_'))
2599 XSTRING (new)->data
[i
] = '_';
2604 extern char *x_get_string_resource ();
2606 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2607 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2608 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2609 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2610 the name specified by the `-name' or `-rn' command-line arguments.\n\
2612 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2613 class, respectively. You must specify both of them or neither.\n\
2614 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2615 and the class is `Emacs.CLASS.SUBCLASS'.")
2616 (attribute
, class, component
, subclass
)
2617 Lisp_Object attribute
, class, component
, subclass
;
2619 register char *value
;
2625 CHECK_STRING (attribute
, 0);
2626 CHECK_STRING (class, 0);
2628 if (!NILP (component
))
2629 CHECK_STRING (component
, 1);
2630 if (!NILP (subclass
))
2631 CHECK_STRING (subclass
, 2);
2632 if (NILP (component
) != NILP (subclass
))
2633 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2635 validate_x_resource_name ();
2637 /* Allocate space for the components, the dots which separate them,
2638 and the final '\0'. Make them big enough for the worst case. */
2639 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2640 + (STRINGP (component
)
2641 ? STRING_BYTES (XSTRING (component
)) : 0)
2642 + STRING_BYTES (XSTRING (attribute
))
2645 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2646 + STRING_BYTES (XSTRING (class))
2647 + (STRINGP (subclass
)
2648 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2651 /* Start with emacs.FRAMENAME for the name (the specific one)
2652 and with `Emacs' for the class key (the general one). */
2653 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2654 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2656 strcat (class_key
, ".");
2657 strcat (class_key
, XSTRING (class)->data
);
2659 if (!NILP (component
))
2661 strcat (class_key
, ".");
2662 strcat (class_key
, XSTRING (subclass
)->data
);
2664 strcat (name_key
, ".");
2665 strcat (name_key
, XSTRING (component
)->data
);
2668 strcat (name_key
, ".");
2669 strcat (name_key
, XSTRING (attribute
)->data
);
2671 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2672 name_key
, class_key
);
2674 if (value
!= (char *) 0)
2675 return build_string (value
);
2680 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2683 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2684 struct x_display_info
*dpyinfo
;
2685 Lisp_Object attribute
, class, component
, subclass
;
2687 register char *value
;
2691 CHECK_STRING (attribute
, 0);
2692 CHECK_STRING (class, 0);
2694 if (!NILP (component
))
2695 CHECK_STRING (component
, 1);
2696 if (!NILP (subclass
))
2697 CHECK_STRING (subclass
, 2);
2698 if (NILP (component
) != NILP (subclass
))
2699 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2701 validate_x_resource_name ();
2703 /* Allocate space for the components, the dots which separate them,
2704 and the final '\0'. Make them big enough for the worst case. */
2705 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2706 + (STRINGP (component
)
2707 ? STRING_BYTES (XSTRING (component
)) : 0)
2708 + STRING_BYTES (XSTRING (attribute
))
2711 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2712 + STRING_BYTES (XSTRING (class))
2713 + (STRINGP (subclass
)
2714 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2717 /* Start with emacs.FRAMENAME for the name (the specific one)
2718 and with `Emacs' for the class key (the general one). */
2719 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2720 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2722 strcat (class_key
, ".");
2723 strcat (class_key
, XSTRING (class)->data
);
2725 if (!NILP (component
))
2727 strcat (class_key
, ".");
2728 strcat (class_key
, XSTRING (subclass
)->data
);
2730 strcat (name_key
, ".");
2731 strcat (name_key
, XSTRING (component
)->data
);
2734 strcat (name_key
, ".");
2735 strcat (name_key
, XSTRING (attribute
)->data
);
2737 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2739 if (value
!= (char *) 0)
2740 return build_string (value
);
2745 /* Used when C code wants a resource value. */
2748 x_get_resource_string (attribute
, class)
2749 char *attribute
, *class;
2753 struct frame
*sf
= SELECTED_FRAME ();
2755 /* Allocate space for the components, the dots which separate them,
2756 and the final '\0'. */
2757 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2758 + strlen (attribute
) + 2);
2759 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2760 + strlen (class) + 2);
2762 sprintf (name_key
, "%s.%s",
2763 XSTRING (Vinvocation_name
)->data
,
2765 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2767 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2768 name_key
, class_key
);
2771 /* Types we might convert a resource string into. */
2781 /* Return the value of parameter PARAM.
2783 First search ALIST, then Vdefault_frame_alist, then the X defaults
2784 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2786 Convert the resource to the type specified by desired_type.
2788 If no default is specified, return Qunbound. If you call
2789 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2790 and don't let it get stored in any Lisp-visible variables! */
2793 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2794 struct x_display_info
*dpyinfo
;
2795 Lisp_Object alist
, param
;
2798 enum resource_types type
;
2800 register Lisp_Object tem
;
2802 tem
= Fassq (param
, alist
);
2804 tem
= Fassq (param
, Vdefault_frame_alist
);
2810 tem
= display_x_get_resource (dpyinfo
,
2811 build_string (attribute
),
2812 build_string (class),
2820 case RES_TYPE_NUMBER
:
2821 return make_number (atoi (XSTRING (tem
)->data
));
2823 case RES_TYPE_FLOAT
:
2824 return make_float (atof (XSTRING (tem
)->data
));
2826 case RES_TYPE_BOOLEAN
:
2827 tem
= Fdowncase (tem
);
2828 if (!strcmp (XSTRING (tem
)->data
, "on")
2829 || !strcmp (XSTRING (tem
)->data
, "true"))
2834 case RES_TYPE_STRING
:
2837 case RES_TYPE_SYMBOL
:
2838 /* As a special case, we map the values `true' and `on'
2839 to Qt, and `false' and `off' to Qnil. */
2842 lower
= Fdowncase (tem
);
2843 if (!strcmp (XSTRING (lower
)->data
, "on")
2844 || !strcmp (XSTRING (lower
)->data
, "true"))
2846 else if (!strcmp (XSTRING (lower
)->data
, "off")
2847 || !strcmp (XSTRING (lower
)->data
, "false"))
2850 return Fintern (tem
, Qnil
);
2863 /* Like x_get_arg, but also record the value in f->param_alist. */
2866 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2868 Lisp_Object alist
, param
;
2871 enum resource_types type
;
2875 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2876 attribute
, class, type
);
2878 store_frame_param (f
, param
, value
);
2883 /* Record in frame F the specified or default value according to ALIST
2884 of the parameter named PROP (a Lisp symbol).
2885 If no value is specified for PROP, look for an X default for XPROP
2886 on the frame named NAME.
2887 If that is not found either, use the value DEFLT. */
2890 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2897 enum resource_types type
;
2901 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2902 if (EQ (tem
, Qunbound
))
2904 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2909 /* Record in frame F the specified or default value according to ALIST
2910 of the parameter named PROP (a Lisp symbol). If no value is
2911 specified for PROP, look for an X default for XPROP on the frame
2912 named NAME. If that is not found either, use the value DEFLT. */
2915 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2924 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2927 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2928 if (EQ (tem
, Qunbound
))
2930 #ifdef USE_TOOLKIT_SCROLL_BARS
2932 /* See if an X resource for the scroll bar color has been
2934 tem
= display_x_get_resource (dpyinfo
,
2935 build_string (foreground_p
2939 build_string ("verticalScrollBar"),
2943 /* If nothing has been specified, scroll bars will use a
2944 toolkit-dependent default. Because these defaults are
2945 difficult to get at without actually creating a scroll
2946 bar, use nil to indicate that no color has been
2951 #else /* not USE_TOOLKIT_SCROLL_BARS */
2955 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2958 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2964 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2965 "Parse an X-style geometry string STRING.\n\
2966 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2967 The properties returned may include `top', `left', `height', and `width'.\n\
2968 The value of `left' or `top' may be an integer,\n\
2969 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2970 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2975 unsigned int width
, height
;
2978 CHECK_STRING (string
, 0);
2980 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2981 &x
, &y
, &width
, &height
);
2984 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2985 error ("Must specify both x and y position, or neither");
2989 if (geometry
& XValue
)
2991 Lisp_Object element
;
2993 if (x
>= 0 && (geometry
& XNegative
))
2994 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2995 else if (x
< 0 && ! (geometry
& XNegative
))
2996 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2998 element
= Fcons (Qleft
, make_number (x
));
2999 result
= Fcons (element
, result
);
3002 if (geometry
& YValue
)
3004 Lisp_Object element
;
3006 if (y
>= 0 && (geometry
& YNegative
))
3007 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3008 else if (y
< 0 && ! (geometry
& YNegative
))
3009 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3011 element
= Fcons (Qtop
, make_number (y
));
3012 result
= Fcons (element
, result
);
3015 if (geometry
& WidthValue
)
3016 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3017 if (geometry
& HeightValue
)
3018 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3023 /* Calculate the desired size and position of this window,
3024 and return the flags saying which aspects were specified.
3026 This function does not make the coordinates positive. */
3028 #define DEFAULT_ROWS 40
3029 #define DEFAULT_COLS 80
3032 x_figure_window_size (f
, parms
)
3036 register Lisp_Object tem0
, tem1
, tem2
;
3037 long window_prompting
= 0;
3038 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3040 /* Default values if we fall through.
3041 Actually, if that happens we should get
3042 window manager prompting. */
3043 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3044 f
->height
= DEFAULT_ROWS
;
3045 /* Window managers expect that if program-specified
3046 positions are not (0,0), they're intentional, not defaults. */
3047 f
->output_data
.x
->top_pos
= 0;
3048 f
->output_data
.x
->left_pos
= 0;
3050 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3051 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3052 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3053 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3055 if (!EQ (tem0
, Qunbound
))
3057 CHECK_NUMBER (tem0
, 0);
3058 f
->height
= XINT (tem0
);
3060 if (!EQ (tem1
, Qunbound
))
3062 CHECK_NUMBER (tem1
, 0);
3063 SET_FRAME_WIDTH (f
, XINT (tem1
));
3065 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3066 window_prompting
|= USSize
;
3068 window_prompting
|= PSize
;
3071 f
->output_data
.x
->vertical_scroll_bar_extra
3072 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3074 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3075 f
->output_data
.x
->flags_areas_extra
3076 = FRAME_FLAGS_AREA_WIDTH (f
);
3077 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3078 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3080 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3081 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3082 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3083 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3085 if (EQ (tem0
, Qminus
))
3087 f
->output_data
.x
->top_pos
= 0;
3088 window_prompting
|= YNegative
;
3090 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3091 && CONSP (XCDR (tem0
))
3092 && INTEGERP (XCAR (XCDR (tem0
))))
3094 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3095 window_prompting
|= YNegative
;
3097 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3098 && CONSP (XCDR (tem0
))
3099 && INTEGERP (XCAR (XCDR (tem0
))))
3101 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3103 else if (EQ (tem0
, Qunbound
))
3104 f
->output_data
.x
->top_pos
= 0;
3107 CHECK_NUMBER (tem0
, 0);
3108 f
->output_data
.x
->top_pos
= XINT (tem0
);
3109 if (f
->output_data
.x
->top_pos
< 0)
3110 window_prompting
|= YNegative
;
3113 if (EQ (tem1
, Qminus
))
3115 f
->output_data
.x
->left_pos
= 0;
3116 window_prompting
|= XNegative
;
3118 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3119 && CONSP (XCDR (tem1
))
3120 && INTEGERP (XCAR (XCDR (tem1
))))
3122 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3123 window_prompting
|= XNegative
;
3125 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3126 && CONSP (XCDR (tem1
))
3127 && INTEGERP (XCAR (XCDR (tem1
))))
3129 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3131 else if (EQ (tem1
, Qunbound
))
3132 f
->output_data
.x
->left_pos
= 0;
3135 CHECK_NUMBER (tem1
, 0);
3136 f
->output_data
.x
->left_pos
= XINT (tem1
);
3137 if (f
->output_data
.x
->left_pos
< 0)
3138 window_prompting
|= XNegative
;
3141 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3142 window_prompting
|= USPosition
;
3144 window_prompting
|= PPosition
;
3147 return window_prompting
;
3150 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3153 XSetWMProtocols (dpy
, w
, protocols
, count
)
3160 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3161 if (prop
== None
) return False
;
3162 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3163 (unsigned char *) protocols
, count
);
3166 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3168 #ifdef USE_X_TOOLKIT
3170 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3171 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3172 already be present because of the toolkit (Motif adds some of them,
3173 for example, but Xt doesn't). */
3176 hack_wm_protocols (f
, widget
)
3180 Display
*dpy
= XtDisplay (widget
);
3181 Window w
= XtWindow (widget
);
3182 int need_delete
= 1;
3188 Atom type
, *atoms
= 0;
3190 unsigned long nitems
= 0;
3191 unsigned long bytes_after
;
3193 if ((XGetWindowProperty (dpy
, w
,
3194 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3195 (long)0, (long)100, False
, XA_ATOM
,
3196 &type
, &format
, &nitems
, &bytes_after
,
3197 (unsigned char **) &atoms
)
3199 && format
== 32 && type
== XA_ATOM
)
3203 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3205 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3207 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3210 if (atoms
) XFree ((char *) atoms
);
3216 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3218 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3220 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3222 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3223 XA_ATOM
, 32, PropModeAppend
,
3224 (unsigned char *) props
, count
);
3232 /* Support routines for XIC (X Input Context). */
3236 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3237 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3240 /* Supported XIM styles, ordered by preferenc. */
3242 static XIMStyle supported_xim_styles
[] =
3244 XIMPreeditPosition
| XIMStatusArea
,
3245 XIMPreeditPosition
| XIMStatusNothing
,
3246 XIMPreeditPosition
| XIMStatusNone
,
3247 XIMPreeditNothing
| XIMStatusArea
,
3248 XIMPreeditNothing
| XIMStatusNothing
,
3249 XIMPreeditNothing
| XIMStatusNone
,
3250 XIMPreeditNone
| XIMStatusArea
,
3251 XIMPreeditNone
| XIMStatusNothing
,
3252 XIMPreeditNone
| XIMStatusNone
,
3257 /* Create an X fontset on frame F with base font name
3261 xic_create_xfontset (f
, base_fontname
)
3263 char *base_fontname
;
3266 char **missing_list
;
3270 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3271 base_fontname
, &missing_list
,
3272 &missing_count
, &def_string
);
3274 XFreeStringList (missing_list
);
3276 /* No need to free def_string. */
3281 /* Value is the best input style, given user preferences USER (already
3282 checked to be supported by Emacs), and styles supported by the
3283 input method XIM. */
3286 best_xim_style (user
, xim
)
3292 for (i
= 0; i
< user
->count_styles
; ++i
)
3293 for (j
= 0; j
< xim
->count_styles
; ++j
)
3294 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3295 return user
->supported_styles
[i
];
3297 /* Return the default style. */
3298 return XIMPreeditNothing
| XIMStatusNothing
;
3301 /* Create XIC for frame F. */
3303 static XIMStyle xic_style
;
3306 create_frame_xic (f
)
3311 XFontSet xfs
= NULL
;
3316 xim
= FRAME_X_XIM (f
);
3321 XVaNestedList preedit_attr
;
3322 XVaNestedList status_attr
;
3323 char *base_fontname
;
3326 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3327 spot
.x
= 0; spot
.y
= 1;
3328 /* Create X fontset. */
3329 fontset
= FRAME_FONTSET (f
);
3331 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3334 /* Determine the base fontname from the ASCII font name of
3336 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3337 char *p
= ascii_font
;
3340 for (i
= 0; *p
; p
++)
3343 /* As the font name doesn't conform to XLFD, we can't
3344 modify it to get a suitable base fontname for the
3346 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3349 int len
= strlen (ascii_font
) + 1;
3352 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3361 base_fontname
= (char *) alloca (len
);
3362 bzero (base_fontname
, len
);
3363 strcpy (base_fontname
, "-*-*-");
3364 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3365 strcat (base_fontname
, "*-*-*-*-*-*-*");
3368 xfs
= xic_create_xfontset (f
, base_fontname
);
3370 /* Determine XIC style. */
3373 XIMStyles supported_list
;
3374 supported_list
.count_styles
= (sizeof supported_xim_styles
3375 / sizeof supported_xim_styles
[0]);
3376 supported_list
.supported_styles
= supported_xim_styles
;
3377 xic_style
= best_xim_style (&supported_list
,
3378 FRAME_X_XIM_STYLES (f
));
3381 preedit_attr
= XVaCreateNestedList (0,
3384 FRAME_FOREGROUND_PIXEL (f
),
3386 FRAME_BACKGROUND_PIXEL (f
),
3387 (xic_style
& XIMPreeditPosition
3392 status_attr
= XVaCreateNestedList (0,
3398 FRAME_FOREGROUND_PIXEL (f
),
3400 FRAME_BACKGROUND_PIXEL (f
),
3403 xic
= XCreateIC (xim
,
3404 XNInputStyle
, xic_style
,
3405 XNClientWindow
, FRAME_X_WINDOW(f
),
3406 XNFocusWindow
, FRAME_X_WINDOW(f
),
3407 XNStatusAttributes
, status_attr
,
3408 XNPreeditAttributes
, preedit_attr
,
3410 XFree (preedit_attr
);
3411 XFree (status_attr
);
3414 FRAME_XIC (f
) = xic
;
3415 FRAME_XIC_STYLE (f
) = xic_style
;
3416 FRAME_XIC_FONTSET (f
) = xfs
;
3420 /* Destroy XIC and free XIC fontset of frame F, if any. */
3426 if (FRAME_XIC (f
) == NULL
)
3429 XDestroyIC (FRAME_XIC (f
));
3430 if (FRAME_XIC_FONTSET (f
))
3431 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3433 FRAME_XIC (f
) = NULL
;
3434 FRAME_XIC_FONTSET (f
) = NULL
;
3438 /* Place preedit area for XIC of window W's frame to specified
3439 pixel position X/Y. X and Y are relative to window W. */
3442 xic_set_preeditarea (w
, x
, y
)
3446 struct frame
*f
= XFRAME (w
->frame
);
3450 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3451 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3452 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3453 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3458 /* Place status area for XIC in bottom right corner of frame F.. */
3461 xic_set_statusarea (f
)
3464 XIC xic
= FRAME_XIC (f
);
3469 /* Negotiate geometry of status area. If input method has existing
3470 status area, use its current size. */
3471 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3472 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3473 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3476 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3477 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3480 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3482 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3483 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3487 area
.width
= needed
->width
;
3488 area
.height
= needed
->height
;
3489 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3490 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3491 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3494 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3495 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3500 /* Set X fontset for XIC of frame F, using base font name
3501 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3504 xic_set_xfontset (f
, base_fontname
)
3506 char *base_fontname
;
3511 xfs
= xic_create_xfontset (f
, base_fontname
);
3513 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3514 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3515 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3516 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3517 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3520 if (FRAME_XIC_FONTSET (f
))
3521 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3522 FRAME_XIC_FONTSET (f
) = xfs
;
3525 #endif /* HAVE_X_I18N */
3529 #ifdef USE_X_TOOLKIT
3531 /* Create and set up the X widget for frame F. */
3534 x_window (f
, window_prompting
, minibuffer_only
)
3536 long window_prompting
;
3537 int minibuffer_only
;
3539 XClassHint class_hints
;
3540 XSetWindowAttributes attributes
;
3541 unsigned long attribute_mask
;
3542 Widget shell_widget
;
3544 Widget frame_widget
;
3550 /* Use the resource name as the top-level widget name
3551 for looking up resources. Make a non-Lisp copy
3552 for the window manager, so GC relocation won't bother it.
3554 Elsewhere we specify the window name for the window manager. */
3557 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3558 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3559 strcpy (f
->namebuf
, str
);
3563 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3564 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3565 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3566 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3567 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3568 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3569 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3570 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3571 applicationShellWidgetClass
,
3572 FRAME_X_DISPLAY (f
), al
, ac
);
3574 f
->output_data
.x
->widget
= shell_widget
;
3575 /* maybe_set_screen_title_format (shell_widget); */
3577 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3578 (widget_value
*) NULL
,
3579 shell_widget
, False
,
3583 (lw_callback
) NULL
);
3586 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3587 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3588 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3589 XtSetValues (pane_widget
, al
, ac
);
3590 f
->output_data
.x
->column_widget
= pane_widget
;
3592 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3593 the emacs screen when changing menubar. This reduces flickering. */
3596 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3597 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3598 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3599 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3600 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3601 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3602 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3603 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3604 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3607 f
->output_data
.x
->edit_widget
= frame_widget
;
3609 XtManageChild (frame_widget
);
3611 /* Do some needed geometry management. */
3614 char *tem
, shell_position
[32];
3617 int extra_borders
= 0;
3619 = (f
->output_data
.x
->menubar_widget
3620 ? (f
->output_data
.x
->menubar_widget
->core
.height
3621 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3624 #if 0 /* Experimentally, we now get the right results
3625 for -geometry -0-0 without this. 24 Aug 96, rms. */
3626 if (FRAME_EXTERNAL_MENU_BAR (f
))
3629 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3630 menubar_size
+= ibw
;
3634 f
->output_data
.x
->menubar_height
= menubar_size
;
3637 /* Motif seems to need this amount added to the sizes
3638 specified for the shell widget. The Athena/Lucid widgets don't.
3639 Both conclusions reached experimentally. -- rms. */
3640 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3641 &extra_borders
, NULL
);
3645 /* Convert our geometry parameters into a geometry string
3647 Note that we do not specify here whether the position
3648 is a user-specified or program-specified one.
3649 We pass that information later, in x_wm_set_size_hints. */
3651 int left
= f
->output_data
.x
->left_pos
;
3652 int xneg
= window_prompting
& XNegative
;
3653 int top
= f
->output_data
.x
->top_pos
;
3654 int yneg
= window_prompting
& YNegative
;
3660 if (window_prompting
& USPosition
)
3661 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3662 PIXEL_WIDTH (f
) + extra_borders
,
3663 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3664 (xneg
? '-' : '+'), left
,
3665 (yneg
? '-' : '+'), top
);
3667 sprintf (shell_position
, "=%dx%d",
3668 PIXEL_WIDTH (f
) + extra_borders
,
3669 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3672 len
= strlen (shell_position
) + 1;
3673 /* We don't free this because we don't know whether
3674 it is safe to free it while the frame exists.
3675 It isn't worth the trouble of arranging to free it
3676 when the frame is deleted. */
3677 tem
= (char *) xmalloc (len
);
3678 strncpy (tem
, shell_position
, len
);
3679 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3680 XtSetValues (shell_widget
, al
, ac
);
3683 XtManageChild (pane_widget
);
3684 XtRealizeWidget (shell_widget
);
3686 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3688 validate_x_resource_name ();
3690 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3691 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3692 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3695 FRAME_XIC (f
) = NULL
;
3697 create_frame_xic (f
);
3701 f
->output_data
.x
->wm_hints
.input
= True
;
3702 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3703 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3704 &f
->output_data
.x
->wm_hints
);
3706 hack_wm_protocols (f
, shell_widget
);
3709 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3712 /* Do a stupid property change to force the server to generate a
3713 PropertyNotify event so that the event_stream server timestamp will
3714 be initialized to something relevant to the time we created the window.
3716 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3717 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3718 XA_ATOM
, 32, PropModeAppend
,
3719 (unsigned char*) NULL
, 0);
3721 /* Make all the standard events reach the Emacs frame. */
3722 attributes
.event_mask
= STANDARD_EVENT_SET
;
3727 /* XIM server might require some X events. */
3728 unsigned long fevent
= NoEventMask
;
3729 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3730 attributes
.event_mask
|= fevent
;
3732 #endif /* HAVE_X_I18N */
3734 attribute_mask
= CWEventMask
;
3735 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3736 attribute_mask
, &attributes
);
3738 XtMapWidget (frame_widget
);
3740 /* x_set_name normally ignores requests to set the name if the
3741 requested name is the same as the current name. This is the one
3742 place where that assumption isn't correct; f->name is set, but
3743 the X server hasn't been told. */
3746 int explicit = f
->explicit_name
;
3748 f
->explicit_name
= 0;
3751 x_set_name (f
, name
, explicit);
3754 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3755 f
->output_data
.x
->text_cursor
);
3759 /* This is a no-op, except under Motif. Make sure main areas are
3760 set to something reasonable, in case we get an error later. */
3761 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3764 #else /* not USE_X_TOOLKIT */
3766 /* Create and set up the X window for frame F. */
3773 XClassHint class_hints
;
3774 XSetWindowAttributes attributes
;
3775 unsigned long attribute_mask
;
3777 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3778 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3779 attributes
.bit_gravity
= StaticGravity
;
3780 attributes
.backing_store
= NotUseful
;
3781 attributes
.save_under
= True
;
3782 attributes
.event_mask
= STANDARD_EVENT_SET
;
3783 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3784 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3789 = XCreateWindow (FRAME_X_DISPLAY (f
),
3790 f
->output_data
.x
->parent_desc
,
3791 f
->output_data
.x
->left_pos
,
3792 f
->output_data
.x
->top_pos
,
3793 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3794 f
->output_data
.x
->border_width
,
3795 CopyFromParent
, /* depth */
3796 InputOutput
, /* class */
3798 attribute_mask
, &attributes
);
3802 create_frame_xic (f
);
3805 /* XIM server might require some X events. */
3806 unsigned long fevent
= NoEventMask
;
3807 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3808 attributes
.event_mask
|= fevent
;
3809 attribute_mask
= CWEventMask
;
3810 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3811 attribute_mask
, &attributes
);
3814 #endif /* HAVE_X_I18N */
3816 validate_x_resource_name ();
3818 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3819 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3820 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3822 /* The menubar is part of the ordinary display;
3823 it does not count in addition to the height of the window. */
3824 f
->output_data
.x
->menubar_height
= 0;
3826 /* This indicates that we use the "Passive Input" input model.
3827 Unless we do this, we don't get the Focus{In,Out} events that we
3828 need to draw the cursor correctly. Accursed bureaucrats.
3829 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3831 f
->output_data
.x
->wm_hints
.input
= True
;
3832 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3833 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3834 &f
->output_data
.x
->wm_hints
);
3835 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3837 /* Request "save yourself" and "delete window" commands from wm. */
3840 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3841 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3842 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3845 /* x_set_name normally ignores requests to set the name if the
3846 requested name is the same as the current name. This is the one
3847 place where that assumption isn't correct; f->name is set, but
3848 the X server hasn't been told. */
3851 int explicit = f
->explicit_name
;
3853 f
->explicit_name
= 0;
3856 x_set_name (f
, name
, explicit);
3859 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3860 f
->output_data
.x
->text_cursor
);
3864 if (FRAME_X_WINDOW (f
) == 0)
3865 error ("Unable to create window");
3868 #endif /* not USE_X_TOOLKIT */
3870 /* Handle the icon stuff for this window. Perhaps later we might
3871 want an x_set_icon_position which can be called interactively as
3879 Lisp_Object icon_x
, icon_y
;
3880 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3882 /* Set the position of the icon. Note that twm groups all
3883 icons in an icon window. */
3884 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3885 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3886 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3888 CHECK_NUMBER (icon_x
, 0);
3889 CHECK_NUMBER (icon_y
, 0);
3891 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3892 error ("Both left and top icon corners of icon must be specified");
3896 if (! EQ (icon_x
, Qunbound
))
3897 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3899 /* Start up iconic or window? */
3900 x_wm_set_window_state
3901 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3906 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3913 /* Make the GCs needed for this window, setting the
3914 background, border and mouse colors; also create the
3915 mouse cursor and the gray border tile. */
3917 static char cursor_bits
[] =
3919 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3920 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3921 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3922 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3929 XGCValues gc_values
;
3933 /* Create the GCs of this frame.
3934 Note that many default values are used. */
3937 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3938 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3939 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3940 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3941 f
->output_data
.x
->normal_gc
3942 = XCreateGC (FRAME_X_DISPLAY (f
),
3944 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
3947 /* Reverse video style. */
3948 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3949 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3950 f
->output_data
.x
->reverse_gc
3951 = XCreateGC (FRAME_X_DISPLAY (f
),
3953 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
3956 /* Cursor has cursor-color background, background-color foreground. */
3957 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3958 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3959 gc_values
.fill_style
= FillOpaqueStippled
;
3961 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3962 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3963 cursor_bits
, 16, 16);
3964 f
->output_data
.x
->cursor_gc
3965 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3966 (GCFont
| GCForeground
| GCBackground
3967 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3971 f
->output_data
.x
->white_relief
.gc
= 0;
3972 f
->output_data
.x
->black_relief
.gc
= 0;
3974 /* Create the gray border tile used when the pointer is not in
3975 the frame. Since this depends on the frame's pixel values,
3976 this must be done on a per-frame basis. */
3977 f
->output_data
.x
->border_tile
3978 = (XCreatePixmapFromBitmapData
3979 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3980 gray_bits
, gray_width
, gray_height
,
3981 f
->output_data
.x
->foreground_pixel
,
3982 f
->output_data
.x
->background_pixel
,
3983 DefaultDepth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
))));
3989 /* Free what was was allocated in x_make_gc. */
3995 Display
*dpy
= FRAME_X_DISPLAY (f
);
3999 if (f
->output_data
.x
->normal_gc
)
4001 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
4002 f
->output_data
.x
->normal_gc
= 0;
4005 if (f
->output_data
.x
->reverse_gc
)
4007 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4008 f
->output_data
.x
->reverse_gc
= 0;
4011 if (f
->output_data
.x
->cursor_gc
)
4013 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4014 f
->output_data
.x
->cursor_gc
= 0;
4017 if (f
->output_data
.x
->border_tile
)
4019 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4020 f
->output_data
.x
->border_tile
= 0;
4027 /* Handler for signals raised during x_create_frame and
4028 x_create_top_frame. FRAME is the frame which is partially
4032 unwind_create_frame (frame
)
4035 struct frame
*f
= XFRAME (frame
);
4037 /* If frame is ``official'', nothing to do. */
4038 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4041 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4044 x_free_frame_resources (f
);
4046 /* Check that reference counts are indeed correct. */
4047 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4048 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4056 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4058 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
4059 Returns an Emacs frame object.\n\
4060 ALIST is an alist of frame parameters.\n\
4061 If the parameters specify that the frame should not have a minibuffer,\n\
4062 and do not specify a specific minibuffer window to use,\n\
4063 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4064 be shared by the new frame.\n\
4066 This function is an internal primitive--use `make-frame' instead.")
4071 Lisp_Object frame
, tem
;
4073 int minibuffer_only
= 0;
4074 long window_prompting
= 0;
4076 int count
= BINDING_STACK_SIZE ();
4077 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4078 Lisp_Object display
;
4079 struct x_display_info
*dpyinfo
= NULL
;
4085 /* Use this general default value to start with
4086 until we know if this frame has a specified name. */
4087 Vx_resource_name
= Vinvocation_name
;
4089 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4090 if (EQ (display
, Qunbound
))
4092 dpyinfo
= check_x_display_info (display
);
4094 kb
= dpyinfo
->kboard
;
4096 kb
= &the_only_kboard
;
4099 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4101 && ! EQ (name
, Qunbound
)
4103 error ("Invalid frame name--not a string or nil");
4106 Vx_resource_name
= name
;
4108 /* See if parent window is specified. */
4109 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4110 if (EQ (parent
, Qunbound
))
4112 if (! NILP (parent
))
4113 CHECK_NUMBER (parent
, 0);
4115 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4116 /* No need to protect DISPLAY because that's not used after passing
4117 it to make_frame_without_minibuffer. */
4119 GCPRO4 (parms
, parent
, name
, frame
);
4120 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4122 if (EQ (tem
, Qnone
) || NILP (tem
))
4123 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4124 else if (EQ (tem
, Qonly
))
4126 f
= make_minibuffer_frame ();
4127 minibuffer_only
= 1;
4129 else if (WINDOWP (tem
))
4130 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4134 XSETFRAME (frame
, f
);
4136 /* Note that X Windows does support scroll bars. */
4137 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4139 f
->output_method
= output_x_window
;
4140 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4141 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4142 f
->output_data
.x
->icon_bitmap
= -1;
4143 f
->output_data
.x
->fontset
= -1;
4144 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4145 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4146 record_unwind_protect (unwind_create_frame
, frame
);
4149 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4151 if (! STRINGP (f
->icon_name
))
4152 f
->icon_name
= Qnil
;
4154 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4156 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4157 dpyinfo_refcount
= dpyinfo
->reference_count
;
4158 #endif /* GLYPH_DEBUG */
4160 FRAME_KBOARD (f
) = kb
;
4163 /* These colors will be set anyway later, but it's important
4164 to get the color reference counts right, so initialize them! */
4167 struct gcpro gcpro1
;
4169 black
= build_string ("black");
4171 f
->output_data
.x
->foreground_pixel
4172 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4173 f
->output_data
.x
->background_pixel
4174 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4175 f
->output_data
.x
->cursor_pixel
4176 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4177 f
->output_data
.x
->cursor_foreground_pixel
4178 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4179 f
->output_data
.x
->border_pixel
4180 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4181 f
->output_data
.x
->mouse_pixel
4182 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4186 /* Specify the parent under which to make this X window. */
4190 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4191 f
->output_data
.x
->explicit_parent
= 1;
4195 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4196 f
->output_data
.x
->explicit_parent
= 0;
4199 /* Set the name; the functions to which we pass f expect the name to
4201 if (EQ (name
, Qunbound
) || NILP (name
))
4203 f
->name
= build_string (dpyinfo
->x_id_name
);
4204 f
->explicit_name
= 0;
4209 f
->explicit_name
= 1;
4210 /* use the frame's title when getting resources for this frame. */
4211 specbind (Qx_resource_name
, name
);
4214 /* Extract the window parameters from the supplied values
4215 that are needed to determine window geometry. */
4219 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4222 /* First, try whatever font the caller has specified. */
4225 tem
= Fquery_fontset (font
, Qnil
);
4227 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4229 font
= x_new_font (f
, XSTRING (font
)->data
);
4232 /* Try out a font which we hope has bold and italic variations. */
4233 if (!STRINGP (font
))
4234 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4235 if (!STRINGP (font
))
4236 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4237 if (! STRINGP (font
))
4238 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4239 if (! STRINGP (font
))
4240 /* This was formerly the first thing tried, but it finds too many fonts
4241 and takes too long. */
4242 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4243 /* If those didn't work, look for something which will at least work. */
4244 if (! STRINGP (font
))
4245 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4247 if (! STRINGP (font
))
4248 font
= build_string ("fixed");
4250 x_default_parameter (f
, parms
, Qfont
, font
,
4251 "font", "Font", RES_TYPE_STRING
);
4255 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4256 whereby it fails to get any font. */
4257 xlwmenu_default_font
= f
->output_data
.x
->font
;
4260 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4261 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4263 /* This defaults to 2 in order to match xterm. We recognize either
4264 internalBorderWidth or internalBorder (which is what xterm calls
4266 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4270 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4271 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4272 if (! EQ (value
, Qunbound
))
4273 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4276 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4277 "internalBorderWidth", "internalBorderWidth",
4279 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4280 "verticalScrollBars", "ScrollBars",
4283 /* Also do the stuff which must be set before the window exists. */
4284 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4285 "foreground", "Foreground", RES_TYPE_STRING
);
4286 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4287 "background", "Background", RES_TYPE_STRING
);
4288 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4289 "pointerColor", "Foreground", RES_TYPE_STRING
);
4290 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4291 "cursorColor", "Foreground", RES_TYPE_STRING
);
4292 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4293 "borderColor", "BorderColor", RES_TYPE_STRING
);
4294 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4295 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4296 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4297 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4299 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4300 "scrollBarForeground",
4301 "ScrollBarForeground", 1);
4302 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4303 "scrollBarBackground",
4304 "ScrollBarBackground", 0);
4306 /* Init faces before x_default_parameter is called for scroll-bar
4307 parameters because that function calls x_set_scroll_bar_width,
4308 which calls change_frame_size, which calls Fset_window_buffer,
4309 which runs hooks, which call Fvertical_motion. At the end, we
4310 end up in init_iterator with a null face cache, which should not
4312 init_frame_faces (f
);
4314 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4315 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4316 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4317 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4318 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4319 "bufferPredicate", "BufferPredicate",
4321 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4322 "title", "Title", RES_TYPE_STRING
);
4324 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4326 /* Add the tool-bar height to the initial frame height so that the
4327 user gets a text display area of the size he specified with -g or
4328 via .Xdefaults. Later changes of the tool-bar height don't
4329 change the frame size. This is done so that users can create
4330 tall Emacs frames without having to guess how tall the tool-bar
4332 if (FRAME_TOOL_BAR_LINES (f
))
4334 int margin
, relief
, bar_height
;
4336 relief
= (tool_bar_button_relief
> 0
4337 ? tool_bar_button_relief
4338 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4340 if (INTEGERP (Vtool_bar_button_margin
)
4341 && XINT (Vtool_bar_button_margin
) > 0)
4342 margin
= XFASTINT (Vtool_bar_button_margin
);
4343 else if (CONSP (Vtool_bar_button_margin
)
4344 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4345 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4346 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4350 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4351 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4354 /* Compute the size of the X window. */
4355 window_prompting
= x_figure_window_size (f
, parms
);
4357 if (window_prompting
& XNegative
)
4359 if (window_prompting
& YNegative
)
4360 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4362 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4366 if (window_prompting
& YNegative
)
4367 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4369 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4372 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4374 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4375 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4377 /* Create the X widget or window. */
4378 #ifdef USE_X_TOOLKIT
4379 x_window (f
, window_prompting
, minibuffer_only
);
4387 /* Now consider the frame official. */
4388 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4389 Vframe_list
= Fcons (frame
, Vframe_list
);
4391 /* We need to do this after creating the X window, so that the
4392 icon-creation functions can say whose icon they're describing. */
4393 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4394 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4396 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4397 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4398 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4399 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4400 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4401 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4402 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4403 "scrollBarWidth", "ScrollBarWidth",
4406 /* Dimensions, especially f->height, must be done via change_frame_size.
4407 Change will not be effected unless different from the current
4413 SET_FRAME_WIDTH (f
, 0);
4414 change_frame_size (f
, height
, width
, 1, 0, 0);
4416 /* Set up faces after all frame parameters are known. This call
4417 also merges in face attributes specified for new frames. If we
4418 don't do this, the `menu' face for instance won't have the right
4419 colors, and the menu bar won't appear in the specified colors for
4421 call1 (Qface_set_after_frame_default
, frame
);
4423 #ifdef USE_X_TOOLKIT
4424 /* Create the menu bar. */
4425 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4427 /* If this signals an error, we haven't set size hints for the
4428 frame and we didn't make it visible. */
4429 initialize_frame_menubar (f
);
4431 /* This is a no-op, except under Motif where it arranges the
4432 main window for the widgets on it. */
4433 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4434 f
->output_data
.x
->menubar_widget
,
4435 f
->output_data
.x
->edit_widget
);
4437 #endif /* USE_X_TOOLKIT */
4439 /* Tell the server what size and position, etc, we want, and how
4440 badly we want them. This should be done after we have the menu
4441 bar so that its size can be taken into account. */
4443 x_wm_set_size_hint (f
, window_prompting
, 0);
4446 /* Make the window appear on the frame and enable display, unless
4447 the caller says not to. However, with explicit parent, Emacs
4448 cannot control visibility, so don't try. */
4449 if (! f
->output_data
.x
->explicit_parent
)
4451 Lisp_Object visibility
;
4453 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4455 if (EQ (visibility
, Qunbound
))
4458 if (EQ (visibility
, Qicon
))
4459 x_iconify_frame (f
);
4460 else if (! NILP (visibility
))
4461 x_make_frame_visible (f
);
4463 /* Must have been Qnil. */
4469 /* Make sure windows on this frame appear in calls to next-window
4470 and similar functions. */
4471 Vwindow_list
= Qnil
;
4473 return unbind_to (count
, frame
);
4477 /* FRAME is used only to get a handle on the X display. We don't pass the
4478 display info directly because we're called from frame.c, which doesn't
4479 know about that structure. */
4482 x_get_focus_frame (frame
)
4483 struct frame
*frame
;
4485 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4487 if (! dpyinfo
->x_focus_frame
)
4490 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4495 /* In certain situations, when the window manager follows a
4496 click-to-focus policy, there seems to be no way around calling
4497 XSetInputFocus to give another frame the input focus .
4499 In an ideal world, XSetInputFocus should generally be avoided so
4500 that applications don't interfere with the window manager's focus
4501 policy. But I think it's okay to use when it's clearly done
4502 following a user-command. */
4504 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4505 "Set the input focus to FRAME.\n\
4506 FRAME nil means use the selected frame.")
4510 struct frame
*f
= check_x_frame (frame
);
4511 Display
*dpy
= FRAME_X_DISPLAY (f
);
4515 count
= x_catch_errors (dpy
);
4516 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4517 RevertToParent
, CurrentTime
);
4518 x_uncatch_errors (dpy
, count
);
4525 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4526 "Internal function called by `color-defined-p', which see.")
4528 Lisp_Object color
, frame
;
4531 FRAME_PTR f
= check_x_frame (frame
);
4533 CHECK_STRING (color
, 1);
4535 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4541 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4542 "Internal function called by `color-values', which see.")
4544 Lisp_Object color
, frame
;
4547 FRAME_PTR f
= check_x_frame (frame
);
4549 CHECK_STRING (color
, 1);
4551 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4555 rgb
[0] = make_number (foo
.red
);
4556 rgb
[1] = make_number (foo
.green
);
4557 rgb
[2] = make_number (foo
.blue
);
4558 return Flist (3, rgb
);
4564 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4565 "Internal function called by `display-color-p', which see.")
4567 Lisp_Object display
;
4569 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4571 if (dpyinfo
->n_planes
<= 2)
4574 switch (dpyinfo
->visual
->class)
4587 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4589 "Return t if the X display supports shades of gray.\n\
4590 Note that color displays do support shades of gray.\n\
4591 The optional argument DISPLAY specifies which display to ask about.\n\
4592 DISPLAY should be either a frame or a display name (a string).\n\
4593 If omitted or nil, that stands for the selected frame's display.")
4595 Lisp_Object display
;
4597 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4599 if (dpyinfo
->n_planes
<= 1)
4602 switch (dpyinfo
->visual
->class)
4617 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4619 "Returns the width in pixels of the X display DISPLAY.\n\
4620 The optional argument DISPLAY specifies which display to ask about.\n\
4621 DISPLAY should be either a frame or a display name (a string).\n\
4622 If omitted or nil, that stands for the selected frame's display.")
4624 Lisp_Object display
;
4626 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4628 return make_number (dpyinfo
->width
);
4631 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4632 Sx_display_pixel_height
, 0, 1, 0,
4633 "Returns the height in pixels of the X display DISPLAY.\n\
4634 The optional argument DISPLAY specifies which display to ask about.\n\
4635 DISPLAY should be either a frame or a display name (a string).\n\
4636 If omitted or nil, that stands for the selected frame's display.")
4638 Lisp_Object display
;
4640 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4642 return make_number (dpyinfo
->height
);
4645 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4647 "Returns the number of bitplanes of the X display DISPLAY.\n\
4648 The optional argument DISPLAY specifies which display to ask about.\n\
4649 DISPLAY should be either a frame or a display name (a string).\n\
4650 If omitted or nil, that stands for the selected frame's display.")
4652 Lisp_Object display
;
4654 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4656 return make_number (dpyinfo
->n_planes
);
4659 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4661 "Returns the number of color cells of the X display DISPLAY.\n\
4662 The optional argument DISPLAY specifies which display to ask about.\n\
4663 DISPLAY should be either a frame or a display name (a string).\n\
4664 If omitted or nil, that stands for the selected frame's display.")
4666 Lisp_Object display
;
4668 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4670 return make_number (DisplayCells (dpyinfo
->display
,
4671 XScreenNumberOfScreen (dpyinfo
->screen
)));
4674 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4675 Sx_server_max_request_size
,
4677 "Returns the maximum request size of the X server of display DISPLAY.\n\
4678 The optional argument DISPLAY specifies which display to ask about.\n\
4679 DISPLAY should be either a frame or a display name (a string).\n\
4680 If omitted or nil, that stands for the selected frame's display.")
4682 Lisp_Object display
;
4684 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4686 return make_number (MAXREQUEST (dpyinfo
->display
));
4689 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4690 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4691 The optional argument DISPLAY specifies which display to ask about.\n\
4692 DISPLAY should be either a frame or a display name (a string).\n\
4693 If omitted or nil, that stands for the selected frame's display.")
4695 Lisp_Object display
;
4697 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4698 char *vendor
= ServerVendor (dpyinfo
->display
);
4700 if (! vendor
) vendor
= "";
4701 return build_string (vendor
);
4704 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4705 "Returns the version numbers of the X server of display DISPLAY.\n\
4706 The value is a list of three integers: the major and minor\n\
4707 version numbers of the X Protocol in use, and the vendor-specific release\n\
4708 number. See also the function `x-server-vendor'.\n\n\
4709 The optional argument DISPLAY specifies which display to ask about.\n\
4710 DISPLAY should be either a frame or a display name (a string).\n\
4711 If omitted or nil, that stands for the selected frame's display.")
4713 Lisp_Object display
;
4715 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4716 Display
*dpy
= dpyinfo
->display
;
4718 return Fcons (make_number (ProtocolVersion (dpy
)),
4719 Fcons (make_number (ProtocolRevision (dpy
)),
4720 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4723 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4724 "Returns the number of screens on the X server of display DISPLAY.\n\
4725 The optional argument DISPLAY specifies which display to ask about.\n\
4726 DISPLAY should be either a frame or a display name (a string).\n\
4727 If omitted or nil, that stands for the selected frame's display.")
4729 Lisp_Object display
;
4731 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4733 return make_number (ScreenCount (dpyinfo
->display
));
4736 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4737 "Returns the height in millimeters of the X display DISPLAY.\n\
4738 The optional argument DISPLAY specifies which display to ask about.\n\
4739 DISPLAY should be either a frame or a display name (a string).\n\
4740 If omitted or nil, that stands for the selected frame's display.")
4742 Lisp_Object display
;
4744 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4746 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4749 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4750 "Returns the width in millimeters of the X display DISPLAY.\n\
4751 The optional argument DISPLAY specifies which display to ask about.\n\
4752 DISPLAY should be either a frame or a display name (a string).\n\
4753 If omitted or nil, that stands for the selected frame's display.")
4755 Lisp_Object display
;
4757 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4759 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4762 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4763 Sx_display_backing_store
, 0, 1, 0,
4764 "Returns an indication of whether X display DISPLAY does backing store.\n\
4765 The value may be `always', `when-mapped', or `not-useful'.\n\
4766 The optional argument DISPLAY specifies which display to ask about.\n\
4767 DISPLAY should be either a frame or a display name (a string).\n\
4768 If omitted or nil, that stands for the selected frame's display.")
4770 Lisp_Object display
;
4772 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4775 switch (DoesBackingStore (dpyinfo
->screen
))
4778 result
= intern ("always");
4782 result
= intern ("when-mapped");
4786 result
= intern ("not-useful");
4790 error ("Strange value for BackingStore parameter of screen");
4797 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4798 Sx_display_visual_class
, 0, 1, 0,
4799 "Returns the visual class of the X display DISPLAY.\n\
4800 The value is one of the symbols `static-gray', `gray-scale',\n\
4801 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4802 The optional argument DISPLAY specifies which display to ask about.\n\
4803 DISPLAY should be either a frame or a display name (a string).\n\
4804 If omitted or nil, that stands for the selected frame's display.")
4806 Lisp_Object display
;
4808 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4811 switch (dpyinfo
->visual
->class)
4814 result
= intern ("static-gray");
4817 result
= intern ("gray-scale");
4820 result
= intern ("static-color");
4823 result
= intern ("pseudo-color");
4826 result
= intern ("true-color");
4829 result
= intern ("direct-color");
4832 error ("Display has an unknown visual class");
4839 DEFUN ("x-display-save-under", Fx_display_save_under
,
4840 Sx_display_save_under
, 0, 1, 0,
4841 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4842 The optional argument DISPLAY specifies which display to ask about.\n\
4843 DISPLAY should be either a frame or a display name (a string).\n\
4844 If omitted or nil, that stands for the selected frame's display.")
4846 Lisp_Object display
;
4848 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4850 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4858 register struct frame
*f
;
4860 return PIXEL_WIDTH (f
);
4865 register struct frame
*f
;
4867 return PIXEL_HEIGHT (f
);
4872 register struct frame
*f
;
4874 return FONT_WIDTH (f
->output_data
.x
->font
);
4879 register struct frame
*f
;
4881 return f
->output_data
.x
->line_height
;
4886 register struct frame
*f
;
4888 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4893 /************************************************************************
4895 ************************************************************************/
4898 /* Mapping visual names to visuals. */
4900 static struct visual_class
4907 {"StaticGray", StaticGray
},
4908 {"GrayScale", GrayScale
},
4909 {"StaticColor", StaticColor
},
4910 {"PseudoColor", PseudoColor
},
4911 {"TrueColor", TrueColor
},
4912 {"DirectColor", DirectColor
},
4917 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4919 /* Value is the screen number of screen SCR. This is a substitute for
4920 the X function with the same name when that doesn't exist. */
4923 XScreenNumberOfScreen (scr
)
4924 register Screen
*scr
;
4926 Display
*dpy
= scr
->display
;
4929 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4930 if (scr
== dpy
->screens
[i
])
4936 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4939 /* Select the visual that should be used on display DPYINFO. Set
4940 members of DPYINFO appropriately. Called from x_term_init. */
4943 select_visual (dpyinfo
)
4944 struct x_display_info
*dpyinfo
;
4946 Display
*dpy
= dpyinfo
->display
;
4947 Screen
*screen
= dpyinfo
->screen
;
4950 /* See if a visual is specified. */
4951 value
= display_x_get_resource (dpyinfo
,
4952 build_string ("visualClass"),
4953 build_string ("VisualClass"),
4955 if (STRINGP (value
))
4957 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4958 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4959 depth, a decimal number. NAME is compared with case ignored. */
4960 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4965 strcpy (s
, XSTRING (value
)->data
);
4966 dash
= index (s
, '-');
4969 dpyinfo
->n_planes
= atoi (dash
+ 1);
4973 /* We won't find a matching visual with depth 0, so that
4974 an error will be printed below. */
4975 dpyinfo
->n_planes
= 0;
4977 /* Determine the visual class. */
4978 for (i
= 0; visual_classes
[i
].name
; ++i
)
4979 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4981 class = visual_classes
[i
].class;
4985 /* Look up a matching visual for the specified class. */
4987 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4988 dpyinfo
->n_planes
, class, &vinfo
))
4989 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4991 dpyinfo
->visual
= vinfo
.visual
;
4996 XVisualInfo
*vinfo
, vinfo_template
;
4998 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
5001 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
5003 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
5005 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5006 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
5007 &vinfo_template
, &n_visuals
);
5009 fatal ("Can't get proper X visual info");
5011 dpyinfo
->n_planes
= vinfo
->depth
;
5012 XFree ((char *) vinfo
);
5017 /* Return the X display structure for the display named NAME.
5018 Open a new connection if necessary. */
5020 struct x_display_info
*
5021 x_display_info_for_name (name
)
5025 struct x_display_info
*dpyinfo
;
5027 CHECK_STRING (name
, 0);
5029 if (! EQ (Vwindow_system
, intern ("x")))
5030 error ("Not using X Windows");
5032 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5034 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5037 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5042 /* Use this general default value to start with. */
5043 Vx_resource_name
= Vinvocation_name
;
5045 validate_x_resource_name ();
5047 dpyinfo
= x_term_init (name
, (char *)0,
5048 (char *) XSTRING (Vx_resource_name
)->data
);
5051 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5054 XSETFASTINT (Vwindow_system_version
, 11);
5060 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5061 1, 3, 0, "Open a connection to an X server.\n\
5062 DISPLAY is the name of the display to connect to.\n\
5063 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5064 If the optional third arg MUST-SUCCEED is non-nil,\n\
5065 terminate Emacs if we can't open the connection.")
5066 (display
, xrm_string
, must_succeed
)
5067 Lisp_Object display
, xrm_string
, must_succeed
;
5069 unsigned char *xrm_option
;
5070 struct x_display_info
*dpyinfo
;
5072 CHECK_STRING (display
, 0);
5073 if (! NILP (xrm_string
))
5074 CHECK_STRING (xrm_string
, 1);
5076 if (! EQ (Vwindow_system
, intern ("x")))
5077 error ("Not using X Windows");
5079 if (! NILP (xrm_string
))
5080 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5082 xrm_option
= (unsigned char *) 0;
5084 validate_x_resource_name ();
5086 /* This is what opens the connection and sets x_current_display.
5087 This also initializes many symbols, such as those used for input. */
5088 dpyinfo
= x_term_init (display
, xrm_option
,
5089 (char *) XSTRING (Vx_resource_name
)->data
);
5093 if (!NILP (must_succeed
))
5094 fatal ("Cannot connect to X server %s.\n\
5095 Check the DISPLAY environment variable or use `-d'.\n\
5096 Also use the `xhost' program to verify that it is set to permit\n\
5097 connections from your machine.\n",
5098 XSTRING (display
)->data
);
5100 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5105 XSETFASTINT (Vwindow_system_version
, 11);
5109 DEFUN ("x-close-connection", Fx_close_connection
,
5110 Sx_close_connection
, 1, 1, 0,
5111 "Close the connection to DISPLAY's X server.\n\
5112 For DISPLAY, specify either a frame or a display name (a string).\n\
5113 If DISPLAY is nil, that stands for the selected frame's display.")
5115 Lisp_Object display
;
5117 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5120 if (dpyinfo
->reference_count
> 0)
5121 error ("Display still has frames on it");
5124 /* Free the fonts in the font table. */
5125 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5126 if (dpyinfo
->font_table
[i
].name
)
5128 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5129 xfree (dpyinfo
->font_table
[i
].full_name
);
5130 xfree (dpyinfo
->font_table
[i
].name
);
5131 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5134 x_destroy_all_bitmaps (dpyinfo
);
5135 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5137 #ifdef USE_X_TOOLKIT
5138 XtCloseDisplay (dpyinfo
->display
);
5140 XCloseDisplay (dpyinfo
->display
);
5143 x_delete_display (dpyinfo
);
5149 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5150 "Return the list of display names that Emacs has connections to.")
5153 Lisp_Object tail
, result
;
5156 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5157 result
= Fcons (XCAR (XCAR (tail
)), result
);
5162 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5163 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5164 If ON is nil, allow buffering of requests.\n\
5165 Turning on synchronization prohibits the Xlib routines from buffering\n\
5166 requests and seriously degrades performance, but makes debugging much\n\
5168 The optional second argument DISPLAY specifies which display to act on.\n\
5169 DISPLAY should be either a frame or a display name (a string).\n\
5170 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5172 Lisp_Object display
, on
;
5174 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5176 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5181 /* Wait for responses to all X commands issued so far for frame F. */
5188 XSync (FRAME_X_DISPLAY (f
), False
);
5193 /***********************************************************************
5195 ***********************************************************************/
5197 /* Value is the number of elements of vector VECTOR. */
5199 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5201 /* List of supported image types. Use define_image_type to add new
5202 types. Use lookup_image_type to find a type for a given symbol. */
5204 static struct image_type
*image_types
;
5206 /* The symbol `image' which is the car of the lists used to represent
5209 extern Lisp_Object Qimage
;
5211 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5217 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5218 extern Lisp_Object QCdata
;
5219 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5220 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5221 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5223 /* Other symbols. */
5225 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5227 /* Time in seconds after which images should be removed from the cache
5228 if not displayed. */
5230 Lisp_Object Vimage_cache_eviction_delay
;
5232 /* Function prototypes. */
5234 static void define_image_type
P_ ((struct image_type
*type
));
5235 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5236 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5237 static void x_laplace
P_ ((struct frame
*, struct image
*));
5238 static void x_emboss
P_ ((struct frame
*, struct image
*));
5239 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5243 /* Define a new image type from TYPE. This adds a copy of TYPE to
5244 image_types and adds the symbol *TYPE->type to Vimage_types. */
5247 define_image_type (type
)
5248 struct image_type
*type
;
5250 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5251 The initialized data segment is read-only. */
5252 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5253 bcopy (type
, p
, sizeof *p
);
5254 p
->next
= image_types
;
5256 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5260 /* Look up image type SYMBOL, and return a pointer to its image_type
5261 structure. Value is null if SYMBOL is not a known image type. */
5263 static INLINE
struct image_type
*
5264 lookup_image_type (symbol
)
5267 struct image_type
*type
;
5269 for (type
= image_types
; type
; type
= type
->next
)
5270 if (EQ (symbol
, *type
->type
))
5277 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5278 valid image specification is a list whose car is the symbol
5279 `image', and whose rest is a property list. The property list must
5280 contain a value for key `:type'. That value must be the name of a
5281 supported image type. The rest of the property list depends on the
5285 valid_image_p (object
)
5290 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5292 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5293 struct image_type
*type
= lookup_image_type (symbol
);
5296 valid_p
= type
->valid_p (object
);
5303 /* Log error message with format string FORMAT and argument ARG.
5304 Signaling an error, e.g. when an image cannot be loaded, is not a
5305 good idea because this would interrupt redisplay, and the error
5306 message display would lead to another redisplay. This function
5307 therefore simply displays a message. */
5310 image_error (format
, arg1
, arg2
)
5312 Lisp_Object arg1
, arg2
;
5314 add_to_log (format
, arg1
, arg2
);
5319 /***********************************************************************
5320 Image specifications
5321 ***********************************************************************/
5323 enum image_value_type
5325 IMAGE_DONT_CHECK_VALUE_TYPE
,
5327 IMAGE_STRING_OR_NIL_VALUE
,
5329 IMAGE_POSITIVE_INTEGER_VALUE
,
5330 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5331 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5333 IMAGE_INTEGER_VALUE
,
5334 IMAGE_FUNCTION_VALUE
,
5339 /* Structure used when parsing image specifications. */
5341 struct image_keyword
5343 /* Name of keyword. */
5346 /* The type of value allowed. */
5347 enum image_value_type type
;
5349 /* Non-zero means key must be present. */
5352 /* Used to recognize duplicate keywords in a property list. */
5355 /* The value that was found. */
5360 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5362 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5365 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5366 has the format (image KEYWORD VALUE ...). One of the keyword/
5367 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5368 image_keywords structures of size NKEYWORDS describing other
5369 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5372 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5374 struct image_keyword
*keywords
;
5381 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5384 plist
= XCDR (spec
);
5385 while (CONSP (plist
))
5387 Lisp_Object key
, value
;
5389 /* First element of a pair must be a symbol. */
5391 plist
= XCDR (plist
);
5395 /* There must follow a value. */
5398 value
= XCAR (plist
);
5399 plist
= XCDR (plist
);
5401 /* Find key in KEYWORDS. Error if not found. */
5402 for (i
= 0; i
< nkeywords
; ++i
)
5403 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5409 /* Record that we recognized the keyword. If a keywords
5410 was found more than once, it's an error. */
5411 keywords
[i
].value
= value
;
5412 ++keywords
[i
].count
;
5414 if (keywords
[i
].count
> 1)
5417 /* Check type of value against allowed type. */
5418 switch (keywords
[i
].type
)
5420 case IMAGE_STRING_VALUE
:
5421 if (!STRINGP (value
))
5425 case IMAGE_STRING_OR_NIL_VALUE
:
5426 if (!STRINGP (value
) && !NILP (value
))
5430 case IMAGE_SYMBOL_VALUE
:
5431 if (!SYMBOLP (value
))
5435 case IMAGE_POSITIVE_INTEGER_VALUE
:
5436 if (!INTEGERP (value
) || XINT (value
) <= 0)
5440 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5441 if (INTEGERP (value
) && XINT (value
) >= 0)
5444 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5445 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5449 case IMAGE_ASCENT_VALUE
:
5450 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5452 else if (INTEGERP (value
)
5453 && XINT (value
) >= 0
5454 && XINT (value
) <= 100)
5458 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5459 if (!INTEGERP (value
) || XINT (value
) < 0)
5463 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5466 case IMAGE_FUNCTION_VALUE
:
5467 value
= indirect_function (value
);
5469 || COMPILEDP (value
)
5470 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5474 case IMAGE_NUMBER_VALUE
:
5475 if (!INTEGERP (value
) && !FLOATP (value
))
5479 case IMAGE_INTEGER_VALUE
:
5480 if (!INTEGERP (value
))
5484 case IMAGE_BOOL_VALUE
:
5485 if (!NILP (value
) && !EQ (value
, Qt
))
5494 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5498 /* Check that all mandatory fields are present. */
5499 for (i
= 0; i
< nkeywords
; ++i
)
5500 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5503 return NILP (plist
);
5507 /* Return the value of KEY in image specification SPEC. Value is nil
5508 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5509 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5512 image_spec_value (spec
, key
, found
)
5513 Lisp_Object spec
, key
;
5518 xassert (valid_image_p (spec
));
5520 for (tail
= XCDR (spec
);
5521 CONSP (tail
) && CONSP (XCDR (tail
));
5522 tail
= XCDR (XCDR (tail
)))
5524 if (EQ (XCAR (tail
), key
))
5528 return XCAR (XCDR (tail
));
5538 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5539 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5540 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5541 size in canonical character units.\n\
5542 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5543 or omitted means use the selected frame.")
5544 (spec
, pixels
, frame
)
5545 Lisp_Object spec
, pixels
, frame
;
5550 if (valid_image_p (spec
))
5552 struct frame
*f
= check_x_frame (frame
);
5553 int id
= lookup_image (f
, spec
);
5554 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5555 int width
= img
->width
+ 2 * img
->hmargin
;
5556 int height
= img
->height
+ 2 * img
->vmargin
;
5559 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5560 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5562 size
= Fcons (make_number (width
), make_number (height
));
5565 error ("Invalid image specification");
5571 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5572 "Return t if image SPEC has a mask bitmap.\n\
5573 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5574 or omitted means use the selected frame.")
5576 Lisp_Object spec
, frame
;
5581 if (valid_image_p (spec
))
5583 struct frame
*f
= check_x_frame (frame
);
5584 int id
= lookup_image (f
, spec
);
5585 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5590 error ("Invalid image specification");
5597 /***********************************************************************
5598 Image type independent image structures
5599 ***********************************************************************/
5601 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5602 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5605 /* Allocate and return a new image structure for image specification
5606 SPEC. SPEC has a hash value of HASH. */
5608 static struct image
*
5609 make_image (spec
, hash
)
5613 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5615 xassert (valid_image_p (spec
));
5616 bzero (img
, sizeof *img
);
5617 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5618 xassert (img
->type
!= NULL
);
5620 img
->data
.lisp_val
= Qnil
;
5621 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5627 /* Free image IMG which was used on frame F, including its resources. */
5636 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5638 /* Remove IMG from the hash table of its cache. */
5640 img
->prev
->next
= img
->next
;
5642 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5645 img
->next
->prev
= img
->prev
;
5647 c
->images
[img
->id
] = NULL
;
5649 /* Free resources, then free IMG. */
5650 img
->type
->free (f
, img
);
5656 /* Prepare image IMG for display on frame F. Must be called before
5657 drawing an image. */
5660 prepare_image_for_display (f
, img
)
5666 /* We're about to display IMG, so set its timestamp to `now'. */
5668 img
->timestamp
= EMACS_SECS (t
);
5670 /* If IMG doesn't have a pixmap yet, load it now, using the image
5671 type dependent loader function. */
5672 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5673 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5677 /* Value is the number of pixels for the ascent of image IMG when
5678 drawn in face FACE. */
5681 image_ascent (img
, face
)
5685 int height
= img
->height
+ img
->vmargin
;
5688 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5691 /* This expression is arranged so that if the image can't be
5692 exactly centered, it will be moved slightly up. This is
5693 because a typical font is `top-heavy' (due to the presence
5694 uppercase letters), so the image placement should err towards
5695 being top-heavy too. It also just generally looks better. */
5696 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5698 ascent
= height
/ 2;
5701 ascent
= height
* img
->ascent
/ 100.0;
5708 /***********************************************************************
5709 Helper functions for X image types
5710 ***********************************************************************/
5712 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5714 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5715 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5717 Lisp_Object color_name
,
5718 unsigned long dflt
));
5721 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5722 free the pixmap if any. MASK_P non-zero means clear the mask
5723 pixmap if any. COLORS_P non-zero means free colors allocated for
5724 the image, if any. */
5727 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5730 int pixmap_p
, mask_p
, colors_p
;
5732 if (pixmap_p
&& img
->pixmap
)
5734 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5738 if (mask_p
&& img
->mask
)
5740 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5744 if (colors_p
&& img
->ncolors
)
5746 x_free_colors (f
, img
->colors
, img
->ncolors
);
5747 xfree (img
->colors
);
5753 /* Free X resources of image IMG which is used on frame F. */
5756 x_clear_image (f
, img
)
5761 x_clear_image_1 (f
, img
, 1, 1, 1);
5766 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5767 cannot be allocated, use DFLT. Add a newly allocated color to
5768 IMG->colors, so that it can be freed again. Value is the pixel
5771 static unsigned long
5772 x_alloc_image_color (f
, img
, color_name
, dflt
)
5775 Lisp_Object color_name
;
5779 unsigned long result
;
5781 xassert (STRINGP (color_name
));
5783 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5785 /* This isn't called frequently so we get away with simply
5786 reallocating the color vector to the needed size, here. */
5789 (unsigned long *) xrealloc (img
->colors
,
5790 img
->ncolors
* sizeof *img
->colors
);
5791 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5792 result
= color
.pixel
;
5802 /***********************************************************************
5804 ***********************************************************************/
5806 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5807 static void postprocess_image
P_ ((struct frame
*, struct image
*));
5810 /* Return a new, initialized image cache that is allocated from the
5811 heap. Call free_image_cache to free an image cache. */
5813 struct image_cache
*
5816 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5819 bzero (c
, sizeof *c
);
5821 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5822 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5823 c
->buckets
= (struct image
**) xmalloc (size
);
5824 bzero (c
->buckets
, size
);
5829 /* Free image cache of frame F. Be aware that X frames share images
5833 free_image_cache (f
)
5836 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5841 /* Cache should not be referenced by any frame when freed. */
5842 xassert (c
->refcount
== 0);
5844 for (i
= 0; i
< c
->used
; ++i
)
5845 free_image (f
, c
->images
[i
]);
5849 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5854 /* Clear image cache of frame F. FORCE_P non-zero means free all
5855 images. FORCE_P zero means clear only images that haven't been
5856 displayed for some time. Should be called from time to time to
5857 reduce the number of loaded images. If image-eviction-seconds is
5858 non-nil, this frees images in the cache which weren't displayed for
5859 at least that many seconds. */
5862 clear_image_cache (f
, force_p
)
5866 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5868 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5875 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5877 /* Block input so that we won't be interrupted by a SIGIO
5878 while being in an inconsistent state. */
5881 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5883 struct image
*img
= c
->images
[i
];
5885 && (force_p
|| img
->timestamp
< old
))
5887 free_image (f
, img
);
5892 /* We may be clearing the image cache because, for example,
5893 Emacs was iconified for a longer period of time. In that
5894 case, current matrices may still contain references to
5895 images freed above. So, clear these matrices. */
5898 Lisp_Object tail
, frame
;
5900 FOR_EACH_FRAME (tail
, frame
)
5902 struct frame
*f
= XFRAME (frame
);
5904 && FRAME_X_IMAGE_CACHE (f
) == c
)
5905 clear_current_matrices (f
);
5908 ++windows_or_buffers_changed
;
5916 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5918 "Clear the image cache of FRAME.\n\
5919 FRAME nil or omitted means use the selected frame.\n\
5920 FRAME t means clear the image caches of all frames.")
5928 FOR_EACH_FRAME (tail
, frame
)
5929 if (FRAME_X_P (XFRAME (frame
)))
5930 clear_image_cache (XFRAME (frame
), 1);
5933 clear_image_cache (check_x_frame (frame
), 1);
5939 /* Compute masks and transform image IMG on frame F, as specified
5940 by the image's specification, */
5943 postprocess_image (f
, img
)
5947 /* Manipulation of the image's mask. */
5950 Lisp_Object conversion
, spec
;
5955 /* `:heuristic-mask t'
5957 means build a mask heuristically.
5958 `:heuristic-mask (R G B)'
5959 `:mask (heuristic (R G B))'
5960 means build a mask from color (R G B) in the
5963 means remove a mask, if any. */
5965 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
5967 x_build_heuristic_mask (f
, img
, mask
);
5972 mask
= image_spec_value (spec
, QCmask
, &found_p
);
5974 if (EQ (mask
, Qheuristic
))
5975 x_build_heuristic_mask (f
, img
, Qt
);
5976 else if (CONSP (mask
)
5977 && EQ (XCAR (mask
), Qheuristic
))
5979 if (CONSP (XCDR (mask
)))
5980 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
5982 x_build_heuristic_mask (f
, img
, XCDR (mask
));
5984 else if (NILP (mask
) && found_p
&& img
->mask
)
5986 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5992 /* Should we apply an image transformation algorithm? */
5993 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
5994 if (EQ (conversion
, Qdisabled
))
5995 x_disable_image (f
, img
);
5996 else if (EQ (conversion
, Qlaplace
))
5998 else if (EQ (conversion
, Qemboss
))
6000 else if (CONSP (conversion
)
6001 && EQ (XCAR (conversion
), Qedge_detection
))
6004 tem
= XCDR (conversion
);
6006 x_edge_detection (f
, img
,
6007 Fplist_get (tem
, QCmatrix
),
6008 Fplist_get (tem
, QCcolor_adjustment
));
6014 /* Return the id of image with Lisp specification SPEC on frame F.
6015 SPEC must be a valid Lisp image specification (see valid_image_p). */
6018 lookup_image (f
, spec
)
6022 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6026 struct gcpro gcpro1
;
6029 /* F must be a window-system frame, and SPEC must be a valid image
6031 xassert (FRAME_WINDOW_P (f
));
6032 xassert (valid_image_p (spec
));
6036 /* Look up SPEC in the hash table of the image cache. */
6037 hash
= sxhash (spec
, 0);
6038 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6040 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6041 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6044 /* If not found, create a new image and cache it. */
6047 extern Lisp_Object Qpostscript
;
6050 img
= make_image (spec
, hash
);
6051 cache_image (f
, img
);
6052 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6054 /* If we can't load the image, and we don't have a width and
6055 height, use some arbitrary width and height so that we can
6056 draw a rectangle for it. */
6057 if (img
->load_failed_p
)
6061 value
= image_spec_value (spec
, QCwidth
, NULL
);
6062 img
->width
= (INTEGERP (value
)
6063 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6064 value
= image_spec_value (spec
, QCheight
, NULL
);
6065 img
->height
= (INTEGERP (value
)
6066 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6070 /* Handle image type independent image attributes
6071 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
6072 Lisp_Object ascent
, margin
, relief
;
6074 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6075 if (INTEGERP (ascent
))
6076 img
->ascent
= XFASTINT (ascent
);
6077 else if (EQ (ascent
, Qcenter
))
6078 img
->ascent
= CENTERED_IMAGE_ASCENT
;
6080 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6081 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6082 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
6083 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
6084 && INTEGERP (XCDR (margin
)))
6086 if (XINT (XCAR (margin
)) > 0)
6087 img
->hmargin
= XFASTINT (XCAR (margin
));
6088 if (XINT (XCDR (margin
)) > 0)
6089 img
->vmargin
= XFASTINT (XCDR (margin
));
6092 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6093 if (INTEGERP (relief
))
6095 img
->relief
= XINT (relief
);
6096 img
->hmargin
+= abs (img
->relief
);
6097 img
->vmargin
+= abs (img
->relief
);
6100 /* Do image transformations and compute masks, unless we
6101 don't have the image yet. */
6102 if (!EQ (*img
->type
->type
, Qpostscript
))
6103 postprocess_image (f
, img
);
6107 xassert (!interrupt_input_blocked
);
6110 /* We're using IMG, so set its timestamp to `now'. */
6111 EMACS_GET_TIME (now
);
6112 img
->timestamp
= EMACS_SECS (now
);
6116 /* Value is the image id. */
6121 /* Cache image IMG in the image cache of frame F. */
6124 cache_image (f
, img
)
6128 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6131 /* Find a free slot in c->images. */
6132 for (i
= 0; i
< c
->used
; ++i
)
6133 if (c
->images
[i
] == NULL
)
6136 /* If no free slot found, maybe enlarge c->images. */
6137 if (i
== c
->used
&& c
->used
== c
->size
)
6140 c
->images
= (struct image
**) xrealloc (c
->images
,
6141 c
->size
* sizeof *c
->images
);
6144 /* Add IMG to c->images, and assign IMG an id. */
6150 /* Add IMG to the cache's hash table. */
6151 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6152 img
->next
= c
->buckets
[i
];
6154 img
->next
->prev
= img
;
6156 c
->buckets
[i
] = img
;
6160 /* Call FN on every image in the image cache of frame F. Used to mark
6161 Lisp Objects in the image cache. */
6164 forall_images_in_image_cache (f
, fn
)
6166 void (*fn
) P_ ((struct image
*img
));
6168 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6170 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6174 for (i
= 0; i
< c
->used
; ++i
)
6183 /***********************************************************************
6185 ***********************************************************************/
6187 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6188 XImage
**, Pixmap
*));
6189 static void x_destroy_x_image
P_ ((XImage
*));
6190 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6193 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6194 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6195 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6196 via xmalloc. Print error messages via image_error if an error
6197 occurs. Value is non-zero if successful. */
6200 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6202 int width
, height
, depth
;
6206 Display
*display
= FRAME_X_DISPLAY (f
);
6207 Screen
*screen
= FRAME_X_SCREEN (f
);
6208 Window window
= FRAME_X_WINDOW (f
);
6210 xassert (interrupt_input_blocked
);
6213 depth
= DefaultDepthOfScreen (screen
);
6214 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6215 depth
, ZPixmap
, 0, NULL
, width
, height
,
6216 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6219 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6223 /* Allocate image raster. */
6224 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6226 /* Allocate a pixmap of the same size. */
6227 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6228 if (*pixmap
== None
)
6230 x_destroy_x_image (*ximg
);
6232 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6240 /* Destroy XImage XIMG. Free XIMG->data. */
6243 x_destroy_x_image (ximg
)
6246 xassert (interrupt_input_blocked
);
6251 XDestroyImage (ximg
);
6256 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6257 are width and height of both the image and pixmap. */
6260 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6267 xassert (interrupt_input_blocked
);
6268 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6269 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6270 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6275 /***********************************************************************
6277 ***********************************************************************/
6279 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6280 static char *slurp_file
P_ ((char *, int *));
6283 /* Find image file FILE. Look in data-directory, then
6284 x-bitmap-file-path. Value is the full name of the file found, or
6285 nil if not found. */
6288 x_find_image_file (file
)
6291 Lisp_Object file_found
, search_path
;
6292 struct gcpro gcpro1
, gcpro2
;
6296 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6297 GCPRO2 (file_found
, search_path
);
6299 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6300 fd
= openp (search_path
, file
, "", &file_found
, 0);
6312 /* Read FILE into memory. Value is a pointer to a buffer allocated
6313 with xmalloc holding FILE's contents. Value is null if an error
6314 occurred. *SIZE is set to the size of the file. */
6317 slurp_file (file
, size
)
6325 if (stat (file
, &st
) == 0
6326 && (fp
= fopen (file
, "r")) != NULL
6327 && (buf
= (char *) xmalloc (st
.st_size
),
6328 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6349 /***********************************************************************
6351 ***********************************************************************/
6353 static int xbm_scan
P_ ((char **, char *, char *, int *));
6354 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6355 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6357 static int xbm_image_p
P_ ((Lisp_Object object
));
6358 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6360 static int xbm_file_p
P_ ((Lisp_Object
));
6363 /* Indices of image specification fields in xbm_format, below. */
6365 enum xbm_keyword_index
6383 /* Vector of image_keyword structures describing the format
6384 of valid XBM image specifications. */
6386 static struct image_keyword xbm_format
[XBM_LAST
] =
6388 {":type", IMAGE_SYMBOL_VALUE
, 1},
6389 {":file", IMAGE_STRING_VALUE
, 0},
6390 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6391 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6392 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6393 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
6394 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
6395 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6396 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6397 {":relief", IMAGE_INTEGER_VALUE
, 0},
6398 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6399 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6400 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6403 /* Structure describing the image type XBM. */
6405 static struct image_type xbm_type
=
6414 /* Tokens returned from xbm_scan. */
6423 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6424 A valid specification is a list starting with the symbol `image'
6425 The rest of the list is a property list which must contain an
6428 If the specification specifies a file to load, it must contain
6429 an entry `:file FILENAME' where FILENAME is a string.
6431 If the specification is for a bitmap loaded from memory it must
6432 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6433 WIDTH and HEIGHT are integers > 0. DATA may be:
6435 1. a string large enough to hold the bitmap data, i.e. it must
6436 have a size >= (WIDTH + 7) / 8 * HEIGHT
6438 2. a bool-vector of size >= WIDTH * HEIGHT
6440 3. a vector of strings or bool-vectors, one for each line of the
6443 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6444 may not be specified in this case because they are defined in the
6447 Both the file and data forms may contain the additional entries
6448 `:background COLOR' and `:foreground COLOR'. If not present,
6449 foreground and background of the frame on which the image is
6450 displayed is used. */
6453 xbm_image_p (object
)
6456 struct image_keyword kw
[XBM_LAST
];
6458 bcopy (xbm_format
, kw
, sizeof kw
);
6459 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6462 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6464 if (kw
[XBM_FILE
].count
)
6466 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6469 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6471 /* In-memory XBM file. */
6472 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6480 /* Entries for `:width', `:height' and `:data' must be present. */
6481 if (!kw
[XBM_WIDTH
].count
6482 || !kw
[XBM_HEIGHT
].count
6483 || !kw
[XBM_DATA
].count
)
6486 data
= kw
[XBM_DATA
].value
;
6487 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6488 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6490 /* Check type of data, and width and height against contents of
6496 /* Number of elements of the vector must be >= height. */
6497 if (XVECTOR (data
)->size
< height
)
6500 /* Each string or bool-vector in data must be large enough
6501 for one line of the image. */
6502 for (i
= 0; i
< height
; ++i
)
6504 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6508 if (XSTRING (elt
)->size
6509 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6512 else if (BOOL_VECTOR_P (elt
))
6514 if (XBOOL_VECTOR (elt
)->size
< width
)
6521 else if (STRINGP (data
))
6523 if (XSTRING (data
)->size
6524 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6527 else if (BOOL_VECTOR_P (data
))
6529 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6540 /* Scan a bitmap file. FP is the stream to read from. Value is
6541 either an enumerator from enum xbm_token, or a character for a
6542 single-character token, or 0 at end of file. If scanning an
6543 identifier, store the lexeme of the identifier in SVAL. If
6544 scanning a number, store its value in *IVAL. */
6547 xbm_scan (s
, end
, sval
, ival
)
6556 /* Skip white space. */
6557 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6562 else if (isdigit (c
))
6564 int value
= 0, digit
;
6566 if (c
== '0' && *s
< end
)
6569 if (c
== 'x' || c
== 'X')
6576 else if (c
>= 'a' && c
<= 'f')
6577 digit
= c
- 'a' + 10;
6578 else if (c
>= 'A' && c
<= 'F')
6579 digit
= c
- 'A' + 10;
6582 value
= 16 * value
+ digit
;
6585 else if (isdigit (c
))
6589 && (c
= *(*s
)++, isdigit (c
)))
6590 value
= 8 * value
+ c
- '0';
6597 && (c
= *(*s
)++, isdigit (c
)))
6598 value
= 10 * value
+ c
- '0';
6606 else if (isalpha (c
) || c
== '_')
6610 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6617 else if (c
== '/' && **s
== '*')
6619 /* C-style comment. */
6621 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6634 /* Replacement for XReadBitmapFileData which isn't available under old
6635 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6636 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6637 the image. Return in *DATA the bitmap data allocated with xmalloc.
6638 Value is non-zero if successful. DATA null means just test if
6639 CONTENTS looks like an in-memory XBM file. */
6642 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6643 char *contents
, *end
;
6644 int *width
, *height
;
6645 unsigned char **data
;
6648 char buffer
[BUFSIZ
];
6651 int bytes_per_line
, i
, nbytes
;
6657 LA1 = xbm_scan (&s, end, buffer, &value)
6659 #define expect(TOKEN) \
6660 if (LA1 != (TOKEN)) \
6665 #define expect_ident(IDENT) \
6666 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6671 *width
= *height
= -1;
6674 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6676 /* Parse defines for width, height and hot-spots. */
6680 expect_ident ("define");
6681 expect (XBM_TK_IDENT
);
6683 if (LA1
== XBM_TK_NUMBER
);
6685 char *p
= strrchr (buffer
, '_');
6686 p
= p
? p
+ 1 : buffer
;
6687 if (strcmp (p
, "width") == 0)
6689 else if (strcmp (p
, "height") == 0)
6692 expect (XBM_TK_NUMBER
);
6695 if (*width
< 0 || *height
< 0)
6697 else if (data
== NULL
)
6700 /* Parse bits. Must start with `static'. */
6701 expect_ident ("static");
6702 if (LA1
== XBM_TK_IDENT
)
6704 if (strcmp (buffer
, "unsigned") == 0)
6707 expect_ident ("char");
6709 else if (strcmp (buffer
, "short") == 0)
6713 if (*width
% 16 && *width
% 16 < 9)
6716 else if (strcmp (buffer
, "char") == 0)
6724 expect (XBM_TK_IDENT
);
6730 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6731 nbytes
= bytes_per_line
* *height
;
6732 p
= *data
= (char *) xmalloc (nbytes
);
6736 for (i
= 0; i
< nbytes
; i
+= 2)
6739 expect (XBM_TK_NUMBER
);
6742 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6745 if (LA1
== ',' || LA1
== '}')
6753 for (i
= 0; i
< nbytes
; ++i
)
6756 expect (XBM_TK_NUMBER
);
6760 if (LA1
== ',' || LA1
== '}')
6785 /* Load XBM image IMG which will be displayed on frame F from buffer
6786 CONTENTS. END is the end of the buffer. Value is non-zero if
6790 xbm_load_image (f
, img
, contents
, end
)
6793 char *contents
, *end
;
6796 unsigned char *data
;
6799 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6802 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6803 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6804 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6807 xassert (img
->width
> 0 && img
->height
> 0);
6809 /* Get foreground and background colors, maybe allocate colors. */
6810 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6812 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6814 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6816 background
= x_alloc_image_color (f
, img
, value
, background
);
6819 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6822 img
->width
, img
->height
,
6823 foreground
, background
,
6827 if (img
->pixmap
== None
)
6829 x_clear_image (f
, img
);
6830 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6836 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6842 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6849 return (STRINGP (data
)
6850 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6851 (XSTRING (data
)->data
6852 + STRING_BYTES (XSTRING (data
))),
6857 /* Fill image IMG which is used on frame F with pixmap data. Value is
6858 non-zero if successful. */
6866 Lisp_Object file_name
;
6868 xassert (xbm_image_p (img
->spec
));
6870 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6871 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6872 if (STRINGP (file_name
))
6877 struct gcpro gcpro1
;
6879 file
= x_find_image_file (file_name
);
6881 if (!STRINGP (file
))
6883 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6888 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6889 if (contents
== NULL
)
6891 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6896 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6901 struct image_keyword fmt
[XBM_LAST
];
6904 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6905 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6908 int in_memory_file_p
= 0;
6910 /* See if data looks like an in-memory XBM file. */
6911 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6912 in_memory_file_p
= xbm_file_p (data
);
6914 /* Parse the image specification. */
6915 bcopy (xbm_format
, fmt
, sizeof fmt
);
6916 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6919 /* Get specified width, and height. */
6920 if (!in_memory_file_p
)
6922 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6923 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6924 xassert (img
->width
> 0 && img
->height
> 0);
6927 /* Get foreground and background colors, maybe allocate colors. */
6928 if (fmt
[XBM_FOREGROUND
].count
6929 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
6930 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6932 if (fmt
[XBM_BACKGROUND
].count
6933 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
6934 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6937 if (in_memory_file_p
)
6938 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6939 (XSTRING (data
)->data
6940 + STRING_BYTES (XSTRING (data
))));
6947 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6949 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6950 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6952 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6954 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6956 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6959 else if (STRINGP (data
))
6960 bits
= XSTRING (data
)->data
;
6962 bits
= XBOOL_VECTOR (data
)->data
;
6964 /* Create the pixmap. */
6965 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6967 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6970 img
->width
, img
->height
,
6971 foreground
, background
,
6977 image_error ("Unable to create pixmap for XBM image `%s'",
6979 x_clear_image (f
, img
);
6989 /***********************************************************************
6991 ***********************************************************************/
6995 static int xpm_image_p
P_ ((Lisp_Object object
));
6996 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6997 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6999 #include "X11/xpm.h"
7001 /* The symbol `xpm' identifying XPM-format images. */
7005 /* Indices of image specification fields in xpm_format, below. */
7007 enum xpm_keyword_index
7022 /* Vector of image_keyword structures describing the format
7023 of valid XPM image specifications. */
7025 static struct image_keyword xpm_format
[XPM_LAST
] =
7027 {":type", IMAGE_SYMBOL_VALUE
, 1},
7028 {":file", IMAGE_STRING_VALUE
, 0},
7029 {":data", IMAGE_STRING_VALUE
, 0},
7030 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7031 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7032 {":relief", IMAGE_INTEGER_VALUE
, 0},
7033 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7034 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7035 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7036 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7039 /* Structure describing the image type XBM. */
7041 static struct image_type xpm_type
=
7051 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7052 functions for allocating image colors. Our own functions handle
7053 color allocation failures more gracefully than the ones on the XPM
7056 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7057 #define ALLOC_XPM_COLORS
7060 #ifdef ALLOC_XPM_COLORS
7062 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7063 static void xpm_free_color_cache
P_ ((void));
7064 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7065 static int xpm_color_bucket
P_ ((char *));
7066 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7069 /* An entry in a hash table used to cache color definitions of named
7070 colors. This cache is necessary to speed up XPM image loading in
7071 case we do color allocations ourselves. Without it, we would need
7072 a call to XParseColor per pixel in the image. */
7074 struct xpm_cached_color
7076 /* Next in collision chain. */
7077 struct xpm_cached_color
*next
;
7079 /* Color definition (RGB and pixel color). */
7086 /* The hash table used for the color cache, and its bucket vector
7089 #define XPM_COLOR_CACHE_BUCKETS 1001
7090 struct xpm_cached_color
**xpm_color_cache
;
7092 /* Initialize the color cache. */
7095 xpm_init_color_cache (f
, attrs
)
7097 XpmAttributes
*attrs
;
7099 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7100 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7101 memset (xpm_color_cache
, 0, nbytes
);
7102 init_color_table ();
7104 if (attrs
->valuemask
& XpmColorSymbols
)
7109 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7110 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7111 attrs
->colorsymbols
[i
].value
, &color
))
7113 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7115 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7121 /* Free the color cache. */
7124 xpm_free_color_cache ()
7126 struct xpm_cached_color
*p
, *next
;
7129 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7130 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7136 xfree (xpm_color_cache
);
7137 xpm_color_cache
= NULL
;
7138 free_color_table ();
7142 /* Return the bucket index for color named COLOR_NAME in the color
7146 xpm_color_bucket (color_name
)
7152 for (s
= color_name
; *s
; ++s
)
7154 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7158 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7159 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7162 static struct xpm_cached_color
*
7163 xpm_cache_color (f
, color_name
, color
, bucket
)
7170 struct xpm_cached_color
*p
;
7173 bucket
= xpm_color_bucket (color_name
);
7175 nbytes
= sizeof *p
+ strlen (color_name
);
7176 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7177 strcpy (p
->name
, color_name
);
7179 p
->next
= xpm_color_cache
[bucket
];
7180 xpm_color_cache
[bucket
] = p
;
7185 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7186 return the cached definition in *COLOR. Otherwise, make a new
7187 entry in the cache and allocate the color. Value is zero if color
7188 allocation failed. */
7191 xpm_lookup_color (f
, color_name
, color
)
7196 struct xpm_cached_color
*p
;
7197 int h
= xpm_color_bucket (color_name
);
7199 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7200 if (strcmp (p
->name
, color_name
) == 0)
7205 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7208 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7210 p
= xpm_cache_color (f
, color_name
, color
, h
);
7217 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7218 CLOSURE is a pointer to the frame on which we allocate the
7219 color. Return in *COLOR the allocated color. Value is non-zero
7223 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7230 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7234 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7235 is a pointer to the frame on which we allocate the color. Value is
7236 non-zero if successful. */
7239 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7249 #endif /* ALLOC_XPM_COLORS */
7252 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7253 for XPM images. Such a list must consist of conses whose car and
7257 xpm_valid_color_symbols_p (color_symbols
)
7258 Lisp_Object color_symbols
;
7260 while (CONSP (color_symbols
))
7262 Lisp_Object sym
= XCAR (color_symbols
);
7264 || !STRINGP (XCAR (sym
))
7265 || !STRINGP (XCDR (sym
)))
7267 color_symbols
= XCDR (color_symbols
);
7270 return NILP (color_symbols
);
7274 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7277 xpm_image_p (object
)
7280 struct image_keyword fmt
[XPM_LAST
];
7281 bcopy (xpm_format
, fmt
, sizeof fmt
);
7282 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7283 /* Either `:file' or `:data' must be present. */
7284 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7285 /* Either no `:color-symbols' or it's a list of conses
7286 whose car and cdr are strings. */
7287 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7288 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7292 /* Load image IMG which will be displayed on frame F. Value is
7293 non-zero if successful. */
7301 XpmAttributes attrs
;
7302 Lisp_Object specified_file
, color_symbols
;
7304 /* Configure the XPM lib. Use the visual of frame F. Allocate
7305 close colors. Return colors allocated. */
7306 bzero (&attrs
, sizeof attrs
);
7307 attrs
.visual
= FRAME_X_VISUAL (f
);
7308 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7309 attrs
.valuemask
|= XpmVisual
;
7310 attrs
.valuemask
|= XpmColormap
;
7312 #ifdef ALLOC_XPM_COLORS
7313 /* Allocate colors with our own functions which handle
7314 failing color allocation more gracefully. */
7315 attrs
.color_closure
= f
;
7316 attrs
.alloc_color
= xpm_alloc_color
;
7317 attrs
.free_colors
= xpm_free_colors
;
7318 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7319 #else /* not ALLOC_XPM_COLORS */
7320 /* Let the XPM lib allocate colors. */
7321 attrs
.valuemask
|= XpmReturnAllocPixels
;
7322 #ifdef XpmAllocCloseColors
7323 attrs
.alloc_close_colors
= 1;
7324 attrs
.valuemask
|= XpmAllocCloseColors
;
7325 #else /* not XpmAllocCloseColors */
7326 attrs
.closeness
= 600;
7327 attrs
.valuemask
|= XpmCloseness
;
7328 #endif /* not XpmAllocCloseColors */
7329 #endif /* ALLOC_XPM_COLORS */
7331 /* If image specification contains symbolic color definitions, add
7332 these to `attrs'. */
7333 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7334 if (CONSP (color_symbols
))
7337 XpmColorSymbol
*xpm_syms
;
7340 attrs
.valuemask
|= XpmColorSymbols
;
7342 /* Count number of symbols. */
7343 attrs
.numsymbols
= 0;
7344 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7347 /* Allocate an XpmColorSymbol array. */
7348 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7349 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7350 bzero (xpm_syms
, size
);
7351 attrs
.colorsymbols
= xpm_syms
;
7353 /* Fill the color symbol array. */
7354 for (tail
= color_symbols
, i
= 0;
7356 ++i
, tail
= XCDR (tail
))
7358 Lisp_Object name
= XCAR (XCAR (tail
));
7359 Lisp_Object color
= XCDR (XCAR (tail
));
7360 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7361 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7362 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7363 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7367 /* Create a pixmap for the image, either from a file, or from a
7368 string buffer containing data in the same format as an XPM file. */
7369 #ifdef ALLOC_XPM_COLORS
7370 xpm_init_color_cache (f
, &attrs
);
7373 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7374 if (STRINGP (specified_file
))
7376 Lisp_Object file
= x_find_image_file (specified_file
);
7377 if (!STRINGP (file
))
7379 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7383 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7384 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7389 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7390 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7391 XSTRING (buffer
)->data
,
7392 &img
->pixmap
, &img
->mask
,
7396 if (rc
== XpmSuccess
)
7398 #ifdef ALLOC_XPM_COLORS
7399 img
->colors
= colors_in_color_table (&img
->ncolors
);
7400 #else /* not ALLOC_XPM_COLORS */
7403 img
->ncolors
= attrs
.nalloc_pixels
;
7404 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7405 * sizeof *img
->colors
);
7406 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7408 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7409 #ifdef DEBUG_X_COLORS
7410 register_color (img
->colors
[i
]);
7413 #endif /* not ALLOC_XPM_COLORS */
7415 img
->width
= attrs
.width
;
7416 img
->height
= attrs
.height
;
7417 xassert (img
->width
> 0 && img
->height
> 0);
7419 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7420 XpmFreeAttributes (&attrs
);
7427 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7430 case XpmFileInvalid
:
7431 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7435 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7438 case XpmColorFailed
:
7439 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7443 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7448 #ifdef ALLOC_XPM_COLORS
7449 xpm_free_color_cache ();
7451 return rc
== XpmSuccess
;
7454 #endif /* HAVE_XPM != 0 */
7457 /***********************************************************************
7459 ***********************************************************************/
7461 /* An entry in the color table mapping an RGB color to a pixel color. */
7466 unsigned long pixel
;
7468 /* Next in color table collision list. */
7469 struct ct_color
*next
;
7472 /* The bucket vector size to use. Must be prime. */
7476 /* Value is a hash of the RGB color given by R, G, and B. */
7478 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7480 /* The color hash table. */
7482 struct ct_color
**ct_table
;
7484 /* Number of entries in the color table. */
7486 int ct_colors_allocated
;
7488 /* Initialize the color table. */
7493 int size
= CT_SIZE
* sizeof (*ct_table
);
7494 ct_table
= (struct ct_color
**) xmalloc (size
);
7495 bzero (ct_table
, size
);
7496 ct_colors_allocated
= 0;
7500 /* Free memory associated with the color table. */
7506 struct ct_color
*p
, *next
;
7508 for (i
= 0; i
< CT_SIZE
; ++i
)
7509 for (p
= ct_table
[i
]; p
; p
= next
)
7520 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7521 entry for that color already is in the color table, return the
7522 pixel color of that entry. Otherwise, allocate a new color for R,
7523 G, B, and make an entry in the color table. */
7525 static unsigned long
7526 lookup_rgb_color (f
, r
, g
, b
)
7530 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7531 int i
= hash
% CT_SIZE
;
7534 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7535 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7548 cmap
= FRAME_X_COLORMAP (f
);
7549 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7553 ++ct_colors_allocated
;
7555 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7559 p
->pixel
= color
.pixel
;
7560 p
->next
= ct_table
[i
];
7564 return FRAME_FOREGROUND_PIXEL (f
);
7571 /* Look up pixel color PIXEL which is used on frame F in the color
7572 table. If not already present, allocate it. Value is PIXEL. */
7574 static unsigned long
7575 lookup_pixel_color (f
, pixel
)
7577 unsigned long pixel
;
7579 int i
= pixel
% CT_SIZE
;
7582 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7583 if (p
->pixel
== pixel
)
7592 cmap
= FRAME_X_COLORMAP (f
);
7593 color
.pixel
= pixel
;
7594 x_query_color (f
, &color
);
7595 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7599 ++ct_colors_allocated
;
7601 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7606 p
->next
= ct_table
[i
];
7610 return FRAME_FOREGROUND_PIXEL (f
);
7617 /* Value is a vector of all pixel colors contained in the color table,
7618 allocated via xmalloc. Set *N to the number of colors. */
7620 static unsigned long *
7621 colors_in_color_table (n
)
7626 unsigned long *colors
;
7628 if (ct_colors_allocated
== 0)
7635 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7637 *n
= ct_colors_allocated
;
7639 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7640 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7641 colors
[j
++] = p
->pixel
;
7649 /***********************************************************************
7651 ***********************************************************************/
7653 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7654 int, XImage
*, int));
7655 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7656 XColor
*, int, XImage
*, int));
7657 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7658 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7659 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7661 /* Non-zero means draw a cross on images having `:conversion
7664 int cross_disabled_images
;
7666 /* Edge detection matrices for different edge-detection
7669 static int emboss_matrix
[9] = {
7671 2, -1, 0, /* y - 1 */
7673 0, 1, -2 /* y + 1 */
7676 static int laplace_matrix
[9] = {
7678 1, 0, 0, /* y - 1 */
7680 0, 0, -1 /* y + 1 */
7683 /* Value is the intensity of the color whose red/green/blue values
7686 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7689 /* On frame F, return an array of XColor structures describing image
7690 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7691 non-zero means also fill the red/green/blue members of the XColor
7692 structures. Value is a pointer to the array of XColors structures,
7693 allocated with xmalloc; it must be freed by the caller. */
7696 x_to_xcolors (f
, img
, rgb_p
)
7705 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7707 /* Get the X image IMG->pixmap. */
7708 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7709 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7711 /* Fill the `pixel' members of the XColor array. I wished there
7712 were an easy and portable way to circumvent XGetPixel. */
7714 for (y
= 0; y
< img
->height
; ++y
)
7718 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7719 p
->pixel
= XGetPixel (ximg
, x
, y
);
7722 x_query_colors (f
, row
, img
->width
);
7725 XDestroyImage (ximg
);
7730 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7731 RGB members are set. F is the frame on which this all happens.
7732 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7735 x_from_xcolors (f
, img
, colors
)
7745 init_color_table ();
7747 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7750 for (y
= 0; y
< img
->height
; ++y
)
7751 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7753 unsigned long pixel
;
7754 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7755 XPutPixel (oimg
, x
, y
, pixel
);
7759 x_clear_image_1 (f
, img
, 1, 0, 1);
7761 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7762 x_destroy_x_image (oimg
);
7763 img
->pixmap
= pixmap
;
7764 img
->colors
= colors_in_color_table (&img
->ncolors
);
7765 free_color_table ();
7769 /* On frame F, perform edge-detection on image IMG.
7771 MATRIX is a nine-element array specifying the transformation
7772 matrix. See emboss_matrix for an example.
7774 COLOR_ADJUST is a color adjustment added to each pixel of the
7778 x_detect_edges (f
, img
, matrix
, color_adjust
)
7781 int matrix
[9], color_adjust
;
7783 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7787 for (i
= sum
= 0; i
< 9; ++i
)
7788 sum
+= abs (matrix
[i
]);
7790 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7792 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7794 for (y
= 0; y
< img
->height
; ++y
)
7796 p
= COLOR (new, 0, y
);
7797 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7798 p
= COLOR (new, img
->width
- 1, y
);
7799 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7802 for (x
= 1; x
< img
->width
- 1; ++x
)
7804 p
= COLOR (new, x
, 0);
7805 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7806 p
= COLOR (new, x
, img
->height
- 1);
7807 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7810 for (y
= 1; y
< img
->height
- 1; ++y
)
7812 p
= COLOR (new, 1, y
);
7814 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7816 int r
, g
, b
, y1
, x1
;
7819 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7820 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7823 XColor
*t
= COLOR (colors
, x1
, y1
);
7824 r
+= matrix
[i
] * t
->red
;
7825 g
+= matrix
[i
] * t
->green
;
7826 b
+= matrix
[i
] * t
->blue
;
7829 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7830 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7831 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7832 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7837 x_from_xcolors (f
, img
, new);
7843 /* Perform the pre-defined `emboss' edge-detection on image IMG
7851 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7855 /* Perform the pre-defined `laplace' edge-detection on image IMG
7863 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7867 /* Perform edge-detection on image IMG on frame F, with specified
7868 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7870 MATRIX must be either
7872 - a list of at least 9 numbers in row-major form
7873 - a vector of at least 9 numbers
7875 COLOR_ADJUST nil means use a default; otherwise it must be a
7879 x_edge_detection (f
, img
, matrix
, color_adjust
)
7882 Lisp_Object matrix
, color_adjust
;
7890 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7891 ++i
, matrix
= XCDR (matrix
))
7892 trans
[i
] = XFLOATINT (XCAR (matrix
));
7894 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7896 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7897 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7900 if (NILP (color_adjust
))
7901 color_adjust
= make_number (0xffff / 2);
7903 if (i
== 9 && NUMBERP (color_adjust
))
7904 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7908 /* Transform image IMG on frame F so that it looks disabled. */
7911 x_disable_image (f
, img
)
7915 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7917 if (dpyinfo
->n_planes
>= 2)
7919 /* Color (or grayscale). Convert to gray, and equalize. Just
7920 drawing such images with a stipple can look very odd, so
7921 we're using this method instead. */
7922 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7924 const int h
= 15000;
7925 const int l
= 30000;
7927 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7931 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7932 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7933 p
->red
= p
->green
= p
->blue
= i2
;
7936 x_from_xcolors (f
, img
, colors
);
7939 /* Draw a cross over the disabled image, if we must or if we
7941 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
7943 Display
*dpy
= FRAME_X_DISPLAY (f
);
7946 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
7947 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
7948 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
7949 img
->width
- 1, img
->height
- 1);
7950 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
7956 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
7957 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
7958 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
7959 img
->width
- 1, img
->height
- 1);
7960 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
7968 /* Build a mask for image IMG which is used on frame F. FILE is the
7969 name of an image file, for error messages. HOW determines how to
7970 determine the background color of IMG. If it is a list '(R G B)',
7971 with R, G, and B being integers >= 0, take that as the color of the
7972 background. Otherwise, determine the background color of IMG
7973 heuristically. Value is non-zero if successful. */
7976 x_build_heuristic_mask (f
, img
, how
)
7981 Display
*dpy
= FRAME_X_DISPLAY (f
);
7982 XImage
*ximg
, *mask_img
;
7983 int x
, y
, rc
, look_at_corners_p
;
7984 unsigned long bg
= 0;
7988 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
7992 /* Create an image and pixmap serving as mask. */
7993 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7994 &mask_img
, &img
->mask
);
7998 /* Get the X image of IMG->pixmap. */
7999 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
8002 /* Determine the background color of ximg. If HOW is `(R G B)'
8003 take that as color. Otherwise, try to determine the color
8005 look_at_corners_p
= 1;
8013 && NATNUMP (XCAR (how
)))
8015 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
8019 if (i
== 3 && NILP (how
))
8021 char color_name
[30];
8022 XColor exact
, color
;
8025 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
8027 cmap
= FRAME_X_COLORMAP (f
);
8028 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
8031 look_at_corners_p
= 0;
8036 if (look_at_corners_p
)
8038 unsigned long corners
[4];
8041 /* Get the colors at the corners of ximg. */
8042 corners
[0] = XGetPixel (ximg
, 0, 0);
8043 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
8044 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
8045 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
8047 /* Choose the most frequently found color as background. */
8048 for (i
= best_count
= 0; i
< 4; ++i
)
8052 for (j
= n
= 0; j
< 4; ++j
)
8053 if (corners
[i
] == corners
[j
])
8057 bg
= corners
[i
], best_count
= n
;
8061 /* Set all bits in mask_img to 1 whose color in ximg is different
8062 from the background color bg. */
8063 for (y
= 0; y
< img
->height
; ++y
)
8064 for (x
= 0; x
< img
->width
; ++x
)
8065 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8067 /* Put mask_img into img->mask. */
8068 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8069 x_destroy_x_image (mask_img
);
8070 XDestroyImage (ximg
);
8077 /***********************************************************************
8078 PBM (mono, gray, color)
8079 ***********************************************************************/
8081 static int pbm_image_p
P_ ((Lisp_Object object
));
8082 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8083 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8085 /* The symbol `pbm' identifying images of this type. */
8089 /* Indices of image specification fields in gs_format, below. */
8091 enum pbm_keyword_index
8107 /* Vector of image_keyword structures describing the format
8108 of valid user-defined image specifications. */
8110 static struct image_keyword pbm_format
[PBM_LAST
] =
8112 {":type", IMAGE_SYMBOL_VALUE
, 1},
8113 {":file", IMAGE_STRING_VALUE
, 0},
8114 {":data", IMAGE_STRING_VALUE
, 0},
8115 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8116 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8117 {":relief", IMAGE_INTEGER_VALUE
, 0},
8118 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8119 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8120 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8121 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8122 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8125 /* Structure describing the image type `pbm'. */
8127 static struct image_type pbm_type
=
8137 /* Return non-zero if OBJECT is a valid PBM image specification. */
8140 pbm_image_p (object
)
8143 struct image_keyword fmt
[PBM_LAST
];
8145 bcopy (pbm_format
, fmt
, sizeof fmt
);
8147 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8150 /* Must specify either :data or :file. */
8151 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8155 /* Scan a decimal number from *S and return it. Advance *S while
8156 reading the number. END is the end of the string. Value is -1 at
8160 pbm_scan_number (s
, end
)
8161 unsigned char **s
, *end
;
8163 int c
= 0, val
= -1;
8167 /* Skip white-space. */
8168 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8173 /* Skip comment to end of line. */
8174 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8177 else if (isdigit (c
))
8179 /* Read decimal number. */
8181 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8182 val
= 10 * val
+ c
- '0';
8193 /* Load PBM image IMG for use on frame F. */
8201 int width
, height
, max_color_idx
= 0;
8203 Lisp_Object file
, specified_file
;
8204 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8205 struct gcpro gcpro1
;
8206 unsigned char *contents
= NULL
;
8207 unsigned char *end
, *p
;
8210 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8214 if (STRINGP (specified_file
))
8216 file
= x_find_image_file (specified_file
);
8217 if (!STRINGP (file
))
8219 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8224 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8225 if (contents
== NULL
)
8227 image_error ("Error reading `%s'", file
, Qnil
);
8233 end
= contents
+ size
;
8238 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8239 p
= XSTRING (data
)->data
;
8240 end
= p
+ STRING_BYTES (XSTRING (data
));
8243 /* Check magic number. */
8244 if (end
- p
< 2 || *p
++ != 'P')
8246 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8256 raw_p
= 0, type
= PBM_MONO
;
8260 raw_p
= 0, type
= PBM_GRAY
;
8264 raw_p
= 0, type
= PBM_COLOR
;
8268 raw_p
= 1, type
= PBM_MONO
;
8272 raw_p
= 1, type
= PBM_GRAY
;
8276 raw_p
= 1, type
= PBM_COLOR
;
8280 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8284 /* Read width, height, maximum color-component. Characters
8285 starting with `#' up to the end of a line are ignored. */
8286 width
= pbm_scan_number (&p
, end
);
8287 height
= pbm_scan_number (&p
, end
);
8289 if (type
!= PBM_MONO
)
8291 max_color_idx
= pbm_scan_number (&p
, end
);
8292 if (raw_p
&& max_color_idx
> 255)
8293 max_color_idx
= 255;
8298 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8301 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8302 &ximg
, &img
->pixmap
))
8305 /* Initialize the color hash table. */
8306 init_color_table ();
8308 if (type
== PBM_MONO
)
8311 struct image_keyword fmt
[PBM_LAST
];
8312 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8313 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8315 /* Parse the image specification. */
8316 bcopy (pbm_format
, fmt
, sizeof fmt
);
8317 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8319 /* Get foreground and background colors, maybe allocate colors. */
8320 if (fmt
[PBM_FOREGROUND
].count
8321 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
8322 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8323 if (fmt
[PBM_BACKGROUND
].count
8324 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
8325 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8327 for (y
= 0; y
< height
; ++y
)
8328 for (x
= 0; x
< width
; ++x
)
8338 g
= pbm_scan_number (&p
, end
);
8340 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8345 for (y
= 0; y
< height
; ++y
)
8346 for (x
= 0; x
< width
; ++x
)
8350 if (type
== PBM_GRAY
)
8351 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8360 r
= pbm_scan_number (&p
, end
);
8361 g
= pbm_scan_number (&p
, end
);
8362 b
= pbm_scan_number (&p
, end
);
8365 if (r
< 0 || g
< 0 || b
< 0)
8369 XDestroyImage (ximg
);
8370 image_error ("Invalid pixel value in image `%s'",
8375 /* RGB values are now in the range 0..max_color_idx.
8376 Scale this to the range 0..0xffff supported by X. */
8377 r
= (double) r
* 65535 / max_color_idx
;
8378 g
= (double) g
* 65535 / max_color_idx
;
8379 b
= (double) b
* 65535 / max_color_idx
;
8380 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8384 /* Store in IMG->colors the colors allocated for the image, and
8385 free the color table. */
8386 img
->colors
= colors_in_color_table (&img
->ncolors
);
8387 free_color_table ();
8389 /* Put the image into a pixmap. */
8390 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8391 x_destroy_x_image (ximg
);
8394 img
->height
= height
;
8403 /***********************************************************************
8405 ***********************************************************************/
8411 /* Function prototypes. */
8413 static int png_image_p
P_ ((Lisp_Object object
));
8414 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8416 /* The symbol `png' identifying images of this type. */
8420 /* Indices of image specification fields in png_format, below. */
8422 enum png_keyword_index
8436 /* Vector of image_keyword structures describing the format
8437 of valid user-defined image specifications. */
8439 static struct image_keyword png_format
[PNG_LAST
] =
8441 {":type", IMAGE_SYMBOL_VALUE
, 1},
8442 {":data", IMAGE_STRING_VALUE
, 0},
8443 {":file", IMAGE_STRING_VALUE
, 0},
8444 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8445 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8446 {":relief", IMAGE_INTEGER_VALUE
, 0},
8447 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8448 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8449 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8452 /* Structure describing the image type `png'. */
8454 static struct image_type png_type
=
8464 /* Return non-zero if OBJECT is a valid PNG image specification. */
8467 png_image_p (object
)
8470 struct image_keyword fmt
[PNG_LAST
];
8471 bcopy (png_format
, fmt
, sizeof fmt
);
8473 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8476 /* Must specify either the :data or :file keyword. */
8477 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8481 /* Error and warning handlers installed when the PNG library
8485 my_png_error (png_ptr
, msg
)
8486 png_struct
*png_ptr
;
8489 xassert (png_ptr
!= NULL
);
8490 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8491 longjmp (png_ptr
->jmpbuf
, 1);
8496 my_png_warning (png_ptr
, msg
)
8497 png_struct
*png_ptr
;
8500 xassert (png_ptr
!= NULL
);
8501 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8504 /* Memory source for PNG decoding. */
8506 struct png_memory_storage
8508 unsigned char *bytes
; /* The data */
8509 size_t len
; /* How big is it? */
8510 int index
; /* Where are we? */
8514 /* Function set as reader function when reading PNG image from memory.
8515 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8516 bytes from the input to DATA. */
8519 png_read_from_memory (png_ptr
, data
, length
)
8520 png_structp png_ptr
;
8524 struct png_memory_storage
*tbr
8525 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8527 if (length
> tbr
->len
- tbr
->index
)
8528 png_error (png_ptr
, "Read error");
8530 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8531 tbr
->index
= tbr
->index
+ length
;
8534 /* Load PNG image IMG for use on frame F. Value is non-zero if
8542 Lisp_Object file
, specified_file
;
8543 Lisp_Object specified_data
;
8545 XImage
*ximg
, *mask_img
= NULL
;
8546 struct gcpro gcpro1
;
8547 png_struct
*png_ptr
= NULL
;
8548 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8549 FILE *volatile fp
= NULL
;
8551 png_byte
* volatile pixels
= NULL
;
8552 png_byte
** volatile rows
= NULL
;
8553 png_uint_32 width
, height
;
8554 int bit_depth
, color_type
, interlace_type
;
8556 png_uint_32 row_bytes
;
8559 double screen_gamma
, image_gamma
;
8561 struct png_memory_storage tbr
; /* Data to be read */
8563 /* Find out what file to load. */
8564 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8565 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8569 if (NILP (specified_data
))
8571 file
= x_find_image_file (specified_file
);
8572 if (!STRINGP (file
))
8574 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8579 /* Open the image file. */
8580 fp
= fopen (XSTRING (file
)->data
, "rb");
8583 image_error ("Cannot open image file `%s'", file
, Qnil
);
8589 /* Check PNG signature. */
8590 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8591 || !png_check_sig (sig
, sizeof sig
))
8593 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8601 /* Read from memory. */
8602 tbr
.bytes
= XSTRING (specified_data
)->data
;
8603 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8606 /* Check PNG signature. */
8607 if (tbr
.len
< sizeof sig
8608 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8610 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8615 /* Need to skip past the signature. */
8616 tbr
.bytes
+= sizeof (sig
);
8619 /* Initialize read and info structs for PNG lib. */
8620 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8621 my_png_error
, my_png_warning
);
8624 if (fp
) fclose (fp
);
8629 info_ptr
= png_create_info_struct (png_ptr
);
8632 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8633 if (fp
) fclose (fp
);
8638 end_info
= png_create_info_struct (png_ptr
);
8641 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8642 if (fp
) fclose (fp
);
8647 /* Set error jump-back. We come back here when the PNG library
8648 detects an error. */
8649 if (setjmp (png_ptr
->jmpbuf
))
8653 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8656 if (fp
) fclose (fp
);
8661 /* Read image info. */
8662 if (!NILP (specified_data
))
8663 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8665 png_init_io (png_ptr
, fp
);
8667 png_set_sig_bytes (png_ptr
, sizeof sig
);
8668 png_read_info (png_ptr
, info_ptr
);
8669 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8670 &interlace_type
, NULL
, NULL
);
8672 /* If image contains simply transparency data, we prefer to
8673 construct a clipping mask. */
8674 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8679 /* This function is easier to write if we only have to handle
8680 one data format: RGB or RGBA with 8 bits per channel. Let's
8681 transform other formats into that format. */
8683 /* Strip more than 8 bits per channel. */
8684 if (bit_depth
== 16)
8685 png_set_strip_16 (png_ptr
);
8687 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8689 png_set_expand (png_ptr
);
8691 /* Convert grayscale images to RGB. */
8692 if (color_type
== PNG_COLOR_TYPE_GRAY
8693 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8694 png_set_gray_to_rgb (png_ptr
);
8696 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8697 gamma_str
= getenv ("SCREEN_GAMMA");
8698 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8700 /* Tell the PNG lib to handle gamma correction for us. */
8702 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8703 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8704 /* There is a special chunk in the image specifying the gamma. */
8705 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8708 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8709 /* Image contains gamma information. */
8710 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8712 /* Use a default of 0.5 for the image gamma. */
8713 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8715 /* Handle alpha channel by combining the image with a background
8716 color. Do this only if a real alpha channel is supplied. For
8717 simple transparency, we prefer a clipping mask. */
8720 png_color_16
*image_background
;
8722 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8723 /* Image contains a background color with which to
8724 combine the image. */
8725 png_set_background (png_ptr
, image_background
,
8726 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8729 /* Image does not contain a background color with which
8730 to combine the image data via an alpha channel. Use
8731 the frame's background instead. */
8734 png_color_16 frame_background
;
8736 cmap
= FRAME_X_COLORMAP (f
);
8737 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8738 x_query_color (f
, &color
);
8740 bzero (&frame_background
, sizeof frame_background
);
8741 frame_background
.red
= color
.red
;
8742 frame_background
.green
= color
.green
;
8743 frame_background
.blue
= color
.blue
;
8745 png_set_background (png_ptr
, &frame_background
,
8746 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8750 /* Update info structure. */
8751 png_read_update_info (png_ptr
, info_ptr
);
8753 /* Get number of channels. Valid values are 1 for grayscale images
8754 and images with a palette, 2 for grayscale images with transparency
8755 information (alpha channel), 3 for RGB images, and 4 for RGB
8756 images with alpha channel, i.e. RGBA. If conversions above were
8757 sufficient we should only have 3 or 4 channels here. */
8758 channels
= png_get_channels (png_ptr
, info_ptr
);
8759 xassert (channels
== 3 || channels
== 4);
8761 /* Number of bytes needed for one row of the image. */
8762 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8764 /* Allocate memory for the image. */
8765 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8766 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8767 for (i
= 0; i
< height
; ++i
)
8768 rows
[i
] = pixels
+ i
* row_bytes
;
8770 /* Read the entire image. */
8771 png_read_image (png_ptr
, rows
);
8772 png_read_end (png_ptr
, info_ptr
);
8779 /* Create the X image and pixmap. */
8780 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8784 /* Create an image and pixmap serving as mask if the PNG image
8785 contains an alpha channel. */
8788 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8789 &mask_img
, &img
->mask
))
8791 x_destroy_x_image (ximg
);
8792 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8797 /* Fill the X image and mask from PNG data. */
8798 init_color_table ();
8800 for (y
= 0; y
< height
; ++y
)
8802 png_byte
*p
= rows
[y
];
8804 for (x
= 0; x
< width
; ++x
)
8811 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8813 /* An alpha channel, aka mask channel, associates variable
8814 transparency with an image. Where other image formats
8815 support binary transparency---fully transparent or fully
8816 opaque---PNG allows up to 254 levels of partial transparency.
8817 The PNG library implements partial transparency by combining
8818 the image with a specified background color.
8820 I'm not sure how to handle this here nicely: because the
8821 background on which the image is displayed may change, for
8822 real alpha channel support, it would be necessary to create
8823 a new image for each possible background.
8825 What I'm doing now is that a mask is created if we have
8826 boolean transparency information. Otherwise I'm using
8827 the frame's background color to combine the image with. */
8832 XPutPixel (mask_img
, x
, y
, *p
> 0);
8838 /* Remember colors allocated for this image. */
8839 img
->colors
= colors_in_color_table (&img
->ncolors
);
8840 free_color_table ();
8843 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8848 img
->height
= height
;
8850 /* Put the image into the pixmap, then free the X image and its buffer. */
8851 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8852 x_destroy_x_image (ximg
);
8854 /* Same for the mask. */
8857 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8858 x_destroy_x_image (mask_img
);
8865 #endif /* HAVE_PNG != 0 */
8869 /***********************************************************************
8871 ***********************************************************************/
8875 /* Work around a warning about HAVE_STDLIB_H being redefined in
8877 #ifdef HAVE_STDLIB_H
8878 #define HAVE_STDLIB_H_1
8879 #undef HAVE_STDLIB_H
8880 #endif /* HAVE_STLIB_H */
8882 #include <jpeglib.h>
8886 #ifdef HAVE_STLIB_H_1
8887 #define HAVE_STDLIB_H 1
8890 static int jpeg_image_p
P_ ((Lisp_Object object
));
8891 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8893 /* The symbol `jpeg' identifying images of this type. */
8897 /* Indices of image specification fields in gs_format, below. */
8899 enum jpeg_keyword_index
8908 JPEG_HEURISTIC_MASK
,
8913 /* Vector of image_keyword structures describing the format
8914 of valid user-defined image specifications. */
8916 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8918 {":type", IMAGE_SYMBOL_VALUE
, 1},
8919 {":data", IMAGE_STRING_VALUE
, 0},
8920 {":file", IMAGE_STRING_VALUE
, 0},
8921 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8922 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8923 {":relief", IMAGE_INTEGER_VALUE
, 0},
8924 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8925 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8926 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8929 /* Structure describing the image type `jpeg'. */
8931 static struct image_type jpeg_type
=
8941 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8944 jpeg_image_p (object
)
8947 struct image_keyword fmt
[JPEG_LAST
];
8949 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8951 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8954 /* Must specify either the :data or :file keyword. */
8955 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8959 struct my_jpeg_error_mgr
8961 struct jpeg_error_mgr pub
;
8962 jmp_buf setjmp_buffer
;
8967 my_error_exit (cinfo
)
8970 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8971 longjmp (mgr
->setjmp_buffer
, 1);
8975 /* Init source method for JPEG data source manager. Called by
8976 jpeg_read_header() before any data is actually read. See
8977 libjpeg.doc from the JPEG lib distribution. */
8980 our_init_source (cinfo
)
8981 j_decompress_ptr cinfo
;
8986 /* Fill input buffer method for JPEG data source manager. Called
8987 whenever more data is needed. We read the whole image in one step,
8988 so this only adds a fake end of input marker at the end. */
8991 our_fill_input_buffer (cinfo
)
8992 j_decompress_ptr cinfo
;
8994 /* Insert a fake EOI marker. */
8995 struct jpeg_source_mgr
*src
= cinfo
->src
;
8996 static JOCTET buffer
[2];
8998 buffer
[0] = (JOCTET
) 0xFF;
8999 buffer
[1] = (JOCTET
) JPEG_EOI
;
9001 src
->next_input_byte
= buffer
;
9002 src
->bytes_in_buffer
= 2;
9007 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9008 is the JPEG data source manager. */
9011 our_skip_input_data (cinfo
, num_bytes
)
9012 j_decompress_ptr cinfo
;
9015 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9019 if (num_bytes
> src
->bytes_in_buffer
)
9020 ERREXIT (cinfo
, JERR_INPUT_EOF
);
9022 src
->bytes_in_buffer
-= num_bytes
;
9023 src
->next_input_byte
+= num_bytes
;
9028 /* Method to terminate data source. Called by
9029 jpeg_finish_decompress() after all data has been processed. */
9032 our_term_source (cinfo
)
9033 j_decompress_ptr cinfo
;
9038 /* Set up the JPEG lib for reading an image from DATA which contains
9039 LEN bytes. CINFO is the decompression info structure created for
9040 reading the image. */
9043 jpeg_memory_src (cinfo
, data
, len
)
9044 j_decompress_ptr cinfo
;
9048 struct jpeg_source_mgr
*src
;
9050 if (cinfo
->src
== NULL
)
9052 /* First time for this JPEG object? */
9053 cinfo
->src
= (struct jpeg_source_mgr
*)
9054 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9055 sizeof (struct jpeg_source_mgr
));
9056 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9057 src
->next_input_byte
= data
;
9060 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9061 src
->init_source
= our_init_source
;
9062 src
->fill_input_buffer
= our_fill_input_buffer
;
9063 src
->skip_input_data
= our_skip_input_data
;
9064 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9065 src
->term_source
= our_term_source
;
9066 src
->bytes_in_buffer
= len
;
9067 src
->next_input_byte
= data
;
9071 /* Load image IMG for use on frame F. Patterned after example.c
9072 from the JPEG lib. */
9079 struct jpeg_decompress_struct cinfo
;
9080 struct my_jpeg_error_mgr mgr
;
9081 Lisp_Object file
, specified_file
;
9082 Lisp_Object specified_data
;
9083 FILE * volatile fp
= NULL
;
9085 int row_stride
, x
, y
;
9086 XImage
*ximg
= NULL
;
9088 unsigned long *colors
;
9090 struct gcpro gcpro1
;
9092 /* Open the JPEG file. */
9093 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9094 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9098 if (NILP (specified_data
))
9100 file
= x_find_image_file (specified_file
);
9101 if (!STRINGP (file
))
9103 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9108 fp
= fopen (XSTRING (file
)->data
, "r");
9111 image_error ("Cannot open `%s'", file
, Qnil
);
9117 /* Customize libjpeg's error handling to call my_error_exit when an
9118 error is detected. This function will perform a longjmp. */
9119 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9120 mgr
.pub
.error_exit
= my_error_exit
;
9122 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9126 /* Called from my_error_exit. Display a JPEG error. */
9127 char buffer
[JMSG_LENGTH_MAX
];
9128 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9129 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9130 build_string (buffer
));
9133 /* Close the input file and destroy the JPEG object. */
9135 fclose ((FILE *) fp
);
9136 jpeg_destroy_decompress (&cinfo
);
9138 /* If we already have an XImage, free that. */
9139 x_destroy_x_image (ximg
);
9141 /* Free pixmap and colors. */
9142 x_clear_image (f
, img
);
9148 /* Create the JPEG decompression object. Let it read from fp.
9149 Read the JPEG image header. */
9150 jpeg_create_decompress (&cinfo
);
9152 if (NILP (specified_data
))
9153 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9155 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9156 STRING_BYTES (XSTRING (specified_data
)));
9158 jpeg_read_header (&cinfo
, TRUE
);
9160 /* Customize decompression so that color quantization will be used.
9161 Start decompression. */
9162 cinfo
.quantize_colors
= TRUE
;
9163 jpeg_start_decompress (&cinfo
);
9164 width
= img
->width
= cinfo
.output_width
;
9165 height
= img
->height
= cinfo
.output_height
;
9167 /* Create X image and pixmap. */
9168 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9169 longjmp (mgr
.setjmp_buffer
, 2);
9171 /* Allocate colors. When color quantization is used,
9172 cinfo.actual_number_of_colors has been set with the number of
9173 colors generated, and cinfo.colormap is a two-dimensional array
9174 of color indices in the range 0..cinfo.actual_number_of_colors.
9175 No more than 255 colors will be generated. */
9179 if (cinfo
.out_color_components
> 2)
9180 ir
= 0, ig
= 1, ib
= 2;
9181 else if (cinfo
.out_color_components
> 1)
9182 ir
= 0, ig
= 1, ib
= 0;
9184 ir
= 0, ig
= 0, ib
= 0;
9186 /* Use the color table mechanism because it handles colors that
9187 cannot be allocated nicely. Such colors will be replaced with
9188 a default color, and we don't have to care about which colors
9189 can be freed safely, and which can't. */
9190 init_color_table ();
9191 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9194 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9196 /* Multiply RGB values with 255 because X expects RGB values
9197 in the range 0..0xffff. */
9198 int r
= cinfo
.colormap
[ir
][i
] << 8;
9199 int g
= cinfo
.colormap
[ig
][i
] << 8;
9200 int b
= cinfo
.colormap
[ib
][i
] << 8;
9201 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9204 /* Remember those colors actually allocated. */
9205 img
->colors
= colors_in_color_table (&img
->ncolors
);
9206 free_color_table ();
9210 row_stride
= width
* cinfo
.output_components
;
9211 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9213 for (y
= 0; y
< height
; ++y
)
9215 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9216 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9217 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9221 jpeg_finish_decompress (&cinfo
);
9222 jpeg_destroy_decompress (&cinfo
);
9224 fclose ((FILE *) fp
);
9226 /* Put the image into the pixmap. */
9227 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9228 x_destroy_x_image (ximg
);
9233 #endif /* HAVE_JPEG */
9237 /***********************************************************************
9239 ***********************************************************************/
9245 static int tiff_image_p
P_ ((Lisp_Object object
));
9246 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9248 /* The symbol `tiff' identifying images of this type. */
9252 /* Indices of image specification fields in tiff_format, below. */
9254 enum tiff_keyword_index
9263 TIFF_HEURISTIC_MASK
,
9268 /* Vector of image_keyword structures describing the format
9269 of valid user-defined image specifications. */
9271 static struct image_keyword tiff_format
[TIFF_LAST
] =
9273 {":type", IMAGE_SYMBOL_VALUE
, 1},
9274 {":data", IMAGE_STRING_VALUE
, 0},
9275 {":file", IMAGE_STRING_VALUE
, 0},
9276 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9277 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9278 {":relief", IMAGE_INTEGER_VALUE
, 0},
9279 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9280 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9281 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9284 /* Structure describing the image type `tiff'. */
9286 static struct image_type tiff_type
=
9296 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9299 tiff_image_p (object
)
9302 struct image_keyword fmt
[TIFF_LAST
];
9303 bcopy (tiff_format
, fmt
, sizeof fmt
);
9305 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9308 /* Must specify either the :data or :file keyword. */
9309 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9313 /* Reading from a memory buffer for TIFF images Based on the PNG
9314 memory source, but we have to provide a lot of extra functions.
9317 We really only need to implement read and seek, but I am not
9318 convinced that the TIFF library is smart enough not to destroy
9319 itself if we only hand it the function pointers we need to
9324 unsigned char *bytes
;
9332 tiff_read_from_memory (data
, buf
, size
)
9337 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9339 if (size
> src
->len
- src
->index
)
9341 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9348 tiff_write_from_memory (data
, buf
, size
)
9358 tiff_seek_in_memory (data
, off
, whence
)
9363 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9368 case SEEK_SET
: /* Go from beginning of source. */
9372 case SEEK_END
: /* Go from end of source. */
9373 idx
= src
->len
+ off
;
9376 case SEEK_CUR
: /* Go from current position. */
9377 idx
= src
->index
+ off
;
9380 default: /* Invalid `whence'. */
9384 if (idx
> src
->len
|| idx
< 0)
9393 tiff_close_memory (data
)
9402 tiff_mmap_memory (data
, pbase
, psize
)
9407 /* It is already _IN_ memory. */
9413 tiff_unmap_memory (data
, base
, size
)
9418 /* We don't need to do this. */
9423 tiff_size_of_memory (data
)
9426 return ((tiff_memory_source
*) data
)->len
;
9430 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9438 Lisp_Object file
, specified_file
;
9439 Lisp_Object specified_data
;
9441 int width
, height
, x
, y
;
9445 struct gcpro gcpro1
;
9446 tiff_memory_source memsrc
;
9448 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9449 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9453 if (NILP (specified_data
))
9455 /* Read from a file */
9456 file
= x_find_image_file (specified_file
);
9457 if (!STRINGP (file
))
9459 image_error ("Cannot find image file `%s'", file
, Qnil
);
9464 /* Try to open the image file. */
9465 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9468 image_error ("Cannot open `%s'", file
, Qnil
);
9475 /* Memory source! */
9476 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9477 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9480 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9481 (TIFFReadWriteProc
) tiff_read_from_memory
,
9482 (TIFFReadWriteProc
) tiff_write_from_memory
,
9483 tiff_seek_in_memory
,
9485 tiff_size_of_memory
,
9491 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9497 /* Get width and height of the image, and allocate a raster buffer
9498 of width x height 32-bit values. */
9499 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9500 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9501 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9503 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9507 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9513 /* Create the X image and pixmap. */
9514 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9521 /* Initialize the color table. */
9522 init_color_table ();
9524 /* Process the pixel raster. Origin is in the lower-left corner. */
9525 for (y
= 0; y
< height
; ++y
)
9527 uint32
*row
= buf
+ y
* width
;
9529 for (x
= 0; x
< width
; ++x
)
9531 uint32 abgr
= row
[x
];
9532 int r
= TIFFGetR (abgr
) << 8;
9533 int g
= TIFFGetG (abgr
) << 8;
9534 int b
= TIFFGetB (abgr
) << 8;
9535 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9539 /* Remember the colors allocated for the image. Free the color table. */
9540 img
->colors
= colors_in_color_table (&img
->ncolors
);
9541 free_color_table ();
9543 /* Put the image into the pixmap, then free the X image and its buffer. */
9544 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9545 x_destroy_x_image (ximg
);
9549 img
->height
= height
;
9555 #endif /* HAVE_TIFF != 0 */
9559 /***********************************************************************
9561 ***********************************************************************/
9565 #include <gif_lib.h>
9567 static int gif_image_p
P_ ((Lisp_Object object
));
9568 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9570 /* The symbol `gif' identifying images of this type. */
9574 /* Indices of image specification fields in gif_format, below. */
9576 enum gif_keyword_index
9591 /* Vector of image_keyword structures describing the format
9592 of valid user-defined image specifications. */
9594 static struct image_keyword gif_format
[GIF_LAST
] =
9596 {":type", IMAGE_SYMBOL_VALUE
, 1},
9597 {":data", IMAGE_STRING_VALUE
, 0},
9598 {":file", IMAGE_STRING_VALUE
, 0},
9599 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9600 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9601 {":relief", IMAGE_INTEGER_VALUE
, 0},
9602 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9603 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9604 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9605 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9608 /* Structure describing the image type `gif'. */
9610 static struct image_type gif_type
=
9620 /* Return non-zero if OBJECT is a valid GIF image specification. */
9623 gif_image_p (object
)
9626 struct image_keyword fmt
[GIF_LAST
];
9627 bcopy (gif_format
, fmt
, sizeof fmt
);
9629 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9632 /* Must specify either the :data or :file keyword. */
9633 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9637 /* Reading a GIF image from memory
9638 Based on the PNG memory stuff to a certain extent. */
9642 unsigned char *bytes
;
9649 /* Make the current memory source available to gif_read_from_memory.
9650 It's done this way because not all versions of libungif support
9651 a UserData field in the GifFileType structure. */
9652 static gif_memory_source
*current_gif_memory_src
;
9655 gif_read_from_memory (file
, buf
, len
)
9660 gif_memory_source
*src
= current_gif_memory_src
;
9662 if (len
> src
->len
- src
->index
)
9665 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9671 /* Load GIF image IMG for use on frame F. Value is non-zero if
9679 Lisp_Object file
, specified_file
;
9680 Lisp_Object specified_data
;
9681 int rc
, width
, height
, x
, y
, i
;
9683 ColorMapObject
*gif_color_map
;
9684 unsigned long pixel_colors
[256];
9686 struct gcpro gcpro1
;
9688 int ino
, image_left
, image_top
, image_width
, image_height
;
9689 gif_memory_source memsrc
;
9690 unsigned char *raster
;
9692 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9693 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9697 if (NILP (specified_data
))
9699 file
= x_find_image_file (specified_file
);
9700 if (!STRINGP (file
))
9702 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9707 /* Open the GIF file. */
9708 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9711 image_error ("Cannot open `%s'", file
, Qnil
);
9718 /* Read from memory! */
9719 current_gif_memory_src
= &memsrc
;
9720 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9721 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9724 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9727 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9733 /* Read entire contents. */
9734 rc
= DGifSlurp (gif
);
9735 if (rc
== GIF_ERROR
)
9737 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9738 DGifCloseFile (gif
);
9743 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9744 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9745 if (ino
>= gif
->ImageCount
)
9747 image_error ("Invalid image number `%s' in image `%s'",
9749 DGifCloseFile (gif
);
9754 width
= img
->width
= gif
->SWidth
;
9755 height
= img
->height
= gif
->SHeight
;
9757 /* Create the X image and pixmap. */
9758 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9760 DGifCloseFile (gif
);
9765 /* Allocate colors. */
9766 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9768 gif_color_map
= gif
->SColorMap
;
9769 init_color_table ();
9770 bzero (pixel_colors
, sizeof pixel_colors
);
9772 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9774 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9775 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9776 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9777 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9780 img
->colors
= colors_in_color_table (&img
->ncolors
);
9781 free_color_table ();
9783 /* Clear the part of the screen image that are not covered by
9784 the image from the GIF file. Full animated GIF support
9785 requires more than can be done here (see the gif89 spec,
9786 disposal methods). Let's simply assume that the part
9787 not covered by a sub-image is in the frame's background color. */
9788 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9789 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9790 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9791 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9793 for (y
= 0; y
< image_top
; ++y
)
9794 for (x
= 0; x
< width
; ++x
)
9795 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9797 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9798 for (x
= 0; x
< width
; ++x
)
9799 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9801 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9803 for (x
= 0; x
< image_left
; ++x
)
9804 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9805 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9806 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9809 /* Read the GIF image into the X image. We use a local variable
9810 `raster' here because RasterBits below is a char *, and invites
9811 problems with bytes >= 0x80. */
9812 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9814 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9816 static int interlace_start
[] = {0, 4, 2, 1};
9817 static int interlace_increment
[] = {8, 8, 4, 2};
9819 int row
= interlace_start
[0];
9823 for (y
= 0; y
< image_height
; y
++)
9825 if (row
>= image_height
)
9827 row
= interlace_start
[++pass
];
9828 while (row
>= image_height
)
9829 row
= interlace_start
[++pass
];
9832 for (x
= 0; x
< image_width
; x
++)
9834 int i
= raster
[(y
* image_width
) + x
];
9835 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9839 row
+= interlace_increment
[pass
];
9844 for (y
= 0; y
< image_height
; ++y
)
9845 for (x
= 0; x
< image_width
; ++x
)
9847 int i
= raster
[y
* image_width
+ x
];
9848 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9852 DGifCloseFile (gif
);
9854 /* Put the image into the pixmap, then free the X image and its buffer. */
9855 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9856 x_destroy_x_image (ximg
);
9862 #endif /* HAVE_GIF != 0 */
9866 /***********************************************************************
9868 ***********************************************************************/
9870 static int gs_image_p
P_ ((Lisp_Object object
));
9871 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9872 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9874 /* The symbol `postscript' identifying images of this type. */
9876 Lisp_Object Qpostscript
;
9878 /* Keyword symbols. */
9880 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9882 /* Indices of image specification fields in gs_format, below. */
9884 enum gs_keyword_index
9901 /* Vector of image_keyword structures describing the format
9902 of valid user-defined image specifications. */
9904 static struct image_keyword gs_format
[GS_LAST
] =
9906 {":type", IMAGE_SYMBOL_VALUE
, 1},
9907 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9908 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9909 {":file", IMAGE_STRING_VALUE
, 1},
9910 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9911 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9912 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9913 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9914 {":relief", IMAGE_INTEGER_VALUE
, 0},
9915 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9916 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9917 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9920 /* Structure describing the image type `ghostscript'. */
9922 static struct image_type gs_type
=
9932 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9935 gs_clear_image (f
, img
)
9939 /* IMG->data.ptr_val may contain a recorded colormap. */
9940 xfree (img
->data
.ptr_val
);
9941 x_clear_image (f
, img
);
9945 /* Return non-zero if OBJECT is a valid Ghostscript image
9952 struct image_keyword fmt
[GS_LAST
];
9956 bcopy (gs_format
, fmt
, sizeof fmt
);
9958 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
9961 /* Bounding box must be a list or vector containing 4 integers. */
9962 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9965 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9966 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9971 else if (VECTORP (tem
))
9973 if (XVECTOR (tem
)->size
!= 4)
9975 for (i
= 0; i
< 4; ++i
)
9976 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9986 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9995 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9996 struct gcpro gcpro1
, gcpro2
;
9998 double in_width
, in_height
;
9999 Lisp_Object pixel_colors
= Qnil
;
10001 /* Compute pixel size of pixmap needed from the given size in the
10002 image specification. Sizes in the specification are in pt. 1 pt
10003 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10005 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
10006 in_width
= XFASTINT (pt_width
) / 72.0;
10007 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
10008 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
10009 in_height
= XFASTINT (pt_height
) / 72.0;
10010 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
10012 /* Create the pixmap. */
10013 xassert (img
->pixmap
== None
);
10014 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10015 img
->width
, img
->height
,
10016 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
10020 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
10024 /* Call the loader to fill the pixmap. It returns a process object
10025 if successful. We do not record_unwind_protect here because
10026 other places in redisplay like calling window scroll functions
10027 don't either. Let the Lisp loader use `unwind-protect' instead. */
10028 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
10030 sprintf (buffer
, "%lu %lu",
10031 (unsigned long) FRAME_X_WINDOW (f
),
10032 (unsigned long) img
->pixmap
);
10033 window_and_pixmap_id
= build_string (buffer
);
10035 sprintf (buffer
, "%lu %lu",
10036 FRAME_FOREGROUND_PIXEL (f
),
10037 FRAME_BACKGROUND_PIXEL (f
));
10038 pixel_colors
= build_string (buffer
);
10040 XSETFRAME (frame
, f
);
10041 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
10043 loader
= intern ("gs-load-image");
10045 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10046 make_number (img
->width
),
10047 make_number (img
->height
),
10048 window_and_pixmap_id
,
10051 return PROCESSP (img
->data
.lisp_val
);
10055 /* Kill the Ghostscript process that was started to fill PIXMAP on
10056 frame F. Called from XTread_socket when receiving an event
10057 telling Emacs that Ghostscript has finished drawing. */
10060 x_kill_gs_process (pixmap
, f
)
10064 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10068 /* Find the image containing PIXMAP. */
10069 for (i
= 0; i
< c
->used
; ++i
)
10070 if (c
->images
[i
]->pixmap
== pixmap
)
10073 /* Kill the GS process. We should have found PIXMAP in the image
10074 cache and its image should contain a process object. */
10075 xassert (i
< c
->used
);
10076 img
= c
->images
[i
];
10077 xassert (PROCESSP (img
->data
.lisp_val
));
10078 Fkill_process (img
->data
.lisp_val
, Qnil
);
10079 img
->data
.lisp_val
= Qnil
;
10081 /* On displays with a mutable colormap, figure out the colors
10082 allocated for the image by looking at the pixels of an XImage for
10084 class = FRAME_X_VISUAL (f
)->class;
10085 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10091 /* Try to get an XImage for img->pixmep. */
10092 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10093 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10098 /* Initialize the color table. */
10099 init_color_table ();
10101 /* For each pixel of the image, look its color up in the
10102 color table. After having done so, the color table will
10103 contain an entry for each color used by the image. */
10104 for (y
= 0; y
< img
->height
; ++y
)
10105 for (x
= 0; x
< img
->width
; ++x
)
10107 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10108 lookup_pixel_color (f
, pixel
);
10111 /* Record colors in the image. Free color table and XImage. */
10112 img
->colors
= colors_in_color_table (&img
->ncolors
);
10113 free_color_table ();
10114 XDestroyImage (ximg
);
10116 #if 0 /* This doesn't seem to be the case. If we free the colors
10117 here, we get a BadAccess later in x_clear_image when
10118 freeing the colors. */
10119 /* We have allocated colors once, but Ghostscript has also
10120 allocated colors on behalf of us. So, to get the
10121 reference counts right, free them once. */
10123 x_free_colors (f
, img
->colors
, img
->ncolors
);
10127 image_error ("Cannot get X image of `%s'; colors will not be freed",
10133 /* Now that we have the pixmap, compute mask and transform the
10134 image if requested. */
10136 postprocess_image (f
, img
);
10142 /***********************************************************************
10144 ***********************************************************************/
10146 DEFUN ("x-change-window-property", Fx_change_window_property
,
10147 Sx_change_window_property
, 2, 3, 0,
10148 "Change window property PROP to VALUE on the X window of FRAME.\n\
10149 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
10150 selected frame. Value is VALUE.")
10151 (prop
, value
, frame
)
10152 Lisp_Object frame
, prop
, value
;
10154 struct frame
*f
= check_x_frame (frame
);
10157 CHECK_STRING (prop
, 1);
10158 CHECK_STRING (value
, 2);
10161 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10162 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10163 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10164 XSTRING (value
)->data
, XSTRING (value
)->size
);
10166 /* Make sure the property is set when we return. */
10167 XFlush (FRAME_X_DISPLAY (f
));
10174 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10175 Sx_delete_window_property
, 1, 2, 0,
10176 "Remove window property PROP from X window of FRAME.\n\
10177 FRAME nil or omitted means use the selected frame. Value is PROP.")
10179 Lisp_Object prop
, frame
;
10181 struct frame
*f
= check_x_frame (frame
);
10184 CHECK_STRING (prop
, 1);
10186 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10187 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10189 /* Make sure the property is removed when we return. */
10190 XFlush (FRAME_X_DISPLAY (f
));
10197 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10199 "Value is the value of window property PROP on FRAME.\n\
10200 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10201 if FRAME hasn't a property with name PROP or if PROP has no string\n\
10204 Lisp_Object prop
, frame
;
10206 struct frame
*f
= check_x_frame (frame
);
10209 Lisp_Object prop_value
= Qnil
;
10210 char *tmp_data
= NULL
;
10213 unsigned long actual_size
, bytes_remaining
;
10215 CHECK_STRING (prop
, 1);
10217 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10218 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10219 prop_atom
, 0, 0, False
, XA_STRING
,
10220 &actual_type
, &actual_format
, &actual_size
,
10221 &bytes_remaining
, (unsigned char **) &tmp_data
);
10224 int size
= bytes_remaining
;
10229 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10230 prop_atom
, 0, bytes_remaining
,
10232 &actual_type
, &actual_format
,
10233 &actual_size
, &bytes_remaining
,
10234 (unsigned char **) &tmp_data
);
10236 prop_value
= make_string (tmp_data
, size
);
10247 /***********************************************************************
10249 ***********************************************************************/
10251 /* If non-null, an asynchronous timer that, when it expires, displays
10252 an hourglass cursor on all frames. */
10254 static struct atimer
*hourglass_atimer
;
10256 /* Non-zero means an hourglass cursor is currently shown. */
10258 static int hourglass_shown_p
;
10260 /* Number of seconds to wait before displaying an hourglass cursor. */
10262 static Lisp_Object Vhourglass_delay
;
10264 /* Default number of seconds to wait before displaying an hourglass
10267 #define DEFAULT_HOURGLASS_DELAY 1
10269 /* Function prototypes. */
10271 static void show_hourglass
P_ ((struct atimer
*));
10272 static void hide_hourglass
P_ ((void));
10275 /* Cancel a currently active hourglass timer, and start a new one. */
10281 int secs
, usecs
= 0;
10283 cancel_hourglass ();
10285 if (INTEGERP (Vhourglass_delay
)
10286 && XINT (Vhourglass_delay
) > 0)
10287 secs
= XFASTINT (Vhourglass_delay
);
10288 else if (FLOATP (Vhourglass_delay
)
10289 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10292 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10293 secs
= XFASTINT (tem
);
10294 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10297 secs
= DEFAULT_HOURGLASS_DELAY
;
10299 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10300 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10301 show_hourglass
, NULL
);
10305 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10309 cancel_hourglass ()
10311 if (hourglass_atimer
)
10313 cancel_atimer (hourglass_atimer
);
10314 hourglass_atimer
= NULL
;
10317 if (hourglass_shown_p
)
10322 /* Timer function of hourglass_atimer. TIMER is equal to
10325 Display an hourglass pointer on all frames by mapping the frames'
10326 hourglass_window. Set the hourglass_p flag in the frames'
10327 output_data.x structure to indicate that an hourglass cursor is
10328 shown on the frames. */
10331 show_hourglass (timer
)
10332 struct atimer
*timer
;
10334 /* The timer implementation will cancel this timer automatically
10335 after this function has run. Set hourglass_atimer to null
10336 so that we know the timer doesn't have to be canceled. */
10337 hourglass_atimer
= NULL
;
10339 if (!hourglass_shown_p
)
10341 Lisp_Object rest
, frame
;
10345 FOR_EACH_FRAME (rest
, frame
)
10347 struct frame
*f
= XFRAME (frame
);
10349 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10351 Display
*dpy
= FRAME_X_DISPLAY (f
);
10353 #ifdef USE_X_TOOLKIT
10354 if (f
->output_data
.x
->widget
)
10356 if (FRAME_OUTER_WINDOW (f
))
10359 f
->output_data
.x
->hourglass_p
= 1;
10361 if (!f
->output_data
.x
->hourglass_window
)
10363 unsigned long mask
= CWCursor
;
10364 XSetWindowAttributes attrs
;
10366 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10368 f
->output_data
.x
->hourglass_window
10369 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10370 0, 0, 32000, 32000, 0, 0,
10376 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10382 hourglass_shown_p
= 1;
10388 /* Hide the hourglass pointer on all frames, if it is currently
10394 if (hourglass_shown_p
)
10396 Lisp_Object rest
, frame
;
10399 FOR_EACH_FRAME (rest
, frame
)
10401 struct frame
*f
= XFRAME (frame
);
10404 /* Watch out for newly created frames. */
10405 && f
->output_data
.x
->hourglass_window
)
10407 XUnmapWindow (FRAME_X_DISPLAY (f
),
10408 f
->output_data
.x
->hourglass_window
);
10409 /* Sync here because XTread_socket looks at the
10410 hourglass_p flag that is reset to zero below. */
10411 XSync (FRAME_X_DISPLAY (f
), False
);
10412 f
->output_data
.x
->hourglass_p
= 0;
10416 hourglass_shown_p
= 0;
10423 /***********************************************************************
10425 ***********************************************************************/
10427 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10428 Lisp_Object
, Lisp_Object
));
10429 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10430 Lisp_Object
, int, int, int *, int *));
10432 /* The frame of a currently visible tooltip. */
10434 Lisp_Object tip_frame
;
10436 /* If non-nil, a timer started that hides the last tooltip when it
10439 Lisp_Object tip_timer
;
10442 /* If non-nil, a vector of 3 elements containing the last args
10443 with which x-show-tip was called. See there. */
10445 Lisp_Object last_show_tip_args
;
10449 unwind_create_tip_frame (frame
)
10452 Lisp_Object deleted
;
10454 deleted
= unwind_create_frame (frame
);
10455 if (EQ (deleted
, Qt
))
10465 /* Create a frame for a tooltip on the display described by DPYINFO.
10466 PARMS is a list of frame parameters. TEXT is the string to
10467 display in the tip frame. Value is the frame.
10469 Note that functions called here, esp. x_default_parameter can
10470 signal errors, for instance when a specified color name is
10471 undefined. We have to make sure that we're in a consistent state
10472 when this happens. */
10475 x_create_tip_frame (dpyinfo
, parms
, text
)
10476 struct x_display_info
*dpyinfo
;
10477 Lisp_Object parms
, text
;
10480 Lisp_Object frame
, tem
;
10482 long window_prompting
= 0;
10484 int count
= BINDING_STACK_SIZE ();
10485 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10487 int face_change_count_before
= face_change_count
;
10488 Lisp_Object buffer
;
10489 struct buffer
*old_buffer
;
10493 /* Use this general default value to start with until we know if
10494 this frame has a specified name. */
10495 Vx_resource_name
= Vinvocation_name
;
10497 #ifdef MULTI_KBOARD
10498 kb
= dpyinfo
->kboard
;
10500 kb
= &the_only_kboard
;
10503 /* Get the name of the frame to use for resource lookup. */
10504 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10505 if (!STRINGP (name
)
10506 && !EQ (name
, Qunbound
)
10508 error ("Invalid frame name--not a string or nil");
10509 Vx_resource_name
= name
;
10512 GCPRO3 (parms
, name
, frame
);
10513 f
= make_frame (1);
10514 XSETFRAME (frame
, f
);
10516 buffer
= Fget_buffer_create (build_string (" *tip*"));
10517 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10518 old_buffer
= current_buffer
;
10519 set_buffer_internal_1 (XBUFFER (buffer
));
10521 Finsert (1, &text
);
10522 set_buffer_internal_1 (old_buffer
);
10524 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10525 record_unwind_protect (unwind_create_tip_frame
, frame
);
10527 /* By setting the output method, we're essentially saying that
10528 the frame is live, as per FRAME_LIVE_P. If we get a signal
10529 from this point on, x_destroy_window might screw up reference
10531 f
->output_method
= output_x_window
;
10532 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10533 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10534 f
->output_data
.x
->icon_bitmap
= -1;
10535 f
->output_data
.x
->fontset
= -1;
10536 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10537 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10538 f
->icon_name
= Qnil
;
10539 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10541 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10542 dpyinfo_refcount
= dpyinfo
->reference_count
;
10543 #endif /* GLYPH_DEBUG */
10544 #ifdef MULTI_KBOARD
10545 FRAME_KBOARD (f
) = kb
;
10547 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10548 f
->output_data
.x
->explicit_parent
= 0;
10550 /* These colors will be set anyway later, but it's important
10551 to get the color reference counts right, so initialize them! */
10554 struct gcpro gcpro1
;
10556 black
= build_string ("black");
10558 f
->output_data
.x
->foreground_pixel
10559 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10560 f
->output_data
.x
->background_pixel
10561 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10562 f
->output_data
.x
->cursor_pixel
10563 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10564 f
->output_data
.x
->cursor_foreground_pixel
10565 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10566 f
->output_data
.x
->border_pixel
10567 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10568 f
->output_data
.x
->mouse_pixel
10569 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10573 /* Set the name; the functions to which we pass f expect the name to
10575 if (EQ (name
, Qunbound
) || NILP (name
))
10577 f
->name
= build_string (dpyinfo
->x_id_name
);
10578 f
->explicit_name
= 0;
10583 f
->explicit_name
= 1;
10584 /* use the frame's title when getting resources for this frame. */
10585 specbind (Qx_resource_name
, name
);
10588 /* Extract the window parameters from the supplied values that are
10589 needed to determine window geometry. */
10593 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10596 /* First, try whatever font the caller has specified. */
10597 if (STRINGP (font
))
10599 tem
= Fquery_fontset (font
, Qnil
);
10601 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10603 font
= x_new_font (f
, XSTRING (font
)->data
);
10606 /* Try out a font which we hope has bold and italic variations. */
10607 if (!STRINGP (font
))
10608 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10609 if (!STRINGP (font
))
10610 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10611 if (! STRINGP (font
))
10612 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10613 if (! STRINGP (font
))
10614 /* This was formerly the first thing tried, but it finds too many fonts
10615 and takes too long. */
10616 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10617 /* If those didn't work, look for something which will at least work. */
10618 if (! STRINGP (font
))
10619 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10621 if (! STRINGP (font
))
10622 font
= build_string ("fixed");
10624 x_default_parameter (f
, parms
, Qfont
, font
,
10625 "font", "Font", RES_TYPE_STRING
);
10628 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10629 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10631 /* This defaults to 2 in order to match xterm. We recognize either
10632 internalBorderWidth or internalBorder (which is what xterm calls
10634 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10638 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10639 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10640 if (! EQ (value
, Qunbound
))
10641 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10645 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10646 "internalBorderWidth", "internalBorderWidth",
10649 /* Also do the stuff which must be set before the window exists. */
10650 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10651 "foreground", "Foreground", RES_TYPE_STRING
);
10652 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10653 "background", "Background", RES_TYPE_STRING
);
10654 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10655 "pointerColor", "Foreground", RES_TYPE_STRING
);
10656 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10657 "cursorColor", "Foreground", RES_TYPE_STRING
);
10658 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10659 "borderColor", "BorderColor", RES_TYPE_STRING
);
10661 /* Init faces before x_default_parameter is called for scroll-bar
10662 parameters because that function calls x_set_scroll_bar_width,
10663 which calls change_frame_size, which calls Fset_window_buffer,
10664 which runs hooks, which call Fvertical_motion. At the end, we
10665 end up in init_iterator with a null face cache, which should not
10667 init_frame_faces (f
);
10669 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10670 window_prompting
= x_figure_window_size (f
, parms
);
10672 if (window_prompting
& XNegative
)
10674 if (window_prompting
& YNegative
)
10675 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10677 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10681 if (window_prompting
& YNegative
)
10682 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10684 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10687 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10689 XSetWindowAttributes attrs
;
10690 unsigned long mask
;
10693 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10694 if (DoesSaveUnders (dpyinfo
->screen
))
10695 mask
|= CWSaveUnder
;
10697 /* Window managers look at the override-redirect flag to determine
10698 whether or net to give windows a decoration (Xlib spec, chapter
10700 attrs
.override_redirect
= True
;
10701 attrs
.save_under
= True
;
10702 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10703 /* Arrange for getting MapNotify and UnmapNotify events. */
10704 attrs
.event_mask
= StructureNotifyMask
;
10706 = FRAME_X_WINDOW (f
)
10707 = XCreateWindow (FRAME_X_DISPLAY (f
),
10708 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10709 /* x, y, width, height */
10713 CopyFromParent
, InputOutput
, CopyFromParent
,
10720 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10721 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10722 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10723 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10724 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10725 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10727 /* Dimensions, especially f->height, must be done via change_frame_size.
10728 Change will not be effected unless different from the current
10731 height
= f
->height
;
10733 SET_FRAME_WIDTH (f
, 0);
10734 change_frame_size (f
, height
, width
, 1, 0, 0);
10736 /* Set up faces after all frame parameters are known. This call
10737 also merges in face attributes specified for new frames.
10739 Frame parameters may be changed if .Xdefaults contains
10740 specifications for the default font. For example, if there is an
10741 `Emacs.default.attributeBackground: pink', the `background-color'
10742 attribute of the frame get's set, which let's the internal border
10743 of the tooltip frame appear in pink. Prevent this. */
10745 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
10747 /* Set tip_frame here, so that */
10749 call1 (Qface_set_after_frame_default
, frame
);
10751 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
10752 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
10760 /* It is now ok to make the frame official even if we get an error
10761 below. And the frame needs to be on Vframe_list or making it
10762 visible won't work. */
10763 Vframe_list
= Fcons (frame
, Vframe_list
);
10765 /* Now that the frame is official, it counts as a reference to
10767 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10769 /* Setting attributes of faces of the tooltip frame from resources
10770 and similar will increment face_change_count, which leads to the
10771 clearing of all current matrices. Since this isn't necessary
10772 here, avoid it by resetting face_change_count to the value it
10773 had before we created the tip frame. */
10774 face_change_count
= face_change_count_before
;
10776 /* Discard the unwind_protect. */
10777 return unbind_to (count
, frame
);
10781 /* Compute where to display tip frame F. PARMS is the list of frame
10782 parameters for F. DX and DY are specified offsets from the current
10783 location of the mouse. WIDTH and HEIGHT are the width and height
10784 of the tooltip. Return coordinates relative to the root window of
10785 the display in *ROOT_X, and *ROOT_Y. */
10788 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
10790 Lisp_Object parms
, dx
, dy
;
10792 int *root_x
, *root_y
;
10794 Lisp_Object left
, top
;
10796 Window root
, child
;
10799 /* User-specified position? */
10800 left
= Fcdr (Fassq (Qleft
, parms
));
10801 top
= Fcdr (Fassq (Qtop
, parms
));
10803 /* Move the tooltip window where the mouse pointer is. Resize and
10805 if (!INTEGERP (left
) && !INTEGERP (top
))
10808 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10809 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
10813 if (INTEGERP (top
))
10814 *root_y
= XINT (top
);
10815 else if (*root_y
+ XINT (dy
) - height
< 0)
10816 *root_y
-= XINT (dy
);
10820 *root_y
+= XINT (dy
);
10823 if (INTEGERP (left
))
10824 *root_x
= XINT (left
);
10825 else if (*root_x
+ XINT (dx
) + width
> FRAME_X_DISPLAY_INFO (f
)->width
)
10826 *root_x
-= width
+ XINT (dx
);
10828 *root_x
+= XINT (dx
);
10832 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10833 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10834 A tooltip window is a small X window displaying a string.\n\
10836 FRAME nil or omitted means use the selected frame.\n\
10838 PARMS is an optional list of frame parameters which can be\n\
10839 used to change the tooltip's appearance.\n\
10841 Automatically hide the tooltip after TIMEOUT seconds.\n\
10842 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10844 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10845 the tooltip is displayed at that x-position. Otherwise it is\n\
10846 displayed at the mouse position, with offset DX added (default is 5 if\n\
10847 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10848 parameter is specified, it determines the y-position of the tooltip\n\
10849 window, otherwise it is displayed at the mouse position, with offset\n\
10850 DY added (default is -10).")
10851 (string
, frame
, parms
, timeout
, dx
, dy
)
10852 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10856 Lisp_Object buffer
, top
, left
;
10857 int root_x
, root_y
;
10858 struct buffer
*old_buffer
;
10859 struct text_pos pos
;
10860 int i
, width
, height
;
10861 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10862 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10863 int count
= BINDING_STACK_SIZE ();
10865 specbind (Qinhibit_redisplay
, Qt
);
10867 GCPRO4 (string
, parms
, frame
, timeout
);
10869 CHECK_STRING (string
, 0);
10870 f
= check_x_frame (frame
);
10871 if (NILP (timeout
))
10872 timeout
= make_number (5);
10874 CHECK_NATNUM (timeout
, 2);
10877 dx
= make_number (5);
10879 CHECK_NUMBER (dx
, 5);
10882 dy
= make_number (-10);
10884 CHECK_NUMBER (dy
, 6);
10886 if (NILP (last_show_tip_args
))
10887 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
10889 if (!NILP (tip_frame
))
10891 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
10892 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
10893 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
10895 if (EQ (frame
, last_frame
)
10896 && !NILP (Fequal (last_string
, string
))
10897 && !NILP (Fequal (last_parms
, parms
)))
10899 struct frame
*f
= XFRAME (tip_frame
);
10901 /* Only DX and DY have changed. */
10902 if (!NILP (tip_timer
))
10904 Lisp_Object timer
= tip_timer
;
10906 call1 (Qcancel_timer
, timer
);
10910 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
10911 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
10912 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10919 /* Hide a previous tip, if any. */
10922 ASET (last_show_tip_args
, 0, string
);
10923 ASET (last_show_tip_args
, 1, frame
);
10924 ASET (last_show_tip_args
, 2, parms
);
10926 /* Add default values to frame parameters. */
10927 if (NILP (Fassq (Qname
, parms
)))
10928 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10929 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10930 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10931 if (NILP (Fassq (Qborder_width
, parms
)))
10932 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10933 if (NILP (Fassq (Qborder_color
, parms
)))
10934 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10935 if (NILP (Fassq (Qbackground_color
, parms
)))
10936 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10939 /* Create a frame for the tooltip, and record it in the global
10940 variable tip_frame. */
10941 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
, string
);
10942 f
= XFRAME (frame
);
10944 /* Set up the frame's root window. Currently we use a size of 80
10945 columns x 40 lines. If someone wants to show a larger tip, he
10946 will loose. I don't think this is a realistic case. */
10947 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10948 w
->left
= w
->top
= make_number (0);
10949 w
->width
= make_number (80);
10950 w
->height
= make_number (40);
10952 w
->pseudo_window_p
= 1;
10954 /* Display the tooltip text in a temporary buffer. */
10955 old_buffer
= current_buffer
;
10956 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
10957 clear_glyph_matrix (w
->desired_matrix
);
10958 clear_glyph_matrix (w
->current_matrix
);
10959 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10960 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10962 /* Compute width and height of the tooltip. */
10963 width
= height
= 0;
10964 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10966 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10967 struct glyph
*last
;
10970 /* Stop at the first empty row at the end. */
10971 if (!row
->enabled_p
|| !row
->displays_text_p
)
10974 /* Let the row go over the full width of the frame. */
10975 row
->full_width_p
= 1;
10977 /* There's a glyph at the end of rows that is used to place
10978 the cursor there. Don't include the width of this glyph. */
10979 if (row
->used
[TEXT_AREA
])
10981 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10982 row_width
= row
->pixel_width
- last
->pixel_width
;
10985 row_width
= row
->pixel_width
;
10987 height
+= row
->height
;
10988 width
= max (width
, row_width
);
10991 /* Add the frame's internal border to the width and height the X
10992 window should have. */
10993 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10994 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10996 /* Move the tooltip window where the mouse pointer is. Resize and
10998 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
11001 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11002 root_x
, root_y
, width
, height
);
11003 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
11006 /* Draw into the window. */
11007 w
->must_be_updated_p
= 1;
11008 update_single_window (w
, 1);
11010 /* Restore original current buffer. */
11011 set_buffer_internal_1 (old_buffer
);
11012 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
11015 /* Let the tip disappear after timeout seconds. */
11016 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
11017 intern ("x-hide-tip"));
11020 return unbind_to (count
, Qnil
);
11024 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
11025 "Hide the current tooltip window, if there is any.\n\
11026 Value is t is tooltip was open, nil otherwise.")
11030 Lisp_Object deleted
, frame
, timer
;
11031 struct gcpro gcpro1
, gcpro2
;
11033 /* Return quickly if nothing to do. */
11034 if (NILP (tip_timer
) && NILP (tip_frame
))
11039 GCPRO2 (frame
, timer
);
11040 tip_frame
= tip_timer
= deleted
= Qnil
;
11042 count
= BINDING_STACK_SIZE ();
11043 specbind (Qinhibit_redisplay
, Qt
);
11044 specbind (Qinhibit_quit
, Qt
);
11047 call1 (Qcancel_timer
, timer
);
11049 if (FRAMEP (frame
))
11051 Fdelete_frame (frame
, Qnil
);
11055 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11056 redisplay procedure is not called when a tip frame over menu
11057 items is unmapped. Redisplay the menu manually... */
11059 struct frame
*f
= SELECTED_FRAME ();
11060 Widget w
= f
->output_data
.x
->menubar_widget
;
11061 extern void xlwmenu_redisplay
P_ ((Widget
));
11063 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
11067 xlwmenu_redisplay (w
);
11071 #endif /* USE_LUCID */
11075 return unbind_to (count
, deleted
);
11080 /***********************************************************************
11081 File selection dialog
11082 ***********************************************************************/
11086 /* Callback for "OK" and "Cancel" on file selection dialog. */
11089 file_dialog_cb (widget
, client_data
, call_data
)
11091 XtPointer call_data
, client_data
;
11093 int *result
= (int *) client_data
;
11094 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11095 *result
= cb
->reason
;
11099 /* Callback for unmapping a file selection dialog. This is used to
11100 capture the case where a dialog is closed via a window manager's
11101 closer button, for example. Using a XmNdestroyCallback didn't work
11105 file_dialog_unmap_cb (widget
, client_data
, call_data
)
11107 XtPointer call_data
, client_data
;
11109 int *result
= (int *) client_data
;
11110 *result
= XmCR_CANCEL
;
11114 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11115 "Read file name, prompting with PROMPT in directory DIR.\n\
11116 Use a file selection dialog.\n\
11117 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
11118 specified. Don't let the user enter a file name in the file\n\
11119 selection dialog's entry field, if MUSTMATCH is non-nil.")
11120 (prompt
, dir
, default_filename
, mustmatch
)
11121 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11124 struct frame
*f
= SELECTED_FRAME ();
11125 Lisp_Object file
= Qnil
;
11126 Widget dialog
, text
, list
, help
;
11129 extern XtAppContext Xt_app_con
;
11131 XmString dir_xmstring
, pattern_xmstring
;
11132 int popup_activated_flag
;
11133 int count
= specpdl_ptr
- specpdl
;
11134 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11136 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11137 CHECK_STRING (prompt
, 0);
11138 CHECK_STRING (dir
, 1);
11140 /* Prevent redisplay. */
11141 specbind (Qinhibit_redisplay
, Qt
);
11145 /* Create the dialog with PROMPT as title, using DIR as initial
11146 directory and using "*" as pattern. */
11147 dir
= Fexpand_file_name (dir
, Qnil
);
11148 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11149 pattern_xmstring
= XmStringCreateLocalized ("*");
11151 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11152 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11153 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11154 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11155 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11156 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11158 XmStringFree (dir_xmstring
);
11159 XmStringFree (pattern_xmstring
);
11161 /* Add callbacks for OK and Cancel. */
11162 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11163 (XtPointer
) &result
);
11164 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11165 (XtPointer
) &result
);
11166 XtAddCallback (dialog
, XmNunmapCallback
, file_dialog_unmap_cb
,
11167 (XtPointer
) &result
);
11169 /* Disable the help button since we can't display help. */
11170 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11171 XtSetSensitive (help
, False
);
11173 /* Mark OK button as default. */
11174 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11175 XmNshowAsDefault
, True
, NULL
);
11177 /* If MUSTMATCH is non-nil, disable the file entry field of the
11178 dialog, so that the user must select a file from the files list
11179 box. We can't remove it because we wouldn't have a way to get at
11180 the result file name, then. */
11181 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11182 if (!NILP (mustmatch
))
11185 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11186 XtSetSensitive (text
, False
);
11187 XtSetSensitive (label
, False
);
11190 /* Manage the dialog, so that list boxes get filled. */
11191 XtManageChild (dialog
);
11193 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11194 must include the path for this to work. */
11195 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11196 if (STRINGP (default_filename
))
11198 XmString default_xmstring
;
11202 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11204 if (!XmListItemExists (list
, default_xmstring
))
11206 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11207 XmListAddItem (list
, default_xmstring
, 0);
11211 item_pos
= XmListItemPos (list
, default_xmstring
);
11212 XmStringFree (default_xmstring
);
11214 /* Select the item and scroll it into view. */
11215 XmListSelectPos (list
, item_pos
, True
);
11216 XmListSetPos (list
, item_pos
);
11219 /* Process events until the user presses Cancel or OK. */
11221 while (result
== 0)
11222 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11224 /* Get the result. */
11225 if (result
== XmCR_OK
)
11230 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11231 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11232 XmStringFree (text
);
11233 file
= build_string (data
);
11240 XtUnmanageChild (dialog
);
11241 XtDestroyWidget (dialog
);
11245 /* Make "Cancel" equivalent to C-g. */
11247 Fsignal (Qquit
, Qnil
);
11249 return unbind_to (count
, file
);
11252 #endif /* USE_MOTIF */
11256 /***********************************************************************
11258 ***********************************************************************/
11260 #ifdef HAVE_XKBGETKEYBOARD
11261 #include <X11/XKBlib.h>
11262 #include <X11/keysym.h>
11265 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11266 Sx_backspace_delete_keys_p
, 0, 1, 0,
11267 "Check if both Backspace and Delete keys are on the keyboard of FRAME.\n\
11268 FRAME nil means use the selected frame.\n\
11269 Value is t if we know that both keys are present, and are mapped to the\n\
11274 #ifdef HAVE_XKBGETKEYBOARD
11276 struct frame
*f
= check_x_frame (frame
);
11277 Display
*dpy
= FRAME_X_DISPLAY (f
);
11278 Lisp_Object have_keys
;
11279 int major
, minor
, op
, event
, error
;
11283 /* Check library version in case we're dynamically linked. */
11284 major
= XkbMajorVersion
;
11285 minor
= XkbMinorVersion
;
11286 if (!XkbLibraryVersion (&major
, &minor
))
11292 /* Check that the server supports XKB. */
11293 major
= XkbMajorVersion
;
11294 minor
= XkbMinorVersion
;
11295 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11302 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11305 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11307 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11309 for (i
= kb
->min_key_code
;
11310 (i
< kb
->max_key_code
11311 && (delete_keycode
== 0 || backspace_keycode
== 0));
11314 /* The XKB symbolic key names can be seen most easily
11315 in the PS file generated by `xkbprint -label name $DISPLAY'. */
11316 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11317 delete_keycode
= i
;
11318 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11319 backspace_keycode
= i
;
11322 XkbFreeNames (kb
, 0, True
);
11325 XkbFreeClientMap (kb
, 0, True
);
11328 && backspace_keycode
11329 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11330 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11335 #else /* not HAVE_XKBGETKEYBOARD */
11337 #endif /* not HAVE_XKBGETKEYBOARD */
11342 /***********************************************************************
11344 ***********************************************************************/
11349 /* This is zero if not using X windows. */
11352 /* The section below is built by the lisp expression at the top of the file,
11353 just above where these variables are declared. */
11354 /*&&& init symbols here &&&*/
11355 Qauto_raise
= intern ("auto-raise");
11356 staticpro (&Qauto_raise
);
11357 Qauto_lower
= intern ("auto-lower");
11358 staticpro (&Qauto_lower
);
11359 Qbar
= intern ("bar");
11361 Qborder_color
= intern ("border-color");
11362 staticpro (&Qborder_color
);
11363 Qborder_width
= intern ("border-width");
11364 staticpro (&Qborder_width
);
11365 Qbox
= intern ("box");
11367 Qcursor_color
= intern ("cursor-color");
11368 staticpro (&Qcursor_color
);
11369 Qcursor_type
= intern ("cursor-type");
11370 staticpro (&Qcursor_type
);
11371 Qgeometry
= intern ("geometry");
11372 staticpro (&Qgeometry
);
11373 Qicon_left
= intern ("icon-left");
11374 staticpro (&Qicon_left
);
11375 Qicon_top
= intern ("icon-top");
11376 staticpro (&Qicon_top
);
11377 Qicon_type
= intern ("icon-type");
11378 staticpro (&Qicon_type
);
11379 Qicon_name
= intern ("icon-name");
11380 staticpro (&Qicon_name
);
11381 Qinternal_border_width
= intern ("internal-border-width");
11382 staticpro (&Qinternal_border_width
);
11383 Qleft
= intern ("left");
11384 staticpro (&Qleft
);
11385 Qright
= intern ("right");
11386 staticpro (&Qright
);
11387 Qmouse_color
= intern ("mouse-color");
11388 staticpro (&Qmouse_color
);
11389 Qnone
= intern ("none");
11390 staticpro (&Qnone
);
11391 Qparent_id
= intern ("parent-id");
11392 staticpro (&Qparent_id
);
11393 Qscroll_bar_width
= intern ("scroll-bar-width");
11394 staticpro (&Qscroll_bar_width
);
11395 Qsuppress_icon
= intern ("suppress-icon");
11396 staticpro (&Qsuppress_icon
);
11397 Qundefined_color
= intern ("undefined-color");
11398 staticpro (&Qundefined_color
);
11399 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11400 staticpro (&Qvertical_scroll_bars
);
11401 Qvisibility
= intern ("visibility");
11402 staticpro (&Qvisibility
);
11403 Qwindow_id
= intern ("window-id");
11404 staticpro (&Qwindow_id
);
11405 Qouter_window_id
= intern ("outer-window-id");
11406 staticpro (&Qouter_window_id
);
11407 Qx_frame_parameter
= intern ("x-frame-parameter");
11408 staticpro (&Qx_frame_parameter
);
11409 Qx_resource_name
= intern ("x-resource-name");
11410 staticpro (&Qx_resource_name
);
11411 Quser_position
= intern ("user-position");
11412 staticpro (&Quser_position
);
11413 Quser_size
= intern ("user-size");
11414 staticpro (&Quser_size
);
11415 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11416 staticpro (&Qscroll_bar_foreground
);
11417 Qscroll_bar_background
= intern ("scroll-bar-background");
11418 staticpro (&Qscroll_bar_background
);
11419 Qscreen_gamma
= intern ("screen-gamma");
11420 staticpro (&Qscreen_gamma
);
11421 Qline_spacing
= intern ("line-spacing");
11422 staticpro (&Qline_spacing
);
11423 Qcenter
= intern ("center");
11424 staticpro (&Qcenter
);
11425 Qcompound_text
= intern ("compound-text");
11426 staticpro (&Qcompound_text
);
11427 Qcancel_timer
= intern ("cancel-timer");
11428 staticpro (&Qcancel_timer
);
11429 /* This is the end of symbol initialization. */
11431 /* Text property `display' should be nonsticky by default. */
11432 Vtext_property_default_nonsticky
11433 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11436 Qlaplace
= intern ("laplace");
11437 staticpro (&Qlaplace
);
11438 Qemboss
= intern ("emboss");
11439 staticpro (&Qemboss
);
11440 Qedge_detection
= intern ("edge-detection");
11441 staticpro (&Qedge_detection
);
11442 Qheuristic
= intern ("heuristic");
11443 staticpro (&Qheuristic
);
11444 QCmatrix
= intern (":matrix");
11445 staticpro (&QCmatrix
);
11446 QCcolor_adjustment
= intern (":color-adjustment");
11447 staticpro (&QCcolor_adjustment
);
11448 QCmask
= intern (":mask");
11449 staticpro (&QCmask
);
11451 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11452 staticpro (&Qface_set_after_frame_default
);
11454 Fput (Qundefined_color
, Qerror_conditions
,
11455 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11456 Fput (Qundefined_color
, Qerror_message
,
11457 build_string ("Undefined color"));
11459 init_x_parm_symbols ();
11461 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11462 "Non-nil means always draw a cross over disabled images.\n\
11463 Disabled images are those having an `:conversion disabled' property.\n\
11464 A cross is always drawn on black & white displays.");
11465 cross_disabled_images
= 0;
11467 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11468 "List of directories to search for bitmap files for X.");
11469 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11471 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11472 "The shape of the pointer when over text.\n\
11473 Changing the value does not affect existing frames\n\
11474 unless you set the mouse color.");
11475 Vx_pointer_shape
= Qnil
;
11477 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11478 "The name Emacs uses to look up X resources.\n\
11479 `x-get-resource' uses this as the first component of the instance name\n\
11480 when requesting resource values.\n\
11481 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
11482 was invoked, or to the value specified with the `-name' or `-rn'\n\
11483 switches, if present.\n\
11485 It may be useful to bind this variable locally around a call\n\
11486 to `x-get-resource'. See also the variable `x-resource-class'.");
11487 Vx_resource_name
= Qnil
;
11489 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11490 "The class Emacs uses to look up X resources.\n\
11491 `x-get-resource' uses this as the first component of the instance class\n\
11492 when requesting resource values.\n\
11493 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
11495 Setting this variable permanently is not a reasonable thing to do,\n\
11496 but binding this variable locally around a call to `x-get-resource'\n\
11497 is a reasonable practice. See also the variable `x-resource-name'.");
11498 Vx_resource_class
= build_string (EMACS_CLASS
);
11500 #if 0 /* This doesn't really do anything. */
11501 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11502 "The shape of the pointer when not over text.\n\
11503 This variable takes effect when you create a new frame\n\
11504 or when you set the mouse color.");
11506 Vx_nontext_pointer_shape
= Qnil
;
11508 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
11509 "The shape of the pointer when Emacs is busy.\n\
11510 This variable takes effect when you create a new frame\n\
11511 or when you set the mouse color.");
11512 Vx_hourglass_pointer_shape
= Qnil
;
11514 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
11515 "Non-zero means Emacs displays an hourglass pointer on window systems.");
11516 display_hourglass_p
= 1;
11518 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
11519 "*Seconds to wait before displaying an hourglass pointer.\n\
11520 Value must be an integer or float.");
11521 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
11523 #if 0 /* This doesn't really do anything. */
11524 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11525 "The shape of the pointer when over the mode line.\n\
11526 This variable takes effect when you create a new frame\n\
11527 or when you set the mouse color.");
11529 Vx_mode_pointer_shape
= Qnil
;
11531 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11532 &Vx_sensitive_text_pointer_shape
,
11533 "The shape of the pointer when over mouse-sensitive text.\n\
11534 This variable takes effect when you create a new frame\n\
11535 or when you set the mouse color.");
11536 Vx_sensitive_text_pointer_shape
= Qnil
;
11538 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11539 &Vx_window_horizontal_drag_shape
,
11540 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
11541 This variable takes effect when you create a new frame\n\
11542 or when you set the mouse color.");
11543 Vx_window_horizontal_drag_shape
= Qnil
;
11545 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11546 "A string indicating the foreground color of the cursor box.");
11547 Vx_cursor_fore_pixel
= Qnil
;
11549 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11550 "Non-nil if no X window manager is in use.\n\
11551 Emacs doesn't try to figure this out; this is always nil\n\
11552 unless you set it to something else.");
11553 /* We don't have any way to find this out, so set it to nil
11554 and maybe the user would like to set it to t. */
11555 Vx_no_window_manager
= Qnil
;
11557 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11558 &Vx_pixel_size_width_font_regexp
,
11559 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11561 Since Emacs gets width of a font matching with this regexp from\n\
11562 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11563 such a font. This is especially effective for such large fonts as\n\
11564 Chinese, Japanese, and Korean.");
11565 Vx_pixel_size_width_font_regexp
= Qnil
;
11567 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11568 "Time after which cached images are removed from the cache.\n\
11569 When an image has not been displayed this many seconds, remove it\n\
11570 from the image cache. Value must be an integer or nil with nil\n\
11571 meaning don't clear the cache.");
11572 Vimage_cache_eviction_delay
= make_number (30 * 60);
11574 #ifdef USE_X_TOOLKIT
11575 Fprovide (intern ("x-toolkit"));
11578 Fprovide (intern ("motif"));
11580 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string
,
11581 "Version info for LessTif/Motif.");
11582 Vmotif_version_string
= build_string (XmVERSION_STRING
);
11583 #endif /* USE_MOTIF */
11584 #endif /* USE_X_TOOLKIT */
11586 defsubr (&Sx_get_resource
);
11588 /* X window properties. */
11589 defsubr (&Sx_change_window_property
);
11590 defsubr (&Sx_delete_window_property
);
11591 defsubr (&Sx_window_property
);
11593 defsubr (&Sxw_display_color_p
);
11594 defsubr (&Sx_display_grayscale_p
);
11595 defsubr (&Sxw_color_defined_p
);
11596 defsubr (&Sxw_color_values
);
11597 defsubr (&Sx_server_max_request_size
);
11598 defsubr (&Sx_server_vendor
);
11599 defsubr (&Sx_server_version
);
11600 defsubr (&Sx_display_pixel_width
);
11601 defsubr (&Sx_display_pixel_height
);
11602 defsubr (&Sx_display_mm_width
);
11603 defsubr (&Sx_display_mm_height
);
11604 defsubr (&Sx_display_screens
);
11605 defsubr (&Sx_display_planes
);
11606 defsubr (&Sx_display_color_cells
);
11607 defsubr (&Sx_display_visual_class
);
11608 defsubr (&Sx_display_backing_store
);
11609 defsubr (&Sx_display_save_under
);
11610 defsubr (&Sx_parse_geometry
);
11611 defsubr (&Sx_create_frame
);
11612 defsubr (&Sx_open_connection
);
11613 defsubr (&Sx_close_connection
);
11614 defsubr (&Sx_display_list
);
11615 defsubr (&Sx_synchronize
);
11616 defsubr (&Sx_focus_frame
);
11617 defsubr (&Sx_backspace_delete_keys_p
);
11619 /* Setting callback functions for fontset handler. */
11620 get_font_info_func
= x_get_font_info
;
11622 #if 0 /* This function pointer doesn't seem to be used anywhere.
11623 And the pointer assigned has the wrong type, anyway. */
11624 list_fonts_func
= x_list_fonts
;
11627 load_font_func
= x_load_font
;
11628 find_ccl_program_func
= x_find_ccl_program
;
11629 query_font_func
= x_query_font
;
11630 set_frame_fontset_func
= x_set_font
;
11631 check_window_system_func
= check_x
;
11634 Qxbm
= intern ("xbm");
11636 QCtype
= intern (":type");
11637 staticpro (&QCtype
);
11638 QCconversion
= intern (":conversion");
11639 staticpro (&QCconversion
);
11640 QCheuristic_mask
= intern (":heuristic-mask");
11641 staticpro (&QCheuristic_mask
);
11642 QCcolor_symbols
= intern (":color-symbols");
11643 staticpro (&QCcolor_symbols
);
11644 QCascent
= intern (":ascent");
11645 staticpro (&QCascent
);
11646 QCmargin
= intern (":margin");
11647 staticpro (&QCmargin
);
11648 QCrelief
= intern (":relief");
11649 staticpro (&QCrelief
);
11650 Qpostscript
= intern ("postscript");
11651 staticpro (&Qpostscript
);
11652 QCloader
= intern (":loader");
11653 staticpro (&QCloader
);
11654 QCbounding_box
= intern (":bounding-box");
11655 staticpro (&QCbounding_box
);
11656 QCpt_width
= intern (":pt-width");
11657 staticpro (&QCpt_width
);
11658 QCpt_height
= intern (":pt-height");
11659 staticpro (&QCpt_height
);
11660 QCindex
= intern (":index");
11661 staticpro (&QCindex
);
11662 Qpbm
= intern ("pbm");
11666 Qxpm
= intern ("xpm");
11671 Qjpeg
= intern ("jpeg");
11672 staticpro (&Qjpeg
);
11676 Qtiff
= intern ("tiff");
11677 staticpro (&Qtiff
);
11681 Qgif
= intern ("gif");
11686 Qpng
= intern ("png");
11690 defsubr (&Sclear_image_cache
);
11691 defsubr (&Simage_size
);
11692 defsubr (&Simage_mask_p
);
11694 hourglass_atimer
= NULL
;
11695 hourglass_shown_p
= 0;
11697 defsubr (&Sx_show_tip
);
11698 defsubr (&Sx_hide_tip
);
11700 staticpro (&tip_timer
);
11702 staticpro (&tip_frame
);
11704 last_show_tip_args
= Qnil
;
11705 staticpro (&last_show_tip_args
);
11708 defsubr (&Sx_file_dialog
);
11716 image_types
= NULL
;
11717 Vimage_types
= Qnil
;
11719 define_image_type (&xbm_type
);
11720 define_image_type (&gs_type
);
11721 define_image_type (&pbm_type
);
11724 define_image_type (&xpm_type
);
11728 define_image_type (&jpeg_type
);
11732 define_image_type (&tiff_type
);
11736 define_image_type (&gif_type
);
11740 define_image_type (&png_type
);
11744 #endif /* HAVE_X_WINDOWS */