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. */
31 /* This makes the fields of a Display accessible, in Xlib header files. */
33 #define XLIB_ILLEGAL_ACCESS
40 #include "intervals.h"
41 #include "dispextern.h"
43 #include "blockinput.h"
49 #include "termhooks.h"
55 #include <sys/types.h>
59 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
60 #include "bitmaps/gray.xbm"
62 #include <X11/bitmaps/gray>
65 #include "[.bitmaps]gray.xbm"
69 #include <X11/Shell.h>
72 #include <X11/Xaw/Paned.h>
73 #include <X11/Xaw/Label.h>
74 #endif /* USE_MOTIF */
77 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
86 #include "../lwlib/lwlib.h"
90 #include <Xm/DialogS.h>
91 #include <Xm/FileSB.h>
94 /* Do the EDITRES protocol if running X11R5
95 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
97 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
99 extern void _XEditResCheckMessages ();
100 #endif /* R5 + Athena */
102 /* Unique id counter for widgets created by the Lucid Widget Library. */
104 extern LWLIB_ID widget_id_tick
;
107 /* This is part of a kludge--see lwlib/xlwmenu.c. */
108 extern XFontStruct
*xlwmenu_default_font
;
111 extern void free_frame_menubar ();
112 extern double atof ();
116 /* LessTif/Motif version info. */
118 static Lisp_Object Vmotif_version_string
;
120 #endif /* USE_MOTIF */
122 #endif /* USE_X_TOOLKIT */
125 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
127 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
130 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
131 it, and including `bitmaps/gray' more than once is a problem when
132 config.h defines `static' as an empty replacement string. */
134 int gray_bitmap_width
= gray_width
;
135 int gray_bitmap_height
= gray_height
;
136 char *gray_bitmap_bits
= gray_bits
;
138 /* The name we're using in resource queries. Most often "emacs". */
140 Lisp_Object Vx_resource_name
;
142 /* The application class we're using in resource queries.
145 Lisp_Object Vx_resource_class
;
147 /* Non-zero means we're allowed to display an hourglass cursor. */
149 int display_hourglass_p
;
151 /* The background and shape of the mouse pointer, and shape when not
152 over text or in the modeline. */
154 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
155 Lisp_Object Vx_hourglass_pointer_shape
;
157 /* The shape when over mouse-sensitive text. */
159 Lisp_Object Vx_sensitive_text_pointer_shape
;
161 /* If non-nil, the pointer shape to indicate that windows can be
162 dragged horizontally. */
164 Lisp_Object Vx_window_horizontal_drag_shape
;
166 /* Color of chars displayed in cursor box. */
168 Lisp_Object Vx_cursor_fore_pixel
;
170 /* Nonzero if using X. */
174 /* Non nil if no window manager is in use. */
176 Lisp_Object Vx_no_window_manager
;
178 /* Search path for bitmap files. */
180 Lisp_Object Vx_bitmap_file_path
;
182 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
184 Lisp_Object Vx_pixel_size_width_font_regexp
;
186 Lisp_Object Qauto_raise
;
187 Lisp_Object Qauto_lower
;
189 Lisp_Object Qborder_color
;
190 Lisp_Object Qborder_width
;
192 Lisp_Object Qcursor_color
;
193 Lisp_Object Qcursor_type
;
194 Lisp_Object Qgeometry
;
195 Lisp_Object Qicon_left
;
196 Lisp_Object Qicon_top
;
197 Lisp_Object Qicon_type
;
198 Lisp_Object Qicon_name
;
199 Lisp_Object Qinternal_border_width
;
202 Lisp_Object Qmouse_color
;
204 Lisp_Object Qouter_window_id
;
205 Lisp_Object Qparent_id
;
206 Lisp_Object Qscroll_bar_width
;
207 Lisp_Object Qsuppress_icon
;
208 extern Lisp_Object Qtop
;
209 Lisp_Object Qundefined_color
;
210 Lisp_Object Qvertical_scroll_bars
;
211 Lisp_Object Qvisibility
;
212 Lisp_Object Qwindow_id
;
213 Lisp_Object Qx_frame_parameter
;
214 Lisp_Object Qx_resource_name
;
215 Lisp_Object Quser_position
;
216 Lisp_Object Quser_size
;
217 extern Lisp_Object Qdisplay
;
218 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
219 Lisp_Object Qscreen_gamma
, Qline_spacing
, Qcenter
;
220 Lisp_Object Qcompound_text
, Qcancel_timer
;
221 Lisp_Object Qwait_for_wm
;
223 /* The below are defined in frame.c. */
225 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
226 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
227 extern Lisp_Object Qtool_bar_lines
;
229 extern Lisp_Object Vwindow_system_version
;
231 Lisp_Object Qface_set_after_frame_default
;
234 int image_cache_refcount
, dpyinfo_refcount
;
239 /* Error if we are not connected to X. */
245 error ("X windows are not in use or not initialized");
248 /* Nonzero if we can use mouse menus.
249 You should not call this unless HAVE_MENUS is defined. */
257 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
258 and checking validity for X. */
261 check_x_frame (frame
)
267 frame
= selected_frame
;
268 CHECK_LIVE_FRAME (frame
);
271 error ("Non-X frame used");
275 /* Let the user specify an X display with a frame.
276 nil stands for the selected frame--or, if that is not an X frame,
277 the first X display on the list. */
279 static struct x_display_info
*
280 check_x_display_info (frame
)
283 struct x_display_info
*dpyinfo
= NULL
;
287 struct frame
*sf
= XFRAME (selected_frame
);
289 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
290 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
291 else if (x_display_list
!= 0)
292 dpyinfo
= x_display_list
;
294 error ("X windows are not in use or not initialized");
296 else if (STRINGP (frame
))
297 dpyinfo
= x_display_info_for_name (frame
);
302 CHECK_LIVE_FRAME (frame
);
305 error ("Non-X frame used");
306 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
313 /* Return the Emacs frame-object corresponding to an X window.
314 It could be the frame's main window or an icon window. */
316 /* This function can be called during GC, so use GC_xxx type test macros. */
319 x_window_to_frame (dpyinfo
, wdesc
)
320 struct x_display_info
*dpyinfo
;
323 Lisp_Object tail
, frame
;
326 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
329 if (!GC_FRAMEP (frame
))
332 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
334 if (f
->output_data
.x
->hourglass_window
== wdesc
)
337 if ((f
->output_data
.x
->edit_widget
338 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
339 /* A tooltip frame? */
340 || (!f
->output_data
.x
->edit_widget
341 && FRAME_X_WINDOW (f
) == wdesc
)
342 || f
->output_data
.x
->icon_desc
== wdesc
)
344 #else /* not USE_X_TOOLKIT */
345 if (FRAME_X_WINDOW (f
) == wdesc
346 || f
->output_data
.x
->icon_desc
== wdesc
)
348 #endif /* not USE_X_TOOLKIT */
354 /* Like x_window_to_frame but also compares the window with the widget's
358 x_any_window_to_frame (dpyinfo
, wdesc
)
359 struct x_display_info
*dpyinfo
;
362 Lisp_Object tail
, frame
;
363 struct frame
*f
, *found
;
367 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
370 if (!GC_FRAMEP (frame
))
374 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
376 /* This frame matches if the window is any of its widgets. */
377 x
= f
->output_data
.x
;
378 if (x
->hourglass_window
== wdesc
)
382 if (wdesc
== XtWindow (x
->widget
)
383 || wdesc
== XtWindow (x
->column_widget
)
384 || wdesc
== XtWindow (x
->edit_widget
))
386 /* Match if the window is this frame's menubar. */
387 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
390 else if (FRAME_X_WINDOW (f
) == wdesc
)
391 /* A tooltip frame. */
399 /* Likewise, but exclude the menu bar widget. */
402 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
403 struct x_display_info
*dpyinfo
;
406 Lisp_Object tail
, frame
;
410 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
413 if (!GC_FRAMEP (frame
))
416 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
418 x
= f
->output_data
.x
;
419 /* This frame matches if the window is any of its widgets. */
420 if (x
->hourglass_window
== wdesc
)
424 if (wdesc
== XtWindow (x
->widget
)
425 || wdesc
== XtWindow (x
->column_widget
)
426 || wdesc
== XtWindow (x
->edit_widget
))
429 else if (FRAME_X_WINDOW (f
) == wdesc
)
430 /* A tooltip frame. */
436 /* Likewise, but consider only the menu bar widget. */
439 x_menubar_window_to_frame (dpyinfo
, wdesc
)
440 struct x_display_info
*dpyinfo
;
443 Lisp_Object tail
, frame
;
447 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
450 if (!GC_FRAMEP (frame
))
453 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
455 x
= f
->output_data
.x
;
456 /* Match if the window is this frame's menubar. */
457 if (x
->menubar_widget
458 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
464 /* Return the frame whose principal (outermost) window is WDESC.
465 If WDESC is some other (smaller) window, we return 0. */
468 x_top_window_to_frame (dpyinfo
, wdesc
)
469 struct x_display_info
*dpyinfo
;
472 Lisp_Object tail
, frame
;
476 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
479 if (!GC_FRAMEP (frame
))
482 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
484 x
= f
->output_data
.x
;
488 /* This frame matches if the window is its topmost widget. */
489 if (wdesc
== XtWindow (x
->widget
))
491 #if 0 /* I don't know why it did this,
492 but it seems logically wrong,
493 and it causes trouble for MapNotify events. */
494 /* Match if the window is this frame's menubar. */
495 if (x
->menubar_widget
496 && wdesc
== XtWindow (x
->menubar_widget
))
500 else if (FRAME_X_WINDOW (f
) == wdesc
)
506 #endif /* USE_X_TOOLKIT */
510 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
511 id, which is just an int that this section returns. Bitmaps are
512 reference counted so they can be shared among frames.
514 Bitmap indices are guaranteed to be > 0, so a negative number can
515 be used to indicate no bitmap.
517 If you use x_create_bitmap_from_data, then you must keep track of
518 the bitmaps yourself. That is, creating a bitmap from the same
519 data more than once will not be caught. */
522 /* Functions to access the contents of a bitmap, given an id. */
525 x_bitmap_height (f
, id
)
529 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
533 x_bitmap_width (f
, id
)
537 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
541 x_bitmap_pixmap (f
, id
)
545 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
549 /* Allocate a new bitmap record. Returns index of new record. */
552 x_allocate_bitmap_record (f
)
555 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
558 if (dpyinfo
->bitmaps
== NULL
)
560 dpyinfo
->bitmaps_size
= 10;
562 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
563 dpyinfo
->bitmaps_last
= 1;
567 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
568 return ++dpyinfo
->bitmaps_last
;
570 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
571 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
574 dpyinfo
->bitmaps_size
*= 2;
576 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
577 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
578 return ++dpyinfo
->bitmaps_last
;
581 /* Add one reference to the reference count of the bitmap with id ID. */
584 x_reference_bitmap (f
, id
)
588 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
591 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
594 x_create_bitmap_from_data (f
, bits
, width
, height
)
597 unsigned int width
, height
;
599 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
603 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
604 bits
, width
, height
);
609 id
= x_allocate_bitmap_record (f
);
610 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
611 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
612 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
613 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
614 dpyinfo
->bitmaps
[id
- 1].height
= height
;
615 dpyinfo
->bitmaps
[id
- 1].width
= width
;
620 /* Create bitmap from file FILE for frame F. */
623 x_create_bitmap_from_file (f
, file
)
627 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
628 unsigned int width
, height
;
630 int xhot
, yhot
, result
, id
;
635 /* Look for an existing bitmap with the same name. */
636 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
638 if (dpyinfo
->bitmaps
[id
].refcount
639 && dpyinfo
->bitmaps
[id
].file
640 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
642 ++dpyinfo
->bitmaps
[id
].refcount
;
647 /* Search bitmap-file-path for the file, if appropriate. */
648 fd
= openp (Vx_bitmap_file_path
, file
, Qnil
, &found
, 0);
653 filename
= (char *) XSTRING (found
)->data
;
655 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
656 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
657 if (result
!= BitmapSuccess
)
660 id
= x_allocate_bitmap_record (f
);
661 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
662 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
663 dpyinfo
->bitmaps
[id
- 1].file
664 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
665 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
666 dpyinfo
->bitmaps
[id
- 1].height
= height
;
667 dpyinfo
->bitmaps
[id
- 1].width
= width
;
668 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
673 /* Remove reference to bitmap with id number ID. */
676 x_destroy_bitmap (f
, id
)
680 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
684 --dpyinfo
->bitmaps
[id
- 1].refcount
;
685 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
688 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
689 if (dpyinfo
->bitmaps
[id
- 1].file
)
691 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
692 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
699 /* Free all the bitmaps for the display specified by DPYINFO. */
702 x_destroy_all_bitmaps (dpyinfo
)
703 struct x_display_info
*dpyinfo
;
706 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
707 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
709 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
710 if (dpyinfo
->bitmaps
[i
].file
)
711 xfree (dpyinfo
->bitmaps
[i
].file
);
713 dpyinfo
->bitmaps_last
= 0;
716 /* Connect the frame-parameter names for X frames
717 to the ways of passing the parameter values to the window system.
719 The name of a parameter, as a Lisp symbol,
720 has an `x-frame-parameter' property which is an integer in Lisp
721 that is an index in this table. */
723 struct x_frame_parm_table
726 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
729 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
730 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
731 static void x_change_window_heights
P_ ((Lisp_Object
, int));
732 static void x_disable_image
P_ ((struct frame
*, struct image
*));
733 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
734 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
735 static void x_set_wait_for_wm
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
736 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
737 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
738 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
739 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
740 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
741 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
742 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
743 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
744 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
745 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
747 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
750 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
752 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
755 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
760 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
762 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
767 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
768 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
770 static void init_color_table
P_ ((void));
771 static void free_color_table
P_ ((void));
772 static unsigned long *colors_in_color_table
P_ ((int *n
));
773 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
774 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
778 static struct x_frame_parm_table x_frame_parms
[] =
780 "auto-raise", x_set_autoraise
,
781 "auto-lower", x_set_autolower
,
782 "background-color", x_set_background_color
,
783 "border-color", x_set_border_color
,
784 "border-width", x_set_border_width
,
785 "cursor-color", x_set_cursor_color
,
786 "cursor-type", x_set_cursor_type
,
788 "foreground-color", x_set_foreground_color
,
789 "icon-name", x_set_icon_name
,
790 "icon-type", x_set_icon_type
,
791 "internal-border-width", x_set_internal_border_width
,
792 "menu-bar-lines", x_set_menu_bar_lines
,
793 "mouse-color", x_set_mouse_color
,
794 "name", x_explicitly_set_name
,
795 "scroll-bar-width", x_set_scroll_bar_width
,
796 "title", x_set_title
,
797 "unsplittable", x_set_unsplittable
,
798 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
799 "visibility", x_set_visibility
,
800 "tool-bar-lines", x_set_tool_bar_lines
,
801 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
802 "scroll-bar-background", x_set_scroll_bar_background
,
803 "screen-gamma", x_set_screen_gamma
,
804 "line-spacing", x_set_line_spacing
,
805 "wait-for-wm", x_set_wait_for_wm
808 /* Attach the `x-frame-parameter' properties to
809 the Lisp symbol names of parameters relevant to X. */
812 init_x_parm_symbols ()
816 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
817 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
821 /* Change the parameters of frame F as specified by ALIST.
822 If a parameter is not specially recognized, do nothing special;
823 otherwise call the `x_set_...' function for that parameter.
824 Except for certain geometry properties, always call store_frame_param
825 to store the new value in the parameter alist. */
828 x_set_frame_parameters (f
, alist
)
834 /* If both of these parameters are present, it's more efficient to
835 set them both at once. So we wait until we've looked at the
836 entire list before we set them. */
840 Lisp_Object left
, top
;
842 /* Same with these. */
843 Lisp_Object icon_left
, icon_top
;
845 /* Record in these vectors all the parms specified. */
849 int left_no_change
= 0, top_no_change
= 0;
850 int icon_left_no_change
= 0, icon_top_no_change
= 0;
852 struct gcpro gcpro1
, gcpro2
;
855 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
858 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
859 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
861 /* Extract parm names and values into those vectors. */
864 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
869 parms
[i
] = Fcar (elt
);
870 values
[i
] = Fcdr (elt
);
873 /* TAIL and ALIST are not used again below here. */
876 GCPRO2 (*parms
, *values
);
880 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
881 because their values appear in VALUES and strings are not valid. */
882 top
= left
= Qunbound
;
883 icon_left
= icon_top
= Qunbound
;
885 /* Provide default values for HEIGHT and WIDTH. */
886 if (FRAME_NEW_WIDTH (f
))
887 width
= FRAME_NEW_WIDTH (f
);
889 width
= FRAME_WIDTH (f
);
891 if (FRAME_NEW_HEIGHT (f
))
892 height
= FRAME_NEW_HEIGHT (f
);
894 height
= FRAME_HEIGHT (f
);
896 /* Process foreground_color and background_color before anything else.
897 They are independent of other properties, but other properties (e.g.,
898 cursor_color) are dependent upon them. */
899 for (p
= 0; p
< i
; p
++)
901 Lisp_Object prop
, val
;
905 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
907 register Lisp_Object param_index
, old_value
;
909 param_index
= Fget (prop
, Qx_frame_parameter
);
910 old_value
= get_frame_param (f
, prop
);
911 store_frame_param (f
, prop
, val
);
912 if (NATNUMP (param_index
)
913 && (XFASTINT (param_index
)
914 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
915 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
919 /* Now process them in reverse of specified order. */
920 for (i
--; i
>= 0; i
--)
922 Lisp_Object prop
, val
;
927 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
928 width
= XFASTINT (val
);
929 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
930 height
= XFASTINT (val
);
931 else if (EQ (prop
, Qtop
))
933 else if (EQ (prop
, Qleft
))
935 else if (EQ (prop
, Qicon_top
))
937 else if (EQ (prop
, Qicon_left
))
939 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
940 /* Processed above. */
944 register Lisp_Object param_index
, old_value
;
946 param_index
= Fget (prop
, Qx_frame_parameter
);
947 old_value
= get_frame_param (f
, prop
);
948 store_frame_param (f
, prop
, val
);
949 if (NATNUMP (param_index
)
950 && (XFASTINT (param_index
)
951 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
952 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
956 /* Don't die if just one of these was set. */
957 if (EQ (left
, Qunbound
))
960 if (f
->output_data
.x
->left_pos
< 0)
961 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
963 XSETINT (left
, f
->output_data
.x
->left_pos
);
965 if (EQ (top
, Qunbound
))
968 if (f
->output_data
.x
->top_pos
< 0)
969 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
971 XSETINT (top
, f
->output_data
.x
->top_pos
);
974 /* If one of the icon positions was not set, preserve or default it. */
975 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
977 icon_left_no_change
= 1;
978 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
979 if (NILP (icon_left
))
980 XSETINT (icon_left
, 0);
982 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
984 icon_top_no_change
= 1;
985 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
987 XSETINT (icon_top
, 0);
990 /* Don't set these parameters unless they've been explicitly
991 specified. The window might be mapped or resized while we're in
992 this function, and we don't want to override that unless the lisp
993 code has asked for it.
995 Don't set these parameters unless they actually differ from the
996 window's current parameters; the window may not actually exist
1001 check_frame_size (f
, &height
, &width
);
1003 XSETFRAME (frame
, f
);
1005 if (width
!= FRAME_WIDTH (f
)
1006 || height
!= FRAME_HEIGHT (f
)
1007 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1008 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1010 if ((!NILP (left
) || !NILP (top
))
1011 && ! (left_no_change
&& top_no_change
)
1012 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1013 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1018 /* Record the signs. */
1019 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1020 if (EQ (left
, Qminus
))
1021 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1022 else if (INTEGERP (left
))
1024 leftpos
= XINT (left
);
1026 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1028 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1029 && CONSP (XCDR (left
))
1030 && INTEGERP (XCAR (XCDR (left
))))
1032 leftpos
= - XINT (XCAR (XCDR (left
)));
1033 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1035 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1036 && CONSP (XCDR (left
))
1037 && INTEGERP (XCAR (XCDR (left
))))
1039 leftpos
= XINT (XCAR (XCDR (left
)));
1042 if (EQ (top
, Qminus
))
1043 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1044 else if (INTEGERP (top
))
1046 toppos
= XINT (top
);
1048 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1050 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1051 && CONSP (XCDR (top
))
1052 && INTEGERP (XCAR (XCDR (top
))))
1054 toppos
= - XINT (XCAR (XCDR (top
)));
1055 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1057 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1058 && CONSP (XCDR (top
))
1059 && INTEGERP (XCAR (XCDR (top
))))
1061 toppos
= XINT (XCAR (XCDR (top
)));
1065 /* Store the numeric value of the position. */
1066 f
->output_data
.x
->top_pos
= toppos
;
1067 f
->output_data
.x
->left_pos
= leftpos
;
1069 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1071 /* Actually set that position, and convert to absolute. */
1072 x_set_offset (f
, leftpos
, toppos
, -1);
1075 if ((!NILP (icon_left
) || !NILP (icon_top
))
1076 && ! (icon_left_no_change
&& icon_top_no_change
))
1077 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1083 /* Store the screen positions of frame F into XPTR and YPTR.
1084 These are the positions of the containing window manager window,
1085 not Emacs's own window. */
1088 x_real_positions (f
, xptr
, yptr
)
1095 /* This is pretty gross, but seems to be the easiest way out of
1096 the problem that arises when restarting window-managers. */
1098 #ifdef USE_X_TOOLKIT
1099 Window outer
= (f
->output_data
.x
->widget
1100 ? XtWindow (f
->output_data
.x
->widget
)
1101 : FRAME_X_WINDOW (f
));
1103 Window outer
= f
->output_data
.x
->window_desc
;
1105 Window tmp_root_window
;
1106 Window
*tmp_children
;
1107 unsigned int tmp_nchildren
;
1111 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1112 Window outer_window
;
1114 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1115 &f
->output_data
.x
->parent_desc
,
1116 &tmp_children
, &tmp_nchildren
);
1117 XFree ((char *) tmp_children
);
1121 /* Find the position of the outside upper-left corner of
1122 the inner window, with respect to the outer window. */
1123 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1124 outer_window
= f
->output_data
.x
->parent_desc
;
1126 outer_window
= outer
;
1128 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1130 /* From-window, to-window. */
1132 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1134 /* From-position, to-position. */
1135 0, 0, &win_x
, &win_y
,
1140 /* It is possible for the window returned by the XQueryNotify
1141 to become invalid by the time we call XTranslateCoordinates.
1142 That can happen when you restart some window managers.
1143 If so, we get an error in XTranslateCoordinates.
1144 Detect that and try the whole thing over. */
1145 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1147 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1151 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1158 /* Insert a description of internally-recorded parameters of frame X
1159 into the parameter alist *ALISTPTR that is to be given to the user.
1160 Only parameters that are specific to the X window system
1161 and whose values are not correctly recorded in the frame's
1162 param_alist need to be considered here. */
1165 x_report_frame_params (f
, alistptr
)
1167 Lisp_Object
*alistptr
;
1172 /* Represent negative positions (off the top or left screen edge)
1173 in a way that Fmodify_frame_parameters will understand correctly. */
1174 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1175 if (f
->output_data
.x
->left_pos
>= 0)
1176 store_in_alist (alistptr
, Qleft
, tem
);
1178 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1180 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1181 if (f
->output_data
.x
->top_pos
>= 0)
1182 store_in_alist (alistptr
, Qtop
, tem
);
1184 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1186 store_in_alist (alistptr
, Qborder_width
,
1187 make_number (f
->output_data
.x
->border_width
));
1188 store_in_alist (alistptr
, Qinternal_border_width
,
1189 make_number (f
->output_data
.x
->internal_border_width
));
1190 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1191 store_in_alist (alistptr
, Qwindow_id
,
1192 build_string (buf
));
1193 #ifdef USE_X_TOOLKIT
1194 /* Tooltip frame may not have this widget. */
1195 if (f
->output_data
.x
->widget
)
1197 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1198 store_in_alist (alistptr
, Qouter_window_id
,
1199 build_string (buf
));
1200 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1201 FRAME_SAMPLE_VISIBILITY (f
);
1202 store_in_alist (alistptr
, Qvisibility
,
1203 (FRAME_VISIBLE_P (f
) ? Qt
1204 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1205 store_in_alist (alistptr
, Qdisplay
,
1206 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1208 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1211 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1212 store_in_alist (alistptr
, Qparent_id
, tem
);
1217 /* Gamma-correct COLOR on frame F. */
1220 gamma_correct (f
, color
)
1226 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1227 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1228 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1233 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1234 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1235 allocate the color. Value is zero if COLOR_NAME is invalid, or
1236 no color could be allocated. */
1239 x_defined_color (f
, color_name
, color
, alloc_p
)
1246 Display
*dpy
= FRAME_X_DISPLAY (f
);
1247 Colormap cmap
= FRAME_X_COLORMAP (f
);
1250 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1251 if (success_p
&& alloc_p
)
1252 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1259 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1260 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1261 Signal an error if color can't be allocated. */
1264 x_decode_color (f
, color_name
, mono_color
)
1266 Lisp_Object color_name
;
1271 CHECK_STRING (color_name
);
1273 #if 0 /* Don't do this. It's wrong when we're not using the default
1274 colormap, it makes freeing difficult, and it's probably not
1275 an important optimization. */
1276 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1277 return BLACK_PIX_DEFAULT (f
);
1278 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1279 return WHITE_PIX_DEFAULT (f
);
1282 /* Return MONO_COLOR for monochrome frames. */
1283 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1286 /* x_defined_color is responsible for coping with failures
1287 by looking for a near-miss. */
1288 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1291 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1292 Fcons (color_name
, Qnil
)));
1298 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1299 the previous value of that parameter, NEW_VALUE is the new value. */
1302 x_set_line_spacing (f
, new_value
, old_value
)
1304 Lisp_Object new_value
, old_value
;
1306 if (NILP (new_value
))
1307 f
->extra_line_spacing
= 0;
1308 else if (NATNUMP (new_value
))
1309 f
->extra_line_spacing
= XFASTINT (new_value
);
1311 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1312 Fcons (new_value
, Qnil
)));
1313 if (FRAME_VISIBLE_P (f
))
1318 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1319 the previous value of that parameter, NEW_VALUE is the new value.
1320 See also the comment of wait_for_wm in struct x_output. */
1323 x_set_wait_for_wm (f
, new_value
, old_value
)
1325 Lisp_Object new_value
, old_value
;
1327 f
->output_data
.x
->wait_for_wm
= !NILP (new_value
);
1331 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1332 the previous value of that parameter, NEW_VALUE is the new
1336 x_set_screen_gamma (f
, new_value
, old_value
)
1338 Lisp_Object new_value
, old_value
;
1340 if (NILP (new_value
))
1342 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1343 /* The value 0.4545 is the normal viewing gamma. */
1344 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1346 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1347 Fcons (new_value
, Qnil
)));
1349 clear_face_cache (0);
1353 /* Functions called only from `x_set_frame_param'
1354 to set individual parameters.
1356 If FRAME_X_WINDOW (f) is 0,
1357 the frame is being created and its X-window does not exist yet.
1358 In that case, just record the parameter's new value
1359 in the standard place; do not attempt to change the window. */
1362 x_set_foreground_color (f
, arg
, oldval
)
1364 Lisp_Object arg
, oldval
;
1366 struct x_output
*x
= f
->output_data
.x
;
1367 unsigned long fg
, old_fg
;
1369 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1370 old_fg
= x
->foreground_pixel
;
1371 x
->foreground_pixel
= fg
;
1373 if (FRAME_X_WINDOW (f
) != 0)
1375 Display
*dpy
= FRAME_X_DISPLAY (f
);
1378 XSetForeground (dpy
, x
->normal_gc
, fg
);
1379 XSetBackground (dpy
, x
->reverse_gc
, fg
);
1381 if (x
->cursor_pixel
== old_fg
)
1383 unload_color (f
, x
->cursor_pixel
);
1384 x
->cursor_pixel
= x_copy_color (f
, fg
);
1385 XSetBackground (dpy
, x
->cursor_gc
, x
->cursor_pixel
);
1390 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1392 if (FRAME_VISIBLE_P (f
))
1396 unload_color (f
, old_fg
);
1400 x_set_background_color (f
, arg
, oldval
)
1402 Lisp_Object arg
, oldval
;
1404 struct x_output
*x
= f
->output_data
.x
;
1407 bg
= x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1408 unload_color (f
, x
->background_pixel
);
1409 x
->background_pixel
= bg
;
1411 if (FRAME_X_WINDOW (f
) != 0)
1413 Display
*dpy
= FRAME_X_DISPLAY (f
);
1416 XSetBackground (dpy
, x
->normal_gc
, bg
);
1417 XSetForeground (dpy
, x
->reverse_gc
, bg
);
1418 XSetWindowBackground (dpy
, FRAME_X_WINDOW (f
), bg
);
1419 XSetForeground (dpy
, x
->cursor_gc
, bg
);
1421 #ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1422 toolkit scroll bars. */
1425 for (bar
= FRAME_SCROLL_BARS (f
);
1427 bar
= XSCROLL_BAR (bar
)->next
)
1429 Window window
= SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
));
1430 XSetWindowBackground (dpy
, window
, bg
);
1433 #endif /* USE_TOOLKIT_SCROLL_BARS */
1436 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1438 if (FRAME_VISIBLE_P (f
))
1444 x_set_mouse_color (f
, arg
, oldval
)
1446 Lisp_Object arg
, oldval
;
1448 struct x_output
*x
= f
->output_data
.x
;
1449 Display
*dpy
= FRAME_X_DISPLAY (f
);
1450 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1451 Cursor hourglass_cursor
, horizontal_drag_cursor
;
1453 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1454 unsigned long mask_color
= x
->background_pixel
;
1456 /* Don't let pointers be invisible. */
1457 if (mask_color
== pixel
)
1459 x_free_colors (f
, &pixel
, 1);
1460 pixel
= x_copy_color (f
, x
->foreground_pixel
);
1463 unload_color (f
, x
->mouse_pixel
);
1464 x
->mouse_pixel
= pixel
;
1468 /* It's not okay to crash if the user selects a screwy cursor. */
1469 count
= x_catch_errors (dpy
);
1471 if (!NILP (Vx_pointer_shape
))
1473 CHECK_NUMBER (Vx_pointer_shape
);
1474 cursor
= XCreateFontCursor (dpy
, XINT (Vx_pointer_shape
));
1477 cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1478 x_check_errors (dpy
, "bad text pointer cursor: %s");
1480 if (!NILP (Vx_nontext_pointer_shape
))
1482 CHECK_NUMBER (Vx_nontext_pointer_shape
);
1484 = XCreateFontCursor (dpy
, XINT (Vx_nontext_pointer_shape
));
1487 nontext_cursor
= XCreateFontCursor (dpy
, XC_left_ptr
);
1488 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1490 if (!NILP (Vx_hourglass_pointer_shape
))
1492 CHECK_NUMBER (Vx_hourglass_pointer_shape
);
1494 = XCreateFontCursor (dpy
, XINT (Vx_hourglass_pointer_shape
));
1497 hourglass_cursor
= XCreateFontCursor (dpy
, XC_watch
);
1498 x_check_errors (dpy
, "bad hourglass pointer cursor: %s");
1500 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1501 if (!NILP (Vx_mode_pointer_shape
))
1503 CHECK_NUMBER (Vx_mode_pointer_shape
);
1504 mode_cursor
= XCreateFontCursor (dpy
, XINT (Vx_mode_pointer_shape
));
1507 mode_cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1508 x_check_errors (dpy
, "bad modeline pointer cursor: %s");
1510 if (!NILP (Vx_sensitive_text_pointer_shape
))
1512 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
);
1514 = XCreateFontCursor (dpy
, XINT (Vx_sensitive_text_pointer_shape
));
1517 cross_cursor
= XCreateFontCursor (dpy
, XC_crosshair
);
1519 if (!NILP (Vx_window_horizontal_drag_shape
))
1521 CHECK_NUMBER (Vx_window_horizontal_drag_shape
);
1522 horizontal_drag_cursor
1523 = XCreateFontCursor (dpy
, XINT (Vx_window_horizontal_drag_shape
));
1526 horizontal_drag_cursor
1527 = XCreateFontCursor (dpy
, XC_sb_h_double_arrow
);
1529 /* Check and report errors with the above calls. */
1530 x_check_errors (dpy
, "can't set cursor shape: %s");
1531 x_uncatch_errors (dpy
, count
);
1534 XColor fore_color
, back_color
;
1536 fore_color
.pixel
= x
->mouse_pixel
;
1537 x_query_color (f
, &fore_color
);
1538 back_color
.pixel
= mask_color
;
1539 x_query_color (f
, &back_color
);
1541 XRecolorCursor (dpy
, cursor
, &fore_color
, &back_color
);
1542 XRecolorCursor (dpy
, nontext_cursor
, &fore_color
, &back_color
);
1543 XRecolorCursor (dpy
, mode_cursor
, &fore_color
, &back_color
);
1544 XRecolorCursor (dpy
, cross_cursor
, &fore_color
, &back_color
);
1545 XRecolorCursor (dpy
, hourglass_cursor
, &fore_color
, &back_color
);
1546 XRecolorCursor (dpy
, horizontal_drag_cursor
, &fore_color
, &back_color
);
1549 if (FRAME_X_WINDOW (f
) != 0)
1550 XDefineCursor (dpy
, FRAME_X_WINDOW (f
), cursor
);
1552 if (cursor
!= x
->text_cursor
1553 && x
->text_cursor
!= 0)
1554 XFreeCursor (dpy
, x
->text_cursor
);
1555 x
->text_cursor
= cursor
;
1557 if (nontext_cursor
!= x
->nontext_cursor
1558 && x
->nontext_cursor
!= 0)
1559 XFreeCursor (dpy
, x
->nontext_cursor
);
1560 x
->nontext_cursor
= nontext_cursor
;
1562 if (hourglass_cursor
!= x
->hourglass_cursor
1563 && x
->hourglass_cursor
!= 0)
1564 XFreeCursor (dpy
, x
->hourglass_cursor
);
1565 x
->hourglass_cursor
= hourglass_cursor
;
1567 if (mode_cursor
!= x
->modeline_cursor
1568 && x
->modeline_cursor
!= 0)
1569 XFreeCursor (dpy
, f
->output_data
.x
->modeline_cursor
);
1570 x
->modeline_cursor
= mode_cursor
;
1572 if (cross_cursor
!= x
->cross_cursor
1573 && x
->cross_cursor
!= 0)
1574 XFreeCursor (dpy
, x
->cross_cursor
);
1575 x
->cross_cursor
= cross_cursor
;
1577 if (horizontal_drag_cursor
!= x
->horizontal_drag_cursor
1578 && x
->horizontal_drag_cursor
!= 0)
1579 XFreeCursor (dpy
, x
->horizontal_drag_cursor
);
1580 x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1585 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1589 x_set_cursor_color (f
, arg
, oldval
)
1591 Lisp_Object arg
, oldval
;
1593 unsigned long fore_pixel
, pixel
;
1594 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1595 struct x_output
*x
= f
->output_data
.x
;
1597 if (!NILP (Vx_cursor_fore_pixel
))
1599 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1600 WHITE_PIX_DEFAULT (f
));
1601 fore_pixel_allocated_p
= 1;
1604 fore_pixel
= x
->background_pixel
;
1606 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1607 pixel_allocated_p
= 1;
1609 /* Make sure that the cursor color differs from the background color. */
1610 if (pixel
== x
->background_pixel
)
1612 if (pixel_allocated_p
)
1614 x_free_colors (f
, &pixel
, 1);
1615 pixel_allocated_p
= 0;
1618 pixel
= x
->mouse_pixel
;
1619 if (pixel
== fore_pixel
)
1621 if (fore_pixel_allocated_p
)
1623 x_free_colors (f
, &fore_pixel
, 1);
1624 fore_pixel_allocated_p
= 0;
1626 fore_pixel
= x
->background_pixel
;
1630 unload_color (f
, x
->cursor_foreground_pixel
);
1631 if (!fore_pixel_allocated_p
)
1632 fore_pixel
= x_copy_color (f
, fore_pixel
);
1633 x
->cursor_foreground_pixel
= fore_pixel
;
1635 unload_color (f
, x
->cursor_pixel
);
1636 if (!pixel_allocated_p
)
1637 pixel
= x_copy_color (f
, pixel
);
1638 x
->cursor_pixel
= pixel
;
1640 if (FRAME_X_WINDOW (f
) != 0)
1643 XSetBackground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, x
->cursor_pixel
);
1644 XSetForeground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, fore_pixel
);
1647 if (FRAME_VISIBLE_P (f
))
1649 x_update_cursor (f
, 0);
1650 x_update_cursor (f
, 1);
1654 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1657 /* Set the border-color of frame F to value described by ARG.
1658 ARG can be a string naming a color.
1659 The border-color is used for the border that is drawn by the X server.
1660 Note that this does not fully take effect if done before
1661 F has an x-window; it must be redone when the window is created.
1663 Note: this is done in two routines because of the way X10 works.
1665 Note: under X11, this is normally the province of the window manager,
1666 and so emacs' border colors may be overridden. */
1669 x_set_border_color (f
, arg
, oldval
)
1671 Lisp_Object arg
, oldval
;
1676 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1677 x_set_border_pixel (f
, pix
);
1678 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1681 /* Set the border-color of frame F to pixel value PIX.
1682 Note that this does not fully take effect if done before
1683 F has an x-window. */
1686 x_set_border_pixel (f
, pix
)
1690 unload_color (f
, f
->output_data
.x
->border_pixel
);
1691 f
->output_data
.x
->border_pixel
= pix
;
1693 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1696 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1697 (unsigned long)pix
);
1700 if (FRAME_VISIBLE_P (f
))
1706 /* Value is the internal representation of the specified cursor type
1707 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1708 of the bar cursor. */
1710 enum text_cursor_kinds
1711 x_specified_cursor_type (arg
, width
)
1715 enum text_cursor_kinds type
;
1722 else if (CONSP (arg
)
1723 && EQ (XCAR (arg
), Qbar
)
1724 && INTEGERP (XCDR (arg
))
1725 && XINT (XCDR (arg
)) >= 0)
1728 *width
= XINT (XCDR (arg
));
1730 else if (NILP (arg
))
1733 /* Treat anything unknown as "box cursor".
1734 It was bad to signal an error; people have trouble fixing
1735 .Xdefaults with Emacs, when it has something bad in it. */
1736 type
= FILLED_BOX_CURSOR
;
1742 x_set_cursor_type (f
, arg
, oldval
)
1744 Lisp_Object arg
, oldval
;
1748 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1749 f
->output_data
.x
->cursor_width
= width
;
1751 /* Make sure the cursor gets redrawn. This is overkill, but how
1752 often do people change cursor types? */
1753 update_mode_lines
++;
1757 x_set_icon_type (f
, arg
, oldval
)
1759 Lisp_Object arg
, oldval
;
1765 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1768 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1773 result
= x_text_icon (f
,
1774 (char *) XSTRING ((!NILP (f
->icon_name
)
1778 result
= x_bitmap_icon (f
, arg
);
1783 error ("No icon window available");
1786 XFlush (FRAME_X_DISPLAY (f
));
1790 /* Return non-nil if frame F wants a bitmap icon. */
1798 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1806 x_set_icon_name (f
, arg
, oldval
)
1808 Lisp_Object arg
, oldval
;
1814 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1817 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1822 if (f
->output_data
.x
->icon_bitmap
!= 0)
1827 result
= x_text_icon (f
,
1828 (char *) XSTRING ((!NILP (f
->icon_name
)
1837 error ("No icon window available");
1840 XFlush (FRAME_X_DISPLAY (f
));
1845 x_set_font (f
, arg
, oldval
)
1847 Lisp_Object arg
, oldval
;
1850 Lisp_Object fontset_name
;
1852 int old_fontset
= f
->output_data
.x
->fontset
;
1856 fontset_name
= Fquery_fontset (arg
, Qnil
);
1859 result
= (STRINGP (fontset_name
)
1860 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1861 : x_new_font (f
, XSTRING (arg
)->data
));
1864 if (EQ (result
, Qnil
))
1865 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1866 else if (EQ (result
, Qt
))
1867 error ("The characters of the given font have varying widths");
1868 else if (STRINGP (result
))
1870 if (STRINGP (fontset_name
))
1872 /* Fontset names are built from ASCII font names, so the
1873 names may be equal despite there was a change. */
1874 if (old_fontset
== f
->output_data
.x
->fontset
)
1877 else if (!NILP (Fequal (result
, oldval
)))
1880 store_frame_param (f
, Qfont
, result
);
1881 recompute_basic_faces (f
);
1886 do_pending_window_change (0);
1888 /* Don't call `face-set-after-frame-default' when faces haven't been
1889 initialized yet. This is the case when called from
1890 Fx_create_frame. In that case, the X widget or window doesn't
1891 exist either, and we can end up in x_report_frame_params with a
1892 null widget which gives a segfault. */
1893 if (FRAME_FACE_CACHE (f
))
1895 XSETFRAME (frame
, f
);
1896 call1 (Qface_set_after_frame_default
, frame
);
1901 x_set_border_width (f
, arg
, oldval
)
1903 Lisp_Object arg
, oldval
;
1907 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1910 if (FRAME_X_WINDOW (f
) != 0)
1911 error ("Cannot change the border width of a window");
1913 f
->output_data
.x
->border_width
= XINT (arg
);
1917 x_set_internal_border_width (f
, arg
, oldval
)
1919 Lisp_Object arg
, oldval
;
1921 int old
= f
->output_data
.x
->internal_border_width
;
1924 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1925 if (f
->output_data
.x
->internal_border_width
< 0)
1926 f
->output_data
.x
->internal_border_width
= 0;
1928 #ifdef USE_X_TOOLKIT
1929 if (f
->output_data
.x
->edit_widget
)
1930 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1933 if (f
->output_data
.x
->internal_border_width
== old
)
1936 if (FRAME_X_WINDOW (f
) != 0)
1938 x_set_window_size (f
, 0, f
->width
, f
->height
);
1939 SET_FRAME_GARBAGED (f
);
1940 do_pending_window_change (0);
1943 SET_FRAME_GARBAGED (f
);
1947 x_set_visibility (f
, value
, oldval
)
1949 Lisp_Object value
, oldval
;
1952 XSETFRAME (frame
, f
);
1955 Fmake_frame_invisible (frame
, Qt
);
1956 else if (EQ (value
, Qicon
))
1957 Ficonify_frame (frame
);
1959 Fmake_frame_visible (frame
);
1963 /* Change window heights in windows rooted in WINDOW by N lines. */
1966 x_change_window_heights (window
, n
)
1970 struct window
*w
= XWINDOW (window
);
1972 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1973 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1975 if (INTEGERP (w
->orig_top
))
1976 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1977 if (INTEGERP (w
->orig_height
))
1978 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1980 /* Handle just the top child in a vertical split. */
1981 if (!NILP (w
->vchild
))
1982 x_change_window_heights (w
->vchild
, n
);
1984 /* Adjust all children in a horizontal split. */
1985 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1987 w
= XWINDOW (window
);
1988 x_change_window_heights (window
, n
);
1993 x_set_menu_bar_lines (f
, value
, oldval
)
1995 Lisp_Object value
, oldval
;
1998 #ifndef USE_X_TOOLKIT
1999 int olines
= FRAME_MENU_BAR_LINES (f
);
2002 /* Right now, menu bars don't work properly in minibuf-only frames;
2003 most of the commands try to apply themselves to the minibuffer
2004 frame itself, and get an error because you can't switch buffers
2005 in or split the minibuffer window. */
2006 if (FRAME_MINIBUF_ONLY_P (f
))
2009 if (INTEGERP (value
))
2010 nlines
= XINT (value
);
2014 /* Make sure we redisplay all windows in this frame. */
2015 windows_or_buffers_changed
++;
2017 #ifdef USE_X_TOOLKIT
2018 FRAME_MENU_BAR_LINES (f
) = 0;
2021 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2022 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
2023 /* Make sure next redisplay shows the menu bar. */
2024 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2028 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2029 free_frame_menubar (f
);
2030 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2032 f
->output_data
.x
->menubar_widget
= 0;
2034 #else /* not USE_X_TOOLKIT */
2035 FRAME_MENU_BAR_LINES (f
) = nlines
;
2036 x_change_window_heights (f
->root_window
, nlines
- olines
);
2037 #endif /* not USE_X_TOOLKIT */
2042 /* Set the number of lines used for the tool bar of frame F to VALUE.
2043 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2044 is the old number of tool bar lines. This function changes the
2045 height of all windows on frame F to match the new tool bar height.
2046 The frame's height doesn't change. */
2049 x_set_tool_bar_lines (f
, value
, oldval
)
2051 Lisp_Object value
, oldval
;
2053 int delta
, nlines
, root_height
;
2054 Lisp_Object root_window
;
2056 /* Treat tool bars like menu bars. */
2057 if (FRAME_MINIBUF_ONLY_P (f
))
2060 /* Use VALUE only if an integer >= 0. */
2061 if (INTEGERP (value
) && XINT (value
) >= 0)
2062 nlines
= XFASTINT (value
);
2066 /* Make sure we redisplay all windows in this frame. */
2067 ++windows_or_buffers_changed
;
2069 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2071 /* Don't resize the tool-bar to more than we have room for. */
2072 root_window
= FRAME_ROOT_WINDOW (f
);
2073 root_height
= XINT (XWINDOW (root_window
)->height
);
2074 if (root_height
- delta
< 1)
2076 delta
= root_height
- 1;
2077 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2080 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2081 x_change_window_heights (root_window
, delta
);
2084 /* We also have to make sure that the internal border at the top of
2085 the frame, below the menu bar or tool bar, is redrawn when the
2086 tool bar disappears. This is so because the internal border is
2087 below the tool bar if one is displayed, but is below the menu bar
2088 if there isn't a tool bar. The tool bar draws into the area
2089 below the menu bar. */
2090 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2094 clear_current_matrices (f
);
2095 updating_frame
= NULL
;
2098 /* If the tool bar gets smaller, the internal border below it
2099 has to be cleared. It was formerly part of the display
2100 of the larger tool bar, and updating windows won't clear it. */
2103 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2104 int width
= PIXEL_WIDTH (f
);
2105 int y
= nlines
* CANON_Y_UNIT (f
);
2108 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2109 0, y
, width
, height
, False
);
2112 if (WINDOWP (f
->tool_bar_window
))
2113 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2118 /* Set the foreground color for scroll bars on frame F to VALUE.
2119 VALUE should be a string, a color name. If it isn't a string or
2120 isn't a valid color name, do nothing. OLDVAL is the old value of
2121 the frame parameter. */
2124 x_set_scroll_bar_foreground (f
, value
, oldval
)
2126 Lisp_Object value
, oldval
;
2128 unsigned long pixel
;
2130 if (STRINGP (value
))
2131 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2135 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2136 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2138 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2139 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2141 /* Remove all scroll bars because they have wrong colors. */
2142 if (condemn_scroll_bars_hook
)
2143 (*condemn_scroll_bars_hook
) (f
);
2144 if (judge_scroll_bars_hook
)
2145 (*judge_scroll_bars_hook
) (f
);
2147 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2153 /* Set the background color for scroll bars on frame F to VALUE VALUE
2154 should be a string, a color name. If it isn't a string or isn't a
2155 valid color name, do nothing. OLDVAL is the old value of the frame
2159 x_set_scroll_bar_background (f
, value
, oldval
)
2161 Lisp_Object value
, oldval
;
2163 unsigned long pixel
;
2165 if (STRINGP (value
))
2166 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2170 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2171 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2173 #ifdef USE_TOOLKIT_SCROLL_BARS
2174 /* Scrollbar shadow colors. */
2175 if (f
->output_data
.x
->scroll_bar_top_shadow_pixel
!= -1)
2177 unload_color (f
, f
->output_data
.x
->scroll_bar_top_shadow_pixel
);
2178 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
2180 if (f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
!= -1)
2182 unload_color (f
, f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
);
2183 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
2185 #endif /* USE_TOOLKIT_SCROLL_BARS */
2187 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2188 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2190 /* Remove all scroll bars because they have wrong colors. */
2191 if (condemn_scroll_bars_hook
)
2192 (*condemn_scroll_bars_hook
) (f
);
2193 if (judge_scroll_bars_hook
)
2194 (*judge_scroll_bars_hook
) (f
);
2196 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2202 /* Encode Lisp string STRING as a text in a format appropriate for
2203 XICCC (X Inter Client Communication Conventions).
2205 If STRING contains only ASCII characters, do no conversion and
2206 return the string data of STRING. Otherwise, encode the text by
2207 CODING_SYSTEM, and return a newly allocated memory area which
2208 should be freed by `xfree' by a caller.
2210 Store the byte length of resulting text in *TEXT_BYTES.
2212 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2213 which means that the `encoding' of the result can be `STRING'.
2214 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2215 the result should be `COMPOUND_TEXT'. */
2218 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2219 Lisp_Object string
, coding_system
;
2220 int *text_bytes
, *stringp
;
2222 unsigned char *str
= XSTRING (string
)->data
;
2223 int chars
= XSTRING (string
)->size
;
2224 int bytes
= STRING_BYTES (XSTRING (string
));
2228 struct coding_system coding
;
2230 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2231 if (charset_info
== 0)
2233 /* No multibyte character in OBJ. We need not encode it. */
2234 *text_bytes
= bytes
;
2239 setup_coding_system (coding_system
, &coding
);
2240 coding
.src_multibyte
= 1;
2241 coding
.dst_multibyte
= 0;
2242 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2243 if (coding
.type
== coding_type_iso2022
)
2244 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2245 /* We suppress producing escape sequences for composition. */
2246 coding
.composing
= COMPOSITION_DISABLED
;
2247 bufsize
= encoding_buffer_size (&coding
, bytes
);
2248 buf
= (unsigned char *) xmalloc (bufsize
);
2249 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2250 *text_bytes
= coding
.produced
;
2251 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2256 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2259 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2260 name; if NAME is a string, set F's name to NAME and set
2261 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2263 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2264 suggesting a new name, which lisp code should override; if
2265 F->explicit_name is set, ignore the new name; otherwise, set it. */
2268 x_set_name (f
, name
, explicit)
2273 /* Make sure that requests from lisp code override requests from
2274 Emacs redisplay code. */
2277 /* If we're switching from explicit to implicit, we had better
2278 update the mode lines and thereby update the title. */
2279 if (f
->explicit_name
&& NILP (name
))
2280 update_mode_lines
= 1;
2282 f
->explicit_name
= ! NILP (name
);
2284 else if (f
->explicit_name
)
2287 /* If NAME is nil, set the name to the x_id_name. */
2290 /* Check for no change needed in this very common case
2291 before we do any consing. */
2292 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2293 XSTRING (f
->name
)->data
))
2295 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2298 CHECK_STRING (name
);
2300 /* Don't change the name if it's already NAME. */
2301 if (! NILP (Fstring_equal (name
, f
->name
)))
2306 /* For setting the frame title, the title parameter should override
2307 the name parameter. */
2308 if (! NILP (f
->title
))
2311 if (FRAME_X_WINDOW (f
))
2316 XTextProperty text
, icon
;
2318 Lisp_Object coding_system
;
2320 coding_system
= Vlocale_coding_system
;
2321 if (NILP (coding_system
))
2322 coding_system
= Qcompound_text
;
2323 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2324 text
.encoding
= (stringp
? XA_STRING
2325 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2327 text
.nitems
= bytes
;
2329 if (NILP (f
->icon_name
))
2335 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2337 icon
.encoding
= (stringp
? XA_STRING
2338 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2340 icon
.nitems
= bytes
;
2342 #ifdef USE_X_TOOLKIT
2343 XSetWMName (FRAME_X_DISPLAY (f
),
2344 XtWindow (f
->output_data
.x
->widget
), &text
);
2345 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2347 #else /* not USE_X_TOOLKIT */
2348 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2349 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2350 #endif /* not USE_X_TOOLKIT */
2351 if (!NILP (f
->icon_name
)
2352 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2354 if (text
.value
!= XSTRING (name
)->data
)
2357 #else /* not HAVE_X11R4 */
2358 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2359 XSTRING (name
)->data
);
2360 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2361 XSTRING (name
)->data
);
2362 #endif /* not HAVE_X11R4 */
2367 /* This function should be called when the user's lisp code has
2368 specified a name for the frame; the name will override any set by the
2371 x_explicitly_set_name (f
, arg
, oldval
)
2373 Lisp_Object arg
, oldval
;
2375 x_set_name (f
, arg
, 1);
2378 /* This function should be called by Emacs redisplay code to set the
2379 name; names set this way will never override names set by the user's
2382 x_implicitly_set_name (f
, arg
, oldval
)
2384 Lisp_Object arg
, oldval
;
2386 x_set_name (f
, arg
, 0);
2389 /* Change the title of frame F to NAME.
2390 If NAME is nil, use the frame name as the title.
2392 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2393 name; if NAME is a string, set F's name to NAME and set
2394 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2396 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2397 suggesting a new name, which lisp code should override; if
2398 F->explicit_name is set, ignore the new name; otherwise, set it. */
2401 x_set_title (f
, name
, old_name
)
2403 Lisp_Object name
, old_name
;
2405 /* Don't change the title if it's already NAME. */
2406 if (EQ (name
, f
->title
))
2409 update_mode_lines
= 1;
2416 CHECK_STRING (name
);
2418 if (FRAME_X_WINDOW (f
))
2423 XTextProperty text
, icon
;
2425 Lisp_Object coding_system
;
2427 coding_system
= Vlocale_coding_system
;
2428 if (NILP (coding_system
))
2429 coding_system
= Qcompound_text
;
2430 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2431 text
.encoding
= (stringp
? XA_STRING
2432 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2434 text
.nitems
= bytes
;
2436 if (NILP (f
->icon_name
))
2442 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2444 icon
.encoding
= (stringp
? XA_STRING
2445 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2447 icon
.nitems
= bytes
;
2449 #ifdef USE_X_TOOLKIT
2450 XSetWMName (FRAME_X_DISPLAY (f
),
2451 XtWindow (f
->output_data
.x
->widget
), &text
);
2452 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2454 #else /* not USE_X_TOOLKIT */
2455 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2456 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2457 #endif /* not USE_X_TOOLKIT */
2458 if (!NILP (f
->icon_name
)
2459 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2461 if (text
.value
!= XSTRING (name
)->data
)
2464 #else /* not HAVE_X11R4 */
2465 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2466 XSTRING (name
)->data
);
2467 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2468 XSTRING (name
)->data
);
2469 #endif /* not HAVE_X11R4 */
2475 x_set_autoraise (f
, arg
, oldval
)
2477 Lisp_Object arg
, oldval
;
2479 f
->auto_raise
= !EQ (Qnil
, arg
);
2483 x_set_autolower (f
, arg
, oldval
)
2485 Lisp_Object arg
, oldval
;
2487 f
->auto_lower
= !EQ (Qnil
, arg
);
2491 x_set_unsplittable (f
, arg
, oldval
)
2493 Lisp_Object arg
, oldval
;
2495 f
->no_split
= !NILP (arg
);
2499 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2501 Lisp_Object arg
, oldval
;
2503 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2504 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2505 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2506 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2508 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2510 ? vertical_scroll_bar_none
2512 ? vertical_scroll_bar_right
2513 : vertical_scroll_bar_left
);
2515 /* We set this parameter before creating the X window for the
2516 frame, so we can get the geometry right from the start.
2517 However, if the window hasn't been created yet, we shouldn't
2518 call x_set_window_size. */
2519 if (FRAME_X_WINDOW (f
))
2520 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2521 do_pending_window_change (0);
2526 x_set_scroll_bar_width (f
, arg
, oldval
)
2528 Lisp_Object arg
, oldval
;
2530 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2534 #ifdef USE_TOOLKIT_SCROLL_BARS
2535 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2536 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2537 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2538 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2540 /* Make the actual width at least 14 pixels and a multiple of a
2542 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2544 /* Use all of that space (aside from required margins) for the
2546 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2549 if (FRAME_X_WINDOW (f
))
2550 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2551 do_pending_window_change (0);
2553 else if (INTEGERP (arg
) && XINT (arg
) > 0
2554 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2556 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2557 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2559 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2560 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2561 if (FRAME_X_WINDOW (f
))
2562 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2565 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2566 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2567 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2572 /* Subroutines of creating an X frame. */
2574 /* Make sure that Vx_resource_name is set to a reasonable value.
2575 Fix it up, or set it to `emacs' if it is too hopeless. */
2578 validate_x_resource_name ()
2581 /* Number of valid characters in the resource name. */
2583 /* Number of invalid characters in the resource name. */
2588 if (!STRINGP (Vx_resource_class
))
2589 Vx_resource_class
= build_string (EMACS_CLASS
);
2591 if (STRINGP (Vx_resource_name
))
2593 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2596 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2598 /* Only letters, digits, - and _ are valid in resource names.
2599 Count the valid characters and count the invalid ones. */
2600 for (i
= 0; i
< len
; i
++)
2603 if (! ((c
>= 'a' && c
<= 'z')
2604 || (c
>= 'A' && c
<= 'Z')
2605 || (c
>= '0' && c
<= '9')
2606 || c
== '-' || c
== '_'))
2613 /* Not a string => completely invalid. */
2614 bad_count
= 5, good_count
= 0;
2616 /* If name is valid already, return. */
2620 /* If name is entirely invalid, or nearly so, use `emacs'. */
2622 || (good_count
== 1 && bad_count
> 0))
2624 Vx_resource_name
= build_string ("emacs");
2628 /* Name is partly valid. Copy it and replace the invalid characters
2629 with underscores. */
2631 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2633 for (i
= 0; i
< len
; i
++)
2635 int c
= XSTRING (new)->data
[i
];
2636 if (! ((c
>= 'a' && c
<= 'z')
2637 || (c
>= 'A' && c
<= 'Z')
2638 || (c
>= '0' && c
<= '9')
2639 || c
== '-' || c
== '_'))
2640 XSTRING (new)->data
[i
] = '_';
2645 extern char *x_get_string_resource ();
2647 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2648 doc
: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
2649 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
2650 class, where INSTANCE is the name under which Emacs was invoked, or
2651 the name specified by the `-name' or `-rn' command-line arguments.
2653 The optional arguments COMPONENT and SUBCLASS add to the key and the
2654 class, respectively. You must specify both of them or neither.
2655 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
2656 and the class is `Emacs.CLASS.SUBCLASS'. */)
2657 (attribute
, class, component
, subclass
)
2658 Lisp_Object attribute
, class, component
, subclass
;
2660 register char *value
;
2666 CHECK_STRING (attribute
);
2667 CHECK_STRING (class);
2669 if (!NILP (component
))
2670 CHECK_STRING (component
);
2671 if (!NILP (subclass
))
2672 CHECK_STRING (subclass
);
2673 if (NILP (component
) != NILP (subclass
))
2674 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2676 validate_x_resource_name ();
2678 /* Allocate space for the components, the dots which separate them,
2679 and the final '\0'. Make them big enough for the worst case. */
2680 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2681 + (STRINGP (component
)
2682 ? STRING_BYTES (XSTRING (component
)) : 0)
2683 + STRING_BYTES (XSTRING (attribute
))
2686 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2687 + STRING_BYTES (XSTRING (class))
2688 + (STRINGP (subclass
)
2689 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2692 /* Start with emacs.FRAMENAME for the name (the specific one)
2693 and with `Emacs' for the class key (the general one). */
2694 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2695 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2697 strcat (class_key
, ".");
2698 strcat (class_key
, XSTRING (class)->data
);
2700 if (!NILP (component
))
2702 strcat (class_key
, ".");
2703 strcat (class_key
, XSTRING (subclass
)->data
);
2705 strcat (name_key
, ".");
2706 strcat (name_key
, XSTRING (component
)->data
);
2709 strcat (name_key
, ".");
2710 strcat (name_key
, XSTRING (attribute
)->data
);
2712 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2713 name_key
, class_key
);
2715 if (value
!= (char *) 0)
2716 return build_string (value
);
2721 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2724 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2725 struct x_display_info
*dpyinfo
;
2726 Lisp_Object attribute
, class, component
, subclass
;
2728 register char *value
;
2732 CHECK_STRING (attribute
);
2733 CHECK_STRING (class);
2735 if (!NILP (component
))
2736 CHECK_STRING (component
);
2737 if (!NILP (subclass
))
2738 CHECK_STRING (subclass
);
2739 if (NILP (component
) != NILP (subclass
))
2740 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2742 validate_x_resource_name ();
2744 /* Allocate space for the components, the dots which separate them,
2745 and the final '\0'. Make them big enough for the worst case. */
2746 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2747 + (STRINGP (component
)
2748 ? STRING_BYTES (XSTRING (component
)) : 0)
2749 + STRING_BYTES (XSTRING (attribute
))
2752 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2753 + STRING_BYTES (XSTRING (class))
2754 + (STRINGP (subclass
)
2755 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2758 /* Start with emacs.FRAMENAME for the name (the specific one)
2759 and with `Emacs' for the class key (the general one). */
2760 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2761 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2763 strcat (class_key
, ".");
2764 strcat (class_key
, XSTRING (class)->data
);
2766 if (!NILP (component
))
2768 strcat (class_key
, ".");
2769 strcat (class_key
, XSTRING (subclass
)->data
);
2771 strcat (name_key
, ".");
2772 strcat (name_key
, XSTRING (component
)->data
);
2775 strcat (name_key
, ".");
2776 strcat (name_key
, XSTRING (attribute
)->data
);
2778 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2780 if (value
!= (char *) 0)
2781 return build_string (value
);
2786 /* Used when C code wants a resource value. */
2789 x_get_resource_string (attribute
, class)
2790 char *attribute
, *class;
2794 struct frame
*sf
= SELECTED_FRAME ();
2796 /* Allocate space for the components, the dots which separate them,
2797 and the final '\0'. */
2798 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2799 + strlen (attribute
) + 2);
2800 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2801 + strlen (class) + 2);
2803 sprintf (name_key
, "%s.%s",
2804 XSTRING (Vinvocation_name
)->data
,
2806 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2808 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2809 name_key
, class_key
);
2812 /* Types we might convert a resource string into. */
2822 /* Return the value of parameter PARAM.
2824 First search ALIST, then Vdefault_frame_alist, then the X defaults
2825 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2827 Convert the resource to the type specified by desired_type.
2829 If no default is specified, return Qunbound. If you call
2830 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2831 and don't let it get stored in any Lisp-visible variables! */
2834 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2835 struct x_display_info
*dpyinfo
;
2836 Lisp_Object alist
, param
;
2839 enum resource_types type
;
2841 register Lisp_Object tem
;
2843 tem
= Fassq (param
, alist
);
2845 tem
= Fassq (param
, Vdefault_frame_alist
);
2851 tem
= display_x_get_resource (dpyinfo
,
2852 build_string (attribute
),
2853 build_string (class),
2861 case RES_TYPE_NUMBER
:
2862 return make_number (atoi (XSTRING (tem
)->data
));
2864 case RES_TYPE_FLOAT
:
2865 return make_float (atof (XSTRING (tem
)->data
));
2867 case RES_TYPE_BOOLEAN
:
2868 tem
= Fdowncase (tem
);
2869 if (!strcmp (XSTRING (tem
)->data
, "on")
2870 || !strcmp (XSTRING (tem
)->data
, "true"))
2875 case RES_TYPE_STRING
:
2878 case RES_TYPE_SYMBOL
:
2879 /* As a special case, we map the values `true' and `on'
2880 to Qt, and `false' and `off' to Qnil. */
2883 lower
= Fdowncase (tem
);
2884 if (!strcmp (XSTRING (lower
)->data
, "on")
2885 || !strcmp (XSTRING (lower
)->data
, "true"))
2887 else if (!strcmp (XSTRING (lower
)->data
, "off")
2888 || !strcmp (XSTRING (lower
)->data
, "false"))
2891 return Fintern (tem
, Qnil
);
2904 /* Like x_get_arg, but also record the value in f->param_alist. */
2907 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2909 Lisp_Object alist
, param
;
2912 enum resource_types type
;
2916 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2917 attribute
, class, type
);
2919 store_frame_param (f
, param
, value
);
2924 /* Record in frame F the specified or default value according to ALIST
2925 of the parameter named PROP (a Lisp symbol).
2926 If no value is specified for PROP, look for an X default for XPROP
2927 on the frame named NAME.
2928 If that is not found either, use the value DEFLT. */
2931 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2938 enum resource_types type
;
2942 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2943 if (EQ (tem
, Qunbound
))
2945 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2950 /* Record in frame F the specified or default value according to ALIST
2951 of the parameter named PROP (a Lisp symbol). If no value is
2952 specified for PROP, look for an X default for XPROP on the frame
2953 named NAME. If that is not found either, use the value DEFLT. */
2956 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2965 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2968 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2969 if (EQ (tem
, Qunbound
))
2971 #ifdef USE_TOOLKIT_SCROLL_BARS
2973 /* See if an X resource for the scroll bar color has been
2975 tem
= display_x_get_resource (dpyinfo
,
2976 build_string (foreground_p
2980 build_string ("verticalScrollBar"),
2984 /* If nothing has been specified, scroll bars will use a
2985 toolkit-dependent default. Because these defaults are
2986 difficult to get at without actually creating a scroll
2987 bar, use nil to indicate that no color has been
2992 #else /* not USE_TOOLKIT_SCROLL_BARS */
2996 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2999 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3005 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3006 doc
: /* Parse an X-style geometry string STRING.
3007 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3008 The properties returned may include `top', `left', `height', and `width'.
3009 The value of `left' or `top' may be an integer,
3010 or a list (+ N) meaning N pixels relative to top/left corner,
3011 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3016 unsigned int width
, height
;
3019 CHECK_STRING (string
);
3021 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
3022 &x
, &y
, &width
, &height
);
3025 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
3026 error ("Must specify both x and y position, or neither");
3030 if (geometry
& XValue
)
3032 Lisp_Object element
;
3034 if (x
>= 0 && (geometry
& XNegative
))
3035 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3036 else if (x
< 0 && ! (geometry
& XNegative
))
3037 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3039 element
= Fcons (Qleft
, make_number (x
));
3040 result
= Fcons (element
, result
);
3043 if (geometry
& YValue
)
3045 Lisp_Object element
;
3047 if (y
>= 0 && (geometry
& YNegative
))
3048 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3049 else if (y
< 0 && ! (geometry
& YNegative
))
3050 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3052 element
= Fcons (Qtop
, make_number (y
));
3053 result
= Fcons (element
, result
);
3056 if (geometry
& WidthValue
)
3057 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3058 if (geometry
& HeightValue
)
3059 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3064 /* Calculate the desired size and position of this window,
3065 and return the flags saying which aspects were specified.
3067 This function does not make the coordinates positive. */
3069 #define DEFAULT_ROWS 40
3070 #define DEFAULT_COLS 80
3073 x_figure_window_size (f
, parms
)
3077 register Lisp_Object tem0
, tem1
, tem2
;
3078 long window_prompting
= 0;
3079 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3081 /* Default values if we fall through.
3082 Actually, if that happens we should get
3083 window manager prompting. */
3084 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3085 f
->height
= DEFAULT_ROWS
;
3086 /* Window managers expect that if program-specified
3087 positions are not (0,0), they're intentional, not defaults. */
3088 f
->output_data
.x
->top_pos
= 0;
3089 f
->output_data
.x
->left_pos
= 0;
3091 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3092 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3093 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3094 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3096 if (!EQ (tem0
, Qunbound
))
3098 CHECK_NUMBER (tem0
);
3099 f
->height
= XINT (tem0
);
3101 if (!EQ (tem1
, Qunbound
))
3103 CHECK_NUMBER (tem1
);
3104 SET_FRAME_WIDTH (f
, XINT (tem1
));
3106 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3107 window_prompting
|= USSize
;
3109 window_prompting
|= PSize
;
3112 f
->output_data
.x
->vertical_scroll_bar_extra
3113 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3115 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3116 f
->output_data
.x
->flags_areas_extra
3117 = FRAME_FLAGS_AREA_WIDTH (f
);
3118 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3119 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3121 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3122 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3123 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3124 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3126 if (EQ (tem0
, Qminus
))
3128 f
->output_data
.x
->top_pos
= 0;
3129 window_prompting
|= YNegative
;
3131 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3132 && CONSP (XCDR (tem0
))
3133 && INTEGERP (XCAR (XCDR (tem0
))))
3135 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3136 window_prompting
|= YNegative
;
3138 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3139 && CONSP (XCDR (tem0
))
3140 && INTEGERP (XCAR (XCDR (tem0
))))
3142 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3144 else if (EQ (tem0
, Qunbound
))
3145 f
->output_data
.x
->top_pos
= 0;
3148 CHECK_NUMBER (tem0
);
3149 f
->output_data
.x
->top_pos
= XINT (tem0
);
3150 if (f
->output_data
.x
->top_pos
< 0)
3151 window_prompting
|= YNegative
;
3154 if (EQ (tem1
, Qminus
))
3156 f
->output_data
.x
->left_pos
= 0;
3157 window_prompting
|= XNegative
;
3159 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3160 && CONSP (XCDR (tem1
))
3161 && INTEGERP (XCAR (XCDR (tem1
))))
3163 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3164 window_prompting
|= XNegative
;
3166 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3167 && CONSP (XCDR (tem1
))
3168 && INTEGERP (XCAR (XCDR (tem1
))))
3170 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3172 else if (EQ (tem1
, Qunbound
))
3173 f
->output_data
.x
->left_pos
= 0;
3176 CHECK_NUMBER (tem1
);
3177 f
->output_data
.x
->left_pos
= XINT (tem1
);
3178 if (f
->output_data
.x
->left_pos
< 0)
3179 window_prompting
|= XNegative
;
3182 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3183 window_prompting
|= USPosition
;
3185 window_prompting
|= PPosition
;
3188 return window_prompting
;
3191 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3194 XSetWMProtocols (dpy
, w
, protocols
, count
)
3201 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3202 if (prop
== None
) return False
;
3203 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3204 (unsigned char *) protocols
, count
);
3207 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3209 #ifdef USE_X_TOOLKIT
3211 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3212 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3213 already be present because of the toolkit (Motif adds some of them,
3214 for example, but Xt doesn't). */
3217 hack_wm_protocols (f
, widget
)
3221 Display
*dpy
= XtDisplay (widget
);
3222 Window w
= XtWindow (widget
);
3223 int need_delete
= 1;
3229 Atom type
, *atoms
= 0;
3231 unsigned long nitems
= 0;
3232 unsigned long bytes_after
;
3234 if ((XGetWindowProperty (dpy
, w
,
3235 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3236 (long)0, (long)100, False
, XA_ATOM
,
3237 &type
, &format
, &nitems
, &bytes_after
,
3238 (unsigned char **) &atoms
)
3240 && format
== 32 && type
== XA_ATOM
)
3244 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3246 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3248 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3251 if (atoms
) XFree ((char *) atoms
);
3257 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3259 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3261 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3263 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3264 XA_ATOM
, 32, PropModeAppend
,
3265 (unsigned char *) props
, count
);
3273 /* Support routines for XIC (X Input Context). */
3277 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3278 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3281 /* Supported XIM styles, ordered by preferenc. */
3283 static XIMStyle supported_xim_styles
[] =
3285 XIMPreeditPosition
| XIMStatusArea
,
3286 XIMPreeditPosition
| XIMStatusNothing
,
3287 XIMPreeditPosition
| XIMStatusNone
,
3288 XIMPreeditNothing
| XIMStatusArea
,
3289 XIMPreeditNothing
| XIMStatusNothing
,
3290 XIMPreeditNothing
| XIMStatusNone
,
3291 XIMPreeditNone
| XIMStatusArea
,
3292 XIMPreeditNone
| XIMStatusNothing
,
3293 XIMPreeditNone
| XIMStatusNone
,
3298 /* Create an X fontset on frame F with base font name
3302 xic_create_xfontset (f
, base_fontname
)
3304 char *base_fontname
;
3307 char **missing_list
;
3311 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3312 base_fontname
, &missing_list
,
3313 &missing_count
, &def_string
);
3315 XFreeStringList (missing_list
);
3317 /* No need to free def_string. */
3322 /* Value is the best input style, given user preferences USER (already
3323 checked to be supported by Emacs), and styles supported by the
3324 input method XIM. */
3327 best_xim_style (user
, xim
)
3333 for (i
= 0; i
< user
->count_styles
; ++i
)
3334 for (j
= 0; j
< xim
->count_styles
; ++j
)
3335 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3336 return user
->supported_styles
[i
];
3338 /* Return the default style. */
3339 return XIMPreeditNothing
| XIMStatusNothing
;
3342 /* Create XIC for frame F. */
3344 static XIMStyle xic_style
;
3347 create_frame_xic (f
)
3352 XFontSet xfs
= NULL
;
3357 xim
= FRAME_X_XIM (f
);
3362 XVaNestedList preedit_attr
;
3363 XVaNestedList status_attr
;
3364 char *base_fontname
;
3367 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3368 spot
.x
= 0; spot
.y
= 1;
3369 /* Create X fontset. */
3370 fontset
= FRAME_FONTSET (f
);
3372 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3375 /* Determine the base fontname from the ASCII font name of
3377 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3378 char *p
= ascii_font
;
3381 for (i
= 0; *p
; p
++)
3384 /* As the font name doesn't conform to XLFD, we can't
3385 modify it to get a suitable base fontname for the
3387 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3390 int len
= strlen (ascii_font
) + 1;
3393 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3402 base_fontname
= (char *) alloca (len
);
3403 bzero (base_fontname
, len
);
3404 strcpy (base_fontname
, "-*-*-");
3405 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3406 strcat (base_fontname
, "*-*-*-*-*-*-*");
3409 xfs
= xic_create_xfontset (f
, base_fontname
);
3411 /* Determine XIC style. */
3414 XIMStyles supported_list
;
3415 supported_list
.count_styles
= (sizeof supported_xim_styles
3416 / sizeof supported_xim_styles
[0]);
3417 supported_list
.supported_styles
= supported_xim_styles
;
3418 xic_style
= best_xim_style (&supported_list
,
3419 FRAME_X_XIM_STYLES (f
));
3422 preedit_attr
= XVaCreateNestedList (0,
3425 FRAME_FOREGROUND_PIXEL (f
),
3427 FRAME_BACKGROUND_PIXEL (f
),
3428 (xic_style
& XIMPreeditPosition
3433 status_attr
= XVaCreateNestedList (0,
3439 FRAME_FOREGROUND_PIXEL (f
),
3441 FRAME_BACKGROUND_PIXEL (f
),
3444 xic
= XCreateIC (xim
,
3445 XNInputStyle
, xic_style
,
3446 XNClientWindow
, FRAME_X_WINDOW(f
),
3447 XNFocusWindow
, FRAME_X_WINDOW(f
),
3448 XNStatusAttributes
, status_attr
,
3449 XNPreeditAttributes
, preedit_attr
,
3451 XFree (preedit_attr
);
3452 XFree (status_attr
);
3455 FRAME_XIC (f
) = xic
;
3456 FRAME_XIC_STYLE (f
) = xic_style
;
3457 FRAME_XIC_FONTSET (f
) = xfs
;
3461 /* Destroy XIC and free XIC fontset of frame F, if any. */
3467 if (FRAME_XIC (f
) == NULL
)
3470 XDestroyIC (FRAME_XIC (f
));
3471 if (FRAME_XIC_FONTSET (f
))
3472 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3474 FRAME_XIC (f
) = NULL
;
3475 FRAME_XIC_FONTSET (f
) = NULL
;
3479 /* Place preedit area for XIC of window W's frame to specified
3480 pixel position X/Y. X and Y are relative to window W. */
3483 xic_set_preeditarea (w
, x
, y
)
3487 struct frame
*f
= XFRAME (w
->frame
);
3491 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3492 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3493 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3494 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3499 /* Place status area for XIC in bottom right corner of frame F.. */
3502 xic_set_statusarea (f
)
3505 XIC xic
= FRAME_XIC (f
);
3510 /* Negotiate geometry of status area. If input method has existing
3511 status area, use its current size. */
3512 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3513 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3514 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3517 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3518 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3521 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3523 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3524 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3528 area
.width
= needed
->width
;
3529 area
.height
= needed
->height
;
3530 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3531 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3532 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3535 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3536 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3541 /* Set X fontset for XIC of frame F, using base font name
3542 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3545 xic_set_xfontset (f
, base_fontname
)
3547 char *base_fontname
;
3552 xfs
= xic_create_xfontset (f
, base_fontname
);
3554 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3555 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3556 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3557 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3558 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3561 if (FRAME_XIC_FONTSET (f
))
3562 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3563 FRAME_XIC_FONTSET (f
) = xfs
;
3566 #endif /* HAVE_X_I18N */
3570 #ifdef USE_X_TOOLKIT
3572 /* Create and set up the X widget for frame F. */
3575 x_window (f
, window_prompting
, minibuffer_only
)
3577 long window_prompting
;
3578 int minibuffer_only
;
3580 XClassHint class_hints
;
3581 XSetWindowAttributes attributes
;
3582 unsigned long attribute_mask
;
3583 Widget shell_widget
;
3585 Widget frame_widget
;
3591 /* Use the resource name as the top-level widget name
3592 for looking up resources. Make a non-Lisp copy
3593 for the window manager, so GC relocation won't bother it.
3595 Elsewhere we specify the window name for the window manager. */
3598 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3599 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3600 strcpy (f
->namebuf
, str
);
3604 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3605 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3606 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3607 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3608 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3609 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3610 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3611 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3612 applicationShellWidgetClass
,
3613 FRAME_X_DISPLAY (f
), al
, ac
);
3615 f
->output_data
.x
->widget
= shell_widget
;
3616 /* maybe_set_screen_title_format (shell_widget); */
3618 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3619 (widget_value
*) NULL
,
3620 shell_widget
, False
,
3624 (lw_callback
) NULL
);
3627 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3628 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3629 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3630 XtSetValues (pane_widget
, al
, ac
);
3631 f
->output_data
.x
->column_widget
= pane_widget
;
3633 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3634 the emacs screen when changing menubar. This reduces flickering. */
3637 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3638 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3639 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3640 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3641 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3642 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3643 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3644 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3645 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3648 f
->output_data
.x
->edit_widget
= frame_widget
;
3650 XtManageChild (frame_widget
);
3652 /* Do some needed geometry management. */
3655 char *tem
, shell_position
[32];
3658 int extra_borders
= 0;
3660 = (f
->output_data
.x
->menubar_widget
3661 ? (f
->output_data
.x
->menubar_widget
->core
.height
3662 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3665 #if 0 /* Experimentally, we now get the right results
3666 for -geometry -0-0 without this. 24 Aug 96, rms. */
3667 if (FRAME_EXTERNAL_MENU_BAR (f
))
3670 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3671 menubar_size
+= ibw
;
3675 f
->output_data
.x
->menubar_height
= menubar_size
;
3678 /* Motif seems to need this amount added to the sizes
3679 specified for the shell widget. The Athena/Lucid widgets don't.
3680 Both conclusions reached experimentally. -- rms. */
3681 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3682 &extra_borders
, NULL
);
3686 /* Convert our geometry parameters into a geometry string
3688 Note that we do not specify here whether the position
3689 is a user-specified or program-specified one.
3690 We pass that information later, in x_wm_set_size_hints. */
3692 int left
= f
->output_data
.x
->left_pos
;
3693 int xneg
= window_prompting
& XNegative
;
3694 int top
= f
->output_data
.x
->top_pos
;
3695 int yneg
= window_prompting
& YNegative
;
3701 if (window_prompting
& USPosition
)
3702 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3703 PIXEL_WIDTH (f
) + extra_borders
,
3704 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3705 (xneg
? '-' : '+'), left
,
3706 (yneg
? '-' : '+'), top
);
3708 sprintf (shell_position
, "=%dx%d",
3709 PIXEL_WIDTH (f
) + extra_borders
,
3710 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3713 len
= strlen (shell_position
) + 1;
3714 /* We don't free this because we don't know whether
3715 it is safe to free it while the frame exists.
3716 It isn't worth the trouble of arranging to free it
3717 when the frame is deleted. */
3718 tem
= (char *) xmalloc (len
);
3719 strncpy (tem
, shell_position
, len
);
3720 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3721 XtSetValues (shell_widget
, al
, ac
);
3724 XtManageChild (pane_widget
);
3725 XtRealizeWidget (shell_widget
);
3727 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3729 validate_x_resource_name ();
3731 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3732 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3733 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3736 FRAME_XIC (f
) = NULL
;
3738 create_frame_xic (f
);
3742 f
->output_data
.x
->wm_hints
.input
= True
;
3743 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3744 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3745 &f
->output_data
.x
->wm_hints
);
3747 hack_wm_protocols (f
, shell_widget
);
3750 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3753 /* Do a stupid property change to force the server to generate a
3754 PropertyNotify event so that the event_stream server timestamp will
3755 be initialized to something relevant to the time we created the window.
3757 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3758 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3759 XA_ATOM
, 32, PropModeAppend
,
3760 (unsigned char*) NULL
, 0);
3762 /* Make all the standard events reach the Emacs frame. */
3763 attributes
.event_mask
= STANDARD_EVENT_SET
;
3768 /* XIM server might require some X events. */
3769 unsigned long fevent
= NoEventMask
;
3770 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3771 attributes
.event_mask
|= fevent
;
3773 #endif /* HAVE_X_I18N */
3775 attribute_mask
= CWEventMask
;
3776 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3777 attribute_mask
, &attributes
);
3779 XtMapWidget (frame_widget
);
3781 /* x_set_name normally ignores requests to set the name if the
3782 requested name is the same as the current name. This is the one
3783 place where that assumption isn't correct; f->name is set, but
3784 the X server hasn't been told. */
3787 int explicit = f
->explicit_name
;
3789 f
->explicit_name
= 0;
3792 x_set_name (f
, name
, explicit);
3795 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3796 f
->output_data
.x
->text_cursor
);
3800 /* This is a no-op, except under Motif. Make sure main areas are
3801 set to something reasonable, in case we get an error later. */
3802 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3805 #else /* not USE_X_TOOLKIT */
3807 /* Create and set up the X window for frame F. */
3814 XClassHint class_hints
;
3815 XSetWindowAttributes attributes
;
3816 unsigned long attribute_mask
;
3818 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3819 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3820 attributes
.bit_gravity
= StaticGravity
;
3821 attributes
.backing_store
= NotUseful
;
3822 attributes
.save_under
= True
;
3823 attributes
.event_mask
= STANDARD_EVENT_SET
;
3824 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3825 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3830 = XCreateWindow (FRAME_X_DISPLAY (f
),
3831 f
->output_data
.x
->parent_desc
,
3832 f
->output_data
.x
->left_pos
,
3833 f
->output_data
.x
->top_pos
,
3834 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3835 f
->output_data
.x
->border_width
,
3836 CopyFromParent
, /* depth */
3837 InputOutput
, /* class */
3839 attribute_mask
, &attributes
);
3843 create_frame_xic (f
);
3846 /* XIM server might require some X events. */
3847 unsigned long fevent
= NoEventMask
;
3848 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3849 attributes
.event_mask
|= fevent
;
3850 attribute_mask
= CWEventMask
;
3851 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3852 attribute_mask
, &attributes
);
3855 #endif /* HAVE_X_I18N */
3857 validate_x_resource_name ();
3859 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3860 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3861 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3863 /* The menubar is part of the ordinary display;
3864 it does not count in addition to the height of the window. */
3865 f
->output_data
.x
->menubar_height
= 0;
3867 /* This indicates that we use the "Passive Input" input model.
3868 Unless we do this, we don't get the Focus{In,Out} events that we
3869 need to draw the cursor correctly. Accursed bureaucrats.
3870 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3872 f
->output_data
.x
->wm_hints
.input
= True
;
3873 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3874 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3875 &f
->output_data
.x
->wm_hints
);
3876 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3878 /* Request "save yourself" and "delete window" commands from wm. */
3881 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3882 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3883 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3886 /* x_set_name normally ignores requests to set the name if the
3887 requested name is the same as the current name. This is the one
3888 place where that assumption isn't correct; f->name is set, but
3889 the X server hasn't been told. */
3892 int explicit = f
->explicit_name
;
3894 f
->explicit_name
= 0;
3897 x_set_name (f
, name
, explicit);
3900 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3901 f
->output_data
.x
->text_cursor
);
3905 if (FRAME_X_WINDOW (f
) == 0)
3906 error ("Unable to create window");
3909 #endif /* not USE_X_TOOLKIT */
3911 /* Handle the icon stuff for this window. Perhaps later we might
3912 want an x_set_icon_position which can be called interactively as
3920 Lisp_Object icon_x
, icon_y
;
3921 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3923 /* Set the position of the icon. Note that twm groups all
3924 icons in an icon window. */
3925 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3926 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3927 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3929 CHECK_NUMBER (icon_x
);
3930 CHECK_NUMBER (icon_y
);
3932 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3933 error ("Both left and top icon corners of icon must be specified");
3937 if (! EQ (icon_x
, Qunbound
))
3938 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3940 /* Start up iconic or window? */
3941 x_wm_set_window_state
3942 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3947 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3954 /* Make the GCs needed for this window, setting the
3955 background, border and mouse colors; also create the
3956 mouse cursor and the gray border tile. */
3958 static char cursor_bits
[] =
3960 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3961 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3962 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3963 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3970 XGCValues gc_values
;
3974 /* Create the GCs of this frame.
3975 Note that many default values are used. */
3978 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3979 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3980 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3981 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3982 f
->output_data
.x
->normal_gc
3983 = XCreateGC (FRAME_X_DISPLAY (f
),
3985 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
3988 /* Reverse video style. */
3989 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3990 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3991 f
->output_data
.x
->reverse_gc
3992 = XCreateGC (FRAME_X_DISPLAY (f
),
3994 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
3997 /* Cursor has cursor-color background, background-color foreground. */
3998 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3999 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
4000 gc_values
.fill_style
= FillOpaqueStippled
;
4002 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
4003 FRAME_X_DISPLAY_INFO (f
)->root_window
,
4004 cursor_bits
, 16, 16);
4005 f
->output_data
.x
->cursor_gc
4006 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4007 (GCFont
| GCForeground
| GCBackground
4008 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
4012 f
->output_data
.x
->white_relief
.gc
= 0;
4013 f
->output_data
.x
->black_relief
.gc
= 0;
4015 /* Create the gray border tile used when the pointer is not in
4016 the frame. Since this depends on the frame's pixel values,
4017 this must be done on a per-frame basis. */
4018 f
->output_data
.x
->border_tile
4019 = (XCreatePixmapFromBitmapData
4020 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
4021 gray_bits
, gray_width
, gray_height
,
4022 f
->output_data
.x
->foreground_pixel
,
4023 f
->output_data
.x
->background_pixel
,
4024 DefaultDepth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
))));
4030 /* Free what was was allocated in x_make_gc. */
4036 Display
*dpy
= FRAME_X_DISPLAY (f
);
4040 if (f
->output_data
.x
->normal_gc
)
4042 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
4043 f
->output_data
.x
->normal_gc
= 0;
4046 if (f
->output_data
.x
->reverse_gc
)
4048 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4049 f
->output_data
.x
->reverse_gc
= 0;
4052 if (f
->output_data
.x
->cursor_gc
)
4054 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4055 f
->output_data
.x
->cursor_gc
= 0;
4058 if (f
->output_data
.x
->border_tile
)
4060 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4061 f
->output_data
.x
->border_tile
= 0;
4068 /* Handler for signals raised during x_create_frame and
4069 x_create_top_frame. FRAME is the frame which is partially
4073 unwind_create_frame (frame
)
4076 struct frame
*f
= XFRAME (frame
);
4078 /* If frame is ``official'', nothing to do. */
4079 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4082 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4085 x_free_frame_resources (f
);
4087 /* Check that reference counts are indeed correct. */
4088 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4089 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4097 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4099 doc
: /* Make a new X window, which is called a "frame" in Emacs terms.
4100 Returns an Emacs frame object.
4101 ALIST is an alist of frame parameters.
4102 If the parameters specify that the frame should not have a minibuffer,
4103 and do not specify a specific minibuffer window to use,
4104 then `default-minibuffer-frame' must be a frame whose minibuffer can
4105 be shared by the new frame.
4107 This function is an internal primitive--use `make-frame' instead. */)
4112 Lisp_Object frame
, tem
;
4114 int minibuffer_only
= 0;
4115 long window_prompting
= 0;
4117 int count
= BINDING_STACK_SIZE ();
4118 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4119 Lisp_Object display
;
4120 struct x_display_info
*dpyinfo
= NULL
;
4126 /* Use this general default value to start with
4127 until we know if this frame has a specified name. */
4128 Vx_resource_name
= Vinvocation_name
;
4130 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4131 if (EQ (display
, Qunbound
))
4133 dpyinfo
= check_x_display_info (display
);
4135 kb
= dpyinfo
->kboard
;
4137 kb
= &the_only_kboard
;
4140 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4142 && ! EQ (name
, Qunbound
)
4144 error ("Invalid frame name--not a string or nil");
4147 Vx_resource_name
= name
;
4149 /* See if parent window is specified. */
4150 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4151 if (EQ (parent
, Qunbound
))
4153 if (! NILP (parent
))
4154 CHECK_NUMBER (parent
);
4156 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4157 /* No need to protect DISPLAY because that's not used after passing
4158 it to make_frame_without_minibuffer. */
4160 GCPRO4 (parms
, parent
, name
, frame
);
4161 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4163 if (EQ (tem
, Qnone
) || NILP (tem
))
4164 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4165 else if (EQ (tem
, Qonly
))
4167 f
= make_minibuffer_frame ();
4168 minibuffer_only
= 1;
4170 else if (WINDOWP (tem
))
4171 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4175 XSETFRAME (frame
, f
);
4177 /* Note that X Windows does support scroll bars. */
4178 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4180 f
->output_method
= output_x_window
;
4181 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4182 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4183 f
->output_data
.x
->icon_bitmap
= -1;
4184 f
->output_data
.x
->fontset
= -1;
4185 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4186 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4187 #ifdef USE_TOOLKIT_SCROLL_BARS
4188 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
4189 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
4190 #endif /* USE_TOOLKIT_SCROLL_BARS */
4191 record_unwind_protect (unwind_create_frame
, frame
);
4194 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4196 if (! STRINGP (f
->icon_name
))
4197 f
->icon_name
= Qnil
;
4199 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4201 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4202 dpyinfo_refcount
= dpyinfo
->reference_count
;
4203 #endif /* GLYPH_DEBUG */
4205 FRAME_KBOARD (f
) = kb
;
4208 /* These colors will be set anyway later, but it's important
4209 to get the color reference counts right, so initialize them! */
4212 struct gcpro gcpro1
;
4214 /* Function x_decode_color can signal an error. Make
4215 sure to initialize color slots so that we won't try
4216 to free colors we haven't allocated. */
4217 f
->output_data
.x
->foreground_pixel
= -1;
4218 f
->output_data
.x
->background_pixel
= -1;
4219 f
->output_data
.x
->cursor_pixel
= -1;
4220 f
->output_data
.x
->cursor_foreground_pixel
= -1;
4221 f
->output_data
.x
->border_pixel
= -1;
4222 f
->output_data
.x
->mouse_pixel
= -1;
4224 black
= build_string ("black");
4226 f
->output_data
.x
->foreground_pixel
4227 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4228 f
->output_data
.x
->background_pixel
4229 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4230 f
->output_data
.x
->cursor_pixel
4231 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4232 f
->output_data
.x
->cursor_foreground_pixel
4233 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4234 f
->output_data
.x
->border_pixel
4235 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4236 f
->output_data
.x
->mouse_pixel
4237 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4241 /* Specify the parent under which to make this X window. */
4245 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4246 f
->output_data
.x
->explicit_parent
= 1;
4250 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4251 f
->output_data
.x
->explicit_parent
= 0;
4254 /* Set the name; the functions to which we pass f expect the name to
4256 if (EQ (name
, Qunbound
) || NILP (name
))
4258 f
->name
= build_string (dpyinfo
->x_id_name
);
4259 f
->explicit_name
= 0;
4264 f
->explicit_name
= 1;
4265 /* use the frame's title when getting resources for this frame. */
4266 specbind (Qx_resource_name
, name
);
4269 /* Extract the window parameters from the supplied values
4270 that are needed to determine window geometry. */
4274 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4277 /* First, try whatever font the caller has specified. */
4280 tem
= Fquery_fontset (font
, Qnil
);
4282 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4284 font
= x_new_font (f
, XSTRING (font
)->data
);
4287 /* Try out a font which we hope has bold and italic variations. */
4288 if (!STRINGP (font
))
4289 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4290 if (!STRINGP (font
))
4291 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4292 if (! STRINGP (font
))
4293 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4294 if (! STRINGP (font
))
4295 /* This was formerly the first thing tried, but it finds too many fonts
4296 and takes too long. */
4297 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4298 /* If those didn't work, look for something which will at least work. */
4299 if (! STRINGP (font
))
4300 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4302 if (! STRINGP (font
))
4303 font
= build_string ("fixed");
4305 x_default_parameter (f
, parms
, Qfont
, font
,
4306 "font", "Font", RES_TYPE_STRING
);
4310 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4311 whereby it fails to get any font. */
4312 xlwmenu_default_font
= f
->output_data
.x
->font
;
4315 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4316 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4318 /* This defaults to 1 in order to match xterm. We recognize either
4319 internalBorderWidth or internalBorder (which is what xterm calls
4321 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4325 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4326 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4327 if (! EQ (value
, Qunbound
))
4328 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4331 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4332 "internalBorderWidth", "internalBorderWidth",
4334 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4335 "verticalScrollBars", "ScrollBars",
4338 /* Also do the stuff which must be set before the window exists. */
4339 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4340 "foreground", "Foreground", RES_TYPE_STRING
);
4341 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4342 "background", "Background", RES_TYPE_STRING
);
4343 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4344 "pointerColor", "Foreground", RES_TYPE_STRING
);
4345 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4346 "cursorColor", "Foreground", RES_TYPE_STRING
);
4347 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4348 "borderColor", "BorderColor", RES_TYPE_STRING
);
4349 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4350 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4351 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4352 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4354 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4355 "scrollBarForeground",
4356 "ScrollBarForeground", 1);
4357 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4358 "scrollBarBackground",
4359 "ScrollBarBackground", 0);
4361 /* Init faces before x_default_parameter is called for scroll-bar
4362 parameters because that function calls x_set_scroll_bar_width,
4363 which calls change_frame_size, which calls Fset_window_buffer,
4364 which runs hooks, which call Fvertical_motion. At the end, we
4365 end up in init_iterator with a null face cache, which should not
4367 init_frame_faces (f
);
4369 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4370 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4371 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4372 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4373 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4374 "bufferPredicate", "BufferPredicate",
4376 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4377 "title", "Title", RES_TYPE_STRING
);
4378 x_default_parameter (f
, parms
, Qwait_for_wm
, Qt
,
4379 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN
);
4381 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4383 /* Add the tool-bar height to the initial frame height so that the
4384 user gets a text display area of the size he specified with -g or
4385 via .Xdefaults. Later changes of the tool-bar height don't
4386 change the frame size. This is done so that users can create
4387 tall Emacs frames without having to guess how tall the tool-bar
4389 if (FRAME_TOOL_BAR_LINES (f
))
4391 int margin
, relief
, bar_height
;
4393 relief
= (tool_bar_button_relief
> 0
4394 ? tool_bar_button_relief
4395 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4397 if (INTEGERP (Vtool_bar_button_margin
)
4398 && XINT (Vtool_bar_button_margin
) > 0)
4399 margin
= XFASTINT (Vtool_bar_button_margin
);
4400 else if (CONSP (Vtool_bar_button_margin
)
4401 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4402 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4403 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4407 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4408 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4411 /* Compute the size of the X window. */
4412 window_prompting
= x_figure_window_size (f
, parms
);
4414 if (window_prompting
& XNegative
)
4416 if (window_prompting
& YNegative
)
4417 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4419 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4423 if (window_prompting
& YNegative
)
4424 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4426 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4429 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4431 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4432 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4434 /* Create the X widget or window. */
4435 #ifdef USE_X_TOOLKIT
4436 x_window (f
, window_prompting
, minibuffer_only
);
4444 /* Now consider the frame official. */
4445 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4446 Vframe_list
= Fcons (frame
, Vframe_list
);
4448 /* We need to do this after creating the X window, so that the
4449 icon-creation functions can say whose icon they're describing. */
4450 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4451 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4453 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4454 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4455 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4456 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4457 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4458 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4459 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4460 "scrollBarWidth", "ScrollBarWidth",
4463 /* Dimensions, especially f->height, must be done via change_frame_size.
4464 Change will not be effected unless different from the current
4470 SET_FRAME_WIDTH (f
, 0);
4471 change_frame_size (f
, height
, width
, 1, 0, 0);
4473 /* Set up faces after all frame parameters are known. This call
4474 also merges in face attributes specified for new frames. If we
4475 don't do this, the `menu' face for instance won't have the right
4476 colors, and the menu bar won't appear in the specified colors for
4478 call1 (Qface_set_after_frame_default
, frame
);
4480 #ifdef USE_X_TOOLKIT
4481 /* Create the menu bar. */
4482 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4484 /* If this signals an error, we haven't set size hints for the
4485 frame and we didn't make it visible. */
4486 initialize_frame_menubar (f
);
4488 /* This is a no-op, except under Motif where it arranges the
4489 main window for the widgets on it. */
4490 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4491 f
->output_data
.x
->menubar_widget
,
4492 f
->output_data
.x
->edit_widget
);
4494 #endif /* USE_X_TOOLKIT */
4496 /* Tell the server what size and position, etc, we want, and how
4497 badly we want them. This should be done after we have the menu
4498 bar so that its size can be taken into account. */
4500 x_wm_set_size_hint (f
, window_prompting
, 0);
4503 /* Make the window appear on the frame and enable display, unless
4504 the caller says not to. However, with explicit parent, Emacs
4505 cannot control visibility, so don't try. */
4506 if (! f
->output_data
.x
->explicit_parent
)
4508 Lisp_Object visibility
;
4510 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4512 if (EQ (visibility
, Qunbound
))
4515 if (EQ (visibility
, Qicon
))
4516 x_iconify_frame (f
);
4517 else if (! NILP (visibility
))
4518 x_make_frame_visible (f
);
4520 /* Must have been Qnil. */
4526 /* Make sure windows on this frame appear in calls to next-window
4527 and similar functions. */
4528 Vwindow_list
= Qnil
;
4530 return unbind_to (count
, frame
);
4534 /* FRAME is used only to get a handle on the X display. We don't pass the
4535 display info directly because we're called from frame.c, which doesn't
4536 know about that structure. */
4539 x_get_focus_frame (frame
)
4540 struct frame
*frame
;
4542 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4544 if (! dpyinfo
->x_focus_frame
)
4547 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4552 /* In certain situations, when the window manager follows a
4553 click-to-focus policy, there seems to be no way around calling
4554 XSetInputFocus to give another frame the input focus .
4556 In an ideal world, XSetInputFocus should generally be avoided so
4557 that applications don't interfere with the window manager's focus
4558 policy. But I think it's okay to use when it's clearly done
4559 following a user-command. */
4561 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4562 doc
: /* Set the input focus to FRAME.
4563 FRAME nil means use the selected frame. */)
4567 struct frame
*f
= check_x_frame (frame
);
4568 Display
*dpy
= FRAME_X_DISPLAY (f
);
4572 count
= x_catch_errors (dpy
);
4573 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4574 RevertToParent
, CurrentTime
);
4575 x_uncatch_errors (dpy
, count
);
4582 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4583 doc
: /* Internal function called by `color-defined-p', which see. */)
4585 Lisp_Object color
, frame
;
4588 FRAME_PTR f
= check_x_frame (frame
);
4590 CHECK_STRING (color
);
4592 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4598 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4599 doc
: /* Internal function called by `color-values', which see. */)
4601 Lisp_Object color
, frame
;
4604 FRAME_PTR f
= check_x_frame (frame
);
4606 CHECK_STRING (color
);
4608 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4612 rgb
[0] = make_number (foo
.red
);
4613 rgb
[1] = make_number (foo
.green
);
4614 rgb
[2] = make_number (foo
.blue
);
4615 return Flist (3, rgb
);
4621 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4622 doc
: /* Internal function called by `display-color-p', which see. */)
4624 Lisp_Object display
;
4626 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4628 if (dpyinfo
->n_planes
<= 2)
4631 switch (dpyinfo
->visual
->class)
4644 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4646 doc
: /* Return t if the X display supports shades of gray.
4647 Note that color displays do support shades of gray.
4648 The optional argument DISPLAY specifies which display to ask about.
4649 DISPLAY should be either a frame or a display name (a string).
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 if (dpyinfo
->n_planes
<= 1)
4659 switch (dpyinfo
->visual
->class)
4674 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4676 doc
: /* Returns the width in pixels of the X display DISPLAY.
4677 The optional argument DISPLAY specifies which display to ask about.
4678 DISPLAY should be either a frame or a display name (a string).
4679 If omitted or nil, that stands for the selected frame's display. */)
4681 Lisp_Object display
;
4683 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4685 return make_number (dpyinfo
->width
);
4688 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4689 Sx_display_pixel_height
, 0, 1, 0,
4690 doc
: /* Returns the height in pixels of the X display DISPLAY.
4691 The optional argument DISPLAY specifies which display to ask about.
4692 DISPLAY should be either a frame or a display name (a string).
4693 If omitted or nil, that stands for the selected frame's display. */)
4695 Lisp_Object display
;
4697 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4699 return make_number (dpyinfo
->height
);
4702 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4704 doc
: /* Returns the number of bitplanes of the X display DISPLAY.
4705 The optional argument DISPLAY specifies which display to ask about.
4706 DISPLAY should be either a frame or a display name (a string).
4707 If omitted or nil, that stands for the selected frame's display. */)
4709 Lisp_Object display
;
4711 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4713 return make_number (dpyinfo
->n_planes
);
4716 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4718 doc
: /* Returns the number of color cells of the X display DISPLAY.
4719 The optional argument DISPLAY specifies which display to ask about.
4720 DISPLAY should be either a frame or a display name (a string).
4721 If omitted or nil, that stands for the selected frame's display. */)
4723 Lisp_Object display
;
4725 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4727 return make_number (DisplayCells (dpyinfo
->display
,
4728 XScreenNumberOfScreen (dpyinfo
->screen
)));
4731 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4732 Sx_server_max_request_size
,
4734 doc
: /* Returns the maximum request size of the X server of display DISPLAY.
4735 The optional argument DISPLAY specifies which display to ask about.
4736 DISPLAY should be either a frame or a display name (a string).
4737 If omitted or nil, that stands for the selected frame's display. */)
4739 Lisp_Object display
;
4741 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4743 return make_number (MAXREQUEST (dpyinfo
->display
));
4746 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4747 doc
: /* Returns the vendor ID string of the X server of display DISPLAY.
4748 The optional argument DISPLAY specifies which display to ask about.
4749 DISPLAY should be either a frame or a display name (a string).
4750 If omitted or nil, that stands for the selected frame's display. */)
4752 Lisp_Object display
;
4754 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4755 char *vendor
= ServerVendor (dpyinfo
->display
);
4757 if (! vendor
) vendor
= "";
4758 return build_string (vendor
);
4761 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4762 doc
: /* Returns the version numbers of the X server of display DISPLAY.
4763 The value is a list of three integers: the major and minor
4764 version numbers of the X Protocol in use, and the vendor-specific release
4765 number. See also the function `x-server-vendor'.
4767 The optional argument DISPLAY specifies which display to ask about.
4768 DISPLAY should be either a frame or a display name (a string).
4769 If omitted or nil, that stands for the selected frame's display. */)
4771 Lisp_Object display
;
4773 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4774 Display
*dpy
= dpyinfo
->display
;
4776 return Fcons (make_number (ProtocolVersion (dpy
)),
4777 Fcons (make_number (ProtocolRevision (dpy
)),
4778 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4781 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4782 doc
: /* Return the number of screens on the X server of display DISPLAY.
4783 The optional argument DISPLAY specifies which display to ask about.
4784 DISPLAY should be either a frame or a display name (a string).
4785 If omitted or nil, that stands for the selected frame's display. */)
4787 Lisp_Object display
;
4789 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4791 return make_number (ScreenCount (dpyinfo
->display
));
4794 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4795 doc
: /* Return the height in millimeters of the X display DISPLAY.
4796 The optional argument DISPLAY specifies which display to ask about.
4797 DISPLAY should be either a frame or a display name (a string).
4798 If omitted or nil, that stands for the selected frame's display. */)
4800 Lisp_Object display
;
4802 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4804 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4807 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4808 doc
: /* Return the width in millimeters of the X display DISPLAY.
4809 The optional argument DISPLAY specifies which display to ask about.
4810 DISPLAY should be either a frame or a display name (a string).
4811 If omitted or nil, that stands for the selected frame's display. */)
4813 Lisp_Object display
;
4815 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4817 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4820 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4821 Sx_display_backing_store
, 0, 1, 0,
4822 doc
: /* Returns an indication of whether X display DISPLAY does backing store.
4823 The value may be `always', `when-mapped', or `not-useful'.
4824 The optional argument DISPLAY specifies which display to ask about.
4825 DISPLAY should be either a frame or a display name (a string).
4826 If omitted or nil, that stands for the selected frame's display. */)
4828 Lisp_Object display
;
4830 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4833 switch (DoesBackingStore (dpyinfo
->screen
))
4836 result
= intern ("always");
4840 result
= intern ("when-mapped");
4844 result
= intern ("not-useful");
4848 error ("Strange value for BackingStore parameter of screen");
4855 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4856 Sx_display_visual_class
, 0, 1, 0,
4857 doc
: /* Return the visual class of the X display DISPLAY.
4858 The value is one of the symbols `static-gray', `gray-scale',
4859 `static-color', `pseudo-color', `true-color', or `direct-color'.
4861 The optional argument DISPLAY specifies which display to ask about.
4862 DISPLAY should be either a frame or a display name (a string).
4863 If omitted or nil, that stands for the selected frame's display. */)
4865 Lisp_Object display
;
4867 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4870 switch (dpyinfo
->visual
->class)
4873 result
= intern ("static-gray");
4876 result
= intern ("gray-scale");
4879 result
= intern ("static-color");
4882 result
= intern ("pseudo-color");
4885 result
= intern ("true-color");
4888 result
= intern ("direct-color");
4891 error ("Display has an unknown visual class");
4898 DEFUN ("x-display-save-under", Fx_display_save_under
,
4899 Sx_display_save_under
, 0, 1, 0,
4900 doc
: /* Returns t if the X display DISPLAY supports the save-under feature.
4901 The optional argument DISPLAY specifies which display to ask about.
4902 DISPLAY should be either a frame or a display name (a string).
4903 If omitted or nil, that stands for the selected frame's display. */)
4905 Lisp_Object display
;
4907 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4909 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4917 register struct frame
*f
;
4919 return PIXEL_WIDTH (f
);
4924 register struct frame
*f
;
4926 return PIXEL_HEIGHT (f
);
4931 register struct frame
*f
;
4933 return FONT_WIDTH (f
->output_data
.x
->font
);
4938 register struct frame
*f
;
4940 return f
->output_data
.x
->line_height
;
4945 register struct frame
*f
;
4947 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4952 /************************************************************************
4954 ************************************************************************/
4957 /* Mapping visual names to visuals. */
4959 static struct visual_class
4966 {"StaticGray", StaticGray
},
4967 {"GrayScale", GrayScale
},
4968 {"StaticColor", StaticColor
},
4969 {"PseudoColor", PseudoColor
},
4970 {"TrueColor", TrueColor
},
4971 {"DirectColor", DirectColor
},
4976 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4978 /* Value is the screen number of screen SCR. This is a substitute for
4979 the X function with the same name when that doesn't exist. */
4982 XScreenNumberOfScreen (scr
)
4983 register Screen
*scr
;
4985 Display
*dpy
= scr
->display
;
4988 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4989 if (scr
== dpy
->screens
+ i
)
4995 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4998 /* Select the visual that should be used on display DPYINFO. Set
4999 members of DPYINFO appropriately. Called from x_term_init. */
5002 select_visual (dpyinfo
)
5003 struct x_display_info
*dpyinfo
;
5005 Display
*dpy
= dpyinfo
->display
;
5006 Screen
*screen
= dpyinfo
->screen
;
5009 /* See if a visual is specified. */
5010 value
= display_x_get_resource (dpyinfo
,
5011 build_string ("visualClass"),
5012 build_string ("VisualClass"),
5014 if (STRINGP (value
))
5016 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
5017 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
5018 depth, a decimal number. NAME is compared with case ignored. */
5019 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
5024 strcpy (s
, XSTRING (value
)->data
);
5025 dash
= index (s
, '-');
5028 dpyinfo
->n_planes
= atoi (dash
+ 1);
5032 /* We won't find a matching visual with depth 0, so that
5033 an error will be printed below. */
5034 dpyinfo
->n_planes
= 0;
5036 /* Determine the visual class. */
5037 for (i
= 0; visual_classes
[i
].name
; ++i
)
5038 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
5040 class = visual_classes
[i
].class;
5044 /* Look up a matching visual for the specified class. */
5046 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
5047 dpyinfo
->n_planes
, class, &vinfo
))
5048 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
5050 dpyinfo
->visual
= vinfo
.visual
;
5055 XVisualInfo
*vinfo
, vinfo_template
;
5057 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
5060 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
5062 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
5064 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5065 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
5066 &vinfo_template
, &n_visuals
);
5068 fatal ("Can't get proper X visual info");
5070 dpyinfo
->n_planes
= vinfo
->depth
;
5071 XFree ((char *) vinfo
);
5076 /* Return the X display structure for the display named NAME.
5077 Open a new connection if necessary. */
5079 struct x_display_info
*
5080 x_display_info_for_name (name
)
5084 struct x_display_info
*dpyinfo
;
5086 CHECK_STRING (name
);
5088 if (! EQ (Vwindow_system
, intern ("x")))
5089 error ("Not using X Windows");
5091 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5093 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5096 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5101 /* Use this general default value to start with. */
5102 Vx_resource_name
= Vinvocation_name
;
5104 validate_x_resource_name ();
5106 dpyinfo
= x_term_init (name
, (char *)0,
5107 (char *) XSTRING (Vx_resource_name
)->data
);
5110 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5113 XSETFASTINT (Vwindow_system_version
, 11);
5119 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5121 doc
: /* Open a connection to an X server.
5122 DISPLAY is the name of the display to connect to.
5123 Optional second arg XRM-STRING is a string of resources in xrdb format.
5124 If the optional third arg MUST-SUCCEED is non-nil,
5125 terminate Emacs if we can't open the connection. */)
5126 (display
, xrm_string
, must_succeed
)
5127 Lisp_Object display
, xrm_string
, must_succeed
;
5129 unsigned char *xrm_option
;
5130 struct x_display_info
*dpyinfo
;
5132 CHECK_STRING (display
);
5133 if (! NILP (xrm_string
))
5134 CHECK_STRING (xrm_string
);
5136 if (! EQ (Vwindow_system
, intern ("x")))
5137 error ("Not using X Windows");
5139 if (! NILP (xrm_string
))
5140 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5142 xrm_option
= (unsigned char *) 0;
5144 validate_x_resource_name ();
5146 /* This is what opens the connection and sets x_current_display.
5147 This also initializes many symbols, such as those used for input. */
5148 dpyinfo
= x_term_init (display
, xrm_option
,
5149 (char *) XSTRING (Vx_resource_name
)->data
);
5153 if (!NILP (must_succeed
))
5154 fatal ("Cannot connect to X server %s.\n\
5155 Check the DISPLAY environment variable or use `-d'.\n\
5156 Also use the `xhost' program to verify that it is set to permit\n\
5157 connections from your machine.\n",
5158 XSTRING (display
)->data
);
5160 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5165 XSETFASTINT (Vwindow_system_version
, 11);
5169 DEFUN ("x-close-connection", Fx_close_connection
,
5170 Sx_close_connection
, 1, 1, 0,
5171 doc
: /* Close the connection to DISPLAY's X server.
5172 For DISPLAY, specify either a frame or a display name (a string).
5173 If DISPLAY is nil, that stands for the selected frame's display. */)
5175 Lisp_Object display
;
5177 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5180 if (dpyinfo
->reference_count
> 0)
5181 error ("Display still has frames on it");
5184 /* Free the fonts in the font table. */
5185 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5186 if (dpyinfo
->font_table
[i
].name
)
5188 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5189 xfree (dpyinfo
->font_table
[i
].full_name
);
5190 xfree (dpyinfo
->font_table
[i
].name
);
5191 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5194 x_destroy_all_bitmaps (dpyinfo
);
5195 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5197 #ifdef USE_X_TOOLKIT
5198 XtCloseDisplay (dpyinfo
->display
);
5200 XCloseDisplay (dpyinfo
->display
);
5203 x_delete_display (dpyinfo
);
5209 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5210 doc
: /* Return the list of display names that Emacs has connections to. */)
5213 Lisp_Object tail
, result
;
5216 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5217 result
= Fcons (XCAR (XCAR (tail
)), result
);
5222 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5223 doc
: /* If ON is non-nil, report X errors as soon as the erring request is made.
5224 If ON is nil, allow buffering of requests.
5225 Turning on synchronization prohibits the Xlib routines from buffering
5226 requests and seriously degrades performance, but makes debugging much
5228 The optional second argument DISPLAY specifies which display to act on.
5229 DISPLAY should be either a frame or a display name (a string).
5230 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
5232 Lisp_Object display
, on
;
5234 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5236 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5241 /* Wait for responses to all X commands issued so far for frame F. */
5248 XSync (FRAME_X_DISPLAY (f
), False
);
5253 /***********************************************************************
5255 ***********************************************************************/
5257 /* Value is the number of elements of vector VECTOR. */
5259 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5261 /* List of supported image types. Use define_image_type to add new
5262 types. Use lookup_image_type to find a type for a given symbol. */
5264 static struct image_type
*image_types
;
5266 /* The symbol `image' which is the car of the lists used to represent
5269 extern Lisp_Object Qimage
;
5271 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5277 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5278 extern Lisp_Object QCdata
;
5279 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5280 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5281 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5283 /* Other symbols. */
5285 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5287 /* Time in seconds after which images should be removed from the cache
5288 if not displayed. */
5290 Lisp_Object Vimage_cache_eviction_delay
;
5292 /* Function prototypes. */
5294 static void define_image_type
P_ ((struct image_type
*type
));
5295 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5296 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5297 static void x_laplace
P_ ((struct frame
*, struct image
*));
5298 static void x_emboss
P_ ((struct frame
*, struct image
*));
5299 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5303 /* Define a new image type from TYPE. This adds a copy of TYPE to
5304 image_types and adds the symbol *TYPE->type to Vimage_types. */
5307 define_image_type (type
)
5308 struct image_type
*type
;
5310 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5311 The initialized data segment is read-only. */
5312 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5313 bcopy (type
, p
, sizeof *p
);
5314 p
->next
= image_types
;
5316 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5320 /* Look up image type SYMBOL, and return a pointer to its image_type
5321 structure. Value is null if SYMBOL is not a known image type. */
5323 static INLINE
struct image_type
*
5324 lookup_image_type (symbol
)
5327 struct image_type
*type
;
5329 for (type
= image_types
; type
; type
= type
->next
)
5330 if (EQ (symbol
, *type
->type
))
5337 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5338 valid image specification is a list whose car is the symbol
5339 `image', and whose rest is a property list. The property list must
5340 contain a value for key `:type'. That value must be the name of a
5341 supported image type. The rest of the property list depends on the
5345 valid_image_p (object
)
5350 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5354 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
5355 if (EQ (XCAR (tem
), QCtype
))
5358 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
5360 struct image_type
*type
;
5361 type
= lookup_image_type (XCAR (tem
));
5363 valid_p
= type
->valid_p (object
);
5374 /* Log error message with format string FORMAT and argument ARG.
5375 Signaling an error, e.g. when an image cannot be loaded, is not a
5376 good idea because this would interrupt redisplay, and the error
5377 message display would lead to another redisplay. This function
5378 therefore simply displays a message. */
5381 image_error (format
, arg1
, arg2
)
5383 Lisp_Object arg1
, arg2
;
5385 add_to_log (format
, arg1
, arg2
);
5390 /***********************************************************************
5391 Image specifications
5392 ***********************************************************************/
5394 enum image_value_type
5396 IMAGE_DONT_CHECK_VALUE_TYPE
,
5398 IMAGE_STRING_OR_NIL_VALUE
,
5400 IMAGE_POSITIVE_INTEGER_VALUE
,
5401 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5402 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5404 IMAGE_INTEGER_VALUE
,
5405 IMAGE_FUNCTION_VALUE
,
5410 /* Structure used when parsing image specifications. */
5412 struct image_keyword
5414 /* Name of keyword. */
5417 /* The type of value allowed. */
5418 enum image_value_type type
;
5420 /* Non-zero means key must be present. */
5423 /* Used to recognize duplicate keywords in a property list. */
5426 /* The value that was found. */
5431 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5433 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5436 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5437 has the format (image KEYWORD VALUE ...). One of the keyword/
5438 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5439 image_keywords structures of size NKEYWORDS describing other
5440 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5443 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5445 struct image_keyword
*keywords
;
5452 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5455 plist
= XCDR (spec
);
5456 while (CONSP (plist
))
5458 Lisp_Object key
, value
;
5460 /* First element of a pair must be a symbol. */
5462 plist
= XCDR (plist
);
5466 /* There must follow a value. */
5469 value
= XCAR (plist
);
5470 plist
= XCDR (plist
);
5472 /* Find key in KEYWORDS. Error if not found. */
5473 for (i
= 0; i
< nkeywords
; ++i
)
5474 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5480 /* Record that we recognized the keyword. If a keywords
5481 was found more than once, it's an error. */
5482 keywords
[i
].value
= value
;
5483 ++keywords
[i
].count
;
5485 if (keywords
[i
].count
> 1)
5488 /* Check type of value against allowed type. */
5489 switch (keywords
[i
].type
)
5491 case IMAGE_STRING_VALUE
:
5492 if (!STRINGP (value
))
5496 case IMAGE_STRING_OR_NIL_VALUE
:
5497 if (!STRINGP (value
) && !NILP (value
))
5501 case IMAGE_SYMBOL_VALUE
:
5502 if (!SYMBOLP (value
))
5506 case IMAGE_POSITIVE_INTEGER_VALUE
:
5507 if (!INTEGERP (value
) || XINT (value
) <= 0)
5511 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5512 if (INTEGERP (value
) && XINT (value
) >= 0)
5515 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5516 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5520 case IMAGE_ASCENT_VALUE
:
5521 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5523 else if (INTEGERP (value
)
5524 && XINT (value
) >= 0
5525 && XINT (value
) <= 100)
5529 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5530 if (!INTEGERP (value
) || XINT (value
) < 0)
5534 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5537 case IMAGE_FUNCTION_VALUE
:
5538 value
= indirect_function (value
);
5540 || COMPILEDP (value
)
5541 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5545 case IMAGE_NUMBER_VALUE
:
5546 if (!INTEGERP (value
) && !FLOATP (value
))
5550 case IMAGE_INTEGER_VALUE
:
5551 if (!INTEGERP (value
))
5555 case IMAGE_BOOL_VALUE
:
5556 if (!NILP (value
) && !EQ (value
, Qt
))
5565 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5569 /* Check that all mandatory fields are present. */
5570 for (i
= 0; i
< nkeywords
; ++i
)
5571 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5574 return NILP (plist
);
5578 /* Return the value of KEY in image specification SPEC. Value is nil
5579 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5580 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5583 image_spec_value (spec
, key
, found
)
5584 Lisp_Object spec
, key
;
5589 xassert (valid_image_p (spec
));
5591 for (tail
= XCDR (spec
);
5592 CONSP (tail
) && CONSP (XCDR (tail
));
5593 tail
= XCDR (XCDR (tail
)))
5595 if (EQ (XCAR (tail
), key
))
5599 return XCAR (XCDR (tail
));
5609 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5610 doc
: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
5611 PIXELS non-nil means return the size in pixels, otherwise return the
5612 size in canonical character units.
5613 FRAME is the frame on which the image will be displayed. FRAME nil
5614 or omitted means use the selected frame. */)
5615 (spec
, pixels
, frame
)
5616 Lisp_Object spec
, pixels
, frame
;
5621 if (valid_image_p (spec
))
5623 struct frame
*f
= check_x_frame (frame
);
5624 int id
= lookup_image (f
, spec
);
5625 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5626 int width
= img
->width
+ 2 * img
->hmargin
;
5627 int height
= img
->height
+ 2 * img
->vmargin
;
5630 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5631 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5633 size
= Fcons (make_number (width
), make_number (height
));
5636 error ("Invalid image specification");
5642 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5643 doc
: /* Return t if image SPEC has a mask bitmap.
5644 FRAME is the frame on which the image will be displayed. FRAME nil
5645 or omitted means use the selected frame. */)
5647 Lisp_Object spec
, frame
;
5652 if (valid_image_p (spec
))
5654 struct frame
*f
= check_x_frame (frame
);
5655 int id
= lookup_image (f
, spec
);
5656 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5661 error ("Invalid image specification");
5668 /***********************************************************************
5669 Image type independent image structures
5670 ***********************************************************************/
5672 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5673 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5676 /* Allocate and return a new image structure for image specification
5677 SPEC. SPEC has a hash value of HASH. */
5679 static struct image
*
5680 make_image (spec
, hash
)
5684 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5686 xassert (valid_image_p (spec
));
5687 bzero (img
, sizeof *img
);
5688 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5689 xassert (img
->type
!= NULL
);
5691 img
->data
.lisp_val
= Qnil
;
5692 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5698 /* Free image IMG which was used on frame F, including its resources. */
5707 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5709 /* Remove IMG from the hash table of its cache. */
5711 img
->prev
->next
= img
->next
;
5713 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5716 img
->next
->prev
= img
->prev
;
5718 c
->images
[img
->id
] = NULL
;
5720 /* Free resources, then free IMG. */
5721 img
->type
->free (f
, img
);
5727 /* Prepare image IMG for display on frame F. Must be called before
5728 drawing an image. */
5731 prepare_image_for_display (f
, img
)
5737 /* We're about to display IMG, so set its timestamp to `now'. */
5739 img
->timestamp
= EMACS_SECS (t
);
5741 /* If IMG doesn't have a pixmap yet, load it now, using the image
5742 type dependent loader function. */
5743 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5744 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5748 /* Value is the number of pixels for the ascent of image IMG when
5749 drawn in face FACE. */
5752 image_ascent (img
, face
)
5756 int height
= img
->height
+ img
->vmargin
;
5759 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5762 /* This expression is arranged so that if the image can't be
5763 exactly centered, it will be moved slightly up. This is
5764 because a typical font is `top-heavy' (due to the presence
5765 uppercase letters), so the image placement should err towards
5766 being top-heavy too. It also just generally looks better. */
5767 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5769 ascent
= height
/ 2;
5772 ascent
= height
* img
->ascent
/ 100.0;
5778 /* Image background colors. */
5780 static unsigned long
5781 four_corners_best (ximg
, width
, height
)
5783 unsigned long width
, height
;
5785 unsigned long corners
[4], best
;
5788 /* Get the colors at the corners of ximg. */
5789 corners
[0] = XGetPixel (ximg
, 0, 0);
5790 corners
[1] = XGetPixel (ximg
, width
- 1, 0);
5791 corners
[2] = XGetPixel (ximg
, width
- 1, height
- 1);
5792 corners
[3] = XGetPixel (ximg
, 0, height
- 1);
5794 /* Choose the most frequently found color as background. */
5795 for (i
= best_count
= 0; i
< 4; ++i
)
5799 for (j
= n
= 0; j
< 4; ++j
)
5800 if (corners
[i
] == corners
[j
])
5804 best
= corners
[i
], best_count
= n
;
5810 /* Return the `background' field of IMG. If IMG doesn't have one yet,
5811 it is guessed heuristically. If non-zero, XIMG is an existing XImage
5812 object to use for the heuristic. */
5815 image_background (img
, f
, ximg
)
5820 if (! img
->background_valid
)
5821 /* IMG doesn't have a background yet, try to guess a reasonable value. */
5823 int free_ximg
= !ximg
;
5826 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
5827 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
5829 img
->background
= four_corners_best (ximg
, img
->width
, img
->height
);
5832 XDestroyImage (ximg
);
5834 img
->background_valid
= 1;
5837 return img
->background
;
5840 /* Return the `background_transparent' field of IMG. If IMG doesn't
5841 have one yet, it is guessed heuristically. If non-zero, MASK is an
5842 existing XImage object to use for the heuristic. */
5845 image_background_transparent (img
, f
, mask
)
5850 if (! img
->background_transparent_valid
)
5851 /* IMG doesn't have a background yet, try to guess a reasonable value. */
5855 int free_mask
= !mask
;
5858 mask
= XGetImage (FRAME_X_DISPLAY (f
), img
->mask
,
5859 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
5861 img
->background_transparent
5862 = !four_corners_best (mask
, img
->width
, img
->height
);
5865 XDestroyImage (mask
);
5868 img
->background_transparent
= 0;
5870 img
->background_transparent_valid
= 1;
5873 return img
->background_transparent
;
5877 /***********************************************************************
5878 Helper functions for X image types
5879 ***********************************************************************/
5881 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5883 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5884 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5886 Lisp_Object color_name
,
5887 unsigned long dflt
));
5890 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5891 free the pixmap if any. MASK_P non-zero means clear the mask
5892 pixmap if any. COLORS_P non-zero means free colors allocated for
5893 the image, if any. */
5896 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5899 int pixmap_p
, mask_p
, colors_p
;
5901 if (pixmap_p
&& img
->pixmap
)
5903 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5905 img
->background_valid
= 0;
5908 if (mask_p
&& img
->mask
)
5910 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5912 img
->background_transparent_valid
= 0;
5915 if (colors_p
&& img
->ncolors
)
5917 x_free_colors (f
, img
->colors
, img
->ncolors
);
5918 xfree (img
->colors
);
5924 /* Free X resources of image IMG which is used on frame F. */
5927 x_clear_image (f
, img
)
5932 x_clear_image_1 (f
, img
, 1, 1, 1);
5937 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5938 cannot be allocated, use DFLT. Add a newly allocated color to
5939 IMG->colors, so that it can be freed again. Value is the pixel
5942 static unsigned long
5943 x_alloc_image_color (f
, img
, color_name
, dflt
)
5946 Lisp_Object color_name
;
5950 unsigned long result
;
5952 xassert (STRINGP (color_name
));
5954 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5956 /* This isn't called frequently so we get away with simply
5957 reallocating the color vector to the needed size, here. */
5960 (unsigned long *) xrealloc (img
->colors
,
5961 img
->ncolors
* sizeof *img
->colors
);
5962 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5963 result
= color
.pixel
;
5973 /***********************************************************************
5975 ***********************************************************************/
5977 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5978 static void postprocess_image
P_ ((struct frame
*, struct image
*));
5981 /* Return a new, initialized image cache that is allocated from the
5982 heap. Call free_image_cache to free an image cache. */
5984 struct image_cache
*
5987 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5990 bzero (c
, sizeof *c
);
5992 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5993 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5994 c
->buckets
= (struct image
**) xmalloc (size
);
5995 bzero (c
->buckets
, size
);
6000 /* Free image cache of frame F. Be aware that X frames share images
6004 free_image_cache (f
)
6007 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6012 /* Cache should not be referenced by any frame when freed. */
6013 xassert (c
->refcount
== 0);
6015 for (i
= 0; i
< c
->used
; ++i
)
6016 free_image (f
, c
->images
[i
]);
6020 FRAME_X_IMAGE_CACHE (f
) = NULL
;
6025 /* Clear image cache of frame F. FORCE_P non-zero means free all
6026 images. FORCE_P zero means clear only images that haven't been
6027 displayed for some time. Should be called from time to time to
6028 reduce the number of loaded images. If image-eviction-seconds is
6029 non-nil, this frees images in the cache which weren't displayed for
6030 at least that many seconds. */
6033 clear_image_cache (f
, force_p
)
6037 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6039 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
6046 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
6048 /* Block input so that we won't be interrupted by a SIGIO
6049 while being in an inconsistent state. */
6052 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
6054 struct image
*img
= c
->images
[i
];
6056 && (force_p
|| img
->timestamp
< old
))
6058 free_image (f
, img
);
6063 /* We may be clearing the image cache because, for example,
6064 Emacs was iconified for a longer period of time. In that
6065 case, current matrices may still contain references to
6066 images freed above. So, clear these matrices. */
6069 Lisp_Object tail
, frame
;
6071 FOR_EACH_FRAME (tail
, frame
)
6073 struct frame
*f
= XFRAME (frame
);
6075 && FRAME_X_IMAGE_CACHE (f
) == c
)
6076 clear_current_matrices (f
);
6079 ++windows_or_buffers_changed
;
6087 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
6089 doc
: /* Clear the image cache of FRAME.
6090 FRAME nil or omitted means use the selected frame.
6091 FRAME t means clear the image caches of all frames. */)
6099 FOR_EACH_FRAME (tail
, frame
)
6100 if (FRAME_X_P (XFRAME (frame
)))
6101 clear_image_cache (XFRAME (frame
), 1);
6104 clear_image_cache (check_x_frame (frame
), 1);
6110 /* Compute masks and transform image IMG on frame F, as specified
6111 by the image's specification, */
6114 postprocess_image (f
, img
)
6118 /* Manipulation of the image's mask. */
6121 Lisp_Object conversion
, spec
;
6126 /* `:heuristic-mask t'
6128 means build a mask heuristically.
6129 `:heuristic-mask (R G B)'
6130 `:mask (heuristic (R G B))'
6131 means build a mask from color (R G B) in the
6134 means remove a mask, if any. */
6136 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6138 x_build_heuristic_mask (f
, img
, mask
);
6143 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6145 if (EQ (mask
, Qheuristic
))
6146 x_build_heuristic_mask (f
, img
, Qt
);
6147 else if (CONSP (mask
)
6148 && EQ (XCAR (mask
), Qheuristic
))
6150 if (CONSP (XCDR (mask
)))
6151 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6153 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6155 else if (NILP (mask
) && found_p
&& img
->mask
)
6157 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6163 /* Should we apply an image transformation algorithm? */
6164 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6165 if (EQ (conversion
, Qdisabled
))
6166 x_disable_image (f
, img
);
6167 else if (EQ (conversion
, Qlaplace
))
6169 else if (EQ (conversion
, Qemboss
))
6171 else if (CONSP (conversion
)
6172 && EQ (XCAR (conversion
), Qedge_detection
))
6175 tem
= XCDR (conversion
);
6177 x_edge_detection (f
, img
,
6178 Fplist_get (tem
, QCmatrix
),
6179 Fplist_get (tem
, QCcolor_adjustment
));
6185 /* Return the id of image with Lisp specification SPEC on frame F.
6186 SPEC must be a valid Lisp image specification (see valid_image_p). */
6189 lookup_image (f
, spec
)
6193 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6197 struct gcpro gcpro1
;
6200 /* F must be a window-system frame, and SPEC must be a valid image
6202 xassert (FRAME_WINDOW_P (f
));
6203 xassert (valid_image_p (spec
));
6207 /* Look up SPEC in the hash table of the image cache. */
6208 hash
= sxhash (spec
, 0);
6209 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6211 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6212 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6215 /* If not found, create a new image and cache it. */
6218 extern Lisp_Object Qpostscript
;
6221 img
= make_image (spec
, hash
);
6222 cache_image (f
, img
);
6223 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6225 /* If we can't load the image, and we don't have a width and
6226 height, use some arbitrary width and height so that we can
6227 draw a rectangle for it. */
6228 if (img
->load_failed_p
)
6232 value
= image_spec_value (spec
, QCwidth
, NULL
);
6233 img
->width
= (INTEGERP (value
)
6234 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6235 value
= image_spec_value (spec
, QCheight
, NULL
);
6236 img
->height
= (INTEGERP (value
)
6237 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6241 /* Handle image type independent image attributes
6242 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
6243 `:background COLOR'. */
6244 Lisp_Object ascent
, margin
, relief
, bg
;
6246 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6247 if (INTEGERP (ascent
))
6248 img
->ascent
= XFASTINT (ascent
);
6249 else if (EQ (ascent
, Qcenter
))
6250 img
->ascent
= CENTERED_IMAGE_ASCENT
;
6252 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6253 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6254 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
6255 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
6256 && INTEGERP (XCDR (margin
)))
6258 if (XINT (XCAR (margin
)) > 0)
6259 img
->hmargin
= XFASTINT (XCAR (margin
));
6260 if (XINT (XCDR (margin
)) > 0)
6261 img
->vmargin
= XFASTINT (XCDR (margin
));
6264 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6265 if (INTEGERP (relief
))
6267 img
->relief
= XINT (relief
);
6268 img
->hmargin
+= abs (img
->relief
);
6269 img
->vmargin
+= abs (img
->relief
);
6272 if (! img
->background_valid
)
6274 bg
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6278 = x_alloc_image_color (f
, img
, bg
,
6279 FRAME_BACKGROUND_PIXEL (f
));
6280 img
->background_valid
= 1;
6284 /* Do image transformations and compute masks, unless we
6285 don't have the image yet. */
6286 if (!EQ (*img
->type
->type
, Qpostscript
))
6287 postprocess_image (f
, img
);
6291 xassert (!interrupt_input_blocked
);
6294 /* We're using IMG, so set its timestamp to `now'. */
6295 EMACS_GET_TIME (now
);
6296 img
->timestamp
= EMACS_SECS (now
);
6300 /* Value is the image id. */
6305 /* Cache image IMG in the image cache of frame F. */
6308 cache_image (f
, img
)
6312 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6315 /* Find a free slot in c->images. */
6316 for (i
= 0; i
< c
->used
; ++i
)
6317 if (c
->images
[i
] == NULL
)
6320 /* If no free slot found, maybe enlarge c->images. */
6321 if (i
== c
->used
&& c
->used
== c
->size
)
6324 c
->images
= (struct image
**) xrealloc (c
->images
,
6325 c
->size
* sizeof *c
->images
);
6328 /* Add IMG to c->images, and assign IMG an id. */
6334 /* Add IMG to the cache's hash table. */
6335 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6336 img
->next
= c
->buckets
[i
];
6338 img
->next
->prev
= img
;
6340 c
->buckets
[i
] = img
;
6344 /* Call FN on every image in the image cache of frame F. Used to mark
6345 Lisp Objects in the image cache. */
6348 forall_images_in_image_cache (f
, fn
)
6350 void (*fn
) P_ ((struct image
*img
));
6352 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6354 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6358 for (i
= 0; i
< c
->used
; ++i
)
6367 /***********************************************************************
6369 ***********************************************************************/
6371 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6372 XImage
**, Pixmap
*));
6373 static void x_destroy_x_image
P_ ((XImage
*));
6374 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6377 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6378 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6379 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6380 via xmalloc. Print error messages via image_error if an error
6381 occurs. Value is non-zero if successful. */
6384 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6386 int width
, height
, depth
;
6390 Display
*display
= FRAME_X_DISPLAY (f
);
6391 Screen
*screen
= FRAME_X_SCREEN (f
);
6392 Window window
= FRAME_X_WINDOW (f
);
6394 xassert (interrupt_input_blocked
);
6397 depth
= DefaultDepthOfScreen (screen
);
6398 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6399 depth
, ZPixmap
, 0, NULL
, width
, height
,
6400 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6403 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6407 /* Allocate image raster. */
6408 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6410 /* Allocate a pixmap of the same size. */
6411 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6412 if (*pixmap
== None
)
6414 x_destroy_x_image (*ximg
);
6416 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6424 /* Destroy XImage XIMG. Free XIMG->data. */
6427 x_destroy_x_image (ximg
)
6430 xassert (interrupt_input_blocked
);
6435 XDestroyImage (ximg
);
6440 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6441 are width and height of both the image and pixmap. */
6444 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6451 xassert (interrupt_input_blocked
);
6452 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6453 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6454 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6459 /***********************************************************************
6461 ***********************************************************************/
6463 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6464 static char *slurp_file
P_ ((char *, int *));
6467 /* Find image file FILE. Look in data-directory, then
6468 x-bitmap-file-path. Value is the full name of the file found, or
6469 nil if not found. */
6472 x_find_image_file (file
)
6475 Lisp_Object file_found
, search_path
;
6476 struct gcpro gcpro1
, gcpro2
;
6480 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6481 GCPRO2 (file_found
, search_path
);
6483 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6484 fd
= openp (search_path
, file
, Qnil
, &file_found
, 0);
6496 /* Read FILE into memory. Value is a pointer to a buffer allocated
6497 with xmalloc holding FILE's contents. Value is null if an error
6498 occurred. *SIZE is set to the size of the file. */
6501 slurp_file (file
, size
)
6509 if (stat (file
, &st
) == 0
6510 && (fp
= fopen (file
, "r")) != NULL
6511 && (buf
= (char *) xmalloc (st
.st_size
),
6512 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6533 /***********************************************************************
6535 ***********************************************************************/
6537 static int xbm_scan
P_ ((char **, char *, char *, int *));
6538 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6539 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6541 static int xbm_image_p
P_ ((Lisp_Object object
));
6542 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6544 static int xbm_file_p
P_ ((Lisp_Object
));
6547 /* Indices of image specification fields in xbm_format, below. */
6549 enum xbm_keyword_index
6567 /* Vector of image_keyword structures describing the format
6568 of valid XBM image specifications. */
6570 static struct image_keyword xbm_format
[XBM_LAST
] =
6572 {":type", IMAGE_SYMBOL_VALUE
, 1},
6573 {":file", IMAGE_STRING_VALUE
, 0},
6574 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6575 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6576 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6577 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
6578 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
6579 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6580 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6581 {":relief", IMAGE_INTEGER_VALUE
, 0},
6582 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6583 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6584 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6587 /* Structure describing the image type XBM. */
6589 static struct image_type xbm_type
=
6598 /* Tokens returned from xbm_scan. */
6607 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6608 A valid specification is a list starting with the symbol `image'
6609 The rest of the list is a property list which must contain an
6612 If the specification specifies a file to load, it must contain
6613 an entry `:file FILENAME' where FILENAME is a string.
6615 If the specification is for a bitmap loaded from memory it must
6616 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6617 WIDTH and HEIGHT are integers > 0. DATA may be:
6619 1. a string large enough to hold the bitmap data, i.e. it must
6620 have a size >= (WIDTH + 7) / 8 * HEIGHT
6622 2. a bool-vector of size >= WIDTH * HEIGHT
6624 3. a vector of strings or bool-vectors, one for each line of the
6627 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6628 may not be specified in this case because they are defined in the
6631 Both the file and data forms may contain the additional entries
6632 `:background COLOR' and `:foreground COLOR'. If not present,
6633 foreground and background of the frame on which the image is
6634 displayed is used. */
6637 xbm_image_p (object
)
6640 struct image_keyword kw
[XBM_LAST
];
6642 bcopy (xbm_format
, kw
, sizeof kw
);
6643 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6646 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6648 if (kw
[XBM_FILE
].count
)
6650 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6653 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6655 /* In-memory XBM file. */
6656 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6664 /* Entries for `:width', `:height' and `:data' must be present. */
6665 if (!kw
[XBM_WIDTH
].count
6666 || !kw
[XBM_HEIGHT
].count
6667 || !kw
[XBM_DATA
].count
)
6670 data
= kw
[XBM_DATA
].value
;
6671 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6672 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6674 /* Check type of data, and width and height against contents of
6680 /* Number of elements of the vector must be >= height. */
6681 if (XVECTOR (data
)->size
< height
)
6684 /* Each string or bool-vector in data must be large enough
6685 for one line of the image. */
6686 for (i
= 0; i
< height
; ++i
)
6688 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6692 if (XSTRING (elt
)->size
6693 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6696 else if (BOOL_VECTOR_P (elt
))
6698 if (XBOOL_VECTOR (elt
)->size
< width
)
6705 else if (STRINGP (data
))
6707 if (XSTRING (data
)->size
6708 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6711 else if (BOOL_VECTOR_P (data
))
6713 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6724 /* Scan a bitmap file. FP is the stream to read from. Value is
6725 either an enumerator from enum xbm_token, or a character for a
6726 single-character token, or 0 at end of file. If scanning an
6727 identifier, store the lexeme of the identifier in SVAL. If
6728 scanning a number, store its value in *IVAL. */
6731 xbm_scan (s
, end
, sval
, ival
)
6740 /* Skip white space. */
6741 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6746 else if (isdigit (c
))
6748 int value
= 0, digit
;
6750 if (c
== '0' && *s
< end
)
6753 if (c
== 'x' || c
== 'X')
6760 else if (c
>= 'a' && c
<= 'f')
6761 digit
= c
- 'a' + 10;
6762 else if (c
>= 'A' && c
<= 'F')
6763 digit
= c
- 'A' + 10;
6766 value
= 16 * value
+ digit
;
6769 else if (isdigit (c
))
6773 && (c
= *(*s
)++, isdigit (c
)))
6774 value
= 8 * value
+ c
- '0';
6781 && (c
= *(*s
)++, isdigit (c
)))
6782 value
= 10 * value
+ c
- '0';
6790 else if (isalpha (c
) || c
== '_')
6794 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6801 else if (c
== '/' && **s
== '*')
6803 /* C-style comment. */
6805 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6818 /* Replacement for XReadBitmapFileData which isn't available under old
6819 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6820 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6821 the image. Return in *DATA the bitmap data allocated with xmalloc.
6822 Value is non-zero if successful. DATA null means just test if
6823 CONTENTS looks like an in-memory XBM file. */
6826 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6827 char *contents
, *end
;
6828 int *width
, *height
;
6829 unsigned char **data
;
6832 char buffer
[BUFSIZ
];
6835 int bytes_per_line
, i
, nbytes
;
6841 LA1 = xbm_scan (&s, end, buffer, &value)
6843 #define expect(TOKEN) \
6844 if (LA1 != (TOKEN)) \
6849 #define expect_ident(IDENT) \
6850 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6855 *width
= *height
= -1;
6858 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6860 /* Parse defines for width, height and hot-spots. */
6864 expect_ident ("define");
6865 expect (XBM_TK_IDENT
);
6867 if (LA1
== XBM_TK_NUMBER
);
6869 char *p
= strrchr (buffer
, '_');
6870 p
= p
? p
+ 1 : buffer
;
6871 if (strcmp (p
, "width") == 0)
6873 else if (strcmp (p
, "height") == 0)
6876 expect (XBM_TK_NUMBER
);
6879 if (*width
< 0 || *height
< 0)
6881 else if (data
== NULL
)
6884 /* Parse bits. Must start with `static'. */
6885 expect_ident ("static");
6886 if (LA1
== XBM_TK_IDENT
)
6888 if (strcmp (buffer
, "unsigned") == 0)
6891 expect_ident ("char");
6893 else if (strcmp (buffer
, "short") == 0)
6897 if (*width
% 16 && *width
% 16 < 9)
6900 else if (strcmp (buffer
, "char") == 0)
6908 expect (XBM_TK_IDENT
);
6914 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6915 nbytes
= bytes_per_line
* *height
;
6916 p
= *data
= (char *) xmalloc (nbytes
);
6920 for (i
= 0; i
< nbytes
; i
+= 2)
6923 expect (XBM_TK_NUMBER
);
6926 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6929 if (LA1
== ',' || LA1
== '}')
6937 for (i
= 0; i
< nbytes
; ++i
)
6940 expect (XBM_TK_NUMBER
);
6944 if (LA1
== ',' || LA1
== '}')
6969 /* Load XBM image IMG which will be displayed on frame F from buffer
6970 CONTENTS. END is the end of the buffer. Value is non-zero if
6974 xbm_load_image (f
, img
, contents
, end
)
6977 char *contents
, *end
;
6980 unsigned char *data
;
6983 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6986 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6987 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6988 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6991 xassert (img
->width
> 0 && img
->height
> 0);
6993 /* Get foreground and background colors, maybe allocate colors. */
6994 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6996 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6997 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
7000 background
= x_alloc_image_color (f
, img
, value
, background
);
7001 img
->background
= background
;
7002 img
->background_valid
= 1;
7006 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7009 img
->width
, img
->height
,
7010 foreground
, background
,
7014 if (img
->pixmap
== None
)
7016 x_clear_image (f
, img
);
7017 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
7023 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7029 /* Value is non-zero if DATA looks like an in-memory XBM file. */
7036 return (STRINGP (data
)
7037 && xbm_read_bitmap_data (XSTRING (data
)->data
,
7038 (XSTRING (data
)->data
7039 + STRING_BYTES (XSTRING (data
))),
7044 /* Fill image IMG which is used on frame F with pixmap data. Value is
7045 non-zero if successful. */
7053 Lisp_Object file_name
;
7055 xassert (xbm_image_p (img
->spec
));
7057 /* If IMG->spec specifies a file name, create a non-file spec from it. */
7058 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
7059 if (STRINGP (file_name
))
7064 struct gcpro gcpro1
;
7066 file
= x_find_image_file (file_name
);
7068 if (!STRINGP (file
))
7070 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
7075 contents
= slurp_file (XSTRING (file
)->data
, &size
);
7076 if (contents
== NULL
)
7078 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7083 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
7088 struct image_keyword fmt
[XBM_LAST
];
7091 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7092 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7095 int in_memory_file_p
= 0;
7097 /* See if data looks like an in-memory XBM file. */
7098 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7099 in_memory_file_p
= xbm_file_p (data
);
7101 /* Parse the image specification. */
7102 bcopy (xbm_format
, fmt
, sizeof fmt
);
7103 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
7106 /* Get specified width, and height. */
7107 if (!in_memory_file_p
)
7109 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
7110 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
7111 xassert (img
->width
> 0 && img
->height
> 0);
7114 /* Get foreground and background colors, maybe allocate colors. */
7115 if (fmt
[XBM_FOREGROUND
].count
7116 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
7117 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
7119 if (fmt
[XBM_BACKGROUND
].count
7120 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
7121 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
7124 if (in_memory_file_p
)
7125 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
7126 (XSTRING (data
)->data
7127 + STRING_BYTES (XSTRING (data
))));
7134 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
7136 p
= bits
= (char *) alloca (nbytes
* img
->height
);
7137 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
7139 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
7141 bcopy (XSTRING (line
)->data
, p
, nbytes
);
7143 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
7146 else if (STRINGP (data
))
7147 bits
= XSTRING (data
)->data
;
7149 bits
= XBOOL_VECTOR (data
)->data
;
7151 /* Create the pixmap. */
7152 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7154 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7157 img
->width
, img
->height
,
7158 foreground
, background
,
7164 image_error ("Unable to create pixmap for XBM image `%s'",
7166 x_clear_image (f
, img
);
7176 /***********************************************************************
7178 ***********************************************************************/
7182 static int xpm_image_p
P_ ((Lisp_Object object
));
7183 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
7184 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
7186 #include "X11/xpm.h"
7188 /* The symbol `xpm' identifying XPM-format images. */
7192 /* Indices of image specification fields in xpm_format, below. */
7194 enum xpm_keyword_index
7210 /* Vector of image_keyword structures describing the format
7211 of valid XPM image specifications. */
7213 static struct image_keyword xpm_format
[XPM_LAST
] =
7215 {":type", IMAGE_SYMBOL_VALUE
, 1},
7216 {":file", IMAGE_STRING_VALUE
, 0},
7217 {":data", IMAGE_STRING_VALUE
, 0},
7218 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7219 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7220 {":relief", IMAGE_INTEGER_VALUE
, 0},
7221 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7222 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7223 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7224 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7225 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
7228 /* Structure describing the image type XBM. */
7230 static struct image_type xpm_type
=
7240 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7241 functions for allocating image colors. Our own functions handle
7242 color allocation failures more gracefully than the ones on the XPM
7245 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7246 #define ALLOC_XPM_COLORS
7249 #ifdef ALLOC_XPM_COLORS
7251 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7252 static void xpm_free_color_cache
P_ ((void));
7253 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7254 static int xpm_color_bucket
P_ ((char *));
7255 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7258 /* An entry in a hash table used to cache color definitions of named
7259 colors. This cache is necessary to speed up XPM image loading in
7260 case we do color allocations ourselves. Without it, we would need
7261 a call to XParseColor per pixel in the image. */
7263 struct xpm_cached_color
7265 /* Next in collision chain. */
7266 struct xpm_cached_color
*next
;
7268 /* Color definition (RGB and pixel color). */
7275 /* The hash table used for the color cache, and its bucket vector
7278 #define XPM_COLOR_CACHE_BUCKETS 1001
7279 struct xpm_cached_color
**xpm_color_cache
;
7281 /* Initialize the color cache. */
7284 xpm_init_color_cache (f
, attrs
)
7286 XpmAttributes
*attrs
;
7288 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7289 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7290 memset (xpm_color_cache
, 0, nbytes
);
7291 init_color_table ();
7293 if (attrs
->valuemask
& XpmColorSymbols
)
7298 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7299 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7300 attrs
->colorsymbols
[i
].value
, &color
))
7302 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7304 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7310 /* Free the color cache. */
7313 xpm_free_color_cache ()
7315 struct xpm_cached_color
*p
, *next
;
7318 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7319 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7325 xfree (xpm_color_cache
);
7326 xpm_color_cache
= NULL
;
7327 free_color_table ();
7331 /* Return the bucket index for color named COLOR_NAME in the color
7335 xpm_color_bucket (color_name
)
7341 for (s
= color_name
; *s
; ++s
)
7343 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7347 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7348 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7351 static struct xpm_cached_color
*
7352 xpm_cache_color (f
, color_name
, color
, bucket
)
7359 struct xpm_cached_color
*p
;
7362 bucket
= xpm_color_bucket (color_name
);
7364 nbytes
= sizeof *p
+ strlen (color_name
);
7365 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7366 strcpy (p
->name
, color_name
);
7368 p
->next
= xpm_color_cache
[bucket
];
7369 xpm_color_cache
[bucket
] = p
;
7374 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7375 return the cached definition in *COLOR. Otherwise, make a new
7376 entry in the cache and allocate the color. Value is zero if color
7377 allocation failed. */
7380 xpm_lookup_color (f
, color_name
, color
)
7385 struct xpm_cached_color
*p
;
7386 int h
= xpm_color_bucket (color_name
);
7388 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7389 if (strcmp (p
->name
, color_name
) == 0)
7394 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7397 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7399 p
= xpm_cache_color (f
, color_name
, color
, h
);
7406 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7407 CLOSURE is a pointer to the frame on which we allocate the
7408 color. Return in *COLOR the allocated color. Value is non-zero
7412 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7419 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7423 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7424 is a pointer to the frame on which we allocate the color. Value is
7425 non-zero if successful. */
7428 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7438 #endif /* ALLOC_XPM_COLORS */
7441 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7442 for XPM images. Such a list must consist of conses whose car and
7446 xpm_valid_color_symbols_p (color_symbols
)
7447 Lisp_Object color_symbols
;
7449 while (CONSP (color_symbols
))
7451 Lisp_Object sym
= XCAR (color_symbols
);
7453 || !STRINGP (XCAR (sym
))
7454 || !STRINGP (XCDR (sym
)))
7456 color_symbols
= XCDR (color_symbols
);
7459 return NILP (color_symbols
);
7463 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7466 xpm_image_p (object
)
7469 struct image_keyword fmt
[XPM_LAST
];
7470 bcopy (xpm_format
, fmt
, sizeof fmt
);
7471 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7472 /* Either `:file' or `:data' must be present. */
7473 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7474 /* Either no `:color-symbols' or it's a list of conses
7475 whose car and cdr are strings. */
7476 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7477 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7481 /* Load image IMG which will be displayed on frame F. Value is
7482 non-zero if successful. */
7490 XpmAttributes attrs
;
7491 Lisp_Object specified_file
, color_symbols
;
7493 /* Configure the XPM lib. Use the visual of frame F. Allocate
7494 close colors. Return colors allocated. */
7495 bzero (&attrs
, sizeof attrs
);
7496 attrs
.visual
= FRAME_X_VISUAL (f
);
7497 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7498 attrs
.valuemask
|= XpmVisual
;
7499 attrs
.valuemask
|= XpmColormap
;
7501 #ifdef ALLOC_XPM_COLORS
7502 /* Allocate colors with our own functions which handle
7503 failing color allocation more gracefully. */
7504 attrs
.color_closure
= f
;
7505 attrs
.alloc_color
= xpm_alloc_color
;
7506 attrs
.free_colors
= xpm_free_colors
;
7507 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7508 #else /* not ALLOC_XPM_COLORS */
7509 /* Let the XPM lib allocate colors. */
7510 attrs
.valuemask
|= XpmReturnAllocPixels
;
7511 #ifdef XpmAllocCloseColors
7512 attrs
.alloc_close_colors
= 1;
7513 attrs
.valuemask
|= XpmAllocCloseColors
;
7514 #else /* not XpmAllocCloseColors */
7515 attrs
.closeness
= 600;
7516 attrs
.valuemask
|= XpmCloseness
;
7517 #endif /* not XpmAllocCloseColors */
7518 #endif /* ALLOC_XPM_COLORS */
7520 /* If image specification contains symbolic color definitions, add
7521 these to `attrs'. */
7522 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7523 if (CONSP (color_symbols
))
7526 XpmColorSymbol
*xpm_syms
;
7529 attrs
.valuemask
|= XpmColorSymbols
;
7531 /* Count number of symbols. */
7532 attrs
.numsymbols
= 0;
7533 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7536 /* Allocate an XpmColorSymbol array. */
7537 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7538 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7539 bzero (xpm_syms
, size
);
7540 attrs
.colorsymbols
= xpm_syms
;
7542 /* Fill the color symbol array. */
7543 for (tail
= color_symbols
, i
= 0;
7545 ++i
, tail
= XCDR (tail
))
7547 Lisp_Object name
= XCAR (XCAR (tail
));
7548 Lisp_Object color
= XCDR (XCAR (tail
));
7549 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7550 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7551 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7552 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7556 /* Create a pixmap for the image, either from a file, or from a
7557 string buffer containing data in the same format as an XPM file. */
7558 #ifdef ALLOC_XPM_COLORS
7559 xpm_init_color_cache (f
, &attrs
);
7562 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7563 if (STRINGP (specified_file
))
7565 Lisp_Object file
= x_find_image_file (specified_file
);
7566 if (!STRINGP (file
))
7568 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7572 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7573 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7578 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7579 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7580 XSTRING (buffer
)->data
,
7581 &img
->pixmap
, &img
->mask
,
7585 if (rc
== XpmSuccess
)
7587 #ifdef ALLOC_XPM_COLORS
7588 img
->colors
= colors_in_color_table (&img
->ncolors
);
7589 #else /* not ALLOC_XPM_COLORS */
7592 img
->ncolors
= attrs
.nalloc_pixels
;
7593 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7594 * sizeof *img
->colors
);
7595 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7597 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7598 #ifdef DEBUG_X_COLORS
7599 register_color (img
->colors
[i
]);
7602 #endif /* not ALLOC_XPM_COLORS */
7604 img
->width
= attrs
.width
;
7605 img
->height
= attrs
.height
;
7606 xassert (img
->width
> 0 && img
->height
> 0);
7608 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7609 XpmFreeAttributes (&attrs
);
7616 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7619 case XpmFileInvalid
:
7620 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7624 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7627 case XpmColorFailed
:
7628 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7632 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7637 #ifdef ALLOC_XPM_COLORS
7638 xpm_free_color_cache ();
7640 return rc
== XpmSuccess
;
7643 #endif /* HAVE_XPM != 0 */
7646 /***********************************************************************
7648 ***********************************************************************/
7650 /* An entry in the color table mapping an RGB color to a pixel color. */
7655 unsigned long pixel
;
7657 /* Next in color table collision list. */
7658 struct ct_color
*next
;
7661 /* The bucket vector size to use. Must be prime. */
7665 /* Value is a hash of the RGB color given by R, G, and B. */
7667 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7669 /* The color hash table. */
7671 struct ct_color
**ct_table
;
7673 /* Number of entries in the color table. */
7675 int ct_colors_allocated
;
7677 /* Initialize the color table. */
7682 int size
= CT_SIZE
* sizeof (*ct_table
);
7683 ct_table
= (struct ct_color
**) xmalloc (size
);
7684 bzero (ct_table
, size
);
7685 ct_colors_allocated
= 0;
7689 /* Free memory associated with the color table. */
7695 struct ct_color
*p
, *next
;
7697 for (i
= 0; i
< CT_SIZE
; ++i
)
7698 for (p
= ct_table
[i
]; p
; p
= next
)
7709 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7710 entry for that color already is in the color table, return the
7711 pixel color of that entry. Otherwise, allocate a new color for R,
7712 G, B, and make an entry in the color table. */
7714 static unsigned long
7715 lookup_rgb_color (f
, r
, g
, b
)
7719 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7720 int i
= hash
% CT_SIZE
;
7723 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7724 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7737 cmap
= FRAME_X_COLORMAP (f
);
7738 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7742 ++ct_colors_allocated
;
7744 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7748 p
->pixel
= color
.pixel
;
7749 p
->next
= ct_table
[i
];
7753 return FRAME_FOREGROUND_PIXEL (f
);
7760 /* Look up pixel color PIXEL which is used on frame F in the color
7761 table. If not already present, allocate it. Value is PIXEL. */
7763 static unsigned long
7764 lookup_pixel_color (f
, pixel
)
7766 unsigned long pixel
;
7768 int i
= pixel
% CT_SIZE
;
7771 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7772 if (p
->pixel
== pixel
)
7781 cmap
= FRAME_X_COLORMAP (f
);
7782 color
.pixel
= pixel
;
7783 x_query_color (f
, &color
);
7784 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7788 ++ct_colors_allocated
;
7790 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7795 p
->next
= ct_table
[i
];
7799 return FRAME_FOREGROUND_PIXEL (f
);
7806 /* Value is a vector of all pixel colors contained in the color table,
7807 allocated via xmalloc. Set *N to the number of colors. */
7809 static unsigned long *
7810 colors_in_color_table (n
)
7815 unsigned long *colors
;
7817 if (ct_colors_allocated
== 0)
7824 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7826 *n
= ct_colors_allocated
;
7828 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7829 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7830 colors
[j
++] = p
->pixel
;
7838 /***********************************************************************
7840 ***********************************************************************/
7842 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7843 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7844 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7846 /* Non-zero means draw a cross on images having `:conversion
7849 int cross_disabled_images
;
7851 /* Edge detection matrices for different edge-detection
7854 static int emboss_matrix
[9] = {
7856 2, -1, 0, /* y - 1 */
7858 0, 1, -2 /* y + 1 */
7861 static int laplace_matrix
[9] = {
7863 1, 0, 0, /* y - 1 */
7865 0, 0, -1 /* y + 1 */
7868 /* Value is the intensity of the color whose red/green/blue values
7871 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7874 /* On frame F, return an array of XColor structures describing image
7875 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7876 non-zero means also fill the red/green/blue members of the XColor
7877 structures. Value is a pointer to the array of XColors structures,
7878 allocated with xmalloc; it must be freed by the caller. */
7881 x_to_xcolors (f
, img
, rgb_p
)
7890 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7892 /* Get the X image IMG->pixmap. */
7893 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7894 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7896 /* Fill the `pixel' members of the XColor array. I wished there
7897 were an easy and portable way to circumvent XGetPixel. */
7899 for (y
= 0; y
< img
->height
; ++y
)
7903 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7904 p
->pixel
= XGetPixel (ximg
, x
, y
);
7907 x_query_colors (f
, row
, img
->width
);
7910 XDestroyImage (ximg
);
7915 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7916 RGB members are set. F is the frame on which this all happens.
7917 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7920 x_from_xcolors (f
, img
, colors
)
7930 init_color_table ();
7932 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7935 for (y
= 0; y
< img
->height
; ++y
)
7936 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7938 unsigned long pixel
;
7939 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7940 XPutPixel (oimg
, x
, y
, pixel
);
7944 x_clear_image_1 (f
, img
, 1, 0, 1);
7946 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7947 x_destroy_x_image (oimg
);
7948 img
->pixmap
= pixmap
;
7949 img
->colors
= colors_in_color_table (&img
->ncolors
);
7950 free_color_table ();
7954 /* On frame F, perform edge-detection on image IMG.
7956 MATRIX is a nine-element array specifying the transformation
7957 matrix. See emboss_matrix for an example.
7959 COLOR_ADJUST is a color adjustment added to each pixel of the
7963 x_detect_edges (f
, img
, matrix
, color_adjust
)
7966 int matrix
[9], color_adjust
;
7968 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7972 for (i
= sum
= 0; i
< 9; ++i
)
7973 sum
+= abs (matrix
[i
]);
7975 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7977 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7979 for (y
= 0; y
< img
->height
; ++y
)
7981 p
= COLOR (new, 0, y
);
7982 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7983 p
= COLOR (new, img
->width
- 1, y
);
7984 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7987 for (x
= 1; x
< img
->width
- 1; ++x
)
7989 p
= COLOR (new, x
, 0);
7990 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7991 p
= COLOR (new, x
, img
->height
- 1);
7992 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7995 for (y
= 1; y
< img
->height
- 1; ++y
)
7997 p
= COLOR (new, 1, y
);
7999 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
8001 int r
, g
, b
, y1
, x1
;
8004 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
8005 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
8008 XColor
*t
= COLOR (colors
, x1
, y1
);
8009 r
+= matrix
[i
] * t
->red
;
8010 g
+= matrix
[i
] * t
->green
;
8011 b
+= matrix
[i
] * t
->blue
;
8014 r
= (r
/ sum
+ color_adjust
) & 0xffff;
8015 g
= (g
/ sum
+ color_adjust
) & 0xffff;
8016 b
= (b
/ sum
+ color_adjust
) & 0xffff;
8017 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
8022 x_from_xcolors (f
, img
, new);
8028 /* Perform the pre-defined `emboss' edge-detection on image IMG
8036 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
8040 /* Perform the pre-defined `laplace' edge-detection on image IMG
8048 x_detect_edges (f
, img
, laplace_matrix
, 45000);
8052 /* Perform edge-detection on image IMG on frame F, with specified
8053 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
8055 MATRIX must be either
8057 - a list of at least 9 numbers in row-major form
8058 - a vector of at least 9 numbers
8060 COLOR_ADJUST nil means use a default; otherwise it must be a
8064 x_edge_detection (f
, img
, matrix
, color_adjust
)
8067 Lisp_Object matrix
, color_adjust
;
8075 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
8076 ++i
, matrix
= XCDR (matrix
))
8077 trans
[i
] = XFLOATINT (XCAR (matrix
));
8079 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
8081 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
8082 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
8085 if (NILP (color_adjust
))
8086 color_adjust
= make_number (0xffff / 2);
8088 if (i
== 9 && NUMBERP (color_adjust
))
8089 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
8093 /* Transform image IMG on frame F so that it looks disabled. */
8096 x_disable_image (f
, img
)
8100 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
8102 if (dpyinfo
->n_planes
>= 2)
8104 /* Color (or grayscale). Convert to gray, and equalize. Just
8105 drawing such images with a stipple can look very odd, so
8106 we're using this method instead. */
8107 XColor
*colors
= x_to_xcolors (f
, img
, 1);
8109 const int h
= 15000;
8110 const int l
= 30000;
8112 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
8116 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
8117 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
8118 p
->red
= p
->green
= p
->blue
= i2
;
8121 x_from_xcolors (f
, img
, colors
);
8124 /* Draw a cross over the disabled image, if we must or if we
8126 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
8128 Display
*dpy
= FRAME_X_DISPLAY (f
);
8131 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
8132 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
8133 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
8134 img
->width
- 1, img
->height
- 1);
8135 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
8141 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
8142 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
8143 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
8144 img
->width
- 1, img
->height
- 1);
8145 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
8153 /* Build a mask for image IMG which is used on frame F. FILE is the
8154 name of an image file, for error messages. HOW determines how to
8155 determine the background color of IMG. If it is a list '(R G B)',
8156 with R, G, and B being integers >= 0, take that as the color of the
8157 background. Otherwise, determine the background color of IMG
8158 heuristically. Value is non-zero if successful. */
8161 x_build_heuristic_mask (f
, img
, how
)
8166 Display
*dpy
= FRAME_X_DISPLAY (f
);
8167 XImage
*ximg
, *mask_img
;
8168 int x
, y
, rc
, use_img_background
;
8169 unsigned long bg
= 0;
8173 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8175 img
->background_transparent_valid
= 0;
8178 /* Create an image and pixmap serving as mask. */
8179 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
8180 &mask_img
, &img
->mask
);
8184 /* Get the X image of IMG->pixmap. */
8185 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
8188 /* Determine the background color of ximg. If HOW is `(R G B)'
8189 take that as color. Otherwise, use the image's background color. */
8190 use_img_background
= 1;
8196 for (i
= 0; i
< 3 && CONSP (how
) && NATNUMP (XCAR (how
)); ++i
)
8198 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
8202 if (i
== 3 && NILP (how
))
8204 char color_name
[30];
8205 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
8206 bg
= x_alloc_image_color (f
, img
, build_string (color_name
), 0);
8207 use_img_background
= 0;
8211 if (use_img_background
)
8212 bg
= four_corners_best (ximg
, img
->width
, img
->height
);
8214 /* Set all bits in mask_img to 1 whose color in ximg is different
8215 from the background color bg. */
8216 for (y
= 0; y
< img
->height
; ++y
)
8217 for (x
= 0; x
< img
->width
; ++x
)
8218 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8220 /* Fill in the background_transparent field while we have the mask handy. */
8221 image_background_transparent (img
, f
, mask_img
);
8223 /* Put mask_img into img->mask. */
8224 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8225 x_destroy_x_image (mask_img
);
8226 XDestroyImage (ximg
);
8233 /***********************************************************************
8234 PBM (mono, gray, color)
8235 ***********************************************************************/
8237 static int pbm_image_p
P_ ((Lisp_Object object
));
8238 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8239 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8241 /* The symbol `pbm' identifying images of this type. */
8245 /* Indices of image specification fields in gs_format, below. */
8247 enum pbm_keyword_index
8263 /* Vector of image_keyword structures describing the format
8264 of valid user-defined image specifications. */
8266 static struct image_keyword pbm_format
[PBM_LAST
] =
8268 {":type", IMAGE_SYMBOL_VALUE
, 1},
8269 {":file", IMAGE_STRING_VALUE
, 0},
8270 {":data", IMAGE_STRING_VALUE
, 0},
8271 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8272 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8273 {":relief", IMAGE_INTEGER_VALUE
, 0},
8274 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8275 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8276 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8277 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8278 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8281 /* Structure describing the image type `pbm'. */
8283 static struct image_type pbm_type
=
8293 /* Return non-zero if OBJECT is a valid PBM image specification. */
8296 pbm_image_p (object
)
8299 struct image_keyword fmt
[PBM_LAST
];
8301 bcopy (pbm_format
, fmt
, sizeof fmt
);
8303 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8306 /* Must specify either :data or :file. */
8307 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8311 /* Scan a decimal number from *S and return it. Advance *S while
8312 reading the number. END is the end of the string. Value is -1 at
8316 pbm_scan_number (s
, end
)
8317 unsigned char **s
, *end
;
8319 int c
= 0, val
= -1;
8323 /* Skip white-space. */
8324 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8329 /* Skip comment to end of line. */
8330 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8333 else if (isdigit (c
))
8335 /* Read decimal number. */
8337 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8338 val
= 10 * val
+ c
- '0';
8349 /* Load PBM image IMG for use on frame F. */
8357 int width
, height
, max_color_idx
= 0;
8359 Lisp_Object file
, specified_file
;
8360 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8361 struct gcpro gcpro1
;
8362 unsigned char *contents
= NULL
;
8363 unsigned char *end
, *p
;
8366 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8370 if (STRINGP (specified_file
))
8372 file
= x_find_image_file (specified_file
);
8373 if (!STRINGP (file
))
8375 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8380 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8381 if (contents
== NULL
)
8383 image_error ("Error reading `%s'", file
, Qnil
);
8389 end
= contents
+ size
;
8394 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8395 p
= XSTRING (data
)->data
;
8396 end
= p
+ STRING_BYTES (XSTRING (data
));
8399 /* Check magic number. */
8400 if (end
- p
< 2 || *p
++ != 'P')
8402 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8412 raw_p
= 0, type
= PBM_MONO
;
8416 raw_p
= 0, type
= PBM_GRAY
;
8420 raw_p
= 0, type
= PBM_COLOR
;
8424 raw_p
= 1, type
= PBM_MONO
;
8428 raw_p
= 1, type
= PBM_GRAY
;
8432 raw_p
= 1, type
= PBM_COLOR
;
8436 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8440 /* Read width, height, maximum color-component. Characters
8441 starting with `#' up to the end of a line are ignored. */
8442 width
= pbm_scan_number (&p
, end
);
8443 height
= pbm_scan_number (&p
, end
);
8445 if (type
!= PBM_MONO
)
8447 max_color_idx
= pbm_scan_number (&p
, end
);
8448 if (raw_p
&& max_color_idx
> 255)
8449 max_color_idx
= 255;
8454 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8457 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8458 &ximg
, &img
->pixmap
))
8461 /* Initialize the color hash table. */
8462 init_color_table ();
8464 if (type
== PBM_MONO
)
8467 struct image_keyword fmt
[PBM_LAST
];
8468 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8469 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8471 /* Parse the image specification. */
8472 bcopy (pbm_format
, fmt
, sizeof fmt
);
8473 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8475 /* Get foreground and background colors, maybe allocate colors. */
8476 if (fmt
[PBM_FOREGROUND
].count
8477 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
8478 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8479 if (fmt
[PBM_BACKGROUND
].count
8480 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
8482 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8483 img
->background
= bg
;
8484 img
->background_valid
= 1;
8487 for (y
= 0; y
< height
; ++y
)
8488 for (x
= 0; x
< width
; ++x
)
8498 g
= pbm_scan_number (&p
, end
);
8500 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8505 for (y
= 0; y
< height
; ++y
)
8506 for (x
= 0; x
< width
; ++x
)
8510 if (type
== PBM_GRAY
)
8511 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8520 r
= pbm_scan_number (&p
, end
);
8521 g
= pbm_scan_number (&p
, end
);
8522 b
= pbm_scan_number (&p
, end
);
8525 if (r
< 0 || g
< 0 || b
< 0)
8529 XDestroyImage (ximg
);
8530 image_error ("Invalid pixel value in image `%s'",
8535 /* RGB values are now in the range 0..max_color_idx.
8536 Scale this to the range 0..0xffff supported by X. */
8537 r
= (double) r
* 65535 / max_color_idx
;
8538 g
= (double) g
* 65535 / max_color_idx
;
8539 b
= (double) b
* 65535 / max_color_idx
;
8540 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8544 /* Store in IMG->colors the colors allocated for the image, and
8545 free the color table. */
8546 img
->colors
= colors_in_color_table (&img
->ncolors
);
8547 free_color_table ();
8549 /* Maybe fill in the background field while we have ximg handy. */
8550 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
8551 IMAGE_BACKGROUND (img
, f
, ximg
);
8553 /* Put the image into a pixmap. */
8554 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8555 x_destroy_x_image (ximg
);
8558 img
->height
= height
;
8567 /***********************************************************************
8569 ***********************************************************************/
8575 /* Function prototypes. */
8577 static int png_image_p
P_ ((Lisp_Object object
));
8578 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8580 /* The symbol `png' identifying images of this type. */
8584 /* Indices of image specification fields in png_format, below. */
8586 enum png_keyword_index
8601 /* Vector of image_keyword structures describing the format
8602 of valid user-defined image specifications. */
8604 static struct image_keyword png_format
[PNG_LAST
] =
8606 {":type", IMAGE_SYMBOL_VALUE
, 1},
8607 {":data", IMAGE_STRING_VALUE
, 0},
8608 {":file", IMAGE_STRING_VALUE
, 0},
8609 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8610 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8611 {":relief", IMAGE_INTEGER_VALUE
, 0},
8612 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8613 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8614 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8615 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8618 /* Structure describing the image type `png'. */
8620 static struct image_type png_type
=
8630 /* Return non-zero if OBJECT is a valid PNG image specification. */
8633 png_image_p (object
)
8636 struct image_keyword fmt
[PNG_LAST
];
8637 bcopy (png_format
, fmt
, sizeof fmt
);
8639 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8642 /* Must specify either the :data or :file keyword. */
8643 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8647 /* Error and warning handlers installed when the PNG library
8651 my_png_error (png_ptr
, msg
)
8652 png_struct
*png_ptr
;
8655 xassert (png_ptr
!= NULL
);
8656 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8657 longjmp (png_ptr
->jmpbuf
, 1);
8662 my_png_warning (png_ptr
, msg
)
8663 png_struct
*png_ptr
;
8666 xassert (png_ptr
!= NULL
);
8667 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8670 /* Memory source for PNG decoding. */
8672 struct png_memory_storage
8674 unsigned char *bytes
; /* The data */
8675 size_t len
; /* How big is it? */
8676 int index
; /* Where are we? */
8680 /* Function set as reader function when reading PNG image from memory.
8681 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8682 bytes from the input to DATA. */
8685 png_read_from_memory (png_ptr
, data
, length
)
8686 png_structp png_ptr
;
8690 struct png_memory_storage
*tbr
8691 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8693 if (length
> tbr
->len
- tbr
->index
)
8694 png_error (png_ptr
, "Read error");
8696 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8697 tbr
->index
= tbr
->index
+ length
;
8700 /* Load PNG image IMG for use on frame F. Value is non-zero if
8708 Lisp_Object file
, specified_file
;
8709 Lisp_Object specified_data
;
8711 XImage
*ximg
, *mask_img
= NULL
;
8712 struct gcpro gcpro1
;
8713 png_struct
*png_ptr
= NULL
;
8714 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8715 FILE *volatile fp
= NULL
;
8717 png_byte
* volatile pixels
= NULL
;
8718 png_byte
** volatile rows
= NULL
;
8719 png_uint_32 width
, height
;
8720 int bit_depth
, color_type
, interlace_type
;
8722 png_uint_32 row_bytes
;
8725 double screen_gamma
, image_gamma
;
8727 struct png_memory_storage tbr
; /* Data to be read */
8729 /* Find out what file to load. */
8730 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8731 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8735 if (NILP (specified_data
))
8737 file
= x_find_image_file (specified_file
);
8738 if (!STRINGP (file
))
8740 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8745 /* Open the image file. */
8746 fp
= fopen (XSTRING (file
)->data
, "rb");
8749 image_error ("Cannot open image file `%s'", file
, Qnil
);
8755 /* Check PNG signature. */
8756 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8757 || !png_check_sig (sig
, sizeof sig
))
8759 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8767 /* Read from memory. */
8768 tbr
.bytes
= XSTRING (specified_data
)->data
;
8769 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8772 /* Check PNG signature. */
8773 if (tbr
.len
< sizeof sig
8774 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8776 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8781 /* Need to skip past the signature. */
8782 tbr
.bytes
+= sizeof (sig
);
8785 /* Initialize read and info structs for PNG lib. */
8786 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8787 my_png_error
, my_png_warning
);
8790 if (fp
) fclose (fp
);
8795 info_ptr
= png_create_info_struct (png_ptr
);
8798 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8799 if (fp
) fclose (fp
);
8804 end_info
= png_create_info_struct (png_ptr
);
8807 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8808 if (fp
) fclose (fp
);
8813 /* Set error jump-back. We come back here when the PNG library
8814 detects an error. */
8815 if (setjmp (png_ptr
->jmpbuf
))
8819 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8822 if (fp
) fclose (fp
);
8827 /* Read image info. */
8828 if (!NILP (specified_data
))
8829 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8831 png_init_io (png_ptr
, fp
);
8833 png_set_sig_bytes (png_ptr
, sizeof sig
);
8834 png_read_info (png_ptr
, info_ptr
);
8835 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8836 &interlace_type
, NULL
, NULL
);
8838 /* If image contains simply transparency data, we prefer to
8839 construct a clipping mask. */
8840 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8845 /* This function is easier to write if we only have to handle
8846 one data format: RGB or RGBA with 8 bits per channel. Let's
8847 transform other formats into that format. */
8849 /* Strip more than 8 bits per channel. */
8850 if (bit_depth
== 16)
8851 png_set_strip_16 (png_ptr
);
8853 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8855 png_set_expand (png_ptr
);
8857 /* Convert grayscale images to RGB. */
8858 if (color_type
== PNG_COLOR_TYPE_GRAY
8859 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8860 png_set_gray_to_rgb (png_ptr
);
8862 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8863 gamma_str
= getenv ("SCREEN_GAMMA");
8864 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8866 /* Tell the PNG lib to handle gamma correction for us. */
8868 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8869 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8870 /* There is a special chunk in the image specifying the gamma. */
8871 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8874 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8875 /* Image contains gamma information. */
8876 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8878 /* Use a default of 0.5 for the image gamma. */
8879 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8881 /* Handle alpha channel by combining the image with a background
8882 color. Do this only if a real alpha channel is supplied. For
8883 simple transparency, we prefer a clipping mask. */
8886 png_color_16
*image_bg
;
8887 Lisp_Object specified_bg
8888 = image_spec_value (img
->spec
, QCbackground
, NULL
);
8890 if (STRINGP (specified_bg
))
8891 /* The user specified `:background', use that. */
8894 if (x_defined_color (f
, XSTRING (specified_bg
)->data
, &color
, 0))
8896 png_color_16 user_bg
;
8898 bzero (&user_bg
, sizeof user_bg
);
8899 user_bg
.red
= color
.red
;
8900 user_bg
.green
= color
.green
;
8901 user_bg
.blue
= color
.blue
;
8903 png_set_background (png_ptr
, &user_bg
,
8904 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8907 else if (png_get_bKGD (png_ptr
, info_ptr
, &image_bg
))
8908 /* Image contains a background color with which to
8909 combine the image. */
8910 png_set_background (png_ptr
, image_bg
,
8911 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8914 /* Image does not contain a background color with which
8915 to combine the image data via an alpha channel. Use
8916 the frame's background instead. */
8919 png_color_16 frame_background
;
8921 cmap
= FRAME_X_COLORMAP (f
);
8922 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8923 x_query_color (f
, &color
);
8925 bzero (&frame_background
, sizeof frame_background
);
8926 frame_background
.red
= color
.red
;
8927 frame_background
.green
= color
.green
;
8928 frame_background
.blue
= color
.blue
;
8930 png_set_background (png_ptr
, &frame_background
,
8931 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8935 /* Update info structure. */
8936 png_read_update_info (png_ptr
, info_ptr
);
8938 /* Get number of channels. Valid values are 1 for grayscale images
8939 and images with a palette, 2 for grayscale images with transparency
8940 information (alpha channel), 3 for RGB images, and 4 for RGB
8941 images with alpha channel, i.e. RGBA. If conversions above were
8942 sufficient we should only have 3 or 4 channels here. */
8943 channels
= png_get_channels (png_ptr
, info_ptr
);
8944 xassert (channels
== 3 || channels
== 4);
8946 /* Number of bytes needed for one row of the image. */
8947 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8949 /* Allocate memory for the image. */
8950 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8951 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8952 for (i
= 0; i
< height
; ++i
)
8953 rows
[i
] = pixels
+ i
* row_bytes
;
8955 /* Read the entire image. */
8956 png_read_image (png_ptr
, rows
);
8957 png_read_end (png_ptr
, info_ptr
);
8964 /* Create the X image and pixmap. */
8965 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8969 /* Create an image and pixmap serving as mask if the PNG image
8970 contains an alpha channel. */
8973 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8974 &mask_img
, &img
->mask
))
8976 x_destroy_x_image (ximg
);
8977 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8982 /* Fill the X image and mask from PNG data. */
8983 init_color_table ();
8985 for (y
= 0; y
< height
; ++y
)
8987 png_byte
*p
= rows
[y
];
8989 for (x
= 0; x
< width
; ++x
)
8996 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8998 /* An alpha channel, aka mask channel, associates variable
8999 transparency with an image. Where other image formats
9000 support binary transparency---fully transparent or fully
9001 opaque---PNG allows up to 254 levels of partial transparency.
9002 The PNG library implements partial transparency by combining
9003 the image with a specified background color.
9005 I'm not sure how to handle this here nicely: because the
9006 background on which the image is displayed may change, for
9007 real alpha channel support, it would be necessary to create
9008 a new image for each possible background.
9010 What I'm doing now is that a mask is created if we have
9011 boolean transparency information. Otherwise I'm using
9012 the frame's background color to combine the image with. */
9017 XPutPixel (mask_img
, x
, y
, *p
> 0);
9023 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9024 /* Set IMG's background color from the PNG image, unless the user
9028 if (png_get_bKGD (png_ptr
, info_ptr
, &bg
))
9030 img
->background
= lookup_rgb_color (f
, bg
->red
, bg
->green
, bg
->blue
);
9031 img
->background_valid
= 1;
9035 /* Remember colors allocated for this image. */
9036 img
->colors
= colors_in_color_table (&img
->ncolors
);
9037 free_color_table ();
9040 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
9045 img
->height
= height
;
9047 /* Maybe fill in the background field while we have ximg handy. */
9048 IMAGE_BACKGROUND (img
, f
, ximg
);
9050 /* Put the image into the pixmap, then free the X image and its buffer. */
9051 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9052 x_destroy_x_image (ximg
);
9054 /* Same for the mask. */
9057 /* Fill in the background_transparent field while we have the mask
9059 image_background_transparent (img
, f
, mask_img
);
9061 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
9062 x_destroy_x_image (mask_img
);
9069 #endif /* HAVE_PNG != 0 */
9073 /***********************************************************************
9075 ***********************************************************************/
9079 /* Work around a warning about HAVE_STDLIB_H being redefined in
9081 #ifdef HAVE_STDLIB_H
9082 #define HAVE_STDLIB_H_1
9083 #undef HAVE_STDLIB_H
9084 #endif /* HAVE_STLIB_H */
9086 #include <jpeglib.h>
9090 #ifdef HAVE_STLIB_H_1
9091 #define HAVE_STDLIB_H 1
9094 static int jpeg_image_p
P_ ((Lisp_Object object
));
9095 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
9097 /* The symbol `jpeg' identifying images of this type. */
9101 /* Indices of image specification fields in gs_format, below. */
9103 enum jpeg_keyword_index
9112 JPEG_HEURISTIC_MASK
,
9118 /* Vector of image_keyword structures describing the format
9119 of valid user-defined image specifications. */
9121 static struct image_keyword jpeg_format
[JPEG_LAST
] =
9123 {":type", IMAGE_SYMBOL_VALUE
, 1},
9124 {":data", IMAGE_STRING_VALUE
, 0},
9125 {":file", IMAGE_STRING_VALUE
, 0},
9126 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9127 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9128 {":relief", IMAGE_INTEGER_VALUE
, 0},
9129 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9130 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9131 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9132 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9135 /* Structure describing the image type `jpeg'. */
9137 static struct image_type jpeg_type
=
9147 /* Return non-zero if OBJECT is a valid JPEG image specification. */
9150 jpeg_image_p (object
)
9153 struct image_keyword fmt
[JPEG_LAST
];
9155 bcopy (jpeg_format
, fmt
, sizeof fmt
);
9157 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
9160 /* Must specify either the :data or :file keyword. */
9161 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
9165 struct my_jpeg_error_mgr
9167 struct jpeg_error_mgr pub
;
9168 jmp_buf setjmp_buffer
;
9173 my_error_exit (cinfo
)
9176 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
9177 longjmp (mgr
->setjmp_buffer
, 1);
9181 /* Init source method for JPEG data source manager. Called by
9182 jpeg_read_header() before any data is actually read. See
9183 libjpeg.doc from the JPEG lib distribution. */
9186 our_init_source (cinfo
)
9187 j_decompress_ptr cinfo
;
9192 /* Fill input buffer method for JPEG data source manager. Called
9193 whenever more data is needed. We read the whole image in one step,
9194 so this only adds a fake end of input marker at the end. */
9197 our_fill_input_buffer (cinfo
)
9198 j_decompress_ptr cinfo
;
9200 /* Insert a fake EOI marker. */
9201 struct jpeg_source_mgr
*src
= cinfo
->src
;
9202 static JOCTET buffer
[2];
9204 buffer
[0] = (JOCTET
) 0xFF;
9205 buffer
[1] = (JOCTET
) JPEG_EOI
;
9207 src
->next_input_byte
= buffer
;
9208 src
->bytes_in_buffer
= 2;
9213 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9214 is the JPEG data source manager. */
9217 our_skip_input_data (cinfo
, num_bytes
)
9218 j_decompress_ptr cinfo
;
9221 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9225 if (num_bytes
> src
->bytes_in_buffer
)
9226 ERREXIT (cinfo
, JERR_INPUT_EOF
);
9228 src
->bytes_in_buffer
-= num_bytes
;
9229 src
->next_input_byte
+= num_bytes
;
9234 /* Method to terminate data source. Called by
9235 jpeg_finish_decompress() after all data has been processed. */
9238 our_term_source (cinfo
)
9239 j_decompress_ptr cinfo
;
9244 /* Set up the JPEG lib for reading an image from DATA which contains
9245 LEN bytes. CINFO is the decompression info structure created for
9246 reading the image. */
9249 jpeg_memory_src (cinfo
, data
, len
)
9250 j_decompress_ptr cinfo
;
9254 struct jpeg_source_mgr
*src
;
9256 if (cinfo
->src
== NULL
)
9258 /* First time for this JPEG object? */
9259 cinfo
->src
= (struct jpeg_source_mgr
*)
9260 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9261 sizeof (struct jpeg_source_mgr
));
9262 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9263 src
->next_input_byte
= data
;
9266 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9267 src
->init_source
= our_init_source
;
9268 src
->fill_input_buffer
= our_fill_input_buffer
;
9269 src
->skip_input_data
= our_skip_input_data
;
9270 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9271 src
->term_source
= our_term_source
;
9272 src
->bytes_in_buffer
= len
;
9273 src
->next_input_byte
= data
;
9277 /* Load image IMG for use on frame F. Patterned after example.c
9278 from the JPEG lib. */
9285 struct jpeg_decompress_struct cinfo
;
9286 struct my_jpeg_error_mgr mgr
;
9287 Lisp_Object file
, specified_file
;
9288 Lisp_Object specified_data
;
9289 FILE * volatile fp
= NULL
;
9291 int row_stride
, x
, y
;
9292 XImage
*ximg
= NULL
;
9294 unsigned long *colors
;
9296 struct gcpro gcpro1
;
9298 /* Open the JPEG file. */
9299 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9300 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9304 if (NILP (specified_data
))
9306 file
= x_find_image_file (specified_file
);
9307 if (!STRINGP (file
))
9309 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9314 fp
= fopen (XSTRING (file
)->data
, "r");
9317 image_error ("Cannot open `%s'", file
, Qnil
);
9323 /* Customize libjpeg's error handling to call my_error_exit when an
9324 error is detected. This function will perform a longjmp. */
9325 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9326 mgr
.pub
.error_exit
= my_error_exit
;
9328 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9332 /* Called from my_error_exit. Display a JPEG error. */
9333 char buffer
[JMSG_LENGTH_MAX
];
9334 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9335 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9336 build_string (buffer
));
9339 /* Close the input file and destroy the JPEG object. */
9341 fclose ((FILE *) fp
);
9342 jpeg_destroy_decompress (&cinfo
);
9344 /* If we already have an XImage, free that. */
9345 x_destroy_x_image (ximg
);
9347 /* Free pixmap and colors. */
9348 x_clear_image (f
, img
);
9354 /* Create the JPEG decompression object. Let it read from fp.
9355 Read the JPEG image header. */
9356 jpeg_create_decompress (&cinfo
);
9358 if (NILP (specified_data
))
9359 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9361 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9362 STRING_BYTES (XSTRING (specified_data
)));
9364 jpeg_read_header (&cinfo
, TRUE
);
9366 /* Customize decompression so that color quantization will be used.
9367 Start decompression. */
9368 cinfo
.quantize_colors
= TRUE
;
9369 jpeg_start_decompress (&cinfo
);
9370 width
= img
->width
= cinfo
.output_width
;
9371 height
= img
->height
= cinfo
.output_height
;
9373 /* Create X image and pixmap. */
9374 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9375 longjmp (mgr
.setjmp_buffer
, 2);
9377 /* Allocate colors. When color quantization is used,
9378 cinfo.actual_number_of_colors has been set with the number of
9379 colors generated, and cinfo.colormap is a two-dimensional array
9380 of color indices in the range 0..cinfo.actual_number_of_colors.
9381 No more than 255 colors will be generated. */
9385 if (cinfo
.out_color_components
> 2)
9386 ir
= 0, ig
= 1, ib
= 2;
9387 else if (cinfo
.out_color_components
> 1)
9388 ir
= 0, ig
= 1, ib
= 0;
9390 ir
= 0, ig
= 0, ib
= 0;
9392 /* Use the color table mechanism because it handles colors that
9393 cannot be allocated nicely. Such colors will be replaced with
9394 a default color, and we don't have to care about which colors
9395 can be freed safely, and which can't. */
9396 init_color_table ();
9397 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9400 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9402 /* Multiply RGB values with 255 because X expects RGB values
9403 in the range 0..0xffff. */
9404 int r
= cinfo
.colormap
[ir
][i
] << 8;
9405 int g
= cinfo
.colormap
[ig
][i
] << 8;
9406 int b
= cinfo
.colormap
[ib
][i
] << 8;
9407 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9410 /* Remember those colors actually allocated. */
9411 img
->colors
= colors_in_color_table (&img
->ncolors
);
9412 free_color_table ();
9416 row_stride
= width
* cinfo
.output_components
;
9417 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9419 for (y
= 0; y
< height
; ++y
)
9421 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9422 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9423 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9427 jpeg_finish_decompress (&cinfo
);
9428 jpeg_destroy_decompress (&cinfo
);
9430 fclose ((FILE *) fp
);
9432 /* Maybe fill in the background field while we have ximg handy. */
9433 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9434 IMAGE_BACKGROUND (img
, f
, ximg
);
9436 /* Put the image into the pixmap. */
9437 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9438 x_destroy_x_image (ximg
);
9443 #endif /* HAVE_JPEG */
9447 /***********************************************************************
9449 ***********************************************************************/
9455 static int tiff_image_p
P_ ((Lisp_Object object
));
9456 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9458 /* The symbol `tiff' identifying images of this type. */
9462 /* Indices of image specification fields in tiff_format, below. */
9464 enum tiff_keyword_index
9473 TIFF_HEURISTIC_MASK
,
9479 /* Vector of image_keyword structures describing the format
9480 of valid user-defined image specifications. */
9482 static struct image_keyword tiff_format
[TIFF_LAST
] =
9484 {":type", IMAGE_SYMBOL_VALUE
, 1},
9485 {":data", IMAGE_STRING_VALUE
, 0},
9486 {":file", IMAGE_STRING_VALUE
, 0},
9487 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9488 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9489 {":relief", IMAGE_INTEGER_VALUE
, 0},
9490 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9491 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9492 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9493 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9496 /* Structure describing the image type `tiff'. */
9498 static struct image_type tiff_type
=
9508 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9511 tiff_image_p (object
)
9514 struct image_keyword fmt
[TIFF_LAST
];
9515 bcopy (tiff_format
, fmt
, sizeof fmt
);
9517 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9520 /* Must specify either the :data or :file keyword. */
9521 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9525 /* Reading from a memory buffer for TIFF images Based on the PNG
9526 memory source, but we have to provide a lot of extra functions.
9529 We really only need to implement read and seek, but I am not
9530 convinced that the TIFF library is smart enough not to destroy
9531 itself if we only hand it the function pointers we need to
9536 unsigned char *bytes
;
9544 tiff_read_from_memory (data
, buf
, size
)
9549 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9551 if (size
> src
->len
- src
->index
)
9553 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9560 tiff_write_from_memory (data
, buf
, size
)
9570 tiff_seek_in_memory (data
, off
, whence
)
9575 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9580 case SEEK_SET
: /* Go from beginning of source. */
9584 case SEEK_END
: /* Go from end of source. */
9585 idx
= src
->len
+ off
;
9588 case SEEK_CUR
: /* Go from current position. */
9589 idx
= src
->index
+ off
;
9592 default: /* Invalid `whence'. */
9596 if (idx
> src
->len
|| idx
< 0)
9605 tiff_close_memory (data
)
9614 tiff_mmap_memory (data
, pbase
, psize
)
9619 /* It is already _IN_ memory. */
9625 tiff_unmap_memory (data
, base
, size
)
9630 /* We don't need to do this. */
9635 tiff_size_of_memory (data
)
9638 return ((tiff_memory_source
*) data
)->len
;
9643 tiff_error_handler (title
, format
, ap
)
9644 const char *title
, *format
;
9650 len
= sprintf (buf
, "TIFF error: %s ", title
);
9651 vsprintf (buf
+ len
, format
, ap
);
9652 add_to_log (buf
, Qnil
, Qnil
);
9657 tiff_warning_handler (title
, format
, ap
)
9658 const char *title
, *format
;
9664 len
= sprintf (buf
, "TIFF warning: %s ", title
);
9665 vsprintf (buf
+ len
, format
, ap
);
9666 add_to_log (buf
, Qnil
, Qnil
);
9670 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9678 Lisp_Object file
, specified_file
;
9679 Lisp_Object specified_data
;
9681 int width
, height
, x
, y
;
9685 struct gcpro gcpro1
;
9686 tiff_memory_source memsrc
;
9688 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9689 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9693 TIFFSetErrorHandler (tiff_error_handler
);
9694 TIFFSetWarningHandler (tiff_warning_handler
);
9696 if (NILP (specified_data
))
9698 /* Read from a file */
9699 file
= x_find_image_file (specified_file
);
9700 if (!STRINGP (file
))
9702 image_error ("Cannot find image file `%s'", file
, Qnil
);
9707 /* Try to open the image file. */
9708 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9711 image_error ("Cannot open `%s'", file
, Qnil
);
9718 /* Memory source! */
9719 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9720 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9723 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9724 (TIFFReadWriteProc
) tiff_read_from_memory
,
9725 (TIFFReadWriteProc
) tiff_write_from_memory
,
9726 tiff_seek_in_memory
,
9728 tiff_size_of_memory
,
9734 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9740 /* Get width and height of the image, and allocate a raster buffer
9741 of width x height 32-bit values. */
9742 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9743 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9744 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9746 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9750 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9756 /* Create the X image and pixmap. */
9757 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9764 /* Initialize the color table. */
9765 init_color_table ();
9767 /* Process the pixel raster. Origin is in the lower-left corner. */
9768 for (y
= 0; y
< height
; ++y
)
9770 uint32
*row
= buf
+ y
* width
;
9772 for (x
= 0; x
< width
; ++x
)
9774 uint32 abgr
= row
[x
];
9775 int r
= TIFFGetR (abgr
) << 8;
9776 int g
= TIFFGetG (abgr
) << 8;
9777 int b
= TIFFGetB (abgr
) << 8;
9778 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9782 /* Remember the colors allocated for the image. Free the color table. */
9783 img
->colors
= colors_in_color_table (&img
->ncolors
);
9784 free_color_table ();
9787 img
->height
= height
;
9789 /* Maybe fill in the background field while we have ximg handy. */
9790 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9791 IMAGE_BACKGROUND (img
, f
, ximg
);
9793 /* Put the image into the pixmap, then free the X image and its buffer. */
9794 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9795 x_destroy_x_image (ximg
);
9802 #endif /* HAVE_TIFF != 0 */
9806 /***********************************************************************
9808 ***********************************************************************/
9812 #include <gif_lib.h>
9814 static int gif_image_p
P_ ((Lisp_Object object
));
9815 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9817 /* The symbol `gif' identifying images of this type. */
9821 /* Indices of image specification fields in gif_format, below. */
9823 enum gif_keyword_index
9839 /* Vector of image_keyword structures describing the format
9840 of valid user-defined image specifications. */
9842 static struct image_keyword gif_format
[GIF_LAST
] =
9844 {":type", IMAGE_SYMBOL_VALUE
, 1},
9845 {":data", IMAGE_STRING_VALUE
, 0},
9846 {":file", IMAGE_STRING_VALUE
, 0},
9847 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9848 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9849 {":relief", IMAGE_INTEGER_VALUE
, 0},
9850 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9851 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9852 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9853 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9854 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9857 /* Structure describing the image type `gif'. */
9859 static struct image_type gif_type
=
9869 /* Return non-zero if OBJECT is a valid GIF image specification. */
9872 gif_image_p (object
)
9875 struct image_keyword fmt
[GIF_LAST
];
9876 bcopy (gif_format
, fmt
, sizeof fmt
);
9878 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9881 /* Must specify either the :data or :file keyword. */
9882 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9886 /* Reading a GIF image from memory
9887 Based on the PNG memory stuff to a certain extent. */
9891 unsigned char *bytes
;
9898 /* Make the current memory source available to gif_read_from_memory.
9899 It's done this way because not all versions of libungif support
9900 a UserData field in the GifFileType structure. */
9901 static gif_memory_source
*current_gif_memory_src
;
9904 gif_read_from_memory (file
, buf
, len
)
9909 gif_memory_source
*src
= current_gif_memory_src
;
9911 if (len
> src
->len
- src
->index
)
9914 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9920 /* Load GIF image IMG for use on frame F. Value is non-zero if
9928 Lisp_Object file
, specified_file
;
9929 Lisp_Object specified_data
;
9930 int rc
, width
, height
, x
, y
, i
;
9932 ColorMapObject
*gif_color_map
;
9933 unsigned long pixel_colors
[256];
9935 struct gcpro gcpro1
;
9937 int ino
, image_left
, image_top
, image_width
, image_height
;
9938 gif_memory_source memsrc
;
9939 unsigned char *raster
;
9941 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9942 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9946 if (NILP (specified_data
))
9948 file
= x_find_image_file (specified_file
);
9949 if (!STRINGP (file
))
9951 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9956 /* Open the GIF file. */
9957 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9960 image_error ("Cannot open `%s'", file
, Qnil
);
9967 /* Read from memory! */
9968 current_gif_memory_src
= &memsrc
;
9969 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9970 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9973 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9976 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9982 /* Read entire contents. */
9983 rc
= DGifSlurp (gif
);
9984 if (rc
== GIF_ERROR
)
9986 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9987 DGifCloseFile (gif
);
9992 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9993 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9994 if (ino
>= gif
->ImageCount
)
9996 image_error ("Invalid image number `%s' in image `%s'",
9998 DGifCloseFile (gif
);
10003 width
= img
->width
= gif
->SWidth
;
10004 height
= img
->height
= gif
->SHeight
;
10006 /* Create the X image and pixmap. */
10007 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
10009 DGifCloseFile (gif
);
10014 /* Allocate colors. */
10015 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
10016 if (!gif_color_map
)
10017 gif_color_map
= gif
->SColorMap
;
10018 init_color_table ();
10019 bzero (pixel_colors
, sizeof pixel_colors
);
10021 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
10023 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
10024 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
10025 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
10026 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
10029 img
->colors
= colors_in_color_table (&img
->ncolors
);
10030 free_color_table ();
10032 /* Clear the part of the screen image that are not covered by
10033 the image from the GIF file. Full animated GIF support
10034 requires more than can be done here (see the gif89 spec,
10035 disposal methods). Let's simply assume that the part
10036 not covered by a sub-image is in the frame's background color. */
10037 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
10038 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
10039 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
10040 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
10042 for (y
= 0; y
< image_top
; ++y
)
10043 for (x
= 0; x
< width
; ++x
)
10044 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10046 for (y
= image_top
+ image_height
; y
< height
; ++y
)
10047 for (x
= 0; x
< width
; ++x
)
10048 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10050 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
10052 for (x
= 0; x
< image_left
; ++x
)
10053 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10054 for (x
= image_left
+ image_width
; x
< width
; ++x
)
10055 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10058 /* Read the GIF image into the X image. We use a local variable
10059 `raster' here because RasterBits below is a char *, and invites
10060 problems with bytes >= 0x80. */
10061 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
10063 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
10065 static int interlace_start
[] = {0, 4, 2, 1};
10066 static int interlace_increment
[] = {8, 8, 4, 2};
10068 int row
= interlace_start
[0];
10072 for (y
= 0; y
< image_height
; y
++)
10074 if (row
>= image_height
)
10076 row
= interlace_start
[++pass
];
10077 while (row
>= image_height
)
10078 row
= interlace_start
[++pass
];
10081 for (x
= 0; x
< image_width
; x
++)
10083 int i
= raster
[(y
* image_width
) + x
];
10084 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
10088 row
+= interlace_increment
[pass
];
10093 for (y
= 0; y
< image_height
; ++y
)
10094 for (x
= 0; x
< image_width
; ++x
)
10096 int i
= raster
[y
* image_width
+ x
];
10097 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
10101 DGifCloseFile (gif
);
10103 /* Maybe fill in the background field while we have ximg handy. */
10104 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10105 IMAGE_BACKGROUND (img
, f
, ximg
);
10107 /* Put the image into the pixmap, then free the X image and its buffer. */
10108 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10109 x_destroy_x_image (ximg
);
10115 #endif /* HAVE_GIF != 0 */
10119 /***********************************************************************
10121 ***********************************************************************/
10123 static int gs_image_p
P_ ((Lisp_Object object
));
10124 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
10125 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
10127 /* The symbol `postscript' identifying images of this type. */
10129 Lisp_Object Qpostscript
;
10131 /* Keyword symbols. */
10133 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
10135 /* Indices of image specification fields in gs_format, below. */
10137 enum gs_keyword_index
10155 /* Vector of image_keyword structures describing the format
10156 of valid user-defined image specifications. */
10158 static struct image_keyword gs_format
[GS_LAST
] =
10160 {":type", IMAGE_SYMBOL_VALUE
, 1},
10161 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10162 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10163 {":file", IMAGE_STRING_VALUE
, 1},
10164 {":loader", IMAGE_FUNCTION_VALUE
, 0},
10165 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
10166 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10167 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10168 {":relief", IMAGE_INTEGER_VALUE
, 0},
10169 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10170 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10171 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10172 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10175 /* Structure describing the image type `ghostscript'. */
10177 static struct image_type gs_type
=
10187 /* Free X resources of Ghostscript image IMG which is used on frame F. */
10190 gs_clear_image (f
, img
)
10194 /* IMG->data.ptr_val may contain a recorded colormap. */
10195 xfree (img
->data
.ptr_val
);
10196 x_clear_image (f
, img
);
10200 /* Return non-zero if OBJECT is a valid Ghostscript image
10204 gs_image_p (object
)
10205 Lisp_Object object
;
10207 struct image_keyword fmt
[GS_LAST
];
10211 bcopy (gs_format
, fmt
, sizeof fmt
);
10213 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
10216 /* Bounding box must be a list or vector containing 4 integers. */
10217 tem
= fmt
[GS_BOUNDING_BOX
].value
;
10220 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
10221 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
10226 else if (VECTORP (tem
))
10228 if (XVECTOR (tem
)->size
!= 4)
10230 for (i
= 0; i
< 4; ++i
)
10231 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
10241 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
10250 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
10251 struct gcpro gcpro1
, gcpro2
;
10253 double in_width
, in_height
;
10254 Lisp_Object pixel_colors
= Qnil
;
10256 /* Compute pixel size of pixmap needed from the given size in the
10257 image specification. Sizes in the specification are in pt. 1 pt
10258 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10260 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
10261 in_width
= XFASTINT (pt_width
) / 72.0;
10262 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
10263 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
10264 in_height
= XFASTINT (pt_height
) / 72.0;
10265 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
10267 /* Create the pixmap. */
10268 xassert (img
->pixmap
== None
);
10269 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10270 img
->width
, img
->height
,
10271 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
10275 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
10279 /* Call the loader to fill the pixmap. It returns a process object
10280 if successful. We do not record_unwind_protect here because
10281 other places in redisplay like calling window scroll functions
10282 don't either. Let the Lisp loader use `unwind-protect' instead. */
10283 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
10285 sprintf (buffer
, "%lu %lu",
10286 (unsigned long) FRAME_X_WINDOW (f
),
10287 (unsigned long) img
->pixmap
);
10288 window_and_pixmap_id
= build_string (buffer
);
10290 sprintf (buffer
, "%lu %lu",
10291 FRAME_FOREGROUND_PIXEL (f
),
10292 FRAME_BACKGROUND_PIXEL (f
));
10293 pixel_colors
= build_string (buffer
);
10295 XSETFRAME (frame
, f
);
10296 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
10298 loader
= intern ("gs-load-image");
10300 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10301 make_number (img
->width
),
10302 make_number (img
->height
),
10303 window_and_pixmap_id
,
10306 return PROCESSP (img
->data
.lisp_val
);
10310 /* Kill the Ghostscript process that was started to fill PIXMAP on
10311 frame F. Called from XTread_socket when receiving an event
10312 telling Emacs that Ghostscript has finished drawing. */
10315 x_kill_gs_process (pixmap
, f
)
10319 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10323 /* Find the image containing PIXMAP. */
10324 for (i
= 0; i
< c
->used
; ++i
)
10325 if (c
->images
[i
]->pixmap
== pixmap
)
10328 /* Should someone in between have cleared the image cache, for
10329 instance, give up. */
10333 /* Kill the GS process. We should have found PIXMAP in the image
10334 cache and its image should contain a process object. */
10335 img
= c
->images
[i
];
10336 xassert (PROCESSP (img
->data
.lisp_val
));
10337 Fkill_process (img
->data
.lisp_val
, Qnil
);
10338 img
->data
.lisp_val
= Qnil
;
10340 /* On displays with a mutable colormap, figure out the colors
10341 allocated for the image by looking at the pixels of an XImage for
10343 class = FRAME_X_VISUAL (f
)->class;
10344 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10350 /* Try to get an XImage for img->pixmep. */
10351 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10352 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10357 /* Initialize the color table. */
10358 init_color_table ();
10360 /* For each pixel of the image, look its color up in the
10361 color table. After having done so, the color table will
10362 contain an entry for each color used by the image. */
10363 for (y
= 0; y
< img
->height
; ++y
)
10364 for (x
= 0; x
< img
->width
; ++x
)
10366 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10367 lookup_pixel_color (f
, pixel
);
10370 /* Record colors in the image. Free color table and XImage. */
10371 img
->colors
= colors_in_color_table (&img
->ncolors
);
10372 free_color_table ();
10373 XDestroyImage (ximg
);
10375 #if 0 /* This doesn't seem to be the case. If we free the colors
10376 here, we get a BadAccess later in x_clear_image when
10377 freeing the colors. */
10378 /* We have allocated colors once, but Ghostscript has also
10379 allocated colors on behalf of us. So, to get the
10380 reference counts right, free them once. */
10382 x_free_colors (f
, img
->colors
, img
->ncolors
);
10386 image_error ("Cannot get X image of `%s'; colors will not be freed",
10392 /* Now that we have the pixmap, compute mask and transform the
10393 image if requested. */
10395 postprocess_image (f
, img
);
10401 /***********************************************************************
10403 ***********************************************************************/
10405 DEFUN ("x-change-window-property", Fx_change_window_property
,
10406 Sx_change_window_property
, 2, 3, 0,
10407 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
10408 PROP and VALUE must be strings. FRAME nil or omitted means use the
10409 selected frame. Value is VALUE. */)
10410 (prop
, value
, frame
)
10411 Lisp_Object frame
, prop
, value
;
10413 struct frame
*f
= check_x_frame (frame
);
10416 CHECK_STRING (prop
);
10417 CHECK_STRING (value
);
10420 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10421 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10422 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10423 XSTRING (value
)->data
, XSTRING (value
)->size
);
10425 /* Make sure the property is set when we return. */
10426 XFlush (FRAME_X_DISPLAY (f
));
10433 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10434 Sx_delete_window_property
, 1, 2, 0,
10435 doc
: /* Remove window property PROP from X window of FRAME.
10436 FRAME nil or omitted means use the selected frame. Value is PROP. */)
10438 Lisp_Object prop
, frame
;
10440 struct frame
*f
= check_x_frame (frame
);
10443 CHECK_STRING (prop
);
10445 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10446 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10448 /* Make sure the property is removed when we return. */
10449 XFlush (FRAME_X_DISPLAY (f
));
10456 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10458 doc
: /* Value is the value of window property PROP on FRAME.
10459 If FRAME is nil or omitted, use the selected frame. Value is nil
10460 if FRAME hasn't a property with name PROP or if PROP has no string
10463 Lisp_Object prop
, frame
;
10465 struct frame
*f
= check_x_frame (frame
);
10468 Lisp_Object prop_value
= Qnil
;
10469 char *tmp_data
= NULL
;
10472 unsigned long actual_size
, bytes_remaining
;
10474 CHECK_STRING (prop
);
10476 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10477 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10478 prop_atom
, 0, 0, False
, XA_STRING
,
10479 &actual_type
, &actual_format
, &actual_size
,
10480 &bytes_remaining
, (unsigned char **) &tmp_data
);
10483 int size
= bytes_remaining
;
10488 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10489 prop_atom
, 0, bytes_remaining
,
10491 &actual_type
, &actual_format
,
10492 &actual_size
, &bytes_remaining
,
10493 (unsigned char **) &tmp_data
);
10494 if (rc
== Success
&& tmp_data
)
10495 prop_value
= make_string (tmp_data
, size
);
10506 /***********************************************************************
10508 ***********************************************************************/
10510 /* If non-null, an asynchronous timer that, when it expires, displays
10511 an hourglass cursor on all frames. */
10513 static struct atimer
*hourglass_atimer
;
10515 /* Non-zero means an hourglass cursor is currently shown. */
10517 static int hourglass_shown_p
;
10519 /* Number of seconds to wait before displaying an hourglass cursor. */
10521 static Lisp_Object Vhourglass_delay
;
10523 /* Default number of seconds to wait before displaying an hourglass
10526 #define DEFAULT_HOURGLASS_DELAY 1
10528 /* Function prototypes. */
10530 static void show_hourglass
P_ ((struct atimer
*));
10531 static void hide_hourglass
P_ ((void));
10534 /* Cancel a currently active hourglass timer, and start a new one. */
10540 int secs
, usecs
= 0;
10542 cancel_hourglass ();
10544 if (INTEGERP (Vhourglass_delay
)
10545 && XINT (Vhourglass_delay
) > 0)
10546 secs
= XFASTINT (Vhourglass_delay
);
10547 else if (FLOATP (Vhourglass_delay
)
10548 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10551 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10552 secs
= XFASTINT (tem
);
10553 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10556 secs
= DEFAULT_HOURGLASS_DELAY
;
10558 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10559 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10560 show_hourglass
, NULL
);
10564 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10568 cancel_hourglass ()
10570 if (hourglass_atimer
)
10572 cancel_atimer (hourglass_atimer
);
10573 hourglass_atimer
= NULL
;
10576 if (hourglass_shown_p
)
10581 /* Timer function of hourglass_atimer. TIMER is equal to
10584 Display an hourglass pointer on all frames by mapping the frames'
10585 hourglass_window. Set the hourglass_p flag in the frames'
10586 output_data.x structure to indicate that an hourglass cursor is
10587 shown on the frames. */
10590 show_hourglass (timer
)
10591 struct atimer
*timer
;
10593 /* The timer implementation will cancel this timer automatically
10594 after this function has run. Set hourglass_atimer to null
10595 so that we know the timer doesn't have to be canceled. */
10596 hourglass_atimer
= NULL
;
10598 if (!hourglass_shown_p
)
10600 Lisp_Object rest
, frame
;
10604 FOR_EACH_FRAME (rest
, frame
)
10606 struct frame
*f
= XFRAME (frame
);
10608 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10610 Display
*dpy
= FRAME_X_DISPLAY (f
);
10612 #ifdef USE_X_TOOLKIT
10613 if (f
->output_data
.x
->widget
)
10615 if (FRAME_OUTER_WINDOW (f
))
10618 f
->output_data
.x
->hourglass_p
= 1;
10620 if (!f
->output_data
.x
->hourglass_window
)
10622 unsigned long mask
= CWCursor
;
10623 XSetWindowAttributes attrs
;
10625 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10627 f
->output_data
.x
->hourglass_window
10628 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10629 0, 0, 32000, 32000, 0, 0,
10635 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10641 hourglass_shown_p
= 1;
10647 /* Hide the hourglass pointer on all frames, if it is currently
10653 if (hourglass_shown_p
)
10655 Lisp_Object rest
, frame
;
10658 FOR_EACH_FRAME (rest
, frame
)
10660 struct frame
*f
= XFRAME (frame
);
10663 /* Watch out for newly created frames. */
10664 && f
->output_data
.x
->hourglass_window
)
10666 XUnmapWindow (FRAME_X_DISPLAY (f
),
10667 f
->output_data
.x
->hourglass_window
);
10668 /* Sync here because XTread_socket looks at the
10669 hourglass_p flag that is reset to zero below. */
10670 XSync (FRAME_X_DISPLAY (f
), False
);
10671 f
->output_data
.x
->hourglass_p
= 0;
10675 hourglass_shown_p
= 0;
10682 /***********************************************************************
10684 ***********************************************************************/
10686 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10687 Lisp_Object
, Lisp_Object
));
10688 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10689 Lisp_Object
, int, int, int *, int *));
10691 /* The frame of a currently visible tooltip. */
10693 Lisp_Object tip_frame
;
10695 /* If non-nil, a timer started that hides the last tooltip when it
10698 Lisp_Object tip_timer
;
10701 /* If non-nil, a vector of 3 elements containing the last args
10702 with which x-show-tip was called. See there. */
10704 Lisp_Object last_show_tip_args
;
10706 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
10708 Lisp_Object Vx_max_tooltip_size
;
10712 unwind_create_tip_frame (frame
)
10715 Lisp_Object deleted
;
10717 deleted
= unwind_create_frame (frame
);
10718 if (EQ (deleted
, Qt
))
10728 /* Create a frame for a tooltip on the display described by DPYINFO.
10729 PARMS is a list of frame parameters. TEXT is the string to
10730 display in the tip frame. Value is the frame.
10732 Note that functions called here, esp. x_default_parameter can
10733 signal errors, for instance when a specified color name is
10734 undefined. We have to make sure that we're in a consistent state
10735 when this happens. */
10738 x_create_tip_frame (dpyinfo
, parms
, text
)
10739 struct x_display_info
*dpyinfo
;
10740 Lisp_Object parms
, text
;
10743 Lisp_Object frame
, tem
;
10745 long window_prompting
= 0;
10747 int count
= BINDING_STACK_SIZE ();
10748 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10750 int face_change_count_before
= face_change_count
;
10751 Lisp_Object buffer
;
10752 struct buffer
*old_buffer
;
10756 /* Use this general default value to start with until we know if
10757 this frame has a specified name. */
10758 Vx_resource_name
= Vinvocation_name
;
10760 #ifdef MULTI_KBOARD
10761 kb
= dpyinfo
->kboard
;
10763 kb
= &the_only_kboard
;
10766 /* Get the name of the frame to use for resource lookup. */
10767 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10768 if (!STRINGP (name
)
10769 && !EQ (name
, Qunbound
)
10771 error ("Invalid frame name--not a string or nil");
10772 Vx_resource_name
= name
;
10775 GCPRO3 (parms
, name
, frame
);
10776 f
= make_frame (1);
10777 XSETFRAME (frame
, f
);
10779 buffer
= Fget_buffer_create (build_string (" *tip*"));
10780 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10781 old_buffer
= current_buffer
;
10782 set_buffer_internal_1 (XBUFFER (buffer
));
10783 current_buffer
->truncate_lines
= Qnil
;
10785 Finsert (1, &text
);
10786 set_buffer_internal_1 (old_buffer
);
10788 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10789 record_unwind_protect (unwind_create_tip_frame
, frame
);
10791 /* By setting the output method, we're essentially saying that
10792 the frame is live, as per FRAME_LIVE_P. If we get a signal
10793 from this point on, x_destroy_window might screw up reference
10795 f
->output_method
= output_x_window
;
10796 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10797 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10798 f
->output_data
.x
->icon_bitmap
= -1;
10799 f
->output_data
.x
->fontset
= -1;
10800 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10801 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10802 #ifdef USE_TOOLKIT_SCROLL_BARS
10803 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
10804 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
10805 #endif /* USE_TOOLKIT_SCROLL_BARS */
10806 f
->icon_name
= Qnil
;
10807 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10809 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10810 dpyinfo_refcount
= dpyinfo
->reference_count
;
10811 #endif /* GLYPH_DEBUG */
10812 #ifdef MULTI_KBOARD
10813 FRAME_KBOARD (f
) = kb
;
10815 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10816 f
->output_data
.x
->explicit_parent
= 0;
10818 /* These colors will be set anyway later, but it's important
10819 to get the color reference counts right, so initialize them! */
10822 struct gcpro gcpro1
;
10824 black
= build_string ("black");
10826 f
->output_data
.x
->foreground_pixel
10827 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10828 f
->output_data
.x
->background_pixel
10829 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10830 f
->output_data
.x
->cursor_pixel
10831 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10832 f
->output_data
.x
->cursor_foreground_pixel
10833 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10834 f
->output_data
.x
->border_pixel
10835 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10836 f
->output_data
.x
->mouse_pixel
10837 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10841 /* Set the name; the functions to which we pass f expect the name to
10843 if (EQ (name
, Qunbound
) || NILP (name
))
10845 f
->name
= build_string (dpyinfo
->x_id_name
);
10846 f
->explicit_name
= 0;
10851 f
->explicit_name
= 1;
10852 /* use the frame's title when getting resources for this frame. */
10853 specbind (Qx_resource_name
, name
);
10856 /* Extract the window parameters from the supplied values that are
10857 needed to determine window geometry. */
10861 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10864 /* First, try whatever font the caller has specified. */
10865 if (STRINGP (font
))
10867 tem
= Fquery_fontset (font
, Qnil
);
10869 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10871 font
= x_new_font (f
, XSTRING (font
)->data
);
10874 /* Try out a font which we hope has bold and italic variations. */
10875 if (!STRINGP (font
))
10876 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10877 if (!STRINGP (font
))
10878 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10879 if (! STRINGP (font
))
10880 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10881 if (! STRINGP (font
))
10882 /* This was formerly the first thing tried, but it finds too many fonts
10883 and takes too long. */
10884 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10885 /* If those didn't work, look for something which will at least work. */
10886 if (! STRINGP (font
))
10887 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10889 if (! STRINGP (font
))
10890 font
= build_string ("fixed");
10892 x_default_parameter (f
, parms
, Qfont
, font
,
10893 "font", "Font", RES_TYPE_STRING
);
10896 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10897 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10899 /* This defaults to 2 in order to match xterm. We recognize either
10900 internalBorderWidth or internalBorder (which is what xterm calls
10902 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10906 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10907 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10908 if (! EQ (value
, Qunbound
))
10909 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10913 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10914 "internalBorderWidth", "internalBorderWidth",
10917 /* Also do the stuff which must be set before the window exists. */
10918 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10919 "foreground", "Foreground", RES_TYPE_STRING
);
10920 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10921 "background", "Background", RES_TYPE_STRING
);
10922 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10923 "pointerColor", "Foreground", RES_TYPE_STRING
);
10924 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10925 "cursorColor", "Foreground", RES_TYPE_STRING
);
10926 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10927 "borderColor", "BorderColor", RES_TYPE_STRING
);
10929 /* Init faces before x_default_parameter is called for scroll-bar
10930 parameters because that function calls x_set_scroll_bar_width,
10931 which calls change_frame_size, which calls Fset_window_buffer,
10932 which runs hooks, which call Fvertical_motion. At the end, we
10933 end up in init_iterator with a null face cache, which should not
10935 init_frame_faces (f
);
10937 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10938 window_prompting
= x_figure_window_size (f
, parms
);
10940 if (window_prompting
& XNegative
)
10942 if (window_prompting
& YNegative
)
10943 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10945 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10949 if (window_prompting
& YNegative
)
10950 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10952 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10955 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10957 XSetWindowAttributes attrs
;
10958 unsigned long mask
;
10961 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10962 if (DoesSaveUnders (dpyinfo
->screen
))
10963 mask
|= CWSaveUnder
;
10965 /* Window managers look at the override-redirect flag to determine
10966 whether or net to give windows a decoration (Xlib spec, chapter
10968 attrs
.override_redirect
= True
;
10969 attrs
.save_under
= True
;
10970 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10971 /* Arrange for getting MapNotify and UnmapNotify events. */
10972 attrs
.event_mask
= StructureNotifyMask
;
10974 = FRAME_X_WINDOW (f
)
10975 = XCreateWindow (FRAME_X_DISPLAY (f
),
10976 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10977 /* x, y, width, height */
10981 CopyFromParent
, InputOutput
, CopyFromParent
,
10988 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10989 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10990 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10991 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10992 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10993 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10995 /* Dimensions, especially f->height, must be done via change_frame_size.
10996 Change will not be effected unless different from the current
10999 height
= f
->height
;
11001 SET_FRAME_WIDTH (f
, 0);
11002 change_frame_size (f
, height
, width
, 1, 0, 0);
11004 /* Set up faces after all frame parameters are known. This call
11005 also merges in face attributes specified for new frames.
11007 Frame parameters may be changed if .Xdefaults contains
11008 specifications for the default font. For example, if there is an
11009 `Emacs.default.attributeBackground: pink', the `background-color'
11010 attribute of the frame get's set, which let's the internal border
11011 of the tooltip frame appear in pink. Prevent this. */
11013 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
11015 /* Set tip_frame here, so that */
11017 call1 (Qface_set_after_frame_default
, frame
);
11019 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
11020 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
11028 /* It is now ok to make the frame official even if we get an error
11029 below. And the frame needs to be on Vframe_list or making it
11030 visible won't work. */
11031 Vframe_list
= Fcons (frame
, Vframe_list
);
11033 /* Now that the frame is official, it counts as a reference to
11035 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
11037 /* Setting attributes of faces of the tooltip frame from resources
11038 and similar will increment face_change_count, which leads to the
11039 clearing of all current matrices. Since this isn't necessary
11040 here, avoid it by resetting face_change_count to the value it
11041 had before we created the tip frame. */
11042 face_change_count
= face_change_count_before
;
11044 /* Discard the unwind_protect. */
11045 return unbind_to (count
, frame
);
11049 /* Compute where to display tip frame F. PARMS is the list of frame
11050 parameters for F. DX and DY are specified offsets from the current
11051 location of the mouse. WIDTH and HEIGHT are the width and height
11052 of the tooltip. Return coordinates relative to the root window of
11053 the display in *ROOT_X, and *ROOT_Y. */
11056 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
11058 Lisp_Object parms
, dx
, dy
;
11060 int *root_x
, *root_y
;
11062 Lisp_Object left
, top
;
11064 Window root
, child
;
11067 /* User-specified position? */
11068 left
= Fcdr (Fassq (Qleft
, parms
));
11069 top
= Fcdr (Fassq (Qtop
, parms
));
11071 /* Move the tooltip window where the mouse pointer is. Resize and
11073 if (!INTEGERP (left
) && !INTEGERP (top
))
11076 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
11077 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
11081 if (INTEGERP (top
))
11082 *root_y
= XINT (top
);
11083 else if (*root_y
+ XINT (dy
) - height
< 0)
11084 *root_y
-= XINT (dy
);
11088 *root_y
+= XINT (dy
);
11091 if (INTEGERP (left
))
11092 *root_x
= XINT (left
);
11093 else if (*root_x
+ XINT (dx
) + width
> FRAME_X_DISPLAY_INFO (f
)->width
)
11094 *root_x
-= width
+ XINT (dx
);
11096 *root_x
+= XINT (dx
);
11100 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
11101 doc
: /* Show STRING in a "tooltip" window on frame FRAME.
11102 A tooltip window is a small X window displaying a string.
11104 FRAME nil or omitted means use the selected frame.
11106 PARMS is an optional list of frame parameters which can be used to
11107 change the tooltip's appearance.
11109 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
11110 means use the default timeout of 5 seconds.
11112 If the list of frame parameters PARAMS contains a `left' parameters,
11113 the tooltip is displayed at that x-position. Otherwise it is
11114 displayed at the mouse position, with offset DX added (default is 5 if
11115 DX isn't specified). Likewise for the y-position; if a `top' frame
11116 parameter is specified, it determines the y-position of the tooltip
11117 window, otherwise it is displayed at the mouse position, with offset
11118 DY added (default is -10).
11120 A tooltip's maximum size is specified by `x-max-tooltip-size'.
11121 Text larger than the specified size is clipped. */)
11122 (string
, frame
, parms
, timeout
, dx
, dy
)
11123 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
11127 int root_x
, root_y
;
11128 struct buffer
*old_buffer
;
11129 struct text_pos pos
;
11130 int i
, width
, height
;
11131 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
11132 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
11133 int count
= BINDING_STACK_SIZE ();
11135 specbind (Qinhibit_redisplay
, Qt
);
11137 GCPRO4 (string
, parms
, frame
, timeout
);
11139 CHECK_STRING (string
);
11140 f
= check_x_frame (frame
);
11141 if (NILP (timeout
))
11142 timeout
= make_number (5);
11144 CHECK_NATNUM (timeout
);
11147 dx
= make_number (5);
11152 dy
= make_number (-10);
11156 if (NILP (last_show_tip_args
))
11157 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
11159 if (!NILP (tip_frame
))
11161 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
11162 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
11163 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
11165 if (EQ (frame
, last_frame
)
11166 && !NILP (Fequal (last_string
, string
))
11167 && !NILP (Fequal (last_parms
, parms
)))
11169 struct frame
*f
= XFRAME (tip_frame
);
11171 /* Only DX and DY have changed. */
11172 if (!NILP (tip_timer
))
11174 Lisp_Object timer
= tip_timer
;
11176 call1 (Qcancel_timer
, timer
);
11180 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
11181 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
11182 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11189 /* Hide a previous tip, if any. */
11192 ASET (last_show_tip_args
, 0, string
);
11193 ASET (last_show_tip_args
, 1, frame
);
11194 ASET (last_show_tip_args
, 2, parms
);
11196 /* Add default values to frame parameters. */
11197 if (NILP (Fassq (Qname
, parms
)))
11198 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
11199 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11200 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
11201 if (NILP (Fassq (Qborder_width
, parms
)))
11202 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
11203 if (NILP (Fassq (Qborder_color
, parms
)))
11204 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
11205 if (NILP (Fassq (Qbackground_color
, parms
)))
11206 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
11209 /* Create a frame for the tooltip, and record it in the global
11210 variable tip_frame. */
11211 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
, string
);
11212 f
= XFRAME (frame
);
11214 /* Set up the frame's root window. */
11215 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
11216 w
->left
= w
->top
= make_number (0);
11218 if (CONSP (Vx_max_tooltip_size
)
11219 && INTEGERP (XCAR (Vx_max_tooltip_size
))
11220 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
11221 && INTEGERP (XCDR (Vx_max_tooltip_size
))
11222 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
11224 w
->width
= XCAR (Vx_max_tooltip_size
);
11225 w
->height
= XCDR (Vx_max_tooltip_size
);
11229 w
->width
= make_number (80);
11230 w
->height
= make_number (40);
11233 f
->window_width
= XINT (w
->width
);
11235 w
->pseudo_window_p
= 1;
11237 /* Display the tooltip text in a temporary buffer. */
11238 old_buffer
= current_buffer
;
11239 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
11240 current_buffer
->truncate_lines
= Qnil
;
11241 clear_glyph_matrix (w
->desired_matrix
);
11242 clear_glyph_matrix (w
->current_matrix
);
11243 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
11244 try_window (FRAME_ROOT_WINDOW (f
), pos
);
11246 /* Compute width and height of the tooltip. */
11247 width
= height
= 0;
11248 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
11250 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
11251 struct glyph
*last
;
11254 /* Stop at the first empty row at the end. */
11255 if (!row
->enabled_p
|| !row
->displays_text_p
)
11258 /* Let the row go over the full width of the frame. */
11259 row
->full_width_p
= 1;
11261 /* There's a glyph at the end of rows that is used to place
11262 the cursor there. Don't include the width of this glyph. */
11263 if (row
->used
[TEXT_AREA
])
11265 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
11266 row_width
= row
->pixel_width
- last
->pixel_width
;
11269 row_width
= row
->pixel_width
;
11271 height
+= row
->height
;
11272 width
= max (width
, row_width
);
11275 /* Add the frame's internal border to the width and height the X
11276 window should have. */
11277 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11278 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11280 /* Move the tooltip window where the mouse pointer is. Resize and
11282 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
11285 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11286 root_x
, root_y
, width
, height
);
11287 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
11290 /* Draw into the window. */
11291 w
->must_be_updated_p
= 1;
11292 update_single_window (w
, 1);
11294 /* Restore original current buffer. */
11295 set_buffer_internal_1 (old_buffer
);
11296 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
11299 /* Let the tip disappear after timeout seconds. */
11300 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
11301 intern ("x-hide-tip"));
11304 return unbind_to (count
, Qnil
);
11308 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
11309 doc
: /* Hide the current tooltip window, if there is any.
11310 Value is t if tooltip was open, nil otherwise. */)
11314 Lisp_Object deleted
, frame
, timer
;
11315 struct gcpro gcpro1
, gcpro2
;
11317 /* Return quickly if nothing to do. */
11318 if (NILP (tip_timer
) && NILP (tip_frame
))
11323 GCPRO2 (frame
, timer
);
11324 tip_frame
= tip_timer
= deleted
= Qnil
;
11326 count
= BINDING_STACK_SIZE ();
11327 specbind (Qinhibit_redisplay
, Qt
);
11328 specbind (Qinhibit_quit
, Qt
);
11331 call1 (Qcancel_timer
, timer
);
11333 if (FRAMEP (frame
))
11335 Fdelete_frame (frame
, Qnil
);
11339 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11340 redisplay procedure is not called when a tip frame over menu
11341 items is unmapped. Redisplay the menu manually... */
11343 struct frame
*f
= SELECTED_FRAME ();
11344 Widget w
= f
->output_data
.x
->menubar_widget
;
11345 extern void xlwmenu_redisplay
P_ ((Widget
));
11347 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
11351 xlwmenu_redisplay (w
);
11355 #endif /* USE_LUCID */
11359 return unbind_to (count
, deleted
);
11364 /***********************************************************************
11365 File selection dialog
11366 ***********************************************************************/
11370 /* Callback for "OK" and "Cancel" on file selection dialog. */
11373 file_dialog_cb (widget
, client_data
, call_data
)
11375 XtPointer call_data
, client_data
;
11377 int *result
= (int *) client_data
;
11378 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11379 *result
= cb
->reason
;
11383 /* Callback for unmapping a file selection dialog. This is used to
11384 capture the case where a dialog is closed via a window manager's
11385 closer button, for example. Using a XmNdestroyCallback didn't work
11389 file_dialog_unmap_cb (widget
, client_data
, call_data
)
11391 XtPointer call_data
, client_data
;
11393 int *result
= (int *) client_data
;
11394 *result
= XmCR_CANCEL
;
11398 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11399 doc
: /* Read file name, prompting with PROMPT in directory DIR.
11400 Use a file selection dialog.
11401 Select DEFAULT-FILENAME in the dialog's file selection box, if
11402 specified. Don't let the user enter a file name in the file
11403 selection dialog's entry field, if MUSTMATCH is non-nil. */)
11404 (prompt
, dir
, default_filename
, mustmatch
)
11405 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11408 struct frame
*f
= SELECTED_FRAME ();
11409 Lisp_Object file
= Qnil
;
11410 Widget dialog
, text
, list
, help
;
11413 extern XtAppContext Xt_app_con
;
11414 XmString dir_xmstring
, pattern_xmstring
;
11415 int count
= specpdl_ptr
- specpdl
;
11416 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11418 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11419 CHECK_STRING (prompt
);
11420 CHECK_STRING (dir
);
11422 /* Prevent redisplay. */
11423 specbind (Qinhibit_redisplay
, Qt
);
11427 /* Create the dialog with PROMPT as title, using DIR as initial
11428 directory and using "*" as pattern. */
11429 dir
= Fexpand_file_name (dir
, Qnil
);
11430 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11431 pattern_xmstring
= XmStringCreateLocalized ("*");
11433 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11434 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11435 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11436 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11437 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11438 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11440 XmStringFree (dir_xmstring
);
11441 XmStringFree (pattern_xmstring
);
11443 /* Add callbacks for OK and Cancel. */
11444 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11445 (XtPointer
) &result
);
11446 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11447 (XtPointer
) &result
);
11448 XtAddCallback (dialog
, XmNunmapCallback
, file_dialog_unmap_cb
,
11449 (XtPointer
) &result
);
11451 /* Disable the help button since we can't display help. */
11452 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11453 XtSetSensitive (help
, False
);
11455 /* Mark OK button as default. */
11456 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11457 XmNshowAsDefault
, True
, NULL
);
11459 /* If MUSTMATCH is non-nil, disable the file entry field of the
11460 dialog, so that the user must select a file from the files list
11461 box. We can't remove it because we wouldn't have a way to get at
11462 the result file name, then. */
11463 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11464 if (!NILP (mustmatch
))
11467 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11468 XtSetSensitive (text
, False
);
11469 XtSetSensitive (label
, False
);
11472 /* Manage the dialog, so that list boxes get filled. */
11473 XtManageChild (dialog
);
11475 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11476 must include the path for this to work. */
11477 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11478 if (STRINGP (default_filename
))
11480 XmString default_xmstring
;
11484 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11486 if (!XmListItemExists (list
, default_xmstring
))
11488 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11489 XmListAddItem (list
, default_xmstring
, 0);
11493 item_pos
= XmListItemPos (list
, default_xmstring
);
11494 XmStringFree (default_xmstring
);
11496 /* Select the item and scroll it into view. */
11497 XmListSelectPos (list
, item_pos
, True
);
11498 XmListSetPos (list
, item_pos
);
11501 /* Process events until the user presses Cancel or OK. Block
11502 and unblock input here so that we get a chance of processing
11506 while (result
== 0)
11509 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11514 /* Get the result. */
11515 if (result
== XmCR_OK
)
11520 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11521 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11522 XmStringFree (text
);
11523 file
= build_string (data
);
11530 XtUnmanageChild (dialog
);
11531 XtDestroyWidget (dialog
);
11535 /* Make "Cancel" equivalent to C-g. */
11537 Fsignal (Qquit
, Qnil
);
11539 return unbind_to (count
, file
);
11542 #endif /* USE_MOTIF */
11546 /***********************************************************************
11548 ***********************************************************************/
11550 #ifdef HAVE_XKBGETKEYBOARD
11551 #include <X11/XKBlib.h>
11552 #include <X11/keysym.h>
11555 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11556 Sx_backspace_delete_keys_p
, 0, 1, 0,
11557 doc
: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
11558 FRAME nil means use the selected frame.
11559 Value is t if we know that both keys are present, and are mapped to the
11560 usual X keysyms. */)
11564 #ifdef HAVE_XKBGETKEYBOARD
11566 struct frame
*f
= check_x_frame (frame
);
11567 Display
*dpy
= FRAME_X_DISPLAY (f
);
11568 Lisp_Object have_keys
;
11569 int major
, minor
, op
, event
, error
;
11573 /* Check library version in case we're dynamically linked. */
11574 major
= XkbMajorVersion
;
11575 minor
= XkbMinorVersion
;
11576 if (!XkbLibraryVersion (&major
, &minor
))
11582 /* Check that the server supports XKB. */
11583 major
= XkbMajorVersion
;
11584 minor
= XkbMinorVersion
;
11585 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11592 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11595 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11597 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11599 for (i
= kb
->min_key_code
;
11600 (i
< kb
->max_key_code
11601 && (delete_keycode
== 0 || backspace_keycode
== 0));
11604 /* The XKB symbolic key names can be seen most easily in
11605 the PS file generated by `xkbprint -label name
11607 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11608 delete_keycode
= i
;
11609 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11610 backspace_keycode
= i
;
11613 XkbFreeNames (kb
, 0, True
);
11616 XkbFreeClientMap (kb
, 0, True
);
11619 && backspace_keycode
11620 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11621 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11626 #else /* not HAVE_XKBGETKEYBOARD */
11628 #endif /* not HAVE_XKBGETKEYBOARD */
11633 /***********************************************************************
11635 ***********************************************************************/
11640 /* This is zero if not using X windows. */
11643 /* The section below is built by the lisp expression at the top of the file,
11644 just above where these variables are declared. */
11645 /*&&& init symbols here &&&*/
11646 Qauto_raise
= intern ("auto-raise");
11647 staticpro (&Qauto_raise
);
11648 Qauto_lower
= intern ("auto-lower");
11649 staticpro (&Qauto_lower
);
11650 Qbar
= intern ("bar");
11652 Qborder_color
= intern ("border-color");
11653 staticpro (&Qborder_color
);
11654 Qborder_width
= intern ("border-width");
11655 staticpro (&Qborder_width
);
11656 Qbox
= intern ("box");
11658 Qcursor_color
= intern ("cursor-color");
11659 staticpro (&Qcursor_color
);
11660 Qcursor_type
= intern ("cursor-type");
11661 staticpro (&Qcursor_type
);
11662 Qgeometry
= intern ("geometry");
11663 staticpro (&Qgeometry
);
11664 Qicon_left
= intern ("icon-left");
11665 staticpro (&Qicon_left
);
11666 Qicon_top
= intern ("icon-top");
11667 staticpro (&Qicon_top
);
11668 Qicon_type
= intern ("icon-type");
11669 staticpro (&Qicon_type
);
11670 Qicon_name
= intern ("icon-name");
11671 staticpro (&Qicon_name
);
11672 Qinternal_border_width
= intern ("internal-border-width");
11673 staticpro (&Qinternal_border_width
);
11674 Qleft
= intern ("left");
11675 staticpro (&Qleft
);
11676 Qright
= intern ("right");
11677 staticpro (&Qright
);
11678 Qmouse_color
= intern ("mouse-color");
11679 staticpro (&Qmouse_color
);
11680 Qnone
= intern ("none");
11681 staticpro (&Qnone
);
11682 Qparent_id
= intern ("parent-id");
11683 staticpro (&Qparent_id
);
11684 Qscroll_bar_width
= intern ("scroll-bar-width");
11685 staticpro (&Qscroll_bar_width
);
11686 Qsuppress_icon
= intern ("suppress-icon");
11687 staticpro (&Qsuppress_icon
);
11688 Qundefined_color
= intern ("undefined-color");
11689 staticpro (&Qundefined_color
);
11690 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11691 staticpro (&Qvertical_scroll_bars
);
11692 Qvisibility
= intern ("visibility");
11693 staticpro (&Qvisibility
);
11694 Qwindow_id
= intern ("window-id");
11695 staticpro (&Qwindow_id
);
11696 Qouter_window_id
= intern ("outer-window-id");
11697 staticpro (&Qouter_window_id
);
11698 Qx_frame_parameter
= intern ("x-frame-parameter");
11699 staticpro (&Qx_frame_parameter
);
11700 Qx_resource_name
= intern ("x-resource-name");
11701 staticpro (&Qx_resource_name
);
11702 Quser_position
= intern ("user-position");
11703 staticpro (&Quser_position
);
11704 Quser_size
= intern ("user-size");
11705 staticpro (&Quser_size
);
11706 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11707 staticpro (&Qscroll_bar_foreground
);
11708 Qscroll_bar_background
= intern ("scroll-bar-background");
11709 staticpro (&Qscroll_bar_background
);
11710 Qscreen_gamma
= intern ("screen-gamma");
11711 staticpro (&Qscreen_gamma
);
11712 Qline_spacing
= intern ("line-spacing");
11713 staticpro (&Qline_spacing
);
11714 Qcenter
= intern ("center");
11715 staticpro (&Qcenter
);
11716 Qcompound_text
= intern ("compound-text");
11717 staticpro (&Qcompound_text
);
11718 Qcancel_timer
= intern ("cancel-timer");
11719 staticpro (&Qcancel_timer
);
11720 Qwait_for_wm
= intern ("wait-for-wm");
11721 staticpro (&Qwait_for_wm
);
11722 /* This is the end of symbol initialization. */
11724 /* Text property `display' should be nonsticky by default. */
11725 Vtext_property_default_nonsticky
11726 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11729 Qlaplace
= intern ("laplace");
11730 staticpro (&Qlaplace
);
11731 Qemboss
= intern ("emboss");
11732 staticpro (&Qemboss
);
11733 Qedge_detection
= intern ("edge-detection");
11734 staticpro (&Qedge_detection
);
11735 Qheuristic
= intern ("heuristic");
11736 staticpro (&Qheuristic
);
11737 QCmatrix
= intern (":matrix");
11738 staticpro (&QCmatrix
);
11739 QCcolor_adjustment
= intern (":color-adjustment");
11740 staticpro (&QCcolor_adjustment
);
11741 QCmask
= intern (":mask");
11742 staticpro (&QCmask
);
11744 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11745 staticpro (&Qface_set_after_frame_default
);
11747 Fput (Qundefined_color
, Qerror_conditions
,
11748 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11749 Fput (Qundefined_color
, Qerror_message
,
11750 build_string ("Undefined color"));
11752 init_x_parm_symbols ();
11754 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11755 doc
: /* Non-nil means always draw a cross over disabled images.
11756 Disabled images are those having an `:conversion disabled' property.
11757 A cross is always drawn on black & white displays. */);
11758 cross_disabled_images
= 0;
11760 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11761 doc
: /* List of directories to search for bitmap files for X. */);
11762 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11764 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11765 doc
: /* The shape of the pointer when over text.
11766 Changing the value does not affect existing frames
11767 unless you set the mouse color. */);
11768 Vx_pointer_shape
= Qnil
;
11770 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11771 doc
: /* The name Emacs uses to look up X resources.
11772 `x-get-resource' uses this as the first component of the instance name
11773 when requesting resource values.
11774 Emacs initially sets `x-resource-name' to the name under which Emacs
11775 was invoked, or to the value specified with the `-name' or `-rn'
11776 switches, if present.
11778 It may be useful to bind this variable locally around a call
11779 to `x-get-resource'. See also the variable `x-resource-class'. */);
11780 Vx_resource_name
= Qnil
;
11782 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11783 doc
: /* The class Emacs uses to look up X resources.
11784 `x-get-resource' uses this as the first component of the instance class
11785 when requesting resource values.
11787 Emacs initially sets `x-resource-class' to "Emacs".
11789 Setting this variable permanently is not a reasonable thing to do,
11790 but binding this variable locally around a call to `x-get-resource'
11791 is a reasonable practice. See also the variable `x-resource-name'. */);
11792 Vx_resource_class
= build_string (EMACS_CLASS
);
11794 #if 0 /* This doesn't really do anything. */
11795 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11796 doc
: /* The shape of the pointer when not over text.
11797 This variable takes effect when you create a new frame
11798 or when you set the mouse color. */);
11800 Vx_nontext_pointer_shape
= Qnil
;
11802 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
11803 doc
: /* The shape of the pointer when Emacs is busy.
11804 This variable takes effect when you create a new frame
11805 or when you set the mouse color. */);
11806 Vx_hourglass_pointer_shape
= Qnil
;
11808 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
11809 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
11810 display_hourglass_p
= 1;
11812 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
11813 doc
: /* *Seconds to wait before displaying an hourglass pointer.
11814 Value must be an integer or float. */);
11815 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
11817 #if 0 /* This doesn't really do anything. */
11818 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11819 doc
: /* The shape of the pointer when over the mode line.
11820 This variable takes effect when you create a new frame
11821 or when you set the mouse color. */);
11823 Vx_mode_pointer_shape
= Qnil
;
11825 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11826 &Vx_sensitive_text_pointer_shape
,
11827 doc
: /* The shape of the pointer when over mouse-sensitive text.
11828 This variable takes effect when you create a new frame
11829 or when you set the mouse color. */);
11830 Vx_sensitive_text_pointer_shape
= Qnil
;
11832 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11833 &Vx_window_horizontal_drag_shape
,
11834 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
11835 This variable takes effect when you create a new frame
11836 or when you set the mouse color. */);
11837 Vx_window_horizontal_drag_shape
= Qnil
;
11839 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11840 doc
: /* A string indicating the foreground color of the cursor box. */);
11841 Vx_cursor_fore_pixel
= Qnil
;
11843 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
11844 doc
: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
11845 Text larger than this is clipped. */);
11846 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
11848 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11849 doc
: /* Non-nil if no X window manager is in use.
11850 Emacs doesn't try to figure this out; this is always nil
11851 unless you set it to something else. */);
11852 /* We don't have any way to find this out, so set it to nil
11853 and maybe the user would like to set it to t. */
11854 Vx_no_window_manager
= Qnil
;
11856 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11857 &Vx_pixel_size_width_font_regexp
,
11858 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
11860 Since Emacs gets width of a font matching with this regexp from
11861 PIXEL_SIZE field of the name, font finding mechanism gets faster for
11862 such a font. This is especially effective for such large fonts as
11863 Chinese, Japanese, and Korean. */);
11864 Vx_pixel_size_width_font_regexp
= Qnil
;
11866 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11867 doc
: /* Time after which cached images are removed from the cache.
11868 When an image has not been displayed this many seconds, remove it
11869 from the image cache. Value must be an integer or nil with nil
11870 meaning don't clear the cache. */);
11871 Vimage_cache_eviction_delay
= make_number (30 * 60);
11873 #ifdef USE_X_TOOLKIT
11874 Fprovide (intern ("x-toolkit"), Qnil
);
11876 Fprovide (intern ("motif"), Qnil
);
11878 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string
,
11879 doc
: /* Version info for LessTif/Motif. */);
11880 Vmotif_version_string
= build_string (XmVERSION_STRING
);
11881 #endif /* USE_MOTIF */
11882 #endif /* USE_X_TOOLKIT */
11884 defsubr (&Sx_get_resource
);
11886 /* X window properties. */
11887 defsubr (&Sx_change_window_property
);
11888 defsubr (&Sx_delete_window_property
);
11889 defsubr (&Sx_window_property
);
11891 defsubr (&Sxw_display_color_p
);
11892 defsubr (&Sx_display_grayscale_p
);
11893 defsubr (&Sxw_color_defined_p
);
11894 defsubr (&Sxw_color_values
);
11895 defsubr (&Sx_server_max_request_size
);
11896 defsubr (&Sx_server_vendor
);
11897 defsubr (&Sx_server_version
);
11898 defsubr (&Sx_display_pixel_width
);
11899 defsubr (&Sx_display_pixel_height
);
11900 defsubr (&Sx_display_mm_width
);
11901 defsubr (&Sx_display_mm_height
);
11902 defsubr (&Sx_display_screens
);
11903 defsubr (&Sx_display_planes
);
11904 defsubr (&Sx_display_color_cells
);
11905 defsubr (&Sx_display_visual_class
);
11906 defsubr (&Sx_display_backing_store
);
11907 defsubr (&Sx_display_save_under
);
11908 defsubr (&Sx_parse_geometry
);
11909 defsubr (&Sx_create_frame
);
11910 defsubr (&Sx_open_connection
);
11911 defsubr (&Sx_close_connection
);
11912 defsubr (&Sx_display_list
);
11913 defsubr (&Sx_synchronize
);
11914 defsubr (&Sx_focus_frame
);
11915 defsubr (&Sx_backspace_delete_keys_p
);
11917 /* Setting callback functions for fontset handler. */
11918 get_font_info_func
= x_get_font_info
;
11920 #if 0 /* This function pointer doesn't seem to be used anywhere.
11921 And the pointer assigned has the wrong type, anyway. */
11922 list_fonts_func
= x_list_fonts
;
11925 load_font_func
= x_load_font
;
11926 find_ccl_program_func
= x_find_ccl_program
;
11927 query_font_func
= x_query_font
;
11928 set_frame_fontset_func
= x_set_font
;
11929 check_window_system_func
= check_x
;
11932 Qxbm
= intern ("xbm");
11934 QCtype
= intern (":type");
11935 staticpro (&QCtype
);
11936 QCconversion
= intern (":conversion");
11937 staticpro (&QCconversion
);
11938 QCheuristic_mask
= intern (":heuristic-mask");
11939 staticpro (&QCheuristic_mask
);
11940 QCcolor_symbols
= intern (":color-symbols");
11941 staticpro (&QCcolor_symbols
);
11942 QCascent
= intern (":ascent");
11943 staticpro (&QCascent
);
11944 QCmargin
= intern (":margin");
11945 staticpro (&QCmargin
);
11946 QCrelief
= intern (":relief");
11947 staticpro (&QCrelief
);
11948 Qpostscript
= intern ("postscript");
11949 staticpro (&Qpostscript
);
11950 QCloader
= intern (":loader");
11951 staticpro (&QCloader
);
11952 QCbounding_box
= intern (":bounding-box");
11953 staticpro (&QCbounding_box
);
11954 QCpt_width
= intern (":pt-width");
11955 staticpro (&QCpt_width
);
11956 QCpt_height
= intern (":pt-height");
11957 staticpro (&QCpt_height
);
11958 QCindex
= intern (":index");
11959 staticpro (&QCindex
);
11960 Qpbm
= intern ("pbm");
11964 Qxpm
= intern ("xpm");
11969 Qjpeg
= intern ("jpeg");
11970 staticpro (&Qjpeg
);
11974 Qtiff
= intern ("tiff");
11975 staticpro (&Qtiff
);
11979 Qgif
= intern ("gif");
11984 Qpng
= intern ("png");
11988 defsubr (&Sclear_image_cache
);
11989 defsubr (&Simage_size
);
11990 defsubr (&Simage_mask_p
);
11992 hourglass_atimer
= NULL
;
11993 hourglass_shown_p
= 0;
11995 defsubr (&Sx_show_tip
);
11996 defsubr (&Sx_hide_tip
);
11998 staticpro (&tip_timer
);
12000 staticpro (&tip_frame
);
12002 last_show_tip_args
= Qnil
;
12003 staticpro (&last_show_tip_args
);
12006 defsubr (&Sx_file_dialog
);
12014 image_types
= NULL
;
12015 Vimage_types
= Qnil
;
12017 define_image_type (&xbm_type
);
12018 define_image_type (&gs_type
);
12019 define_image_type (&pbm_type
);
12022 define_image_type (&xpm_type
);
12026 define_image_type (&jpeg_type
);
12030 define_image_type (&tiff_type
);
12034 define_image_type (&gif_type
);
12038 define_image_type (&png_type
);
12042 #endif /* HAVE_X_WINDOWS */