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 old_value
= get_frame_param (f
, prop
);
911 if (NILP (Fequal (val
, old_value
)))
913 store_frame_param (f
, prop
, val
);
915 param_index
= Fget (prop
, Qx_frame_parameter
);
916 if (NATNUMP (param_index
)
917 && (XFASTINT (param_index
)
918 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
919 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
924 /* Now process them in reverse of specified order. */
925 for (i
--; i
>= 0; i
--)
927 Lisp_Object prop
, val
;
932 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
933 width
= XFASTINT (val
);
934 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
935 height
= XFASTINT (val
);
936 else if (EQ (prop
, Qtop
))
938 else if (EQ (prop
, Qleft
))
940 else if (EQ (prop
, Qicon_top
))
942 else if (EQ (prop
, Qicon_left
))
944 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
945 /* Processed above. */
949 register Lisp_Object param_index
, old_value
;
951 old_value
= get_frame_param (f
, prop
);
953 store_frame_param (f
, prop
, val
);
955 param_index
= Fget (prop
, Qx_frame_parameter
);
956 if (NATNUMP (param_index
)
957 && (XFASTINT (param_index
)
958 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
959 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
963 /* Don't die if just one of these was set. */
964 if (EQ (left
, Qunbound
))
967 if (f
->output_data
.x
->left_pos
< 0)
968 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
970 XSETINT (left
, f
->output_data
.x
->left_pos
);
972 if (EQ (top
, Qunbound
))
975 if (f
->output_data
.x
->top_pos
< 0)
976 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
978 XSETINT (top
, f
->output_data
.x
->top_pos
);
981 /* If one of the icon positions was not set, preserve or default it. */
982 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
984 icon_left_no_change
= 1;
985 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
986 if (NILP (icon_left
))
987 XSETINT (icon_left
, 0);
989 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
991 icon_top_no_change
= 1;
992 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
994 XSETINT (icon_top
, 0);
997 /* Don't set these parameters unless they've been explicitly
998 specified. The window might be mapped or resized while we're in
999 this function, and we don't want to override that unless the lisp
1000 code has asked for it.
1002 Don't set these parameters unless they actually differ from the
1003 window's current parameters; the window may not actually exist
1008 check_frame_size (f
, &height
, &width
);
1010 XSETFRAME (frame
, f
);
1012 if (width
!= FRAME_WIDTH (f
)
1013 || height
!= FRAME_HEIGHT (f
)
1014 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1015 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1017 if ((!NILP (left
) || !NILP (top
))
1018 && ! (left_no_change
&& top_no_change
)
1019 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1020 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1025 /* Record the signs. */
1026 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1027 if (EQ (left
, Qminus
))
1028 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1029 else if (INTEGERP (left
))
1031 leftpos
= XINT (left
);
1033 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1035 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1036 && CONSP (XCDR (left
))
1037 && INTEGERP (XCAR (XCDR (left
))))
1039 leftpos
= - XINT (XCAR (XCDR (left
)));
1040 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1042 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1043 && CONSP (XCDR (left
))
1044 && INTEGERP (XCAR (XCDR (left
))))
1046 leftpos
= XINT (XCAR (XCDR (left
)));
1049 if (EQ (top
, Qminus
))
1050 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1051 else if (INTEGERP (top
))
1053 toppos
= XINT (top
);
1055 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1057 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1058 && CONSP (XCDR (top
))
1059 && INTEGERP (XCAR (XCDR (top
))))
1061 toppos
= - XINT (XCAR (XCDR (top
)));
1062 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1064 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1065 && CONSP (XCDR (top
))
1066 && INTEGERP (XCAR (XCDR (top
))))
1068 toppos
= XINT (XCAR (XCDR (top
)));
1072 /* Store the numeric value of the position. */
1073 f
->output_data
.x
->top_pos
= toppos
;
1074 f
->output_data
.x
->left_pos
= leftpos
;
1076 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1078 /* Actually set that position, and convert to absolute. */
1079 x_set_offset (f
, leftpos
, toppos
, -1);
1082 if ((!NILP (icon_left
) || !NILP (icon_top
))
1083 && ! (icon_left_no_change
&& icon_top_no_change
))
1084 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1090 /* Store the screen positions of frame F into XPTR and YPTR.
1091 These are the positions of the containing window manager window,
1092 not Emacs's own window. */
1095 x_real_positions (f
, xptr
, yptr
)
1102 /* This is pretty gross, but seems to be the easiest way out of
1103 the problem that arises when restarting window-managers. */
1105 #ifdef USE_X_TOOLKIT
1106 Window outer
= (f
->output_data
.x
->widget
1107 ? XtWindow (f
->output_data
.x
->widget
)
1108 : FRAME_X_WINDOW (f
));
1110 Window outer
= f
->output_data
.x
->window_desc
;
1112 Window tmp_root_window
;
1113 Window
*tmp_children
;
1114 unsigned int tmp_nchildren
;
1118 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1119 Window outer_window
;
1121 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1122 &f
->output_data
.x
->parent_desc
,
1123 &tmp_children
, &tmp_nchildren
);
1124 XFree ((char *) tmp_children
);
1128 /* Find the position of the outside upper-left corner of
1129 the inner window, with respect to the outer window. */
1130 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1131 outer_window
= f
->output_data
.x
->parent_desc
;
1133 outer_window
= outer
;
1135 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1137 /* From-window, to-window. */
1139 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1141 /* From-position, to-position. */
1142 0, 0, &win_x
, &win_y
,
1147 /* It is possible for the window returned by the XQueryNotify
1148 to become invalid by the time we call XTranslateCoordinates.
1149 That can happen when you restart some window managers.
1150 If so, we get an error in XTranslateCoordinates.
1151 Detect that and try the whole thing over. */
1152 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1154 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1158 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1165 /* Insert a description of internally-recorded parameters of frame X
1166 into the parameter alist *ALISTPTR that is to be given to the user.
1167 Only parameters that are specific to the X window system
1168 and whose values are not correctly recorded in the frame's
1169 param_alist need to be considered here. */
1172 x_report_frame_params (f
, alistptr
)
1174 Lisp_Object
*alistptr
;
1179 /* Represent negative positions (off the top or left screen edge)
1180 in a way that Fmodify_frame_parameters will understand correctly. */
1181 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1182 if (f
->output_data
.x
->left_pos
>= 0)
1183 store_in_alist (alistptr
, Qleft
, tem
);
1185 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1187 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1188 if (f
->output_data
.x
->top_pos
>= 0)
1189 store_in_alist (alistptr
, Qtop
, tem
);
1191 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1193 store_in_alist (alistptr
, Qborder_width
,
1194 make_number (f
->output_data
.x
->border_width
));
1195 store_in_alist (alistptr
, Qinternal_border_width
,
1196 make_number (f
->output_data
.x
->internal_border_width
));
1197 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1198 store_in_alist (alistptr
, Qwindow_id
,
1199 build_string (buf
));
1200 #ifdef USE_X_TOOLKIT
1201 /* Tooltip frame may not have this widget. */
1202 if (f
->output_data
.x
->widget
)
1204 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1205 store_in_alist (alistptr
, Qouter_window_id
,
1206 build_string (buf
));
1207 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1208 FRAME_SAMPLE_VISIBILITY (f
);
1209 store_in_alist (alistptr
, Qvisibility
,
1210 (FRAME_VISIBLE_P (f
) ? Qt
1211 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1212 store_in_alist (alistptr
, Qdisplay
,
1213 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1215 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1218 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1219 store_in_alist (alistptr
, Qparent_id
, tem
);
1224 /* Gamma-correct COLOR on frame F. */
1227 gamma_correct (f
, color
)
1233 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1234 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1235 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1240 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1241 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1242 allocate the color. Value is zero if COLOR_NAME is invalid, or
1243 no color could be allocated. */
1246 x_defined_color (f
, color_name
, color
, alloc_p
)
1253 Display
*dpy
= FRAME_X_DISPLAY (f
);
1254 Colormap cmap
= FRAME_X_COLORMAP (f
);
1257 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1258 if (success_p
&& alloc_p
)
1259 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1266 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1267 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1268 Signal an error if color can't be allocated. */
1271 x_decode_color (f
, color_name
, mono_color
)
1273 Lisp_Object color_name
;
1278 CHECK_STRING (color_name
);
1280 #if 0 /* Don't do this. It's wrong when we're not using the default
1281 colormap, it makes freeing difficult, and it's probably not
1282 an important optimization. */
1283 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1284 return BLACK_PIX_DEFAULT (f
);
1285 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1286 return WHITE_PIX_DEFAULT (f
);
1289 /* Return MONO_COLOR for monochrome frames. */
1290 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1293 /* x_defined_color is responsible for coping with failures
1294 by looking for a near-miss. */
1295 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1298 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1299 Fcons (color_name
, Qnil
)));
1305 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1306 the previous value of that parameter, NEW_VALUE is the new value. */
1309 x_set_line_spacing (f
, new_value
, old_value
)
1311 Lisp_Object new_value
, old_value
;
1313 if (NILP (new_value
))
1314 f
->extra_line_spacing
= 0;
1315 else if (NATNUMP (new_value
))
1316 f
->extra_line_spacing
= XFASTINT (new_value
);
1318 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1319 Fcons (new_value
, Qnil
)));
1320 if (FRAME_VISIBLE_P (f
))
1325 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1326 the previous value of that parameter, NEW_VALUE is the new value.
1327 See also the comment of wait_for_wm in struct x_output. */
1330 x_set_wait_for_wm (f
, new_value
, old_value
)
1332 Lisp_Object new_value
, old_value
;
1334 f
->output_data
.x
->wait_for_wm
= !NILP (new_value
);
1338 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1339 the previous value of that parameter, NEW_VALUE is the new
1343 x_set_screen_gamma (f
, new_value
, old_value
)
1345 Lisp_Object new_value
, old_value
;
1347 if (NILP (new_value
))
1349 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1350 /* The value 0.4545 is the normal viewing gamma. */
1351 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1353 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1354 Fcons (new_value
, Qnil
)));
1356 clear_face_cache (0);
1360 /* Functions called only from `x_set_frame_param'
1361 to set individual parameters.
1363 If FRAME_X_WINDOW (f) is 0,
1364 the frame is being created and its X-window does not exist yet.
1365 In that case, just record the parameter's new value
1366 in the standard place; do not attempt to change the window. */
1369 x_set_foreground_color (f
, arg
, oldval
)
1371 Lisp_Object arg
, oldval
;
1373 struct x_output
*x
= f
->output_data
.x
;
1374 unsigned long fg
, old_fg
;
1376 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1377 old_fg
= x
->foreground_pixel
;
1378 x
->foreground_pixel
= fg
;
1380 if (FRAME_X_WINDOW (f
) != 0)
1382 Display
*dpy
= FRAME_X_DISPLAY (f
);
1385 XSetForeground (dpy
, x
->normal_gc
, fg
);
1386 XSetBackground (dpy
, x
->reverse_gc
, fg
);
1388 if (x
->cursor_pixel
== old_fg
)
1390 unload_color (f
, x
->cursor_pixel
);
1391 x
->cursor_pixel
= x_copy_color (f
, fg
);
1392 XSetBackground (dpy
, x
->cursor_gc
, x
->cursor_pixel
);
1397 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1399 if (FRAME_VISIBLE_P (f
))
1403 unload_color (f
, old_fg
);
1407 x_set_background_color (f
, arg
, oldval
)
1409 Lisp_Object arg
, oldval
;
1411 struct x_output
*x
= f
->output_data
.x
;
1414 bg
= x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1415 unload_color (f
, x
->background_pixel
);
1416 x
->background_pixel
= bg
;
1418 if (FRAME_X_WINDOW (f
) != 0)
1420 Display
*dpy
= FRAME_X_DISPLAY (f
);
1423 XSetBackground (dpy
, x
->normal_gc
, bg
);
1424 XSetForeground (dpy
, x
->reverse_gc
, bg
);
1425 XSetWindowBackground (dpy
, FRAME_X_WINDOW (f
), bg
);
1426 XSetForeground (dpy
, x
->cursor_gc
, bg
);
1428 #ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1429 toolkit scroll bars. */
1432 for (bar
= FRAME_SCROLL_BARS (f
);
1434 bar
= XSCROLL_BAR (bar
)->next
)
1436 Window window
= SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
));
1437 XSetWindowBackground (dpy
, window
, bg
);
1440 #endif /* USE_TOOLKIT_SCROLL_BARS */
1443 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1445 if (FRAME_VISIBLE_P (f
))
1451 x_set_mouse_color (f
, arg
, oldval
)
1453 Lisp_Object arg
, oldval
;
1455 struct x_output
*x
= f
->output_data
.x
;
1456 Display
*dpy
= FRAME_X_DISPLAY (f
);
1457 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1458 Cursor hourglass_cursor
, horizontal_drag_cursor
;
1460 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1461 unsigned long mask_color
= x
->background_pixel
;
1463 /* Don't let pointers be invisible. */
1464 if (mask_color
== pixel
)
1466 x_free_colors (f
, &pixel
, 1);
1467 pixel
= x_copy_color (f
, x
->foreground_pixel
);
1470 unload_color (f
, x
->mouse_pixel
);
1471 x
->mouse_pixel
= pixel
;
1475 /* It's not okay to crash if the user selects a screwy cursor. */
1476 count
= x_catch_errors (dpy
);
1478 if (!NILP (Vx_pointer_shape
))
1480 CHECK_NUMBER (Vx_pointer_shape
);
1481 cursor
= XCreateFontCursor (dpy
, XINT (Vx_pointer_shape
));
1484 cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1485 x_check_errors (dpy
, "bad text pointer cursor: %s");
1487 if (!NILP (Vx_nontext_pointer_shape
))
1489 CHECK_NUMBER (Vx_nontext_pointer_shape
);
1491 = XCreateFontCursor (dpy
, XINT (Vx_nontext_pointer_shape
));
1494 nontext_cursor
= XCreateFontCursor (dpy
, XC_left_ptr
);
1495 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1497 if (!NILP (Vx_hourglass_pointer_shape
))
1499 CHECK_NUMBER (Vx_hourglass_pointer_shape
);
1501 = XCreateFontCursor (dpy
, XINT (Vx_hourglass_pointer_shape
));
1504 hourglass_cursor
= XCreateFontCursor (dpy
, XC_watch
);
1505 x_check_errors (dpy
, "bad hourglass pointer cursor: %s");
1507 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1508 if (!NILP (Vx_mode_pointer_shape
))
1510 CHECK_NUMBER (Vx_mode_pointer_shape
);
1511 mode_cursor
= XCreateFontCursor (dpy
, XINT (Vx_mode_pointer_shape
));
1514 mode_cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1515 x_check_errors (dpy
, "bad modeline pointer cursor: %s");
1517 if (!NILP (Vx_sensitive_text_pointer_shape
))
1519 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
);
1521 = XCreateFontCursor (dpy
, XINT (Vx_sensitive_text_pointer_shape
));
1524 cross_cursor
= XCreateFontCursor (dpy
, XC_crosshair
);
1526 if (!NILP (Vx_window_horizontal_drag_shape
))
1528 CHECK_NUMBER (Vx_window_horizontal_drag_shape
);
1529 horizontal_drag_cursor
1530 = XCreateFontCursor (dpy
, XINT (Vx_window_horizontal_drag_shape
));
1533 horizontal_drag_cursor
1534 = XCreateFontCursor (dpy
, XC_sb_h_double_arrow
);
1536 /* Check and report errors with the above calls. */
1537 x_check_errors (dpy
, "can't set cursor shape: %s");
1538 x_uncatch_errors (dpy
, count
);
1541 XColor fore_color
, back_color
;
1543 fore_color
.pixel
= x
->mouse_pixel
;
1544 x_query_color (f
, &fore_color
);
1545 back_color
.pixel
= mask_color
;
1546 x_query_color (f
, &back_color
);
1548 XRecolorCursor (dpy
, cursor
, &fore_color
, &back_color
);
1549 XRecolorCursor (dpy
, nontext_cursor
, &fore_color
, &back_color
);
1550 XRecolorCursor (dpy
, mode_cursor
, &fore_color
, &back_color
);
1551 XRecolorCursor (dpy
, cross_cursor
, &fore_color
, &back_color
);
1552 XRecolorCursor (dpy
, hourglass_cursor
, &fore_color
, &back_color
);
1553 XRecolorCursor (dpy
, horizontal_drag_cursor
, &fore_color
, &back_color
);
1556 if (FRAME_X_WINDOW (f
) != 0)
1557 XDefineCursor (dpy
, FRAME_X_WINDOW (f
), cursor
);
1559 if (cursor
!= x
->text_cursor
1560 && x
->text_cursor
!= 0)
1561 XFreeCursor (dpy
, x
->text_cursor
);
1562 x
->text_cursor
= cursor
;
1564 if (nontext_cursor
!= x
->nontext_cursor
1565 && x
->nontext_cursor
!= 0)
1566 XFreeCursor (dpy
, x
->nontext_cursor
);
1567 x
->nontext_cursor
= nontext_cursor
;
1569 if (hourglass_cursor
!= x
->hourglass_cursor
1570 && x
->hourglass_cursor
!= 0)
1571 XFreeCursor (dpy
, x
->hourglass_cursor
);
1572 x
->hourglass_cursor
= hourglass_cursor
;
1574 if (mode_cursor
!= x
->modeline_cursor
1575 && x
->modeline_cursor
!= 0)
1576 XFreeCursor (dpy
, f
->output_data
.x
->modeline_cursor
);
1577 x
->modeline_cursor
= mode_cursor
;
1579 if (cross_cursor
!= x
->cross_cursor
1580 && x
->cross_cursor
!= 0)
1581 XFreeCursor (dpy
, x
->cross_cursor
);
1582 x
->cross_cursor
= cross_cursor
;
1584 if (horizontal_drag_cursor
!= x
->horizontal_drag_cursor
1585 && x
->horizontal_drag_cursor
!= 0)
1586 XFreeCursor (dpy
, x
->horizontal_drag_cursor
);
1587 x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1592 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1596 x_set_cursor_color (f
, arg
, oldval
)
1598 Lisp_Object arg
, oldval
;
1600 unsigned long fore_pixel
, pixel
;
1601 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1602 struct x_output
*x
= f
->output_data
.x
;
1604 if (!NILP (Vx_cursor_fore_pixel
))
1606 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1607 WHITE_PIX_DEFAULT (f
));
1608 fore_pixel_allocated_p
= 1;
1611 fore_pixel
= x
->background_pixel
;
1613 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1614 pixel_allocated_p
= 1;
1616 /* Make sure that the cursor color differs from the background color. */
1617 if (pixel
== x
->background_pixel
)
1619 if (pixel_allocated_p
)
1621 x_free_colors (f
, &pixel
, 1);
1622 pixel_allocated_p
= 0;
1625 pixel
= x
->mouse_pixel
;
1626 if (pixel
== fore_pixel
)
1628 if (fore_pixel_allocated_p
)
1630 x_free_colors (f
, &fore_pixel
, 1);
1631 fore_pixel_allocated_p
= 0;
1633 fore_pixel
= x
->background_pixel
;
1637 unload_color (f
, x
->cursor_foreground_pixel
);
1638 if (!fore_pixel_allocated_p
)
1639 fore_pixel
= x_copy_color (f
, fore_pixel
);
1640 x
->cursor_foreground_pixel
= fore_pixel
;
1642 unload_color (f
, x
->cursor_pixel
);
1643 if (!pixel_allocated_p
)
1644 pixel
= x_copy_color (f
, pixel
);
1645 x
->cursor_pixel
= pixel
;
1647 if (FRAME_X_WINDOW (f
) != 0)
1650 XSetBackground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, x
->cursor_pixel
);
1651 XSetForeground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, fore_pixel
);
1654 if (FRAME_VISIBLE_P (f
))
1656 x_update_cursor (f
, 0);
1657 x_update_cursor (f
, 1);
1661 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1664 /* Set the border-color of frame F to value described by ARG.
1665 ARG can be a string naming a color.
1666 The border-color is used for the border that is drawn by the X server.
1667 Note that this does not fully take effect if done before
1668 F has an x-window; it must be redone when the window is created.
1670 Note: this is done in two routines because of the way X10 works.
1672 Note: under X11, this is normally the province of the window manager,
1673 and so emacs' border colors may be overridden. */
1676 x_set_border_color (f
, arg
, oldval
)
1678 Lisp_Object arg
, oldval
;
1683 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1684 x_set_border_pixel (f
, pix
);
1685 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1688 /* Set the border-color of frame F to pixel value PIX.
1689 Note that this does not fully take effect if done before
1690 F has an x-window. */
1693 x_set_border_pixel (f
, pix
)
1697 unload_color (f
, f
->output_data
.x
->border_pixel
);
1698 f
->output_data
.x
->border_pixel
= pix
;
1700 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1703 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1704 (unsigned long)pix
);
1707 if (FRAME_VISIBLE_P (f
))
1713 /* Value is the internal representation of the specified cursor type
1714 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1715 of the bar cursor. */
1717 enum text_cursor_kinds
1718 x_specified_cursor_type (arg
, width
)
1722 enum text_cursor_kinds type
;
1729 else if (CONSP (arg
)
1730 && EQ (XCAR (arg
), Qbar
)
1731 && INTEGERP (XCDR (arg
))
1732 && XINT (XCDR (arg
)) >= 0)
1735 *width
= XINT (XCDR (arg
));
1737 else if (NILP (arg
))
1740 /* Treat anything unknown as "box cursor".
1741 It was bad to signal an error; people have trouble fixing
1742 .Xdefaults with Emacs, when it has something bad in it. */
1743 type
= FILLED_BOX_CURSOR
;
1749 x_set_cursor_type (f
, arg
, oldval
)
1751 Lisp_Object arg
, oldval
;
1755 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1756 f
->output_data
.x
->cursor_width
= width
;
1758 /* Make sure the cursor gets redrawn. This is overkill, but how
1759 often do people change cursor types? */
1760 update_mode_lines
++;
1764 x_set_icon_type (f
, arg
, oldval
)
1766 Lisp_Object arg
, oldval
;
1772 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1775 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1780 result
= x_text_icon (f
,
1781 (char *) XSTRING ((!NILP (f
->icon_name
)
1785 result
= x_bitmap_icon (f
, arg
);
1790 error ("No icon window available");
1793 XFlush (FRAME_X_DISPLAY (f
));
1797 /* Return non-nil if frame F wants a bitmap icon. */
1805 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1813 x_set_icon_name (f
, arg
, oldval
)
1815 Lisp_Object arg
, oldval
;
1821 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1824 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1829 if (f
->output_data
.x
->icon_bitmap
!= 0)
1834 result
= x_text_icon (f
,
1835 (char *) XSTRING ((!NILP (f
->icon_name
)
1844 error ("No icon window available");
1847 XFlush (FRAME_X_DISPLAY (f
));
1852 x_set_font (f
, arg
, oldval
)
1854 Lisp_Object arg
, oldval
;
1857 Lisp_Object fontset_name
;
1859 int old_fontset
= f
->output_data
.x
->fontset
;
1863 fontset_name
= Fquery_fontset (arg
, Qnil
);
1866 result
= (STRINGP (fontset_name
)
1867 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1868 : x_new_font (f
, XSTRING (arg
)->data
));
1871 if (EQ (result
, Qnil
))
1872 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1873 else if (EQ (result
, Qt
))
1874 error ("The characters of the given font have varying widths");
1875 else if (STRINGP (result
))
1877 if (STRINGP (fontset_name
))
1879 /* Fontset names are built from ASCII font names, so the
1880 names may be equal despite there was a change. */
1881 if (old_fontset
== f
->output_data
.x
->fontset
)
1884 else if (!NILP (Fequal (result
, oldval
)))
1887 store_frame_param (f
, Qfont
, result
);
1888 recompute_basic_faces (f
);
1893 do_pending_window_change (0);
1895 /* Don't call `face-set-after-frame-default' when faces haven't been
1896 initialized yet. This is the case when called from
1897 Fx_create_frame. In that case, the X widget or window doesn't
1898 exist either, and we can end up in x_report_frame_params with a
1899 null widget which gives a segfault. */
1900 if (FRAME_FACE_CACHE (f
))
1902 XSETFRAME (frame
, f
);
1903 call1 (Qface_set_after_frame_default
, frame
);
1908 x_set_border_width (f
, arg
, oldval
)
1910 Lisp_Object arg
, oldval
;
1914 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1917 if (FRAME_X_WINDOW (f
) != 0)
1918 error ("Cannot change the border width of a window");
1920 f
->output_data
.x
->border_width
= XINT (arg
);
1924 x_set_internal_border_width (f
, arg
, oldval
)
1926 Lisp_Object arg
, oldval
;
1928 int old
= f
->output_data
.x
->internal_border_width
;
1931 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1932 if (f
->output_data
.x
->internal_border_width
< 0)
1933 f
->output_data
.x
->internal_border_width
= 0;
1935 #ifdef USE_X_TOOLKIT
1936 if (f
->output_data
.x
->edit_widget
)
1937 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1940 if (f
->output_data
.x
->internal_border_width
== old
)
1943 if (FRAME_X_WINDOW (f
) != 0)
1945 x_set_window_size (f
, 0, f
->width
, f
->height
);
1946 SET_FRAME_GARBAGED (f
);
1947 do_pending_window_change (0);
1950 SET_FRAME_GARBAGED (f
);
1954 x_set_visibility (f
, value
, oldval
)
1956 Lisp_Object value
, oldval
;
1959 XSETFRAME (frame
, f
);
1962 Fmake_frame_invisible (frame
, Qt
);
1963 else if (EQ (value
, Qicon
))
1964 Ficonify_frame (frame
);
1966 Fmake_frame_visible (frame
);
1970 /* Change window heights in windows rooted in WINDOW by N lines. */
1973 x_change_window_heights (window
, n
)
1977 struct window
*w
= XWINDOW (window
);
1979 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1980 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1982 if (INTEGERP (w
->orig_top
))
1983 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1984 if (INTEGERP (w
->orig_height
))
1985 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1987 /* Handle just the top child in a vertical split. */
1988 if (!NILP (w
->vchild
))
1989 x_change_window_heights (w
->vchild
, n
);
1991 /* Adjust all children in a horizontal split. */
1992 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1994 w
= XWINDOW (window
);
1995 x_change_window_heights (window
, n
);
2000 x_set_menu_bar_lines (f
, value
, oldval
)
2002 Lisp_Object value
, oldval
;
2005 #ifndef USE_X_TOOLKIT
2006 int olines
= FRAME_MENU_BAR_LINES (f
);
2009 /* Right now, menu bars don't work properly in minibuf-only frames;
2010 most of the commands try to apply themselves to the minibuffer
2011 frame itself, and get an error because you can't switch buffers
2012 in or split the minibuffer window. */
2013 if (FRAME_MINIBUF_ONLY_P (f
))
2016 if (INTEGERP (value
))
2017 nlines
= XINT (value
);
2021 /* Make sure we redisplay all windows in this frame. */
2022 windows_or_buffers_changed
++;
2024 #ifdef USE_X_TOOLKIT
2025 FRAME_MENU_BAR_LINES (f
) = 0;
2028 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2029 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
2030 /* Make sure next redisplay shows the menu bar. */
2031 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2035 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2036 free_frame_menubar (f
);
2037 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2039 f
->output_data
.x
->menubar_widget
= 0;
2041 #else /* not USE_X_TOOLKIT */
2042 FRAME_MENU_BAR_LINES (f
) = nlines
;
2043 x_change_window_heights (f
->root_window
, nlines
- olines
);
2044 #endif /* not USE_X_TOOLKIT */
2049 /* Set the number of lines used for the tool bar of frame F to VALUE.
2050 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2051 is the old number of tool bar lines. This function changes the
2052 height of all windows on frame F to match the new tool bar height.
2053 The frame's height doesn't change. */
2056 x_set_tool_bar_lines (f
, value
, oldval
)
2058 Lisp_Object value
, oldval
;
2060 int delta
, nlines
, root_height
;
2061 Lisp_Object root_window
;
2063 /* Treat tool bars like menu bars. */
2064 if (FRAME_MINIBUF_ONLY_P (f
))
2067 /* Use VALUE only if an integer >= 0. */
2068 if (INTEGERP (value
) && XINT (value
) >= 0)
2069 nlines
= XFASTINT (value
);
2073 /* Make sure we redisplay all windows in this frame. */
2074 ++windows_or_buffers_changed
;
2076 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2078 /* Don't resize the tool-bar to more than we have room for. */
2079 root_window
= FRAME_ROOT_WINDOW (f
);
2080 root_height
= XINT (XWINDOW (root_window
)->height
);
2081 if (root_height
- delta
< 1)
2083 delta
= root_height
- 1;
2084 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2087 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2088 x_change_window_heights (root_window
, delta
);
2091 /* We also have to make sure that the internal border at the top of
2092 the frame, below the menu bar or tool bar, is redrawn when the
2093 tool bar disappears. This is so because the internal border is
2094 below the tool bar if one is displayed, but is below the menu bar
2095 if there isn't a tool bar. The tool bar draws into the area
2096 below the menu bar. */
2097 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2101 clear_current_matrices (f
);
2102 updating_frame
= NULL
;
2105 /* If the tool bar gets smaller, the internal border below it
2106 has to be cleared. It was formerly part of the display
2107 of the larger tool bar, and updating windows won't clear it. */
2110 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2111 int width
= PIXEL_WIDTH (f
);
2112 int y
= nlines
* CANON_Y_UNIT (f
);
2115 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2116 0, y
, width
, height
, False
);
2119 if (WINDOWP (f
->tool_bar_window
))
2120 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2125 /* Set the foreground color for scroll bars on frame F to VALUE.
2126 VALUE should be a string, a color name. If it isn't a string or
2127 isn't a valid color name, do nothing. OLDVAL is the old value of
2128 the frame parameter. */
2131 x_set_scroll_bar_foreground (f
, value
, oldval
)
2133 Lisp_Object value
, oldval
;
2135 unsigned long pixel
;
2137 if (STRINGP (value
))
2138 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2142 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2143 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2145 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2146 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2148 /* Remove all scroll bars because they have wrong colors. */
2149 if (condemn_scroll_bars_hook
)
2150 (*condemn_scroll_bars_hook
) (f
);
2151 if (judge_scroll_bars_hook
)
2152 (*judge_scroll_bars_hook
) (f
);
2154 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2160 /* Set the background color for scroll bars on frame F to VALUE VALUE
2161 should be a string, a color name. If it isn't a string or isn't a
2162 valid color name, do nothing. OLDVAL is the old value of the frame
2166 x_set_scroll_bar_background (f
, value
, oldval
)
2168 Lisp_Object value
, oldval
;
2170 unsigned long pixel
;
2172 if (STRINGP (value
))
2173 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2177 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2178 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2180 #ifdef USE_TOOLKIT_SCROLL_BARS
2181 /* Scrollbar shadow colors. */
2182 if (f
->output_data
.x
->scroll_bar_top_shadow_pixel
!= -1)
2184 unload_color (f
, f
->output_data
.x
->scroll_bar_top_shadow_pixel
);
2185 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
2187 if (f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
!= -1)
2189 unload_color (f
, f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
);
2190 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
2192 #endif /* USE_TOOLKIT_SCROLL_BARS */
2194 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2195 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2197 /* Remove all scroll bars because they have wrong colors. */
2198 if (condemn_scroll_bars_hook
)
2199 (*condemn_scroll_bars_hook
) (f
);
2200 if (judge_scroll_bars_hook
)
2201 (*judge_scroll_bars_hook
) (f
);
2203 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2209 /* Encode Lisp string STRING as a text in a format appropriate for
2210 XICCC (X Inter Client Communication Conventions).
2212 If STRING contains only ASCII characters, do no conversion and
2213 return the string data of STRING. Otherwise, encode the text by
2214 CODING_SYSTEM, and return a newly allocated memory area which
2215 should be freed by `xfree' by a caller.
2217 Store the byte length of resulting text in *TEXT_BYTES.
2219 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2220 which means that the `encoding' of the result can be `STRING'.
2221 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2222 the result should be `COMPOUND_TEXT'. */
2225 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2226 Lisp_Object string
, coding_system
;
2227 int *text_bytes
, *stringp
;
2229 unsigned char *str
= XSTRING (string
)->data
;
2230 int chars
= XSTRING (string
)->size
;
2231 int bytes
= STRING_BYTES (XSTRING (string
));
2235 struct coding_system coding
;
2237 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2238 if (charset_info
== 0)
2240 /* No multibyte character in OBJ. We need not encode it. */
2241 *text_bytes
= bytes
;
2246 setup_coding_system (coding_system
, &coding
);
2247 coding
.src_multibyte
= 1;
2248 coding
.dst_multibyte
= 0;
2249 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2250 if (coding
.type
== coding_type_iso2022
)
2251 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2252 /* We suppress producing escape sequences for composition. */
2253 coding
.composing
= COMPOSITION_DISABLED
;
2254 bufsize
= encoding_buffer_size (&coding
, bytes
);
2255 buf
= (unsigned char *) xmalloc (bufsize
);
2256 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2257 *text_bytes
= coding
.produced
;
2258 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2263 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2266 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2267 name; if NAME is a string, set F's name to NAME and set
2268 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2270 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2271 suggesting a new name, which lisp code should override; if
2272 F->explicit_name is set, ignore the new name; otherwise, set it. */
2275 x_set_name (f
, name
, explicit)
2280 /* Make sure that requests from lisp code override requests from
2281 Emacs redisplay code. */
2284 /* If we're switching from explicit to implicit, we had better
2285 update the mode lines and thereby update the title. */
2286 if (f
->explicit_name
&& NILP (name
))
2287 update_mode_lines
= 1;
2289 f
->explicit_name
= ! NILP (name
);
2291 else if (f
->explicit_name
)
2294 /* If NAME is nil, set the name to the x_id_name. */
2297 /* Check for no change needed in this very common case
2298 before we do any consing. */
2299 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2300 XSTRING (f
->name
)->data
))
2302 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2305 CHECK_STRING (name
);
2307 /* Don't change the name if it's already NAME. */
2308 if (! NILP (Fstring_equal (name
, f
->name
)))
2313 /* For setting the frame title, the title parameter should override
2314 the name parameter. */
2315 if (! NILP (f
->title
))
2318 if (FRAME_X_WINDOW (f
))
2323 XTextProperty text
, icon
;
2325 Lisp_Object coding_system
;
2327 coding_system
= Vlocale_coding_system
;
2328 if (NILP (coding_system
))
2329 coding_system
= Qcompound_text
;
2330 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2331 text
.encoding
= (stringp
? XA_STRING
2332 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2334 text
.nitems
= bytes
;
2336 if (NILP (f
->icon_name
))
2342 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2344 icon
.encoding
= (stringp
? XA_STRING
2345 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2347 icon
.nitems
= bytes
;
2349 #ifdef USE_X_TOOLKIT
2350 XSetWMName (FRAME_X_DISPLAY (f
),
2351 XtWindow (f
->output_data
.x
->widget
), &text
);
2352 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2354 #else /* not USE_X_TOOLKIT */
2355 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2356 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2357 #endif /* not USE_X_TOOLKIT */
2358 if (!NILP (f
->icon_name
)
2359 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2361 if (text
.value
!= XSTRING (name
)->data
)
2364 #else /* not HAVE_X11R4 */
2365 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2366 XSTRING (name
)->data
);
2367 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2368 XSTRING (name
)->data
);
2369 #endif /* not HAVE_X11R4 */
2374 /* This function should be called when the user's lisp code has
2375 specified a name for the frame; the name will override any set by the
2378 x_explicitly_set_name (f
, arg
, oldval
)
2380 Lisp_Object arg
, oldval
;
2382 x_set_name (f
, arg
, 1);
2385 /* This function should be called by Emacs redisplay code to set the
2386 name; names set this way will never override names set by the user's
2389 x_implicitly_set_name (f
, arg
, oldval
)
2391 Lisp_Object arg
, oldval
;
2393 x_set_name (f
, arg
, 0);
2396 /* Change the title of frame F to NAME.
2397 If NAME is nil, use the frame name as the title.
2399 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2400 name; if NAME is a string, set F's name to NAME and set
2401 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2403 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2404 suggesting a new name, which lisp code should override; if
2405 F->explicit_name is set, ignore the new name; otherwise, set it. */
2408 x_set_title (f
, name
, old_name
)
2410 Lisp_Object name
, old_name
;
2412 /* Don't change the title if it's already NAME. */
2413 if (EQ (name
, f
->title
))
2416 update_mode_lines
= 1;
2423 CHECK_STRING (name
);
2425 if (FRAME_X_WINDOW (f
))
2430 XTextProperty text
, icon
;
2432 Lisp_Object coding_system
;
2434 coding_system
= Vlocale_coding_system
;
2435 if (NILP (coding_system
))
2436 coding_system
= Qcompound_text
;
2437 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2438 text
.encoding
= (stringp
? XA_STRING
2439 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2441 text
.nitems
= bytes
;
2443 if (NILP (f
->icon_name
))
2449 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2451 icon
.encoding
= (stringp
? XA_STRING
2452 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2454 icon
.nitems
= bytes
;
2456 #ifdef USE_X_TOOLKIT
2457 XSetWMName (FRAME_X_DISPLAY (f
),
2458 XtWindow (f
->output_data
.x
->widget
), &text
);
2459 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2461 #else /* not USE_X_TOOLKIT */
2462 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2463 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2464 #endif /* not USE_X_TOOLKIT */
2465 if (!NILP (f
->icon_name
)
2466 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2468 if (text
.value
!= XSTRING (name
)->data
)
2471 #else /* not HAVE_X11R4 */
2472 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2473 XSTRING (name
)->data
);
2474 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2475 XSTRING (name
)->data
);
2476 #endif /* not HAVE_X11R4 */
2482 x_set_autoraise (f
, arg
, oldval
)
2484 Lisp_Object arg
, oldval
;
2486 f
->auto_raise
= !EQ (Qnil
, arg
);
2490 x_set_autolower (f
, arg
, oldval
)
2492 Lisp_Object arg
, oldval
;
2494 f
->auto_lower
= !EQ (Qnil
, arg
);
2498 x_set_unsplittable (f
, arg
, oldval
)
2500 Lisp_Object arg
, oldval
;
2502 f
->no_split
= !NILP (arg
);
2506 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2508 Lisp_Object arg
, oldval
;
2510 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2511 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2512 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2513 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2515 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2517 ? vertical_scroll_bar_none
2519 ? vertical_scroll_bar_right
2520 : vertical_scroll_bar_left
);
2522 /* We set this parameter before creating the X window for the
2523 frame, so we can get the geometry right from the start.
2524 However, if the window hasn't been created yet, we shouldn't
2525 call x_set_window_size. */
2526 if (FRAME_X_WINDOW (f
))
2527 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2528 do_pending_window_change (0);
2533 x_set_scroll_bar_width (f
, arg
, oldval
)
2535 Lisp_Object arg
, oldval
;
2537 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2541 #ifdef USE_TOOLKIT_SCROLL_BARS
2542 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2543 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2544 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2545 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2547 /* Make the actual width at least 14 pixels and a multiple of a
2549 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2551 /* Use all of that space (aside from required margins) for the
2553 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2556 if (FRAME_X_WINDOW (f
))
2557 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2558 do_pending_window_change (0);
2560 else if (INTEGERP (arg
) && XINT (arg
) > 0
2561 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2563 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2564 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2566 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2567 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2568 if (FRAME_X_WINDOW (f
))
2569 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2572 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2573 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2574 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2579 /* Subroutines of creating an X frame. */
2581 /* Make sure that Vx_resource_name is set to a reasonable value.
2582 Fix it up, or set it to `emacs' if it is too hopeless. */
2585 validate_x_resource_name ()
2588 /* Number of valid characters in the resource name. */
2590 /* Number of invalid characters in the resource name. */
2595 if (!STRINGP (Vx_resource_class
))
2596 Vx_resource_class
= build_string (EMACS_CLASS
);
2598 if (STRINGP (Vx_resource_name
))
2600 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2603 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2605 /* Only letters, digits, - and _ are valid in resource names.
2606 Count the valid characters and count the invalid ones. */
2607 for (i
= 0; i
< len
; i
++)
2610 if (! ((c
>= 'a' && c
<= 'z')
2611 || (c
>= 'A' && c
<= 'Z')
2612 || (c
>= '0' && c
<= '9')
2613 || c
== '-' || c
== '_'))
2620 /* Not a string => completely invalid. */
2621 bad_count
= 5, good_count
= 0;
2623 /* If name is valid already, return. */
2627 /* If name is entirely invalid, or nearly so, use `emacs'. */
2629 || (good_count
== 1 && bad_count
> 0))
2631 Vx_resource_name
= build_string ("emacs");
2635 /* Name is partly valid. Copy it and replace the invalid characters
2636 with underscores. */
2638 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2640 for (i
= 0; i
< len
; i
++)
2642 int c
= XSTRING (new)->data
[i
];
2643 if (! ((c
>= 'a' && c
<= 'z')
2644 || (c
>= 'A' && c
<= 'Z')
2645 || (c
>= '0' && c
<= '9')
2646 || c
== '-' || c
== '_'))
2647 XSTRING (new)->data
[i
] = '_';
2652 extern char *x_get_string_resource ();
2654 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2655 doc
: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
2656 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
2657 class, where INSTANCE is the name under which Emacs was invoked, or
2658 the name specified by the `-name' or `-rn' command-line arguments.
2660 The optional arguments COMPONENT and SUBCLASS add to the key and the
2661 class, respectively. You must specify both of them or neither.
2662 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
2663 and the class is `Emacs.CLASS.SUBCLASS'. */)
2664 (attribute
, class, component
, subclass
)
2665 Lisp_Object attribute
, class, component
, subclass
;
2667 register char *value
;
2673 CHECK_STRING (attribute
);
2674 CHECK_STRING (class);
2676 if (!NILP (component
))
2677 CHECK_STRING (component
);
2678 if (!NILP (subclass
))
2679 CHECK_STRING (subclass
);
2680 if (NILP (component
) != NILP (subclass
))
2681 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2683 validate_x_resource_name ();
2685 /* Allocate space for the components, the dots which separate them,
2686 and the final '\0'. Make them big enough for the worst case. */
2687 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2688 + (STRINGP (component
)
2689 ? STRING_BYTES (XSTRING (component
)) : 0)
2690 + STRING_BYTES (XSTRING (attribute
))
2693 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2694 + STRING_BYTES (XSTRING (class))
2695 + (STRINGP (subclass
)
2696 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2699 /* Start with emacs.FRAMENAME for the name (the specific one)
2700 and with `Emacs' for the class key (the general one). */
2701 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2702 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2704 strcat (class_key
, ".");
2705 strcat (class_key
, XSTRING (class)->data
);
2707 if (!NILP (component
))
2709 strcat (class_key
, ".");
2710 strcat (class_key
, XSTRING (subclass
)->data
);
2712 strcat (name_key
, ".");
2713 strcat (name_key
, XSTRING (component
)->data
);
2716 strcat (name_key
, ".");
2717 strcat (name_key
, XSTRING (attribute
)->data
);
2719 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2720 name_key
, class_key
);
2722 if (value
!= (char *) 0)
2723 return build_string (value
);
2728 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2731 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2732 struct x_display_info
*dpyinfo
;
2733 Lisp_Object attribute
, class, component
, subclass
;
2735 register char *value
;
2739 CHECK_STRING (attribute
);
2740 CHECK_STRING (class);
2742 if (!NILP (component
))
2743 CHECK_STRING (component
);
2744 if (!NILP (subclass
))
2745 CHECK_STRING (subclass
);
2746 if (NILP (component
) != NILP (subclass
))
2747 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2749 validate_x_resource_name ();
2751 /* Allocate space for the components, the dots which separate them,
2752 and the final '\0'. Make them big enough for the worst case. */
2753 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2754 + (STRINGP (component
)
2755 ? STRING_BYTES (XSTRING (component
)) : 0)
2756 + STRING_BYTES (XSTRING (attribute
))
2759 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2760 + STRING_BYTES (XSTRING (class))
2761 + (STRINGP (subclass
)
2762 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2765 /* Start with emacs.FRAMENAME for the name (the specific one)
2766 and with `Emacs' for the class key (the general one). */
2767 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2768 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2770 strcat (class_key
, ".");
2771 strcat (class_key
, XSTRING (class)->data
);
2773 if (!NILP (component
))
2775 strcat (class_key
, ".");
2776 strcat (class_key
, XSTRING (subclass
)->data
);
2778 strcat (name_key
, ".");
2779 strcat (name_key
, XSTRING (component
)->data
);
2782 strcat (name_key
, ".");
2783 strcat (name_key
, XSTRING (attribute
)->data
);
2785 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2787 if (value
!= (char *) 0)
2788 return build_string (value
);
2793 /* Used when C code wants a resource value. */
2796 x_get_resource_string (attribute
, class)
2797 char *attribute
, *class;
2801 struct frame
*sf
= SELECTED_FRAME ();
2803 /* Allocate space for the components, the dots which separate them,
2804 and the final '\0'. */
2805 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2806 + strlen (attribute
) + 2);
2807 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2808 + strlen (class) + 2);
2810 sprintf (name_key
, "%s.%s",
2811 XSTRING (Vinvocation_name
)->data
,
2813 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2815 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2816 name_key
, class_key
);
2819 /* Types we might convert a resource string into. */
2829 /* Return the value of parameter PARAM.
2831 First search ALIST, then Vdefault_frame_alist, then the X defaults
2832 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2834 Convert the resource to the type specified by desired_type.
2836 If no default is specified, return Qunbound. If you call
2837 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2838 and don't let it get stored in any Lisp-visible variables! */
2841 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2842 struct x_display_info
*dpyinfo
;
2843 Lisp_Object alist
, param
;
2846 enum resource_types type
;
2848 register Lisp_Object tem
;
2850 tem
= Fassq (param
, alist
);
2852 tem
= Fassq (param
, Vdefault_frame_alist
);
2858 tem
= display_x_get_resource (dpyinfo
,
2859 build_string (attribute
),
2860 build_string (class),
2868 case RES_TYPE_NUMBER
:
2869 return make_number (atoi (XSTRING (tem
)->data
));
2871 case RES_TYPE_FLOAT
:
2872 return make_float (atof (XSTRING (tem
)->data
));
2874 case RES_TYPE_BOOLEAN
:
2875 tem
= Fdowncase (tem
);
2876 if (!strcmp (XSTRING (tem
)->data
, "on")
2877 || !strcmp (XSTRING (tem
)->data
, "true"))
2882 case RES_TYPE_STRING
:
2885 case RES_TYPE_SYMBOL
:
2886 /* As a special case, we map the values `true' and `on'
2887 to Qt, and `false' and `off' to Qnil. */
2890 lower
= Fdowncase (tem
);
2891 if (!strcmp (XSTRING (lower
)->data
, "on")
2892 || !strcmp (XSTRING (lower
)->data
, "true"))
2894 else if (!strcmp (XSTRING (lower
)->data
, "off")
2895 || !strcmp (XSTRING (lower
)->data
, "false"))
2898 return Fintern (tem
, Qnil
);
2911 /* Like x_get_arg, but also record the value in f->param_alist. */
2914 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2916 Lisp_Object alist
, param
;
2919 enum resource_types type
;
2923 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2924 attribute
, class, type
);
2926 store_frame_param (f
, param
, value
);
2931 /* Record in frame F the specified or default value according to ALIST
2932 of the parameter named PROP (a Lisp symbol).
2933 If no value is specified for PROP, look for an X default for XPROP
2934 on the frame named NAME.
2935 If that is not found either, use the value DEFLT. */
2938 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2945 enum resource_types type
;
2949 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2950 if (EQ (tem
, Qunbound
))
2952 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2957 /* Record in frame F the specified or default value according to ALIST
2958 of the parameter named PROP (a Lisp symbol). If no value is
2959 specified for PROP, look for an X default for XPROP on the frame
2960 named NAME. If that is not found either, use the value DEFLT. */
2963 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2972 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2975 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2976 if (EQ (tem
, Qunbound
))
2978 #ifdef USE_TOOLKIT_SCROLL_BARS
2980 /* See if an X resource for the scroll bar color has been
2982 tem
= display_x_get_resource (dpyinfo
,
2983 build_string (foreground_p
2987 build_string ("verticalScrollBar"),
2991 /* If nothing has been specified, scroll bars will use a
2992 toolkit-dependent default. Because these defaults are
2993 difficult to get at without actually creating a scroll
2994 bar, use nil to indicate that no color has been
2999 #else /* not USE_TOOLKIT_SCROLL_BARS */
3003 #endif /* not USE_TOOLKIT_SCROLL_BARS */
3006 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3012 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3013 doc
: /* Parse an X-style geometry string STRING.
3014 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3015 The properties returned may include `top', `left', `height', and `width'.
3016 The value of `left' or `top' may be an integer,
3017 or a list (+ N) meaning N pixels relative to top/left corner,
3018 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3023 unsigned int width
, height
;
3026 CHECK_STRING (string
);
3028 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
3029 &x
, &y
, &width
, &height
);
3032 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
3033 error ("Must specify both x and y position, or neither");
3037 if (geometry
& XValue
)
3039 Lisp_Object element
;
3041 if (x
>= 0 && (geometry
& XNegative
))
3042 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3043 else if (x
< 0 && ! (geometry
& XNegative
))
3044 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3046 element
= Fcons (Qleft
, make_number (x
));
3047 result
= Fcons (element
, result
);
3050 if (geometry
& YValue
)
3052 Lisp_Object element
;
3054 if (y
>= 0 && (geometry
& YNegative
))
3055 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3056 else if (y
< 0 && ! (geometry
& YNegative
))
3057 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3059 element
= Fcons (Qtop
, make_number (y
));
3060 result
= Fcons (element
, result
);
3063 if (geometry
& WidthValue
)
3064 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3065 if (geometry
& HeightValue
)
3066 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3071 /* Calculate the desired size and position of this window,
3072 and return the flags saying which aspects were specified.
3074 This function does not make the coordinates positive. */
3076 #define DEFAULT_ROWS 40
3077 #define DEFAULT_COLS 80
3080 x_figure_window_size (f
, parms
)
3084 register Lisp_Object tem0
, tem1
, tem2
;
3085 long window_prompting
= 0;
3086 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3088 /* Default values if we fall through.
3089 Actually, if that happens we should get
3090 window manager prompting. */
3091 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3092 f
->height
= DEFAULT_ROWS
;
3093 /* Window managers expect that if program-specified
3094 positions are not (0,0), they're intentional, not defaults. */
3095 f
->output_data
.x
->top_pos
= 0;
3096 f
->output_data
.x
->left_pos
= 0;
3098 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3099 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3100 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3101 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3103 if (!EQ (tem0
, Qunbound
))
3105 CHECK_NUMBER (tem0
);
3106 f
->height
= XINT (tem0
);
3108 if (!EQ (tem1
, Qunbound
))
3110 CHECK_NUMBER (tem1
);
3111 SET_FRAME_WIDTH (f
, XINT (tem1
));
3113 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3114 window_prompting
|= USSize
;
3116 window_prompting
|= PSize
;
3119 f
->output_data
.x
->vertical_scroll_bar_extra
3120 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3122 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3123 f
->output_data
.x
->fringes_extra
3124 = FRAME_FRINGE_WIDTH (f
);
3125 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3126 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3128 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3129 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3130 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3131 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3133 if (EQ (tem0
, Qminus
))
3135 f
->output_data
.x
->top_pos
= 0;
3136 window_prompting
|= YNegative
;
3138 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3139 && CONSP (XCDR (tem0
))
3140 && INTEGERP (XCAR (XCDR (tem0
))))
3142 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3143 window_prompting
|= YNegative
;
3145 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3146 && CONSP (XCDR (tem0
))
3147 && INTEGERP (XCAR (XCDR (tem0
))))
3149 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3151 else if (EQ (tem0
, Qunbound
))
3152 f
->output_data
.x
->top_pos
= 0;
3155 CHECK_NUMBER (tem0
);
3156 f
->output_data
.x
->top_pos
= XINT (tem0
);
3157 if (f
->output_data
.x
->top_pos
< 0)
3158 window_prompting
|= YNegative
;
3161 if (EQ (tem1
, Qminus
))
3163 f
->output_data
.x
->left_pos
= 0;
3164 window_prompting
|= XNegative
;
3166 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3167 && CONSP (XCDR (tem1
))
3168 && INTEGERP (XCAR (XCDR (tem1
))))
3170 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3171 window_prompting
|= XNegative
;
3173 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3174 && CONSP (XCDR (tem1
))
3175 && INTEGERP (XCAR (XCDR (tem1
))))
3177 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3179 else if (EQ (tem1
, Qunbound
))
3180 f
->output_data
.x
->left_pos
= 0;
3183 CHECK_NUMBER (tem1
);
3184 f
->output_data
.x
->left_pos
= XINT (tem1
);
3185 if (f
->output_data
.x
->left_pos
< 0)
3186 window_prompting
|= XNegative
;
3189 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3190 window_prompting
|= USPosition
;
3192 window_prompting
|= PPosition
;
3195 return window_prompting
;
3198 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3201 XSetWMProtocols (dpy
, w
, protocols
, count
)
3208 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3209 if (prop
== None
) return False
;
3210 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3211 (unsigned char *) protocols
, count
);
3214 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3216 #ifdef USE_X_TOOLKIT
3218 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3219 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3220 already be present because of the toolkit (Motif adds some of them,
3221 for example, but Xt doesn't). */
3224 hack_wm_protocols (f
, widget
)
3228 Display
*dpy
= XtDisplay (widget
);
3229 Window w
= XtWindow (widget
);
3230 int need_delete
= 1;
3236 Atom type
, *atoms
= 0;
3238 unsigned long nitems
= 0;
3239 unsigned long bytes_after
;
3241 if ((XGetWindowProperty (dpy
, w
,
3242 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3243 (long)0, (long)100, False
, XA_ATOM
,
3244 &type
, &format
, &nitems
, &bytes_after
,
3245 (unsigned char **) &atoms
)
3247 && format
== 32 && type
== XA_ATOM
)
3251 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3253 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3255 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3258 if (atoms
) XFree ((char *) atoms
);
3264 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3266 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3268 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3270 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3271 XA_ATOM
, 32, PropModeAppend
,
3272 (unsigned char *) props
, count
);
3280 /* Support routines for XIC (X Input Context). */
3284 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3285 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3288 /* Supported XIM styles, ordered by preferenc. */
3290 static XIMStyle supported_xim_styles
[] =
3292 XIMPreeditPosition
| XIMStatusArea
,
3293 XIMPreeditPosition
| XIMStatusNothing
,
3294 XIMPreeditPosition
| XIMStatusNone
,
3295 XIMPreeditNothing
| XIMStatusArea
,
3296 XIMPreeditNothing
| XIMStatusNothing
,
3297 XIMPreeditNothing
| XIMStatusNone
,
3298 XIMPreeditNone
| XIMStatusArea
,
3299 XIMPreeditNone
| XIMStatusNothing
,
3300 XIMPreeditNone
| XIMStatusNone
,
3305 /* Create an X fontset on frame F with base font name
3309 xic_create_xfontset (f
, base_fontname
)
3311 char *base_fontname
;
3314 char **missing_list
;
3318 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3319 base_fontname
, &missing_list
,
3320 &missing_count
, &def_string
);
3322 XFreeStringList (missing_list
);
3324 /* No need to free def_string. */
3329 /* Value is the best input style, given user preferences USER (already
3330 checked to be supported by Emacs), and styles supported by the
3331 input method XIM. */
3334 best_xim_style (user
, xim
)
3340 for (i
= 0; i
< user
->count_styles
; ++i
)
3341 for (j
= 0; j
< xim
->count_styles
; ++j
)
3342 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3343 return user
->supported_styles
[i
];
3345 /* Return the default style. */
3346 return XIMPreeditNothing
| XIMStatusNothing
;
3349 /* Create XIC for frame F. */
3351 static XIMStyle xic_style
;
3354 create_frame_xic (f
)
3359 XFontSet xfs
= NULL
;
3364 xim
= FRAME_X_XIM (f
);
3369 XVaNestedList preedit_attr
;
3370 XVaNestedList status_attr
;
3371 char *base_fontname
;
3374 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3375 spot
.x
= 0; spot
.y
= 1;
3376 /* Create X fontset. */
3377 fontset
= FRAME_FONTSET (f
);
3379 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3382 /* Determine the base fontname from the ASCII font name of
3384 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3385 char *p
= ascii_font
;
3388 for (i
= 0; *p
; p
++)
3391 /* As the font name doesn't conform to XLFD, we can't
3392 modify it to get a suitable base fontname for the
3394 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3397 int len
= strlen (ascii_font
) + 1;
3400 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3409 base_fontname
= (char *) alloca (len
);
3410 bzero (base_fontname
, len
);
3411 strcpy (base_fontname
, "-*-*-");
3412 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3413 strcat (base_fontname
, "*-*-*-*-*-*-*");
3416 xfs
= xic_create_xfontset (f
, base_fontname
);
3418 /* Determine XIC style. */
3421 XIMStyles supported_list
;
3422 supported_list
.count_styles
= (sizeof supported_xim_styles
3423 / sizeof supported_xim_styles
[0]);
3424 supported_list
.supported_styles
= supported_xim_styles
;
3425 xic_style
= best_xim_style (&supported_list
,
3426 FRAME_X_XIM_STYLES (f
));
3429 preedit_attr
= XVaCreateNestedList (0,
3432 FRAME_FOREGROUND_PIXEL (f
),
3434 FRAME_BACKGROUND_PIXEL (f
),
3435 (xic_style
& XIMPreeditPosition
3440 status_attr
= XVaCreateNestedList (0,
3446 FRAME_FOREGROUND_PIXEL (f
),
3448 FRAME_BACKGROUND_PIXEL (f
),
3451 xic
= XCreateIC (xim
,
3452 XNInputStyle
, xic_style
,
3453 XNClientWindow
, FRAME_X_WINDOW(f
),
3454 XNFocusWindow
, FRAME_X_WINDOW(f
),
3455 XNStatusAttributes
, status_attr
,
3456 XNPreeditAttributes
, preedit_attr
,
3458 XFree (preedit_attr
);
3459 XFree (status_attr
);
3462 FRAME_XIC (f
) = xic
;
3463 FRAME_XIC_STYLE (f
) = xic_style
;
3464 FRAME_XIC_FONTSET (f
) = xfs
;
3468 /* Destroy XIC and free XIC fontset of frame F, if any. */
3474 if (FRAME_XIC (f
) == NULL
)
3477 XDestroyIC (FRAME_XIC (f
));
3478 if (FRAME_XIC_FONTSET (f
))
3479 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3481 FRAME_XIC (f
) = NULL
;
3482 FRAME_XIC_FONTSET (f
) = NULL
;
3486 /* Place preedit area for XIC of window W's frame to specified
3487 pixel position X/Y. X and Y are relative to window W. */
3490 xic_set_preeditarea (w
, x
, y
)
3494 struct frame
*f
= XFRAME (w
->frame
);
3498 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3499 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3500 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3501 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3506 /* Place status area for XIC in bottom right corner of frame F.. */
3509 xic_set_statusarea (f
)
3512 XIC xic
= FRAME_XIC (f
);
3517 /* Negotiate geometry of status area. If input method has existing
3518 status area, use its current size. */
3519 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3520 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3521 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3524 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3525 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3528 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3530 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3531 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3535 area
.width
= needed
->width
;
3536 area
.height
= needed
->height
;
3537 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3538 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3539 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3542 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3543 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3548 /* Set X fontset for XIC of frame F, using base font name
3549 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3552 xic_set_xfontset (f
, base_fontname
)
3554 char *base_fontname
;
3559 xfs
= xic_create_xfontset (f
, base_fontname
);
3561 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3562 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3563 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3564 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3565 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3568 if (FRAME_XIC_FONTSET (f
))
3569 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3570 FRAME_XIC_FONTSET (f
) = xfs
;
3573 #endif /* HAVE_X_I18N */
3577 #ifdef USE_X_TOOLKIT
3579 /* Create and set up the X widget for frame F. */
3582 x_window (f
, window_prompting
, minibuffer_only
)
3584 long window_prompting
;
3585 int minibuffer_only
;
3587 XClassHint class_hints
;
3588 XSetWindowAttributes attributes
;
3589 unsigned long attribute_mask
;
3590 Widget shell_widget
;
3592 Widget frame_widget
;
3598 /* Use the resource name as the top-level widget name
3599 for looking up resources. Make a non-Lisp copy
3600 for the window manager, so GC relocation won't bother it.
3602 Elsewhere we specify the window name for the window manager. */
3605 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3606 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3607 strcpy (f
->namebuf
, str
);
3611 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3612 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3613 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3614 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3615 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3616 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3617 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3618 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3619 applicationShellWidgetClass
,
3620 FRAME_X_DISPLAY (f
), al
, ac
);
3622 f
->output_data
.x
->widget
= shell_widget
;
3623 /* maybe_set_screen_title_format (shell_widget); */
3625 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3626 (widget_value
*) NULL
,
3627 shell_widget
, False
,
3631 (lw_callback
) NULL
);
3634 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3635 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3636 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3637 XtSetValues (pane_widget
, al
, ac
);
3638 f
->output_data
.x
->column_widget
= pane_widget
;
3640 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3641 the emacs screen when changing menubar. This reduces flickering. */
3644 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3645 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3646 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3647 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3648 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3649 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3650 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3651 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3652 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3655 f
->output_data
.x
->edit_widget
= frame_widget
;
3657 XtManageChild (frame_widget
);
3659 /* Do some needed geometry management. */
3662 char *tem
, shell_position
[32];
3665 int extra_borders
= 0;
3667 = (f
->output_data
.x
->menubar_widget
3668 ? (f
->output_data
.x
->menubar_widget
->core
.height
3669 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3672 #if 0 /* Experimentally, we now get the right results
3673 for -geometry -0-0 without this. 24 Aug 96, rms. */
3674 if (FRAME_EXTERNAL_MENU_BAR (f
))
3677 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3678 menubar_size
+= ibw
;
3682 f
->output_data
.x
->menubar_height
= menubar_size
;
3685 /* Motif seems to need this amount added to the sizes
3686 specified for the shell widget. The Athena/Lucid widgets don't.
3687 Both conclusions reached experimentally. -- rms. */
3688 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3689 &extra_borders
, NULL
);
3693 /* Convert our geometry parameters into a geometry string
3695 Note that we do not specify here whether the position
3696 is a user-specified or program-specified one.
3697 We pass that information later, in x_wm_set_size_hints. */
3699 int left
= f
->output_data
.x
->left_pos
;
3700 int xneg
= window_prompting
& XNegative
;
3701 int top
= f
->output_data
.x
->top_pos
;
3702 int yneg
= window_prompting
& YNegative
;
3708 if (window_prompting
& USPosition
)
3709 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3710 PIXEL_WIDTH (f
) + extra_borders
,
3711 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3712 (xneg
? '-' : '+'), left
,
3713 (yneg
? '-' : '+'), top
);
3715 sprintf (shell_position
, "=%dx%d",
3716 PIXEL_WIDTH (f
) + extra_borders
,
3717 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3720 len
= strlen (shell_position
) + 1;
3721 /* We don't free this because we don't know whether
3722 it is safe to free it while the frame exists.
3723 It isn't worth the trouble of arranging to free it
3724 when the frame is deleted. */
3725 tem
= (char *) xmalloc (len
);
3726 strncpy (tem
, shell_position
, len
);
3727 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3728 XtSetValues (shell_widget
, al
, ac
);
3731 XtManageChild (pane_widget
);
3732 XtRealizeWidget (shell_widget
);
3734 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3736 validate_x_resource_name ();
3738 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3739 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3740 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3743 FRAME_XIC (f
) = NULL
;
3745 create_frame_xic (f
);
3749 f
->output_data
.x
->wm_hints
.input
= True
;
3750 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3751 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3752 &f
->output_data
.x
->wm_hints
);
3754 hack_wm_protocols (f
, shell_widget
);
3757 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3760 /* Do a stupid property change to force the server to generate a
3761 PropertyNotify event so that the event_stream server timestamp will
3762 be initialized to something relevant to the time we created the window.
3764 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3765 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3766 XA_ATOM
, 32, PropModeAppend
,
3767 (unsigned char*) NULL
, 0);
3769 /* Make all the standard events reach the Emacs frame. */
3770 attributes
.event_mask
= STANDARD_EVENT_SET
;
3775 /* XIM server might require some X events. */
3776 unsigned long fevent
= NoEventMask
;
3777 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3778 attributes
.event_mask
|= fevent
;
3780 #endif /* HAVE_X_I18N */
3782 attribute_mask
= CWEventMask
;
3783 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3784 attribute_mask
, &attributes
);
3786 XtMapWidget (frame_widget
);
3788 /* x_set_name normally ignores requests to set the name if the
3789 requested name is the same as the current name. This is the one
3790 place where that assumption isn't correct; f->name is set, but
3791 the X server hasn't been told. */
3794 int explicit = f
->explicit_name
;
3796 f
->explicit_name
= 0;
3799 x_set_name (f
, name
, explicit);
3802 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3803 f
->output_data
.x
->text_cursor
);
3807 /* This is a no-op, except under Motif. Make sure main areas are
3808 set to something reasonable, in case we get an error later. */
3809 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3812 #else /* not USE_X_TOOLKIT */
3814 /* Create and set up the X window for frame F. */
3821 XClassHint class_hints
;
3822 XSetWindowAttributes attributes
;
3823 unsigned long attribute_mask
;
3825 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3826 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3827 attributes
.bit_gravity
= StaticGravity
;
3828 attributes
.backing_store
= NotUseful
;
3829 attributes
.save_under
= True
;
3830 attributes
.event_mask
= STANDARD_EVENT_SET
;
3831 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3832 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3837 = XCreateWindow (FRAME_X_DISPLAY (f
),
3838 f
->output_data
.x
->parent_desc
,
3839 f
->output_data
.x
->left_pos
,
3840 f
->output_data
.x
->top_pos
,
3841 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3842 f
->output_data
.x
->border_width
,
3843 CopyFromParent
, /* depth */
3844 InputOutput
, /* class */
3846 attribute_mask
, &attributes
);
3850 create_frame_xic (f
);
3853 /* XIM server might require some X events. */
3854 unsigned long fevent
= NoEventMask
;
3855 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3856 attributes
.event_mask
|= fevent
;
3857 attribute_mask
= CWEventMask
;
3858 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3859 attribute_mask
, &attributes
);
3862 #endif /* HAVE_X_I18N */
3864 validate_x_resource_name ();
3866 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3867 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3868 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3870 /* The menubar is part of the ordinary display;
3871 it does not count in addition to the height of the window. */
3872 f
->output_data
.x
->menubar_height
= 0;
3874 /* This indicates that we use the "Passive Input" input model.
3875 Unless we do this, we don't get the Focus{In,Out} events that we
3876 need to draw the cursor correctly. Accursed bureaucrats.
3877 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3879 f
->output_data
.x
->wm_hints
.input
= True
;
3880 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3881 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3882 &f
->output_data
.x
->wm_hints
);
3883 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3885 /* Request "save yourself" and "delete window" commands from wm. */
3888 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3889 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3890 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3893 /* x_set_name normally ignores requests to set the name if the
3894 requested name is the same as the current name. This is the one
3895 place where that assumption isn't correct; f->name is set, but
3896 the X server hasn't been told. */
3899 int explicit = f
->explicit_name
;
3901 f
->explicit_name
= 0;
3904 x_set_name (f
, name
, explicit);
3907 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3908 f
->output_data
.x
->text_cursor
);
3912 if (FRAME_X_WINDOW (f
) == 0)
3913 error ("Unable to create window");
3916 #endif /* not USE_X_TOOLKIT */
3918 /* Handle the icon stuff for this window. Perhaps later we might
3919 want an x_set_icon_position which can be called interactively as
3927 Lisp_Object icon_x
, icon_y
;
3928 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3930 /* Set the position of the icon. Note that twm groups all
3931 icons in an icon window. */
3932 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3933 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3934 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3936 CHECK_NUMBER (icon_x
);
3937 CHECK_NUMBER (icon_y
);
3939 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3940 error ("Both left and top icon corners of icon must be specified");
3944 if (! EQ (icon_x
, Qunbound
))
3945 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3947 /* Start up iconic or window? */
3948 x_wm_set_window_state
3949 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3954 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3961 /* Make the GCs needed for this window, setting the
3962 background, border and mouse colors; also create the
3963 mouse cursor and the gray border tile. */
3965 static char cursor_bits
[] =
3967 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3968 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3969 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3970 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3977 XGCValues gc_values
;
3981 /* Create the GCs of this frame.
3982 Note that many default values are used. */
3985 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3986 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3987 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3988 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3989 f
->output_data
.x
->normal_gc
3990 = XCreateGC (FRAME_X_DISPLAY (f
),
3992 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
3995 /* Reverse video style. */
3996 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3997 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3998 f
->output_data
.x
->reverse_gc
3999 = XCreateGC (FRAME_X_DISPLAY (f
),
4001 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
4004 /* Cursor has cursor-color background, background-color foreground. */
4005 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4006 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
4007 gc_values
.fill_style
= FillOpaqueStippled
;
4009 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
4010 FRAME_X_DISPLAY_INFO (f
)->root_window
,
4011 cursor_bits
, 16, 16);
4012 f
->output_data
.x
->cursor_gc
4013 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4014 (GCFont
| GCForeground
| GCBackground
4015 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
4019 f
->output_data
.x
->white_relief
.gc
= 0;
4020 f
->output_data
.x
->black_relief
.gc
= 0;
4022 /* Create the gray border tile used when the pointer is not in
4023 the frame. Since this depends on the frame's pixel values,
4024 this must be done on a per-frame basis. */
4025 f
->output_data
.x
->border_tile
4026 = (XCreatePixmapFromBitmapData
4027 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
4028 gray_bits
, gray_width
, gray_height
,
4029 f
->output_data
.x
->foreground_pixel
,
4030 f
->output_data
.x
->background_pixel
,
4031 DefaultDepth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
))));
4037 /* Free what was was allocated in x_make_gc. */
4043 Display
*dpy
= FRAME_X_DISPLAY (f
);
4047 if (f
->output_data
.x
->normal_gc
)
4049 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
4050 f
->output_data
.x
->normal_gc
= 0;
4053 if (f
->output_data
.x
->reverse_gc
)
4055 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4056 f
->output_data
.x
->reverse_gc
= 0;
4059 if (f
->output_data
.x
->cursor_gc
)
4061 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4062 f
->output_data
.x
->cursor_gc
= 0;
4065 if (f
->output_data
.x
->border_tile
)
4067 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4068 f
->output_data
.x
->border_tile
= 0;
4075 /* Handler for signals raised during x_create_frame and
4076 x_create_top_frame. FRAME is the frame which is partially
4080 unwind_create_frame (frame
)
4083 struct frame
*f
= XFRAME (frame
);
4085 /* If frame is ``official'', nothing to do. */
4086 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4089 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4092 x_free_frame_resources (f
);
4094 /* Check that reference counts are indeed correct. */
4095 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4096 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4104 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4106 doc
: /* Make a new X window, which is called a "frame" in Emacs terms.
4107 Returns an Emacs frame object.
4108 ALIST is an alist of frame parameters.
4109 If the parameters specify that the frame should not have a minibuffer,
4110 and do not specify a specific minibuffer window to use,
4111 then `default-minibuffer-frame' must be a frame whose minibuffer can
4112 be shared by the new frame.
4114 This function is an internal primitive--use `make-frame' instead. */)
4119 Lisp_Object frame
, tem
;
4121 int minibuffer_only
= 0;
4122 long window_prompting
= 0;
4124 int count
= BINDING_STACK_SIZE ();
4125 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4126 Lisp_Object display
;
4127 struct x_display_info
*dpyinfo
= NULL
;
4133 /* Use this general default value to start with
4134 until we know if this frame has a specified name. */
4135 Vx_resource_name
= Vinvocation_name
;
4137 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4138 if (EQ (display
, Qunbound
))
4140 dpyinfo
= check_x_display_info (display
);
4142 kb
= dpyinfo
->kboard
;
4144 kb
= &the_only_kboard
;
4147 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4149 && ! EQ (name
, Qunbound
)
4151 error ("Invalid frame name--not a string or nil");
4154 Vx_resource_name
= name
;
4156 /* See if parent window is specified. */
4157 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4158 if (EQ (parent
, Qunbound
))
4160 if (! NILP (parent
))
4161 CHECK_NUMBER (parent
);
4163 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4164 /* No need to protect DISPLAY because that's not used after passing
4165 it to make_frame_without_minibuffer. */
4167 GCPRO4 (parms
, parent
, name
, frame
);
4168 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4170 if (EQ (tem
, Qnone
) || NILP (tem
))
4171 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4172 else if (EQ (tem
, Qonly
))
4174 f
= make_minibuffer_frame ();
4175 minibuffer_only
= 1;
4177 else if (WINDOWP (tem
))
4178 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4182 XSETFRAME (frame
, f
);
4184 /* Note that X Windows does support scroll bars. */
4185 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4187 f
->output_method
= output_x_window
;
4188 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4189 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4190 f
->output_data
.x
->icon_bitmap
= -1;
4191 f
->output_data
.x
->fontset
= -1;
4192 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4193 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4194 #ifdef USE_TOOLKIT_SCROLL_BARS
4195 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
4196 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
4197 #endif /* USE_TOOLKIT_SCROLL_BARS */
4198 record_unwind_protect (unwind_create_frame
, frame
);
4201 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4203 if (! STRINGP (f
->icon_name
))
4204 f
->icon_name
= Qnil
;
4206 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4208 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4209 dpyinfo_refcount
= dpyinfo
->reference_count
;
4210 #endif /* GLYPH_DEBUG */
4212 FRAME_KBOARD (f
) = kb
;
4215 /* These colors will be set anyway later, but it's important
4216 to get the color reference counts right, so initialize them! */
4219 struct gcpro gcpro1
;
4221 /* Function x_decode_color can signal an error. Make
4222 sure to initialize color slots so that we won't try
4223 to free colors we haven't allocated. */
4224 f
->output_data
.x
->foreground_pixel
= -1;
4225 f
->output_data
.x
->background_pixel
= -1;
4226 f
->output_data
.x
->cursor_pixel
= -1;
4227 f
->output_data
.x
->cursor_foreground_pixel
= -1;
4228 f
->output_data
.x
->border_pixel
= -1;
4229 f
->output_data
.x
->mouse_pixel
= -1;
4231 black
= build_string ("black");
4233 f
->output_data
.x
->foreground_pixel
4234 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4235 f
->output_data
.x
->background_pixel
4236 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4237 f
->output_data
.x
->cursor_pixel
4238 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4239 f
->output_data
.x
->cursor_foreground_pixel
4240 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4241 f
->output_data
.x
->border_pixel
4242 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4243 f
->output_data
.x
->mouse_pixel
4244 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4248 /* Specify the parent under which to make this X window. */
4252 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4253 f
->output_data
.x
->explicit_parent
= 1;
4257 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4258 f
->output_data
.x
->explicit_parent
= 0;
4261 /* Set the name; the functions to which we pass f expect the name to
4263 if (EQ (name
, Qunbound
) || NILP (name
))
4265 f
->name
= build_string (dpyinfo
->x_id_name
);
4266 f
->explicit_name
= 0;
4271 f
->explicit_name
= 1;
4272 /* use the frame's title when getting resources for this frame. */
4273 specbind (Qx_resource_name
, name
);
4276 /* Extract the window parameters from the supplied values
4277 that are needed to determine window geometry. */
4281 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4284 /* First, try whatever font the caller has specified. */
4287 tem
= Fquery_fontset (font
, Qnil
);
4289 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4291 font
= x_new_font (f
, XSTRING (font
)->data
);
4294 /* Try out a font which we hope has bold and italic variations. */
4295 if (!STRINGP (font
))
4296 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4297 if (!STRINGP (font
))
4298 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4299 if (! STRINGP (font
))
4300 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4301 if (! STRINGP (font
))
4302 /* This was formerly the first thing tried, but it finds too many fonts
4303 and takes too long. */
4304 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4305 /* If those didn't work, look for something which will at least work. */
4306 if (! STRINGP (font
))
4307 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4309 if (! STRINGP (font
))
4310 font
= build_string ("fixed");
4312 x_default_parameter (f
, parms
, Qfont
, font
,
4313 "font", "Font", RES_TYPE_STRING
);
4317 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4318 whereby it fails to get any font. */
4319 xlwmenu_default_font
= f
->output_data
.x
->font
;
4322 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4323 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4325 /* This defaults to 1 in order to match xterm. We recognize either
4326 internalBorderWidth or internalBorder (which is what xterm calls
4328 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4332 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4333 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4334 if (! EQ (value
, Qunbound
))
4335 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4338 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4339 "internalBorderWidth", "internalBorderWidth",
4341 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4342 "verticalScrollBars", "ScrollBars",
4345 /* Also do the stuff which must be set before the window exists. */
4346 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4347 "foreground", "Foreground", RES_TYPE_STRING
);
4348 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4349 "background", "Background", RES_TYPE_STRING
);
4350 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4351 "pointerColor", "Foreground", RES_TYPE_STRING
);
4352 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4353 "cursorColor", "Foreground", RES_TYPE_STRING
);
4354 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4355 "borderColor", "BorderColor", RES_TYPE_STRING
);
4356 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4357 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4358 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4359 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4361 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4362 "scrollBarForeground",
4363 "ScrollBarForeground", 1);
4364 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4365 "scrollBarBackground",
4366 "ScrollBarBackground", 0);
4368 /* Init faces before x_default_parameter is called for scroll-bar
4369 parameters because that function calls x_set_scroll_bar_width,
4370 which calls change_frame_size, which calls Fset_window_buffer,
4371 which runs hooks, which call Fvertical_motion. At the end, we
4372 end up in init_iterator with a null face cache, which should not
4374 init_frame_faces (f
);
4376 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4377 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4378 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4379 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4380 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4381 "bufferPredicate", "BufferPredicate",
4383 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4384 "title", "Title", RES_TYPE_STRING
);
4385 x_default_parameter (f
, parms
, Qwait_for_wm
, Qt
,
4386 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN
);
4388 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4390 /* Add the tool-bar height to the initial frame height so that the
4391 user gets a text display area of the size he specified with -g or
4392 via .Xdefaults. Later changes of the tool-bar height don't
4393 change the frame size. This is done so that users can create
4394 tall Emacs frames without having to guess how tall the tool-bar
4396 if (FRAME_TOOL_BAR_LINES (f
))
4398 int margin
, relief
, bar_height
;
4400 relief
= (tool_bar_button_relief
>= 0
4401 ? tool_bar_button_relief
4402 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4404 if (INTEGERP (Vtool_bar_button_margin
)
4405 && XINT (Vtool_bar_button_margin
) > 0)
4406 margin
= XFASTINT (Vtool_bar_button_margin
);
4407 else if (CONSP (Vtool_bar_button_margin
)
4408 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4409 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4410 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4414 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4415 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4418 /* Compute the size of the X window. */
4419 window_prompting
= x_figure_window_size (f
, parms
);
4421 if (window_prompting
& XNegative
)
4423 if (window_prompting
& YNegative
)
4424 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4426 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4430 if (window_prompting
& YNegative
)
4431 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4433 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4436 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4438 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4439 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4441 /* Create the X widget or window. */
4442 #ifdef USE_X_TOOLKIT
4443 x_window (f
, window_prompting
, minibuffer_only
);
4451 /* Now consider the frame official. */
4452 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4453 Vframe_list
= Fcons (frame
, Vframe_list
);
4455 /* We need to do this after creating the X window, so that the
4456 icon-creation functions can say whose icon they're describing. */
4457 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4458 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4460 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4461 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4462 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4463 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4464 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4465 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4466 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4467 "scrollBarWidth", "ScrollBarWidth",
4470 /* Dimensions, especially f->height, must be done via change_frame_size.
4471 Change will not be effected unless different from the current
4477 SET_FRAME_WIDTH (f
, 0);
4478 change_frame_size (f
, height
, width
, 1, 0, 0);
4480 /* Set up faces after all frame parameters are known. This call
4481 also merges in face attributes specified for new frames. If we
4482 don't do this, the `menu' face for instance won't have the right
4483 colors, and the menu bar won't appear in the specified colors for
4485 call1 (Qface_set_after_frame_default
, frame
);
4487 #ifdef USE_X_TOOLKIT
4488 /* Create the menu bar. */
4489 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4491 /* If this signals an error, we haven't set size hints for the
4492 frame and we didn't make it visible. */
4493 initialize_frame_menubar (f
);
4495 /* This is a no-op, except under Motif where it arranges the
4496 main window for the widgets on it. */
4497 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4498 f
->output_data
.x
->menubar_widget
,
4499 f
->output_data
.x
->edit_widget
);
4501 #endif /* USE_X_TOOLKIT */
4503 /* Tell the server what size and position, etc, we want, and how
4504 badly we want them. This should be done after we have the menu
4505 bar so that its size can be taken into account. */
4507 x_wm_set_size_hint (f
, window_prompting
, 0);
4510 /* Make the window appear on the frame and enable display, unless
4511 the caller says not to. However, with explicit parent, Emacs
4512 cannot control visibility, so don't try. */
4513 if (! f
->output_data
.x
->explicit_parent
)
4515 Lisp_Object visibility
;
4517 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4519 if (EQ (visibility
, Qunbound
))
4522 if (EQ (visibility
, Qicon
))
4523 x_iconify_frame (f
);
4524 else if (! NILP (visibility
))
4525 x_make_frame_visible (f
);
4527 /* Must have been Qnil. */
4533 /* Make sure windows on this frame appear in calls to next-window
4534 and similar functions. */
4535 Vwindow_list
= Qnil
;
4537 return unbind_to (count
, frame
);
4541 /* FRAME is used only to get a handle on the X display. We don't pass the
4542 display info directly because we're called from frame.c, which doesn't
4543 know about that structure. */
4546 x_get_focus_frame (frame
)
4547 struct frame
*frame
;
4549 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4551 if (! dpyinfo
->x_focus_frame
)
4554 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4559 /* In certain situations, when the window manager follows a
4560 click-to-focus policy, there seems to be no way around calling
4561 XSetInputFocus to give another frame the input focus .
4563 In an ideal world, XSetInputFocus should generally be avoided so
4564 that applications don't interfere with the window manager's focus
4565 policy. But I think it's okay to use when it's clearly done
4566 following a user-command. */
4568 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4569 doc
: /* Set the input focus to FRAME.
4570 FRAME nil means use the selected frame. */)
4574 struct frame
*f
= check_x_frame (frame
);
4575 Display
*dpy
= FRAME_X_DISPLAY (f
);
4579 count
= x_catch_errors (dpy
);
4580 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4581 RevertToParent
, CurrentTime
);
4582 x_uncatch_errors (dpy
, count
);
4589 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4590 doc
: /* Internal function called by `color-defined-p', which see. */)
4592 Lisp_Object color
, frame
;
4595 FRAME_PTR f
= check_x_frame (frame
);
4597 CHECK_STRING (color
);
4599 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4605 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4606 doc
: /* Internal function called by `color-values', which see. */)
4608 Lisp_Object color
, frame
;
4611 FRAME_PTR f
= check_x_frame (frame
);
4613 CHECK_STRING (color
);
4615 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4619 rgb
[0] = make_number (foo
.red
);
4620 rgb
[1] = make_number (foo
.green
);
4621 rgb
[2] = make_number (foo
.blue
);
4622 return Flist (3, rgb
);
4628 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4629 doc
: /* Internal function called by `display-color-p', which see. */)
4631 Lisp_Object display
;
4633 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4635 if (dpyinfo
->n_planes
<= 2)
4638 switch (dpyinfo
->visual
->class)
4651 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4653 doc
: /* Return t if the X display supports shades of gray.
4654 Note that color displays do support shades of gray.
4655 The optional argument DISPLAY specifies which display to ask about.
4656 DISPLAY should be either a frame or a display name (a string).
4657 If omitted or nil, that stands for the selected frame's display. */)
4659 Lisp_Object display
;
4661 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4663 if (dpyinfo
->n_planes
<= 1)
4666 switch (dpyinfo
->visual
->class)
4681 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4683 doc
: /* Returns the width in pixels of the X display DISPLAY.
4684 The optional argument DISPLAY specifies which display to ask about.
4685 DISPLAY should be either a frame or a display name (a string).
4686 If omitted or nil, that stands for the selected frame's display. */)
4688 Lisp_Object display
;
4690 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4692 return make_number (dpyinfo
->width
);
4695 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4696 Sx_display_pixel_height
, 0, 1, 0,
4697 doc
: /* Returns the height in pixels of the X display DISPLAY.
4698 The optional argument DISPLAY specifies which display to ask about.
4699 DISPLAY should be either a frame or a display name (a string).
4700 If omitted or nil, that stands for the selected frame's display. */)
4702 Lisp_Object display
;
4704 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4706 return make_number (dpyinfo
->height
);
4709 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4711 doc
: /* Returns the number of bitplanes of the X display DISPLAY.
4712 The optional argument DISPLAY specifies which display to ask about.
4713 DISPLAY should be either a frame or a display name (a string).
4714 If omitted or nil, that stands for the selected frame's display. */)
4716 Lisp_Object display
;
4718 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4720 return make_number (dpyinfo
->n_planes
);
4723 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4725 doc
: /* Returns the number of color cells of the X display DISPLAY.
4726 The optional argument DISPLAY specifies which display to ask about.
4727 DISPLAY should be either a frame or a display name (a string).
4728 If omitted or nil, that stands for the selected frame's display. */)
4730 Lisp_Object display
;
4732 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4734 return make_number (DisplayCells (dpyinfo
->display
,
4735 XScreenNumberOfScreen (dpyinfo
->screen
)));
4738 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4739 Sx_server_max_request_size
,
4741 doc
: /* Returns the maximum request size of the X server of display DISPLAY.
4742 The optional argument DISPLAY specifies which display to ask about.
4743 DISPLAY should be either a frame or a display name (a string).
4744 If omitted or nil, that stands for the selected frame's display. */)
4746 Lisp_Object display
;
4748 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4750 return make_number (MAXREQUEST (dpyinfo
->display
));
4753 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4754 doc
: /* Returns the vendor ID string of the X server of display DISPLAY.
4755 The optional argument DISPLAY specifies which display to ask about.
4756 DISPLAY should be either a frame or a display name (a string).
4757 If omitted or nil, that stands for the selected frame's display. */)
4759 Lisp_Object display
;
4761 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4762 char *vendor
= ServerVendor (dpyinfo
->display
);
4764 if (! vendor
) vendor
= "";
4765 return build_string (vendor
);
4768 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4769 doc
: /* Returns the version numbers of the X server of display DISPLAY.
4770 The value is a list of three integers: the major and minor
4771 version numbers of the X Protocol in use, and the vendor-specific release
4772 number. See also the function `x-server-vendor'.
4774 The optional argument DISPLAY specifies which display to ask about.
4775 DISPLAY should be either a frame or a display name (a string).
4776 If omitted or nil, that stands for the selected frame's display. */)
4778 Lisp_Object display
;
4780 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4781 Display
*dpy
= dpyinfo
->display
;
4783 return Fcons (make_number (ProtocolVersion (dpy
)),
4784 Fcons (make_number (ProtocolRevision (dpy
)),
4785 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4788 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4789 doc
: /* Return the number of screens on the X server of display DISPLAY.
4790 The optional argument DISPLAY specifies which display to ask about.
4791 DISPLAY should be either a frame or a display name (a string).
4792 If omitted or nil, that stands for the selected frame's display. */)
4794 Lisp_Object display
;
4796 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4798 return make_number (ScreenCount (dpyinfo
->display
));
4801 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4802 doc
: /* Return the height in millimeters of the X display DISPLAY.
4803 The optional argument DISPLAY specifies which display to ask about.
4804 DISPLAY should be either a frame or a display name (a string).
4805 If omitted or nil, that stands for the selected frame's display. */)
4807 Lisp_Object display
;
4809 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4811 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4814 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4815 doc
: /* Return the width in millimeters of the X display DISPLAY.
4816 The optional argument DISPLAY specifies which display to ask about.
4817 DISPLAY should be either a frame or a display name (a string).
4818 If omitted or nil, that stands for the selected frame's display. */)
4820 Lisp_Object display
;
4822 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4824 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4827 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4828 Sx_display_backing_store
, 0, 1, 0,
4829 doc
: /* Returns an indication of whether X display DISPLAY does backing store.
4830 The value may be `always', `when-mapped', or `not-useful'.
4831 The optional argument DISPLAY specifies which display to ask about.
4832 DISPLAY should be either a frame or a display name (a string).
4833 If omitted or nil, that stands for the selected frame's display. */)
4835 Lisp_Object display
;
4837 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4840 switch (DoesBackingStore (dpyinfo
->screen
))
4843 result
= intern ("always");
4847 result
= intern ("when-mapped");
4851 result
= intern ("not-useful");
4855 error ("Strange value for BackingStore parameter of screen");
4862 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4863 Sx_display_visual_class
, 0, 1, 0,
4864 doc
: /* Return the visual class of the X display DISPLAY.
4865 The value is one of the symbols `static-gray', `gray-scale',
4866 `static-color', `pseudo-color', `true-color', or `direct-color'.
4868 The optional argument DISPLAY specifies which display to ask about.
4869 DISPLAY should be either a frame or a display name (a string).
4870 If omitted or nil, that stands for the selected frame's display. */)
4872 Lisp_Object display
;
4874 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4877 switch (dpyinfo
->visual
->class)
4880 result
= intern ("static-gray");
4883 result
= intern ("gray-scale");
4886 result
= intern ("static-color");
4889 result
= intern ("pseudo-color");
4892 result
= intern ("true-color");
4895 result
= intern ("direct-color");
4898 error ("Display has an unknown visual class");
4905 DEFUN ("x-display-save-under", Fx_display_save_under
,
4906 Sx_display_save_under
, 0, 1, 0,
4907 doc
: /* Returns t if the X display DISPLAY supports the save-under feature.
4908 The optional argument DISPLAY specifies which display to ask about.
4909 DISPLAY should be either a frame or a display name (a string).
4910 If omitted or nil, that stands for the selected frame's display. */)
4912 Lisp_Object display
;
4914 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4916 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4924 register struct frame
*f
;
4926 return PIXEL_WIDTH (f
);
4931 register struct frame
*f
;
4933 return PIXEL_HEIGHT (f
);
4938 register struct frame
*f
;
4940 return FONT_WIDTH (f
->output_data
.x
->font
);
4945 register struct frame
*f
;
4947 return f
->output_data
.x
->line_height
;
4952 register struct frame
*f
;
4954 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4959 /************************************************************************
4961 ************************************************************************/
4964 /* Mapping visual names to visuals. */
4966 static struct visual_class
4973 {"StaticGray", StaticGray
},
4974 {"GrayScale", GrayScale
},
4975 {"StaticColor", StaticColor
},
4976 {"PseudoColor", PseudoColor
},
4977 {"TrueColor", TrueColor
},
4978 {"DirectColor", DirectColor
},
4983 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4985 /* Value is the screen number of screen SCR. This is a substitute for
4986 the X function with the same name when that doesn't exist. */
4989 XScreenNumberOfScreen (scr
)
4990 register Screen
*scr
;
4992 Display
*dpy
= scr
->display
;
4995 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4996 if (scr
== dpy
->screens
+ i
)
5002 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5005 /* Select the visual that should be used on display DPYINFO. Set
5006 members of DPYINFO appropriately. Called from x_term_init. */
5009 select_visual (dpyinfo
)
5010 struct x_display_info
*dpyinfo
;
5012 Display
*dpy
= dpyinfo
->display
;
5013 Screen
*screen
= dpyinfo
->screen
;
5016 /* See if a visual is specified. */
5017 value
= display_x_get_resource (dpyinfo
,
5018 build_string ("visualClass"),
5019 build_string ("VisualClass"),
5021 if (STRINGP (value
))
5023 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
5024 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
5025 depth, a decimal number. NAME is compared with case ignored. */
5026 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
5031 strcpy (s
, XSTRING (value
)->data
);
5032 dash
= index (s
, '-');
5035 dpyinfo
->n_planes
= atoi (dash
+ 1);
5039 /* We won't find a matching visual with depth 0, so that
5040 an error will be printed below. */
5041 dpyinfo
->n_planes
= 0;
5043 /* Determine the visual class. */
5044 for (i
= 0; visual_classes
[i
].name
; ++i
)
5045 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
5047 class = visual_classes
[i
].class;
5051 /* Look up a matching visual for the specified class. */
5053 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
5054 dpyinfo
->n_planes
, class, &vinfo
))
5055 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
5057 dpyinfo
->visual
= vinfo
.visual
;
5062 XVisualInfo
*vinfo
, vinfo_template
;
5064 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
5067 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
5069 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
5071 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5072 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
5073 &vinfo_template
, &n_visuals
);
5075 fatal ("Can't get proper X visual info");
5077 dpyinfo
->n_planes
= vinfo
->depth
;
5078 XFree ((char *) vinfo
);
5083 /* Return the X display structure for the display named NAME.
5084 Open a new connection if necessary. */
5086 struct x_display_info
*
5087 x_display_info_for_name (name
)
5091 struct x_display_info
*dpyinfo
;
5093 CHECK_STRING (name
);
5095 if (! EQ (Vwindow_system
, intern ("x")))
5096 error ("Not using X Windows");
5098 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5100 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5103 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5108 /* Use this general default value to start with. */
5109 Vx_resource_name
= Vinvocation_name
;
5111 validate_x_resource_name ();
5113 dpyinfo
= x_term_init (name
, (char *)0,
5114 (char *) XSTRING (Vx_resource_name
)->data
);
5117 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5120 XSETFASTINT (Vwindow_system_version
, 11);
5126 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5128 doc
: /* Open a connection to an X server.
5129 DISPLAY is the name of the display to connect to.
5130 Optional second arg XRM-STRING is a string of resources in xrdb format.
5131 If the optional third arg MUST-SUCCEED is non-nil,
5132 terminate Emacs if we can't open the connection. */)
5133 (display
, xrm_string
, must_succeed
)
5134 Lisp_Object display
, xrm_string
, must_succeed
;
5136 unsigned char *xrm_option
;
5137 struct x_display_info
*dpyinfo
;
5139 CHECK_STRING (display
);
5140 if (! NILP (xrm_string
))
5141 CHECK_STRING (xrm_string
);
5143 if (! EQ (Vwindow_system
, intern ("x")))
5144 error ("Not using X Windows");
5146 if (! NILP (xrm_string
))
5147 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5149 xrm_option
= (unsigned char *) 0;
5151 validate_x_resource_name ();
5153 /* This is what opens the connection and sets x_current_display.
5154 This also initializes many symbols, such as those used for input. */
5155 dpyinfo
= x_term_init (display
, xrm_option
,
5156 (char *) XSTRING (Vx_resource_name
)->data
);
5160 if (!NILP (must_succeed
))
5161 fatal ("Cannot connect to X server %s.\n\
5162 Check the DISPLAY environment variable or use `-d'.\n\
5163 Also use the `xhost' program to verify that it is set to permit\n\
5164 connections from your machine.\n",
5165 XSTRING (display
)->data
);
5167 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5172 XSETFASTINT (Vwindow_system_version
, 11);
5176 DEFUN ("x-close-connection", Fx_close_connection
,
5177 Sx_close_connection
, 1, 1, 0,
5178 doc
: /* Close the connection to DISPLAY's X server.
5179 For DISPLAY, specify either a frame or a display name (a string).
5180 If DISPLAY is nil, that stands for the selected frame's display. */)
5182 Lisp_Object display
;
5184 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5187 if (dpyinfo
->reference_count
> 0)
5188 error ("Display still has frames on it");
5191 /* Free the fonts in the font table. */
5192 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5193 if (dpyinfo
->font_table
[i
].name
)
5195 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5196 xfree (dpyinfo
->font_table
[i
].full_name
);
5197 xfree (dpyinfo
->font_table
[i
].name
);
5198 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5201 x_destroy_all_bitmaps (dpyinfo
);
5202 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5204 #ifdef USE_X_TOOLKIT
5205 XtCloseDisplay (dpyinfo
->display
);
5207 XCloseDisplay (dpyinfo
->display
);
5210 x_delete_display (dpyinfo
);
5216 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5217 doc
: /* Return the list of display names that Emacs has connections to. */)
5220 Lisp_Object tail
, result
;
5223 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5224 result
= Fcons (XCAR (XCAR (tail
)), result
);
5229 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5230 doc
: /* If ON is non-nil, report X errors as soon as the erring request is made.
5231 If ON is nil, allow buffering of requests.
5232 Turning on synchronization prohibits the Xlib routines from buffering
5233 requests and seriously degrades performance, but makes debugging much
5235 The optional second argument DISPLAY specifies which display to act on.
5236 DISPLAY should be either a frame or a display name (a string).
5237 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
5239 Lisp_Object display
, on
;
5241 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5243 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5248 /* Wait for responses to all X commands issued so far for frame F. */
5255 XSync (FRAME_X_DISPLAY (f
), False
);
5260 /***********************************************************************
5262 ***********************************************************************/
5264 /* Value is the number of elements of vector VECTOR. */
5266 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5268 /* List of supported image types. Use define_image_type to add new
5269 types. Use lookup_image_type to find a type for a given symbol. */
5271 static struct image_type
*image_types
;
5273 /* The symbol `image' which is the car of the lists used to represent
5276 extern Lisp_Object Qimage
;
5278 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5284 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5285 extern Lisp_Object QCdata
;
5286 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5287 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5288 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5290 /* Other symbols. */
5292 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5294 /* Time in seconds after which images should be removed from the cache
5295 if not displayed. */
5297 Lisp_Object Vimage_cache_eviction_delay
;
5299 /* Function prototypes. */
5301 static void define_image_type
P_ ((struct image_type
*type
));
5302 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5303 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5304 static void x_laplace
P_ ((struct frame
*, struct image
*));
5305 static void x_emboss
P_ ((struct frame
*, struct image
*));
5306 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5310 /* Define a new image type from TYPE. This adds a copy of TYPE to
5311 image_types and adds the symbol *TYPE->type to Vimage_types. */
5314 define_image_type (type
)
5315 struct image_type
*type
;
5317 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5318 The initialized data segment is read-only. */
5319 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5320 bcopy (type
, p
, sizeof *p
);
5321 p
->next
= image_types
;
5323 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5327 /* Look up image type SYMBOL, and return a pointer to its image_type
5328 structure. Value is null if SYMBOL is not a known image type. */
5330 static INLINE
struct image_type
*
5331 lookup_image_type (symbol
)
5334 struct image_type
*type
;
5336 for (type
= image_types
; type
; type
= type
->next
)
5337 if (EQ (symbol
, *type
->type
))
5344 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5345 valid image specification is a list whose car is the symbol
5346 `image', and whose rest is a property list. The property list must
5347 contain a value for key `:type'. That value must be the name of a
5348 supported image type. The rest of the property list depends on the
5352 valid_image_p (object
)
5357 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5361 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
5362 if (EQ (XCAR (tem
), QCtype
))
5365 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
5367 struct image_type
*type
;
5368 type
= lookup_image_type (XCAR (tem
));
5370 valid_p
= type
->valid_p (object
);
5381 /* Log error message with format string FORMAT and argument ARG.
5382 Signaling an error, e.g. when an image cannot be loaded, is not a
5383 good idea because this would interrupt redisplay, and the error
5384 message display would lead to another redisplay. This function
5385 therefore simply displays a message. */
5388 image_error (format
, arg1
, arg2
)
5390 Lisp_Object arg1
, arg2
;
5392 add_to_log (format
, arg1
, arg2
);
5397 /***********************************************************************
5398 Image specifications
5399 ***********************************************************************/
5401 enum image_value_type
5403 IMAGE_DONT_CHECK_VALUE_TYPE
,
5405 IMAGE_STRING_OR_NIL_VALUE
,
5407 IMAGE_POSITIVE_INTEGER_VALUE
,
5408 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5409 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5411 IMAGE_INTEGER_VALUE
,
5412 IMAGE_FUNCTION_VALUE
,
5417 /* Structure used when parsing image specifications. */
5419 struct image_keyword
5421 /* Name of keyword. */
5424 /* The type of value allowed. */
5425 enum image_value_type type
;
5427 /* Non-zero means key must be present. */
5430 /* Used to recognize duplicate keywords in a property list. */
5433 /* The value that was found. */
5438 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5440 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5443 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5444 has the format (image KEYWORD VALUE ...). One of the keyword/
5445 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5446 image_keywords structures of size NKEYWORDS describing other
5447 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5450 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5452 struct image_keyword
*keywords
;
5459 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5462 plist
= XCDR (spec
);
5463 while (CONSP (plist
))
5465 Lisp_Object key
, value
;
5467 /* First element of a pair must be a symbol. */
5469 plist
= XCDR (plist
);
5473 /* There must follow a value. */
5476 value
= XCAR (plist
);
5477 plist
= XCDR (plist
);
5479 /* Find key in KEYWORDS. Error if not found. */
5480 for (i
= 0; i
< nkeywords
; ++i
)
5481 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5487 /* Record that we recognized the keyword. If a keywords
5488 was found more than once, it's an error. */
5489 keywords
[i
].value
= value
;
5490 ++keywords
[i
].count
;
5492 if (keywords
[i
].count
> 1)
5495 /* Check type of value against allowed type. */
5496 switch (keywords
[i
].type
)
5498 case IMAGE_STRING_VALUE
:
5499 if (!STRINGP (value
))
5503 case IMAGE_STRING_OR_NIL_VALUE
:
5504 if (!STRINGP (value
) && !NILP (value
))
5508 case IMAGE_SYMBOL_VALUE
:
5509 if (!SYMBOLP (value
))
5513 case IMAGE_POSITIVE_INTEGER_VALUE
:
5514 if (!INTEGERP (value
) || XINT (value
) <= 0)
5518 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5519 if (INTEGERP (value
) && XINT (value
) >= 0)
5522 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5523 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5527 case IMAGE_ASCENT_VALUE
:
5528 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5530 else if (INTEGERP (value
)
5531 && XINT (value
) >= 0
5532 && XINT (value
) <= 100)
5536 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5537 if (!INTEGERP (value
) || XINT (value
) < 0)
5541 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5544 case IMAGE_FUNCTION_VALUE
:
5545 value
= indirect_function (value
);
5547 || COMPILEDP (value
)
5548 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5552 case IMAGE_NUMBER_VALUE
:
5553 if (!INTEGERP (value
) && !FLOATP (value
))
5557 case IMAGE_INTEGER_VALUE
:
5558 if (!INTEGERP (value
))
5562 case IMAGE_BOOL_VALUE
:
5563 if (!NILP (value
) && !EQ (value
, Qt
))
5572 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5576 /* Check that all mandatory fields are present. */
5577 for (i
= 0; i
< nkeywords
; ++i
)
5578 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5581 return NILP (plist
);
5585 /* Return the value of KEY in image specification SPEC. Value is nil
5586 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5587 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5590 image_spec_value (spec
, key
, found
)
5591 Lisp_Object spec
, key
;
5596 xassert (valid_image_p (spec
));
5598 for (tail
= XCDR (spec
);
5599 CONSP (tail
) && CONSP (XCDR (tail
));
5600 tail
= XCDR (XCDR (tail
)))
5602 if (EQ (XCAR (tail
), key
))
5606 return XCAR (XCDR (tail
));
5616 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5617 doc
: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
5618 PIXELS non-nil means return the size in pixels, otherwise return the
5619 size in canonical character units.
5620 FRAME is the frame on which the image will be displayed. FRAME nil
5621 or omitted means use the selected frame. */)
5622 (spec
, pixels
, frame
)
5623 Lisp_Object spec
, pixels
, frame
;
5628 if (valid_image_p (spec
))
5630 struct frame
*f
= check_x_frame (frame
);
5631 int id
= lookup_image (f
, spec
);
5632 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5633 int width
= img
->width
+ 2 * img
->hmargin
;
5634 int height
= img
->height
+ 2 * img
->vmargin
;
5637 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5638 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5640 size
= Fcons (make_number (width
), make_number (height
));
5643 error ("Invalid image specification");
5649 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5650 doc
: /* Return t if image SPEC has a mask bitmap.
5651 FRAME is the frame on which the image will be displayed. FRAME nil
5652 or omitted means use the selected frame. */)
5654 Lisp_Object spec
, frame
;
5659 if (valid_image_p (spec
))
5661 struct frame
*f
= check_x_frame (frame
);
5662 int id
= lookup_image (f
, spec
);
5663 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5668 error ("Invalid image specification");
5675 /***********************************************************************
5676 Image type independent image structures
5677 ***********************************************************************/
5679 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5680 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5683 /* Allocate and return a new image structure for image specification
5684 SPEC. SPEC has a hash value of HASH. */
5686 static struct image
*
5687 make_image (spec
, hash
)
5691 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5693 xassert (valid_image_p (spec
));
5694 bzero (img
, sizeof *img
);
5695 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5696 xassert (img
->type
!= NULL
);
5698 img
->data
.lisp_val
= Qnil
;
5699 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5705 /* Free image IMG which was used on frame F, including its resources. */
5714 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5716 /* Remove IMG from the hash table of its cache. */
5718 img
->prev
->next
= img
->next
;
5720 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5723 img
->next
->prev
= img
->prev
;
5725 c
->images
[img
->id
] = NULL
;
5727 /* Free resources, then free IMG. */
5728 img
->type
->free (f
, img
);
5734 /* Prepare image IMG for display on frame F. Must be called before
5735 drawing an image. */
5738 prepare_image_for_display (f
, img
)
5744 /* We're about to display IMG, so set its timestamp to `now'. */
5746 img
->timestamp
= EMACS_SECS (t
);
5748 /* If IMG doesn't have a pixmap yet, load it now, using the image
5749 type dependent loader function. */
5750 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5751 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5755 /* Value is the number of pixels for the ascent of image IMG when
5756 drawn in face FACE. */
5759 image_ascent (img
, face
)
5763 int height
= img
->height
+ img
->vmargin
;
5766 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5769 /* This expression is arranged so that if the image can't be
5770 exactly centered, it will be moved slightly up. This is
5771 because a typical font is `top-heavy' (due to the presence
5772 uppercase letters), so the image placement should err towards
5773 being top-heavy too. It also just generally looks better. */
5774 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5776 ascent
= height
/ 2;
5779 ascent
= height
* img
->ascent
/ 100.0;
5785 /* Image background colors. */
5787 static unsigned long
5788 four_corners_best (ximg
, width
, height
)
5790 unsigned long width
, height
;
5792 unsigned long corners
[4], best
;
5795 /* Get the colors at the corners of ximg. */
5796 corners
[0] = XGetPixel (ximg
, 0, 0);
5797 corners
[1] = XGetPixel (ximg
, width
- 1, 0);
5798 corners
[2] = XGetPixel (ximg
, width
- 1, height
- 1);
5799 corners
[3] = XGetPixel (ximg
, 0, height
- 1);
5801 /* Choose the most frequently found color as background. */
5802 for (i
= best_count
= 0; i
< 4; ++i
)
5806 for (j
= n
= 0; j
< 4; ++j
)
5807 if (corners
[i
] == corners
[j
])
5811 best
= corners
[i
], best_count
= n
;
5817 /* Return the `background' field of IMG. If IMG doesn't have one yet,
5818 it is guessed heuristically. If non-zero, XIMG is an existing XImage
5819 object to use for the heuristic. */
5822 image_background (img
, f
, ximg
)
5827 if (! img
->background_valid
)
5828 /* IMG doesn't have a background yet, try to guess a reasonable value. */
5830 int free_ximg
= !ximg
;
5833 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
5834 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
5836 img
->background
= four_corners_best (ximg
, img
->width
, img
->height
);
5839 XDestroyImage (ximg
);
5841 img
->background_valid
= 1;
5844 return img
->background
;
5847 /* Return the `background_transparent' field of IMG. If IMG doesn't
5848 have one yet, it is guessed heuristically. If non-zero, MASK is an
5849 existing XImage object to use for the heuristic. */
5852 image_background_transparent (img
, f
, mask
)
5857 if (! img
->background_transparent_valid
)
5858 /* IMG doesn't have a background yet, try to guess a reasonable value. */
5862 int free_mask
= !mask
;
5865 mask
= XGetImage (FRAME_X_DISPLAY (f
), img
->mask
,
5866 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
5868 img
->background_transparent
5869 = !four_corners_best (mask
, img
->width
, img
->height
);
5872 XDestroyImage (mask
);
5875 img
->background_transparent
= 0;
5877 img
->background_transparent_valid
= 1;
5880 return img
->background_transparent
;
5884 /***********************************************************************
5885 Helper functions for X image types
5886 ***********************************************************************/
5888 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5890 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5891 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5893 Lisp_Object color_name
,
5894 unsigned long dflt
));
5897 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5898 free the pixmap if any. MASK_P non-zero means clear the mask
5899 pixmap if any. COLORS_P non-zero means free colors allocated for
5900 the image, if any. */
5903 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5906 int pixmap_p
, mask_p
, colors_p
;
5908 if (pixmap_p
&& img
->pixmap
)
5910 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5912 img
->background_valid
= 0;
5915 if (mask_p
&& img
->mask
)
5917 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5919 img
->background_transparent_valid
= 0;
5922 if (colors_p
&& img
->ncolors
)
5924 x_free_colors (f
, img
->colors
, img
->ncolors
);
5925 xfree (img
->colors
);
5931 /* Free X resources of image IMG which is used on frame F. */
5934 x_clear_image (f
, img
)
5939 x_clear_image_1 (f
, img
, 1, 1, 1);
5944 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5945 cannot be allocated, use DFLT. Add a newly allocated color to
5946 IMG->colors, so that it can be freed again. Value is the pixel
5949 static unsigned long
5950 x_alloc_image_color (f
, img
, color_name
, dflt
)
5953 Lisp_Object color_name
;
5957 unsigned long result
;
5959 xassert (STRINGP (color_name
));
5961 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5963 /* This isn't called frequently so we get away with simply
5964 reallocating the color vector to the needed size, here. */
5967 (unsigned long *) xrealloc (img
->colors
,
5968 img
->ncolors
* sizeof *img
->colors
);
5969 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5970 result
= color
.pixel
;
5980 /***********************************************************************
5982 ***********************************************************************/
5984 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5985 static void postprocess_image
P_ ((struct frame
*, struct image
*));
5988 /* Return a new, initialized image cache that is allocated from the
5989 heap. Call free_image_cache to free an image cache. */
5991 struct image_cache
*
5994 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5997 bzero (c
, sizeof *c
);
5999 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
6000 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
6001 c
->buckets
= (struct image
**) xmalloc (size
);
6002 bzero (c
->buckets
, size
);
6007 /* Free image cache of frame F. Be aware that X frames share images
6011 free_image_cache (f
)
6014 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6019 /* Cache should not be referenced by any frame when freed. */
6020 xassert (c
->refcount
== 0);
6022 for (i
= 0; i
< c
->used
; ++i
)
6023 free_image (f
, c
->images
[i
]);
6027 FRAME_X_IMAGE_CACHE (f
) = NULL
;
6032 /* Clear image cache of frame F. FORCE_P non-zero means free all
6033 images. FORCE_P zero means clear only images that haven't been
6034 displayed for some time. Should be called from time to time to
6035 reduce the number of loaded images. If image-eviction-seconds is
6036 non-nil, this frees images in the cache which weren't displayed for
6037 at least that many seconds. */
6040 clear_image_cache (f
, force_p
)
6044 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6046 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
6053 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
6055 /* Block input so that we won't be interrupted by a SIGIO
6056 while being in an inconsistent state. */
6059 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
6061 struct image
*img
= c
->images
[i
];
6063 && (force_p
|| img
->timestamp
< old
))
6065 free_image (f
, img
);
6070 /* We may be clearing the image cache because, for example,
6071 Emacs was iconified for a longer period of time. In that
6072 case, current matrices may still contain references to
6073 images freed above. So, clear these matrices. */
6076 Lisp_Object tail
, frame
;
6078 FOR_EACH_FRAME (tail
, frame
)
6080 struct frame
*f
= XFRAME (frame
);
6082 && FRAME_X_IMAGE_CACHE (f
) == c
)
6083 clear_current_matrices (f
);
6086 ++windows_or_buffers_changed
;
6094 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
6096 doc
: /* Clear the image cache of FRAME.
6097 FRAME nil or omitted means use the selected frame.
6098 FRAME t means clear the image caches of all frames. */)
6106 FOR_EACH_FRAME (tail
, frame
)
6107 if (FRAME_X_P (XFRAME (frame
)))
6108 clear_image_cache (XFRAME (frame
), 1);
6111 clear_image_cache (check_x_frame (frame
), 1);
6117 /* Compute masks and transform image IMG on frame F, as specified
6118 by the image's specification, */
6121 postprocess_image (f
, img
)
6125 /* Manipulation of the image's mask. */
6128 Lisp_Object conversion
, spec
;
6133 /* `:heuristic-mask t'
6135 means build a mask heuristically.
6136 `:heuristic-mask (R G B)'
6137 `:mask (heuristic (R G B))'
6138 means build a mask from color (R G B) in the
6141 means remove a mask, if any. */
6143 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6145 x_build_heuristic_mask (f
, img
, mask
);
6150 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6152 if (EQ (mask
, Qheuristic
))
6153 x_build_heuristic_mask (f
, img
, Qt
);
6154 else if (CONSP (mask
)
6155 && EQ (XCAR (mask
), Qheuristic
))
6157 if (CONSP (XCDR (mask
)))
6158 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6160 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6162 else if (NILP (mask
) && found_p
&& img
->mask
)
6164 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6170 /* Should we apply an image transformation algorithm? */
6171 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6172 if (EQ (conversion
, Qdisabled
))
6173 x_disable_image (f
, img
);
6174 else if (EQ (conversion
, Qlaplace
))
6176 else if (EQ (conversion
, Qemboss
))
6178 else if (CONSP (conversion
)
6179 && EQ (XCAR (conversion
), Qedge_detection
))
6182 tem
= XCDR (conversion
);
6184 x_edge_detection (f
, img
,
6185 Fplist_get (tem
, QCmatrix
),
6186 Fplist_get (tem
, QCcolor_adjustment
));
6192 /* Return the id of image with Lisp specification SPEC on frame F.
6193 SPEC must be a valid Lisp image specification (see valid_image_p). */
6196 lookup_image (f
, spec
)
6200 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6204 struct gcpro gcpro1
;
6207 /* F must be a window-system frame, and SPEC must be a valid image
6209 xassert (FRAME_WINDOW_P (f
));
6210 xassert (valid_image_p (spec
));
6214 /* Look up SPEC in the hash table of the image cache. */
6215 hash
= sxhash (spec
, 0);
6216 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6218 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6219 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6222 /* If not found, create a new image and cache it. */
6225 extern Lisp_Object Qpostscript
;
6228 img
= make_image (spec
, hash
);
6229 cache_image (f
, img
);
6230 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6232 /* If we can't load the image, and we don't have a width and
6233 height, use some arbitrary width and height so that we can
6234 draw a rectangle for it. */
6235 if (img
->load_failed_p
)
6239 value
= image_spec_value (spec
, QCwidth
, NULL
);
6240 img
->width
= (INTEGERP (value
)
6241 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6242 value
= image_spec_value (spec
, QCheight
, NULL
);
6243 img
->height
= (INTEGERP (value
)
6244 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6248 /* Handle image type independent image attributes
6249 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
6250 `:background COLOR'. */
6251 Lisp_Object ascent
, margin
, relief
, bg
;
6253 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6254 if (INTEGERP (ascent
))
6255 img
->ascent
= XFASTINT (ascent
);
6256 else if (EQ (ascent
, Qcenter
))
6257 img
->ascent
= CENTERED_IMAGE_ASCENT
;
6259 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6260 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6261 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
6262 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
6263 && INTEGERP (XCDR (margin
)))
6265 if (XINT (XCAR (margin
)) > 0)
6266 img
->hmargin
= XFASTINT (XCAR (margin
));
6267 if (XINT (XCDR (margin
)) > 0)
6268 img
->vmargin
= XFASTINT (XCDR (margin
));
6271 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6272 if (INTEGERP (relief
))
6274 img
->relief
= XINT (relief
);
6275 img
->hmargin
+= abs (img
->relief
);
6276 img
->vmargin
+= abs (img
->relief
);
6279 if (! img
->background_valid
)
6281 bg
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6285 = x_alloc_image_color (f
, img
, bg
,
6286 FRAME_BACKGROUND_PIXEL (f
));
6287 img
->background_valid
= 1;
6291 /* Do image transformations and compute masks, unless we
6292 don't have the image yet. */
6293 if (!EQ (*img
->type
->type
, Qpostscript
))
6294 postprocess_image (f
, img
);
6298 xassert (!interrupt_input_blocked
);
6301 /* We're using IMG, so set its timestamp to `now'. */
6302 EMACS_GET_TIME (now
);
6303 img
->timestamp
= EMACS_SECS (now
);
6307 /* Value is the image id. */
6312 /* Cache image IMG in the image cache of frame F. */
6315 cache_image (f
, img
)
6319 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6322 /* Find a free slot in c->images. */
6323 for (i
= 0; i
< c
->used
; ++i
)
6324 if (c
->images
[i
] == NULL
)
6327 /* If no free slot found, maybe enlarge c->images. */
6328 if (i
== c
->used
&& c
->used
== c
->size
)
6331 c
->images
= (struct image
**) xrealloc (c
->images
,
6332 c
->size
* sizeof *c
->images
);
6335 /* Add IMG to c->images, and assign IMG an id. */
6341 /* Add IMG to the cache's hash table. */
6342 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6343 img
->next
= c
->buckets
[i
];
6345 img
->next
->prev
= img
;
6347 c
->buckets
[i
] = img
;
6351 /* Call FN on every image in the image cache of frame F. Used to mark
6352 Lisp Objects in the image cache. */
6355 forall_images_in_image_cache (f
, fn
)
6357 void (*fn
) P_ ((struct image
*img
));
6359 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6361 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6365 for (i
= 0; i
< c
->used
; ++i
)
6374 /***********************************************************************
6376 ***********************************************************************/
6378 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6379 XImage
**, Pixmap
*));
6380 static void x_destroy_x_image
P_ ((XImage
*));
6381 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6384 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6385 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6386 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6387 via xmalloc. Print error messages via image_error if an error
6388 occurs. Value is non-zero if successful. */
6391 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6393 int width
, height
, depth
;
6397 Display
*display
= FRAME_X_DISPLAY (f
);
6398 Screen
*screen
= FRAME_X_SCREEN (f
);
6399 Window window
= FRAME_X_WINDOW (f
);
6401 xassert (interrupt_input_blocked
);
6404 depth
= DefaultDepthOfScreen (screen
);
6405 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6406 depth
, ZPixmap
, 0, NULL
, width
, height
,
6407 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6410 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6414 /* Allocate image raster. */
6415 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6417 /* Allocate a pixmap of the same size. */
6418 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6419 if (*pixmap
== None
)
6421 x_destroy_x_image (*ximg
);
6423 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6431 /* Destroy XImage XIMG. Free XIMG->data. */
6434 x_destroy_x_image (ximg
)
6437 xassert (interrupt_input_blocked
);
6442 XDestroyImage (ximg
);
6447 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6448 are width and height of both the image and pixmap. */
6451 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6458 xassert (interrupt_input_blocked
);
6459 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6460 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6461 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6466 /***********************************************************************
6468 ***********************************************************************/
6470 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6471 static char *slurp_file
P_ ((char *, int *));
6474 /* Find image file FILE. Look in data-directory, then
6475 x-bitmap-file-path. Value is the full name of the file found, or
6476 nil if not found. */
6479 x_find_image_file (file
)
6482 Lisp_Object file_found
, search_path
;
6483 struct gcpro gcpro1
, gcpro2
;
6487 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6488 GCPRO2 (file_found
, search_path
);
6490 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6491 fd
= openp (search_path
, file
, Qnil
, &file_found
, 0);
6503 /* Read FILE into memory. Value is a pointer to a buffer allocated
6504 with xmalloc holding FILE's contents. Value is null if an error
6505 occurred. *SIZE is set to the size of the file. */
6508 slurp_file (file
, size
)
6516 if (stat (file
, &st
) == 0
6517 && (fp
= fopen (file
, "r")) != NULL
6518 && (buf
= (char *) xmalloc (st
.st_size
),
6519 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6540 /***********************************************************************
6542 ***********************************************************************/
6544 static int xbm_scan
P_ ((char **, char *, char *, int *));
6545 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6546 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6548 static int xbm_image_p
P_ ((Lisp_Object object
));
6549 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6551 static int xbm_file_p
P_ ((Lisp_Object
));
6554 /* Indices of image specification fields in xbm_format, below. */
6556 enum xbm_keyword_index
6574 /* Vector of image_keyword structures describing the format
6575 of valid XBM image specifications. */
6577 static struct image_keyword xbm_format
[XBM_LAST
] =
6579 {":type", IMAGE_SYMBOL_VALUE
, 1},
6580 {":file", IMAGE_STRING_VALUE
, 0},
6581 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6582 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6583 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6584 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
6585 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
6586 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6587 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6588 {":relief", IMAGE_INTEGER_VALUE
, 0},
6589 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6590 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6591 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6594 /* Structure describing the image type XBM. */
6596 static struct image_type xbm_type
=
6605 /* Tokens returned from xbm_scan. */
6614 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6615 A valid specification is a list starting with the symbol `image'
6616 The rest of the list is a property list which must contain an
6619 If the specification specifies a file to load, it must contain
6620 an entry `:file FILENAME' where FILENAME is a string.
6622 If the specification is for a bitmap loaded from memory it must
6623 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6624 WIDTH and HEIGHT are integers > 0. DATA may be:
6626 1. a string large enough to hold the bitmap data, i.e. it must
6627 have a size >= (WIDTH + 7) / 8 * HEIGHT
6629 2. a bool-vector of size >= WIDTH * HEIGHT
6631 3. a vector of strings or bool-vectors, one for each line of the
6634 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6635 may not be specified in this case because they are defined in the
6638 Both the file and data forms may contain the additional entries
6639 `:background COLOR' and `:foreground COLOR'. If not present,
6640 foreground and background of the frame on which the image is
6641 displayed is used. */
6644 xbm_image_p (object
)
6647 struct image_keyword kw
[XBM_LAST
];
6649 bcopy (xbm_format
, kw
, sizeof kw
);
6650 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6653 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6655 if (kw
[XBM_FILE
].count
)
6657 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6660 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6662 /* In-memory XBM file. */
6663 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6671 /* Entries for `:width', `:height' and `:data' must be present. */
6672 if (!kw
[XBM_WIDTH
].count
6673 || !kw
[XBM_HEIGHT
].count
6674 || !kw
[XBM_DATA
].count
)
6677 data
= kw
[XBM_DATA
].value
;
6678 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6679 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6681 /* Check type of data, and width and height against contents of
6687 /* Number of elements of the vector must be >= height. */
6688 if (XVECTOR (data
)->size
< height
)
6691 /* Each string or bool-vector in data must be large enough
6692 for one line of the image. */
6693 for (i
= 0; i
< height
; ++i
)
6695 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6699 if (XSTRING (elt
)->size
6700 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6703 else if (BOOL_VECTOR_P (elt
))
6705 if (XBOOL_VECTOR (elt
)->size
< width
)
6712 else if (STRINGP (data
))
6714 if (XSTRING (data
)->size
6715 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6718 else if (BOOL_VECTOR_P (data
))
6720 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6731 /* Scan a bitmap file. FP is the stream to read from. Value is
6732 either an enumerator from enum xbm_token, or a character for a
6733 single-character token, or 0 at end of file. If scanning an
6734 identifier, store the lexeme of the identifier in SVAL. If
6735 scanning a number, store its value in *IVAL. */
6738 xbm_scan (s
, end
, sval
, ival
)
6747 /* Skip white space. */
6748 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6753 else if (isdigit (c
))
6755 int value
= 0, digit
;
6757 if (c
== '0' && *s
< end
)
6760 if (c
== 'x' || c
== 'X')
6767 else if (c
>= 'a' && c
<= 'f')
6768 digit
= c
- 'a' + 10;
6769 else if (c
>= 'A' && c
<= 'F')
6770 digit
= c
- 'A' + 10;
6773 value
= 16 * value
+ digit
;
6776 else if (isdigit (c
))
6780 && (c
= *(*s
)++, isdigit (c
)))
6781 value
= 8 * value
+ c
- '0';
6788 && (c
= *(*s
)++, isdigit (c
)))
6789 value
= 10 * value
+ c
- '0';
6797 else if (isalpha (c
) || c
== '_')
6801 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6808 else if (c
== '/' && **s
== '*')
6810 /* C-style comment. */
6812 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6825 /* Replacement for XReadBitmapFileData which isn't available under old
6826 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6827 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6828 the image. Return in *DATA the bitmap data allocated with xmalloc.
6829 Value is non-zero if successful. DATA null means just test if
6830 CONTENTS looks like an in-memory XBM file. */
6833 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6834 char *contents
, *end
;
6835 int *width
, *height
;
6836 unsigned char **data
;
6839 char buffer
[BUFSIZ
];
6842 int bytes_per_line
, i
, nbytes
;
6848 LA1 = xbm_scan (&s, end, buffer, &value)
6850 #define expect(TOKEN) \
6851 if (LA1 != (TOKEN)) \
6856 #define expect_ident(IDENT) \
6857 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6862 *width
= *height
= -1;
6865 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6867 /* Parse defines for width, height and hot-spots. */
6871 expect_ident ("define");
6872 expect (XBM_TK_IDENT
);
6874 if (LA1
== XBM_TK_NUMBER
);
6876 char *p
= strrchr (buffer
, '_');
6877 p
= p
? p
+ 1 : buffer
;
6878 if (strcmp (p
, "width") == 0)
6880 else if (strcmp (p
, "height") == 0)
6883 expect (XBM_TK_NUMBER
);
6886 if (*width
< 0 || *height
< 0)
6888 else if (data
== NULL
)
6891 /* Parse bits. Must start with `static'. */
6892 expect_ident ("static");
6893 if (LA1
== XBM_TK_IDENT
)
6895 if (strcmp (buffer
, "unsigned") == 0)
6898 expect_ident ("char");
6900 else if (strcmp (buffer
, "short") == 0)
6904 if (*width
% 16 && *width
% 16 < 9)
6907 else if (strcmp (buffer
, "char") == 0)
6915 expect (XBM_TK_IDENT
);
6921 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6922 nbytes
= bytes_per_line
* *height
;
6923 p
= *data
= (char *) xmalloc (nbytes
);
6927 for (i
= 0; i
< nbytes
; i
+= 2)
6930 expect (XBM_TK_NUMBER
);
6933 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6936 if (LA1
== ',' || LA1
== '}')
6944 for (i
= 0; i
< nbytes
; ++i
)
6947 expect (XBM_TK_NUMBER
);
6951 if (LA1
== ',' || LA1
== '}')
6976 /* Load XBM image IMG which will be displayed on frame F from buffer
6977 CONTENTS. END is the end of the buffer. Value is non-zero if
6981 xbm_load_image (f
, img
, contents
, end
)
6984 char *contents
, *end
;
6987 unsigned char *data
;
6990 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6993 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6994 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6995 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6998 xassert (img
->width
> 0 && img
->height
> 0);
7000 /* Get foreground and background colors, maybe allocate colors. */
7001 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
7003 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
7004 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
7007 background
= x_alloc_image_color (f
, img
, value
, background
);
7008 img
->background
= background
;
7009 img
->background_valid
= 1;
7013 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7016 img
->width
, img
->height
,
7017 foreground
, background
,
7021 if (img
->pixmap
== None
)
7023 x_clear_image (f
, img
);
7024 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
7030 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7036 /* Value is non-zero if DATA looks like an in-memory XBM file. */
7043 return (STRINGP (data
)
7044 && xbm_read_bitmap_data (XSTRING (data
)->data
,
7045 (XSTRING (data
)->data
7046 + STRING_BYTES (XSTRING (data
))),
7051 /* Fill image IMG which is used on frame F with pixmap data. Value is
7052 non-zero if successful. */
7060 Lisp_Object file_name
;
7062 xassert (xbm_image_p (img
->spec
));
7064 /* If IMG->spec specifies a file name, create a non-file spec from it. */
7065 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
7066 if (STRINGP (file_name
))
7071 struct gcpro gcpro1
;
7073 file
= x_find_image_file (file_name
);
7075 if (!STRINGP (file
))
7077 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
7082 contents
= slurp_file (XSTRING (file
)->data
, &size
);
7083 if (contents
== NULL
)
7085 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7090 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
7095 struct image_keyword fmt
[XBM_LAST
];
7098 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7099 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7102 int in_memory_file_p
= 0;
7104 /* See if data looks like an in-memory XBM file. */
7105 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7106 in_memory_file_p
= xbm_file_p (data
);
7108 /* Parse the image specification. */
7109 bcopy (xbm_format
, fmt
, sizeof fmt
);
7110 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
7113 /* Get specified width, and height. */
7114 if (!in_memory_file_p
)
7116 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
7117 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
7118 xassert (img
->width
> 0 && img
->height
> 0);
7121 /* Get foreground and background colors, maybe allocate colors. */
7122 if (fmt
[XBM_FOREGROUND
].count
7123 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
7124 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
7126 if (fmt
[XBM_BACKGROUND
].count
7127 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
7128 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
7131 if (in_memory_file_p
)
7132 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
7133 (XSTRING (data
)->data
7134 + STRING_BYTES (XSTRING (data
))));
7141 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
7143 p
= bits
= (char *) alloca (nbytes
* img
->height
);
7144 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
7146 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
7148 bcopy (XSTRING (line
)->data
, p
, nbytes
);
7150 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
7153 else if (STRINGP (data
))
7154 bits
= XSTRING (data
)->data
;
7156 bits
= XBOOL_VECTOR (data
)->data
;
7158 /* Create the pixmap. */
7159 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7161 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7164 img
->width
, img
->height
,
7165 foreground
, background
,
7171 image_error ("Unable to create pixmap for XBM image `%s'",
7173 x_clear_image (f
, img
);
7183 /***********************************************************************
7185 ***********************************************************************/
7189 static int xpm_image_p
P_ ((Lisp_Object object
));
7190 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
7191 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
7193 #include "X11/xpm.h"
7195 /* The symbol `xpm' identifying XPM-format images. */
7199 /* Indices of image specification fields in xpm_format, below. */
7201 enum xpm_keyword_index
7217 /* Vector of image_keyword structures describing the format
7218 of valid XPM image specifications. */
7220 static struct image_keyword xpm_format
[XPM_LAST
] =
7222 {":type", IMAGE_SYMBOL_VALUE
, 1},
7223 {":file", IMAGE_STRING_VALUE
, 0},
7224 {":data", IMAGE_STRING_VALUE
, 0},
7225 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7226 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7227 {":relief", IMAGE_INTEGER_VALUE
, 0},
7228 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7229 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7230 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7231 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7232 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
7235 /* Structure describing the image type XBM. */
7237 static struct image_type xpm_type
=
7247 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7248 functions for allocating image colors. Our own functions handle
7249 color allocation failures more gracefully than the ones on the XPM
7252 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7253 #define ALLOC_XPM_COLORS
7256 #ifdef ALLOC_XPM_COLORS
7258 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7259 static void xpm_free_color_cache
P_ ((void));
7260 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7261 static int xpm_color_bucket
P_ ((char *));
7262 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7265 /* An entry in a hash table used to cache color definitions of named
7266 colors. This cache is necessary to speed up XPM image loading in
7267 case we do color allocations ourselves. Without it, we would need
7268 a call to XParseColor per pixel in the image. */
7270 struct xpm_cached_color
7272 /* Next in collision chain. */
7273 struct xpm_cached_color
*next
;
7275 /* Color definition (RGB and pixel color). */
7282 /* The hash table used for the color cache, and its bucket vector
7285 #define XPM_COLOR_CACHE_BUCKETS 1001
7286 struct xpm_cached_color
**xpm_color_cache
;
7288 /* Initialize the color cache. */
7291 xpm_init_color_cache (f
, attrs
)
7293 XpmAttributes
*attrs
;
7295 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7296 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7297 memset (xpm_color_cache
, 0, nbytes
);
7298 init_color_table ();
7300 if (attrs
->valuemask
& XpmColorSymbols
)
7305 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7306 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7307 attrs
->colorsymbols
[i
].value
, &color
))
7309 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7311 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7317 /* Free the color cache. */
7320 xpm_free_color_cache ()
7322 struct xpm_cached_color
*p
, *next
;
7325 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7326 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7332 xfree (xpm_color_cache
);
7333 xpm_color_cache
= NULL
;
7334 free_color_table ();
7338 /* Return the bucket index for color named COLOR_NAME in the color
7342 xpm_color_bucket (color_name
)
7348 for (s
= color_name
; *s
; ++s
)
7350 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7354 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7355 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7358 static struct xpm_cached_color
*
7359 xpm_cache_color (f
, color_name
, color
, bucket
)
7366 struct xpm_cached_color
*p
;
7369 bucket
= xpm_color_bucket (color_name
);
7371 nbytes
= sizeof *p
+ strlen (color_name
);
7372 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7373 strcpy (p
->name
, color_name
);
7375 p
->next
= xpm_color_cache
[bucket
];
7376 xpm_color_cache
[bucket
] = p
;
7381 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7382 return the cached definition in *COLOR. Otherwise, make a new
7383 entry in the cache and allocate the color. Value is zero if color
7384 allocation failed. */
7387 xpm_lookup_color (f
, color_name
, color
)
7392 struct xpm_cached_color
*p
;
7393 int h
= xpm_color_bucket (color_name
);
7395 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7396 if (strcmp (p
->name
, color_name
) == 0)
7401 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7404 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7406 p
= xpm_cache_color (f
, color_name
, color
, h
);
7413 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7414 CLOSURE is a pointer to the frame on which we allocate the
7415 color. Return in *COLOR the allocated color. Value is non-zero
7419 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7426 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7430 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7431 is a pointer to the frame on which we allocate the color. Value is
7432 non-zero if successful. */
7435 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7445 #endif /* ALLOC_XPM_COLORS */
7448 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7449 for XPM images. Such a list must consist of conses whose car and
7453 xpm_valid_color_symbols_p (color_symbols
)
7454 Lisp_Object color_symbols
;
7456 while (CONSP (color_symbols
))
7458 Lisp_Object sym
= XCAR (color_symbols
);
7460 || !STRINGP (XCAR (sym
))
7461 || !STRINGP (XCDR (sym
)))
7463 color_symbols
= XCDR (color_symbols
);
7466 return NILP (color_symbols
);
7470 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7473 xpm_image_p (object
)
7476 struct image_keyword fmt
[XPM_LAST
];
7477 bcopy (xpm_format
, fmt
, sizeof fmt
);
7478 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7479 /* Either `:file' or `:data' must be present. */
7480 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7481 /* Either no `:color-symbols' or it's a list of conses
7482 whose car and cdr are strings. */
7483 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7484 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7488 /* Load image IMG which will be displayed on frame F. Value is
7489 non-zero if successful. */
7497 XpmAttributes attrs
;
7498 Lisp_Object specified_file
, color_symbols
;
7500 /* Configure the XPM lib. Use the visual of frame F. Allocate
7501 close colors. Return colors allocated. */
7502 bzero (&attrs
, sizeof attrs
);
7503 attrs
.visual
= FRAME_X_VISUAL (f
);
7504 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7505 attrs
.valuemask
|= XpmVisual
;
7506 attrs
.valuemask
|= XpmColormap
;
7508 #ifdef ALLOC_XPM_COLORS
7509 /* Allocate colors with our own functions which handle
7510 failing color allocation more gracefully. */
7511 attrs
.color_closure
= f
;
7512 attrs
.alloc_color
= xpm_alloc_color
;
7513 attrs
.free_colors
= xpm_free_colors
;
7514 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7515 #else /* not ALLOC_XPM_COLORS */
7516 /* Let the XPM lib allocate colors. */
7517 attrs
.valuemask
|= XpmReturnAllocPixels
;
7518 #ifdef XpmAllocCloseColors
7519 attrs
.alloc_close_colors
= 1;
7520 attrs
.valuemask
|= XpmAllocCloseColors
;
7521 #else /* not XpmAllocCloseColors */
7522 attrs
.closeness
= 600;
7523 attrs
.valuemask
|= XpmCloseness
;
7524 #endif /* not XpmAllocCloseColors */
7525 #endif /* ALLOC_XPM_COLORS */
7527 /* If image specification contains symbolic color definitions, add
7528 these to `attrs'. */
7529 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7530 if (CONSP (color_symbols
))
7533 XpmColorSymbol
*xpm_syms
;
7536 attrs
.valuemask
|= XpmColorSymbols
;
7538 /* Count number of symbols. */
7539 attrs
.numsymbols
= 0;
7540 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7543 /* Allocate an XpmColorSymbol array. */
7544 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7545 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7546 bzero (xpm_syms
, size
);
7547 attrs
.colorsymbols
= xpm_syms
;
7549 /* Fill the color symbol array. */
7550 for (tail
= color_symbols
, i
= 0;
7552 ++i
, tail
= XCDR (tail
))
7554 Lisp_Object name
= XCAR (XCAR (tail
));
7555 Lisp_Object color
= XCDR (XCAR (tail
));
7556 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7557 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7558 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7559 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7563 /* Create a pixmap for the image, either from a file, or from a
7564 string buffer containing data in the same format as an XPM file. */
7565 #ifdef ALLOC_XPM_COLORS
7566 xpm_init_color_cache (f
, &attrs
);
7569 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7570 if (STRINGP (specified_file
))
7572 Lisp_Object file
= x_find_image_file (specified_file
);
7573 if (!STRINGP (file
))
7575 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7579 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7580 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7585 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7586 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7587 XSTRING (buffer
)->data
,
7588 &img
->pixmap
, &img
->mask
,
7592 if (rc
== XpmSuccess
)
7594 #ifdef ALLOC_XPM_COLORS
7595 img
->colors
= colors_in_color_table (&img
->ncolors
);
7596 #else /* not ALLOC_XPM_COLORS */
7599 img
->ncolors
= attrs
.nalloc_pixels
;
7600 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7601 * sizeof *img
->colors
);
7602 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7604 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7605 #ifdef DEBUG_X_COLORS
7606 register_color (img
->colors
[i
]);
7609 #endif /* not ALLOC_XPM_COLORS */
7611 img
->width
= attrs
.width
;
7612 img
->height
= attrs
.height
;
7613 xassert (img
->width
> 0 && img
->height
> 0);
7615 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7616 XpmFreeAttributes (&attrs
);
7623 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7626 case XpmFileInvalid
:
7627 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7631 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7634 case XpmColorFailed
:
7635 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7639 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7644 #ifdef ALLOC_XPM_COLORS
7645 xpm_free_color_cache ();
7647 return rc
== XpmSuccess
;
7650 #endif /* HAVE_XPM != 0 */
7653 /***********************************************************************
7655 ***********************************************************************/
7657 /* An entry in the color table mapping an RGB color to a pixel color. */
7662 unsigned long pixel
;
7664 /* Next in color table collision list. */
7665 struct ct_color
*next
;
7668 /* The bucket vector size to use. Must be prime. */
7672 /* Value is a hash of the RGB color given by R, G, and B. */
7674 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7676 /* The color hash table. */
7678 struct ct_color
**ct_table
;
7680 /* Number of entries in the color table. */
7682 int ct_colors_allocated
;
7684 /* Initialize the color table. */
7689 int size
= CT_SIZE
* sizeof (*ct_table
);
7690 ct_table
= (struct ct_color
**) xmalloc (size
);
7691 bzero (ct_table
, size
);
7692 ct_colors_allocated
= 0;
7696 /* Free memory associated with the color table. */
7702 struct ct_color
*p
, *next
;
7704 for (i
= 0; i
< CT_SIZE
; ++i
)
7705 for (p
= ct_table
[i
]; p
; p
= next
)
7716 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7717 entry for that color already is in the color table, return the
7718 pixel color of that entry. Otherwise, allocate a new color for R,
7719 G, B, and make an entry in the color table. */
7721 static unsigned long
7722 lookup_rgb_color (f
, r
, g
, b
)
7726 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7727 int i
= hash
% CT_SIZE
;
7730 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7731 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7744 cmap
= FRAME_X_COLORMAP (f
);
7745 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7749 ++ct_colors_allocated
;
7751 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7755 p
->pixel
= color
.pixel
;
7756 p
->next
= ct_table
[i
];
7760 return FRAME_FOREGROUND_PIXEL (f
);
7767 /* Look up pixel color PIXEL which is used on frame F in the color
7768 table. If not already present, allocate it. Value is PIXEL. */
7770 static unsigned long
7771 lookup_pixel_color (f
, pixel
)
7773 unsigned long pixel
;
7775 int i
= pixel
% CT_SIZE
;
7778 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7779 if (p
->pixel
== pixel
)
7788 cmap
= FRAME_X_COLORMAP (f
);
7789 color
.pixel
= pixel
;
7790 x_query_color (f
, &color
);
7791 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7795 ++ct_colors_allocated
;
7797 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7802 p
->next
= ct_table
[i
];
7806 return FRAME_FOREGROUND_PIXEL (f
);
7813 /* Value is a vector of all pixel colors contained in the color table,
7814 allocated via xmalloc. Set *N to the number of colors. */
7816 static unsigned long *
7817 colors_in_color_table (n
)
7822 unsigned long *colors
;
7824 if (ct_colors_allocated
== 0)
7831 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7833 *n
= ct_colors_allocated
;
7835 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7836 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7837 colors
[j
++] = p
->pixel
;
7845 /***********************************************************************
7847 ***********************************************************************/
7849 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7850 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7851 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7853 /* Non-zero means draw a cross on images having `:conversion
7856 int cross_disabled_images
;
7858 /* Edge detection matrices for different edge-detection
7861 static int emboss_matrix
[9] = {
7863 2, -1, 0, /* y - 1 */
7865 0, 1, -2 /* y + 1 */
7868 static int laplace_matrix
[9] = {
7870 1, 0, 0, /* y - 1 */
7872 0, 0, -1 /* y + 1 */
7875 /* Value is the intensity of the color whose red/green/blue values
7878 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7881 /* On frame F, return an array of XColor structures describing image
7882 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7883 non-zero means also fill the red/green/blue members of the XColor
7884 structures. Value is a pointer to the array of XColors structures,
7885 allocated with xmalloc; it must be freed by the caller. */
7888 x_to_xcolors (f
, img
, rgb_p
)
7897 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7899 /* Get the X image IMG->pixmap. */
7900 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7901 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7903 /* Fill the `pixel' members of the XColor array. I wished there
7904 were an easy and portable way to circumvent XGetPixel. */
7906 for (y
= 0; y
< img
->height
; ++y
)
7910 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7911 p
->pixel
= XGetPixel (ximg
, x
, y
);
7914 x_query_colors (f
, row
, img
->width
);
7917 XDestroyImage (ximg
);
7922 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7923 RGB members are set. F is the frame on which this all happens.
7924 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7927 x_from_xcolors (f
, img
, colors
)
7937 init_color_table ();
7939 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7942 for (y
= 0; y
< img
->height
; ++y
)
7943 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7945 unsigned long pixel
;
7946 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7947 XPutPixel (oimg
, x
, y
, pixel
);
7951 x_clear_image_1 (f
, img
, 1, 0, 1);
7953 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7954 x_destroy_x_image (oimg
);
7955 img
->pixmap
= pixmap
;
7956 img
->colors
= colors_in_color_table (&img
->ncolors
);
7957 free_color_table ();
7961 /* On frame F, perform edge-detection on image IMG.
7963 MATRIX is a nine-element array specifying the transformation
7964 matrix. See emboss_matrix for an example.
7966 COLOR_ADJUST is a color adjustment added to each pixel of the
7970 x_detect_edges (f
, img
, matrix
, color_adjust
)
7973 int matrix
[9], color_adjust
;
7975 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7979 for (i
= sum
= 0; i
< 9; ++i
)
7980 sum
+= abs (matrix
[i
]);
7982 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7984 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7986 for (y
= 0; y
< img
->height
; ++y
)
7988 p
= COLOR (new, 0, y
);
7989 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7990 p
= COLOR (new, img
->width
- 1, y
);
7991 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7994 for (x
= 1; x
< img
->width
- 1; ++x
)
7996 p
= COLOR (new, x
, 0);
7997 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7998 p
= COLOR (new, x
, img
->height
- 1);
7999 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8002 for (y
= 1; y
< img
->height
- 1; ++y
)
8004 p
= COLOR (new, 1, y
);
8006 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
8008 int r
, g
, b
, y1
, x1
;
8011 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
8012 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
8015 XColor
*t
= COLOR (colors
, x1
, y1
);
8016 r
+= matrix
[i
] * t
->red
;
8017 g
+= matrix
[i
] * t
->green
;
8018 b
+= matrix
[i
] * t
->blue
;
8021 r
= (r
/ sum
+ color_adjust
) & 0xffff;
8022 g
= (g
/ sum
+ color_adjust
) & 0xffff;
8023 b
= (b
/ sum
+ color_adjust
) & 0xffff;
8024 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
8029 x_from_xcolors (f
, img
, new);
8035 /* Perform the pre-defined `emboss' edge-detection on image IMG
8043 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
8047 /* Perform the pre-defined `laplace' edge-detection on image IMG
8055 x_detect_edges (f
, img
, laplace_matrix
, 45000);
8059 /* Perform edge-detection on image IMG on frame F, with specified
8060 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
8062 MATRIX must be either
8064 - a list of at least 9 numbers in row-major form
8065 - a vector of at least 9 numbers
8067 COLOR_ADJUST nil means use a default; otherwise it must be a
8071 x_edge_detection (f
, img
, matrix
, color_adjust
)
8074 Lisp_Object matrix
, color_adjust
;
8082 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
8083 ++i
, matrix
= XCDR (matrix
))
8084 trans
[i
] = XFLOATINT (XCAR (matrix
));
8086 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
8088 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
8089 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
8092 if (NILP (color_adjust
))
8093 color_adjust
= make_number (0xffff / 2);
8095 if (i
== 9 && NUMBERP (color_adjust
))
8096 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
8100 /* Transform image IMG on frame F so that it looks disabled. */
8103 x_disable_image (f
, img
)
8107 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
8109 if (dpyinfo
->n_planes
>= 2)
8111 /* Color (or grayscale). Convert to gray, and equalize. Just
8112 drawing such images with a stipple can look very odd, so
8113 we're using this method instead. */
8114 XColor
*colors
= x_to_xcolors (f
, img
, 1);
8116 const int h
= 15000;
8117 const int l
= 30000;
8119 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
8123 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
8124 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
8125 p
->red
= p
->green
= p
->blue
= i2
;
8128 x_from_xcolors (f
, img
, colors
);
8131 /* Draw a cross over the disabled image, if we must or if we
8133 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
8135 Display
*dpy
= FRAME_X_DISPLAY (f
);
8138 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
8139 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
8140 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
8141 img
->width
- 1, img
->height
- 1);
8142 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
8148 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
8149 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
8150 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
8151 img
->width
- 1, img
->height
- 1);
8152 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
8160 /* Build a mask for image IMG which is used on frame F. FILE is the
8161 name of an image file, for error messages. HOW determines how to
8162 determine the background color of IMG. If it is a list '(R G B)',
8163 with R, G, and B being integers >= 0, take that as the color of the
8164 background. Otherwise, determine the background color of IMG
8165 heuristically. Value is non-zero if successful. */
8168 x_build_heuristic_mask (f
, img
, how
)
8173 Display
*dpy
= FRAME_X_DISPLAY (f
);
8174 XImage
*ximg
, *mask_img
;
8175 int x
, y
, rc
, use_img_background
;
8176 unsigned long bg
= 0;
8180 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8182 img
->background_transparent_valid
= 0;
8185 /* Create an image and pixmap serving as mask. */
8186 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
8187 &mask_img
, &img
->mask
);
8191 /* Get the X image of IMG->pixmap. */
8192 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
8195 /* Determine the background color of ximg. If HOW is `(R G B)'
8196 take that as color. Otherwise, use the image's background color. */
8197 use_img_background
= 1;
8203 for (i
= 0; i
< 3 && CONSP (how
) && NATNUMP (XCAR (how
)); ++i
)
8205 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
8209 if (i
== 3 && NILP (how
))
8211 char color_name
[30];
8212 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
8213 bg
= x_alloc_image_color (f
, img
, build_string (color_name
), 0);
8214 use_img_background
= 0;
8218 if (use_img_background
)
8219 bg
= four_corners_best (ximg
, img
->width
, img
->height
);
8221 /* Set all bits in mask_img to 1 whose color in ximg is different
8222 from the background color bg. */
8223 for (y
= 0; y
< img
->height
; ++y
)
8224 for (x
= 0; x
< img
->width
; ++x
)
8225 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8227 /* Fill in the background_transparent field while we have the mask handy. */
8228 image_background_transparent (img
, f
, mask_img
);
8230 /* Put mask_img into img->mask. */
8231 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8232 x_destroy_x_image (mask_img
);
8233 XDestroyImage (ximg
);
8240 /***********************************************************************
8241 PBM (mono, gray, color)
8242 ***********************************************************************/
8244 static int pbm_image_p
P_ ((Lisp_Object object
));
8245 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8246 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8248 /* The symbol `pbm' identifying images of this type. */
8252 /* Indices of image specification fields in gs_format, below. */
8254 enum pbm_keyword_index
8270 /* Vector of image_keyword structures describing the format
8271 of valid user-defined image specifications. */
8273 static struct image_keyword pbm_format
[PBM_LAST
] =
8275 {":type", IMAGE_SYMBOL_VALUE
, 1},
8276 {":file", IMAGE_STRING_VALUE
, 0},
8277 {":data", IMAGE_STRING_VALUE
, 0},
8278 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8279 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8280 {":relief", IMAGE_INTEGER_VALUE
, 0},
8281 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8282 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8283 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8284 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8285 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8288 /* Structure describing the image type `pbm'. */
8290 static struct image_type pbm_type
=
8300 /* Return non-zero if OBJECT is a valid PBM image specification. */
8303 pbm_image_p (object
)
8306 struct image_keyword fmt
[PBM_LAST
];
8308 bcopy (pbm_format
, fmt
, sizeof fmt
);
8310 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8313 /* Must specify either :data or :file. */
8314 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8318 /* Scan a decimal number from *S and return it. Advance *S while
8319 reading the number. END is the end of the string. Value is -1 at
8323 pbm_scan_number (s
, end
)
8324 unsigned char **s
, *end
;
8326 int c
= 0, val
= -1;
8330 /* Skip white-space. */
8331 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8336 /* Skip comment to end of line. */
8337 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8340 else if (isdigit (c
))
8342 /* Read decimal number. */
8344 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8345 val
= 10 * val
+ c
- '0';
8356 /* Load PBM image IMG for use on frame F. */
8364 int width
, height
, max_color_idx
= 0;
8366 Lisp_Object file
, specified_file
;
8367 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8368 struct gcpro gcpro1
;
8369 unsigned char *contents
= NULL
;
8370 unsigned char *end
, *p
;
8373 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8377 if (STRINGP (specified_file
))
8379 file
= x_find_image_file (specified_file
);
8380 if (!STRINGP (file
))
8382 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8387 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8388 if (contents
== NULL
)
8390 image_error ("Error reading `%s'", file
, Qnil
);
8396 end
= contents
+ size
;
8401 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8402 p
= XSTRING (data
)->data
;
8403 end
= p
+ STRING_BYTES (XSTRING (data
));
8406 /* Check magic number. */
8407 if (end
- p
< 2 || *p
++ != 'P')
8409 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8419 raw_p
= 0, type
= PBM_MONO
;
8423 raw_p
= 0, type
= PBM_GRAY
;
8427 raw_p
= 0, type
= PBM_COLOR
;
8431 raw_p
= 1, type
= PBM_MONO
;
8435 raw_p
= 1, type
= PBM_GRAY
;
8439 raw_p
= 1, type
= PBM_COLOR
;
8443 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8447 /* Read width, height, maximum color-component. Characters
8448 starting with `#' up to the end of a line are ignored. */
8449 width
= pbm_scan_number (&p
, end
);
8450 height
= pbm_scan_number (&p
, end
);
8452 if (type
!= PBM_MONO
)
8454 max_color_idx
= pbm_scan_number (&p
, end
);
8455 if (raw_p
&& max_color_idx
> 255)
8456 max_color_idx
= 255;
8461 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8464 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8465 &ximg
, &img
->pixmap
))
8468 /* Initialize the color hash table. */
8469 init_color_table ();
8471 if (type
== PBM_MONO
)
8474 struct image_keyword fmt
[PBM_LAST
];
8475 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8476 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8478 /* Parse the image specification. */
8479 bcopy (pbm_format
, fmt
, sizeof fmt
);
8480 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8482 /* Get foreground and background colors, maybe allocate colors. */
8483 if (fmt
[PBM_FOREGROUND
].count
8484 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
8485 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8486 if (fmt
[PBM_BACKGROUND
].count
8487 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
8489 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8490 img
->background
= bg
;
8491 img
->background_valid
= 1;
8494 for (y
= 0; y
< height
; ++y
)
8495 for (x
= 0; x
< width
; ++x
)
8505 g
= pbm_scan_number (&p
, end
);
8507 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8512 for (y
= 0; y
< height
; ++y
)
8513 for (x
= 0; x
< width
; ++x
)
8517 if (type
== PBM_GRAY
)
8518 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8527 r
= pbm_scan_number (&p
, end
);
8528 g
= pbm_scan_number (&p
, end
);
8529 b
= pbm_scan_number (&p
, end
);
8532 if (r
< 0 || g
< 0 || b
< 0)
8536 XDestroyImage (ximg
);
8537 image_error ("Invalid pixel value in image `%s'",
8542 /* RGB values are now in the range 0..max_color_idx.
8543 Scale this to the range 0..0xffff supported by X. */
8544 r
= (double) r
* 65535 / max_color_idx
;
8545 g
= (double) g
* 65535 / max_color_idx
;
8546 b
= (double) b
* 65535 / max_color_idx
;
8547 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8551 /* Store in IMG->colors the colors allocated for the image, and
8552 free the color table. */
8553 img
->colors
= colors_in_color_table (&img
->ncolors
);
8554 free_color_table ();
8556 /* Maybe fill in the background field while we have ximg handy. */
8557 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
8558 IMAGE_BACKGROUND (img
, f
, ximg
);
8560 /* Put the image into a pixmap. */
8561 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8562 x_destroy_x_image (ximg
);
8565 img
->height
= height
;
8574 /***********************************************************************
8576 ***********************************************************************/
8582 /* Function prototypes. */
8584 static int png_image_p
P_ ((Lisp_Object object
));
8585 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8587 /* The symbol `png' identifying images of this type. */
8591 /* Indices of image specification fields in png_format, below. */
8593 enum png_keyword_index
8608 /* Vector of image_keyword structures describing the format
8609 of valid user-defined image specifications. */
8611 static struct image_keyword png_format
[PNG_LAST
] =
8613 {":type", IMAGE_SYMBOL_VALUE
, 1},
8614 {":data", IMAGE_STRING_VALUE
, 0},
8615 {":file", IMAGE_STRING_VALUE
, 0},
8616 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8617 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8618 {":relief", IMAGE_INTEGER_VALUE
, 0},
8619 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8620 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8621 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8622 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8625 /* Structure describing the image type `png'. */
8627 static struct image_type png_type
=
8637 /* Return non-zero if OBJECT is a valid PNG image specification. */
8640 png_image_p (object
)
8643 struct image_keyword fmt
[PNG_LAST
];
8644 bcopy (png_format
, fmt
, sizeof fmt
);
8646 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8649 /* Must specify either the :data or :file keyword. */
8650 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8654 /* Error and warning handlers installed when the PNG library
8658 my_png_error (png_ptr
, msg
)
8659 png_struct
*png_ptr
;
8662 xassert (png_ptr
!= NULL
);
8663 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8664 longjmp (png_ptr
->jmpbuf
, 1);
8669 my_png_warning (png_ptr
, msg
)
8670 png_struct
*png_ptr
;
8673 xassert (png_ptr
!= NULL
);
8674 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8677 /* Memory source for PNG decoding. */
8679 struct png_memory_storage
8681 unsigned char *bytes
; /* The data */
8682 size_t len
; /* How big is it? */
8683 int index
; /* Where are we? */
8687 /* Function set as reader function when reading PNG image from memory.
8688 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8689 bytes from the input to DATA. */
8692 png_read_from_memory (png_ptr
, data
, length
)
8693 png_structp png_ptr
;
8697 struct png_memory_storage
*tbr
8698 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8700 if (length
> tbr
->len
- tbr
->index
)
8701 png_error (png_ptr
, "Read error");
8703 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8704 tbr
->index
= tbr
->index
+ length
;
8707 /* Load PNG image IMG for use on frame F. Value is non-zero if
8715 Lisp_Object file
, specified_file
;
8716 Lisp_Object specified_data
;
8718 XImage
*ximg
, *mask_img
= NULL
;
8719 struct gcpro gcpro1
;
8720 png_struct
*png_ptr
= NULL
;
8721 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8722 FILE *volatile fp
= NULL
;
8724 png_byte
* volatile pixels
= NULL
;
8725 png_byte
** volatile rows
= NULL
;
8726 png_uint_32 width
, height
;
8727 int bit_depth
, color_type
, interlace_type
;
8729 png_uint_32 row_bytes
;
8732 double screen_gamma
, image_gamma
;
8734 struct png_memory_storage tbr
; /* Data to be read */
8736 /* Find out what file to load. */
8737 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8738 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8742 if (NILP (specified_data
))
8744 file
= x_find_image_file (specified_file
);
8745 if (!STRINGP (file
))
8747 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8752 /* Open the image file. */
8753 fp
= fopen (XSTRING (file
)->data
, "rb");
8756 image_error ("Cannot open image file `%s'", file
, Qnil
);
8762 /* Check PNG signature. */
8763 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8764 || !png_check_sig (sig
, sizeof sig
))
8766 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8774 /* Read from memory. */
8775 tbr
.bytes
= XSTRING (specified_data
)->data
;
8776 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8779 /* Check PNG signature. */
8780 if (tbr
.len
< sizeof sig
8781 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8783 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8788 /* Need to skip past the signature. */
8789 tbr
.bytes
+= sizeof (sig
);
8792 /* Initialize read and info structs for PNG lib. */
8793 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8794 my_png_error
, my_png_warning
);
8797 if (fp
) fclose (fp
);
8802 info_ptr
= png_create_info_struct (png_ptr
);
8805 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8806 if (fp
) fclose (fp
);
8811 end_info
= png_create_info_struct (png_ptr
);
8814 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8815 if (fp
) fclose (fp
);
8820 /* Set error jump-back. We come back here when the PNG library
8821 detects an error. */
8822 if (setjmp (png_ptr
->jmpbuf
))
8826 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8829 if (fp
) fclose (fp
);
8834 /* Read image info. */
8835 if (!NILP (specified_data
))
8836 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8838 png_init_io (png_ptr
, fp
);
8840 png_set_sig_bytes (png_ptr
, sizeof sig
);
8841 png_read_info (png_ptr
, info_ptr
);
8842 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8843 &interlace_type
, NULL
, NULL
);
8845 /* If image contains simply transparency data, we prefer to
8846 construct a clipping mask. */
8847 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8852 /* This function is easier to write if we only have to handle
8853 one data format: RGB or RGBA with 8 bits per channel. Let's
8854 transform other formats into that format. */
8856 /* Strip more than 8 bits per channel. */
8857 if (bit_depth
== 16)
8858 png_set_strip_16 (png_ptr
);
8860 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8862 png_set_expand (png_ptr
);
8864 /* Convert grayscale images to RGB. */
8865 if (color_type
== PNG_COLOR_TYPE_GRAY
8866 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8867 png_set_gray_to_rgb (png_ptr
);
8869 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8870 gamma_str
= getenv ("SCREEN_GAMMA");
8871 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8873 /* Tell the PNG lib to handle gamma correction for us. */
8875 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8876 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8877 /* There is a special chunk in the image specifying the gamma. */
8878 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8881 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8882 /* Image contains gamma information. */
8883 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8885 /* Use a default of 0.5 for the image gamma. */
8886 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8888 /* Handle alpha channel by combining the image with a background
8889 color. Do this only if a real alpha channel is supplied. For
8890 simple transparency, we prefer a clipping mask. */
8893 png_color_16
*image_bg
;
8894 Lisp_Object specified_bg
8895 = image_spec_value (img
->spec
, QCbackground
, NULL
);
8897 if (STRINGP (specified_bg
))
8898 /* The user specified `:background', use that. */
8901 if (x_defined_color (f
, XSTRING (specified_bg
)->data
, &color
, 0))
8903 png_color_16 user_bg
;
8905 bzero (&user_bg
, sizeof user_bg
);
8906 user_bg
.red
= color
.red
;
8907 user_bg
.green
= color
.green
;
8908 user_bg
.blue
= color
.blue
;
8910 png_set_background (png_ptr
, &user_bg
,
8911 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8914 else if (png_get_bKGD (png_ptr
, info_ptr
, &image_bg
))
8915 /* Image contains a background color with which to
8916 combine the image. */
8917 png_set_background (png_ptr
, image_bg
,
8918 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8921 /* Image does not contain a background color with which
8922 to combine the image data via an alpha channel. Use
8923 the frame's background instead. */
8926 png_color_16 frame_background
;
8928 cmap
= FRAME_X_COLORMAP (f
);
8929 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8930 x_query_color (f
, &color
);
8932 bzero (&frame_background
, sizeof frame_background
);
8933 frame_background
.red
= color
.red
;
8934 frame_background
.green
= color
.green
;
8935 frame_background
.blue
= color
.blue
;
8937 png_set_background (png_ptr
, &frame_background
,
8938 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8942 /* Update info structure. */
8943 png_read_update_info (png_ptr
, info_ptr
);
8945 /* Get number of channels. Valid values are 1 for grayscale images
8946 and images with a palette, 2 for grayscale images with transparency
8947 information (alpha channel), 3 for RGB images, and 4 for RGB
8948 images with alpha channel, i.e. RGBA. If conversions above were
8949 sufficient we should only have 3 or 4 channels here. */
8950 channels
= png_get_channels (png_ptr
, info_ptr
);
8951 xassert (channels
== 3 || channels
== 4);
8953 /* Number of bytes needed for one row of the image. */
8954 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8956 /* Allocate memory for the image. */
8957 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8958 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8959 for (i
= 0; i
< height
; ++i
)
8960 rows
[i
] = pixels
+ i
* row_bytes
;
8962 /* Read the entire image. */
8963 png_read_image (png_ptr
, rows
);
8964 png_read_end (png_ptr
, info_ptr
);
8971 /* Create the X image and pixmap. */
8972 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8976 /* Create an image and pixmap serving as mask if the PNG image
8977 contains an alpha channel. */
8980 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8981 &mask_img
, &img
->mask
))
8983 x_destroy_x_image (ximg
);
8984 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8989 /* Fill the X image and mask from PNG data. */
8990 init_color_table ();
8992 for (y
= 0; y
< height
; ++y
)
8994 png_byte
*p
= rows
[y
];
8996 for (x
= 0; x
< width
; ++x
)
9003 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
9005 /* An alpha channel, aka mask channel, associates variable
9006 transparency with an image. Where other image formats
9007 support binary transparency---fully transparent or fully
9008 opaque---PNG allows up to 254 levels of partial transparency.
9009 The PNG library implements partial transparency by combining
9010 the image with a specified background color.
9012 I'm not sure how to handle this here nicely: because the
9013 background on which the image is displayed may change, for
9014 real alpha channel support, it would be necessary to create
9015 a new image for each possible background.
9017 What I'm doing now is that a mask is created if we have
9018 boolean transparency information. Otherwise I'm using
9019 the frame's background color to combine the image with. */
9024 XPutPixel (mask_img
, x
, y
, *p
> 0);
9030 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9031 /* Set IMG's background color from the PNG image, unless the user
9035 if (png_get_bKGD (png_ptr
, info_ptr
, &bg
))
9037 img
->background
= lookup_rgb_color (f
, bg
->red
, bg
->green
, bg
->blue
);
9038 img
->background_valid
= 1;
9042 /* Remember colors allocated for this image. */
9043 img
->colors
= colors_in_color_table (&img
->ncolors
);
9044 free_color_table ();
9047 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
9052 img
->height
= height
;
9054 /* Maybe fill in the background field while we have ximg handy. */
9055 IMAGE_BACKGROUND (img
, f
, ximg
);
9057 /* Put the image into the pixmap, then free the X image and its buffer. */
9058 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9059 x_destroy_x_image (ximg
);
9061 /* Same for the mask. */
9064 /* Fill in the background_transparent field while we have the mask
9066 image_background_transparent (img
, f
, mask_img
);
9068 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
9069 x_destroy_x_image (mask_img
);
9076 #endif /* HAVE_PNG != 0 */
9080 /***********************************************************************
9082 ***********************************************************************/
9086 /* Work around a warning about HAVE_STDLIB_H being redefined in
9088 #ifdef HAVE_STDLIB_H
9089 #define HAVE_STDLIB_H_1
9090 #undef HAVE_STDLIB_H
9091 #endif /* HAVE_STLIB_H */
9093 #include <jpeglib.h>
9097 #ifdef HAVE_STLIB_H_1
9098 #define HAVE_STDLIB_H 1
9101 static int jpeg_image_p
P_ ((Lisp_Object object
));
9102 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
9104 /* The symbol `jpeg' identifying images of this type. */
9108 /* Indices of image specification fields in gs_format, below. */
9110 enum jpeg_keyword_index
9119 JPEG_HEURISTIC_MASK
,
9125 /* Vector of image_keyword structures describing the format
9126 of valid user-defined image specifications. */
9128 static struct image_keyword jpeg_format
[JPEG_LAST
] =
9130 {":type", IMAGE_SYMBOL_VALUE
, 1},
9131 {":data", IMAGE_STRING_VALUE
, 0},
9132 {":file", IMAGE_STRING_VALUE
, 0},
9133 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9134 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9135 {":relief", IMAGE_INTEGER_VALUE
, 0},
9136 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9137 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9138 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9139 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9142 /* Structure describing the image type `jpeg'. */
9144 static struct image_type jpeg_type
=
9154 /* Return non-zero if OBJECT is a valid JPEG image specification. */
9157 jpeg_image_p (object
)
9160 struct image_keyword fmt
[JPEG_LAST
];
9162 bcopy (jpeg_format
, fmt
, sizeof fmt
);
9164 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
9167 /* Must specify either the :data or :file keyword. */
9168 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
9172 struct my_jpeg_error_mgr
9174 struct jpeg_error_mgr pub
;
9175 jmp_buf setjmp_buffer
;
9180 my_error_exit (cinfo
)
9183 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
9184 longjmp (mgr
->setjmp_buffer
, 1);
9188 /* Init source method for JPEG data source manager. Called by
9189 jpeg_read_header() before any data is actually read. See
9190 libjpeg.doc from the JPEG lib distribution. */
9193 our_init_source (cinfo
)
9194 j_decompress_ptr cinfo
;
9199 /* Fill input buffer method for JPEG data source manager. Called
9200 whenever more data is needed. We read the whole image in one step,
9201 so this only adds a fake end of input marker at the end. */
9204 our_fill_input_buffer (cinfo
)
9205 j_decompress_ptr cinfo
;
9207 /* Insert a fake EOI marker. */
9208 struct jpeg_source_mgr
*src
= cinfo
->src
;
9209 static JOCTET buffer
[2];
9211 buffer
[0] = (JOCTET
) 0xFF;
9212 buffer
[1] = (JOCTET
) JPEG_EOI
;
9214 src
->next_input_byte
= buffer
;
9215 src
->bytes_in_buffer
= 2;
9220 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9221 is the JPEG data source manager. */
9224 our_skip_input_data (cinfo
, num_bytes
)
9225 j_decompress_ptr cinfo
;
9228 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9232 if (num_bytes
> src
->bytes_in_buffer
)
9233 ERREXIT (cinfo
, JERR_INPUT_EOF
);
9235 src
->bytes_in_buffer
-= num_bytes
;
9236 src
->next_input_byte
+= num_bytes
;
9241 /* Method to terminate data source. Called by
9242 jpeg_finish_decompress() after all data has been processed. */
9245 our_term_source (cinfo
)
9246 j_decompress_ptr cinfo
;
9251 /* Set up the JPEG lib for reading an image from DATA which contains
9252 LEN bytes. CINFO is the decompression info structure created for
9253 reading the image. */
9256 jpeg_memory_src (cinfo
, data
, len
)
9257 j_decompress_ptr cinfo
;
9261 struct jpeg_source_mgr
*src
;
9263 if (cinfo
->src
== NULL
)
9265 /* First time for this JPEG object? */
9266 cinfo
->src
= (struct jpeg_source_mgr
*)
9267 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9268 sizeof (struct jpeg_source_mgr
));
9269 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9270 src
->next_input_byte
= data
;
9273 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9274 src
->init_source
= our_init_source
;
9275 src
->fill_input_buffer
= our_fill_input_buffer
;
9276 src
->skip_input_data
= our_skip_input_data
;
9277 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9278 src
->term_source
= our_term_source
;
9279 src
->bytes_in_buffer
= len
;
9280 src
->next_input_byte
= data
;
9284 /* Load image IMG for use on frame F. Patterned after example.c
9285 from the JPEG lib. */
9292 struct jpeg_decompress_struct cinfo
;
9293 struct my_jpeg_error_mgr mgr
;
9294 Lisp_Object file
, specified_file
;
9295 Lisp_Object specified_data
;
9296 FILE * volatile fp
= NULL
;
9298 int row_stride
, x
, y
;
9299 XImage
*ximg
= NULL
;
9301 unsigned long *colors
;
9303 struct gcpro gcpro1
;
9305 /* Open the JPEG file. */
9306 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9307 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9311 if (NILP (specified_data
))
9313 file
= x_find_image_file (specified_file
);
9314 if (!STRINGP (file
))
9316 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9321 fp
= fopen (XSTRING (file
)->data
, "r");
9324 image_error ("Cannot open `%s'", file
, Qnil
);
9330 /* Customize libjpeg's error handling to call my_error_exit when an
9331 error is detected. This function will perform a longjmp. */
9332 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9333 mgr
.pub
.error_exit
= my_error_exit
;
9335 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9339 /* Called from my_error_exit. Display a JPEG error. */
9340 char buffer
[JMSG_LENGTH_MAX
];
9341 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9342 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9343 build_string (buffer
));
9346 /* Close the input file and destroy the JPEG object. */
9348 fclose ((FILE *) fp
);
9349 jpeg_destroy_decompress (&cinfo
);
9351 /* If we already have an XImage, free that. */
9352 x_destroy_x_image (ximg
);
9354 /* Free pixmap and colors. */
9355 x_clear_image (f
, img
);
9361 /* Create the JPEG decompression object. Let it read from fp.
9362 Read the JPEG image header. */
9363 jpeg_create_decompress (&cinfo
);
9365 if (NILP (specified_data
))
9366 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9368 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9369 STRING_BYTES (XSTRING (specified_data
)));
9371 jpeg_read_header (&cinfo
, TRUE
);
9373 /* Customize decompression so that color quantization will be used.
9374 Start decompression. */
9375 cinfo
.quantize_colors
= TRUE
;
9376 jpeg_start_decompress (&cinfo
);
9377 width
= img
->width
= cinfo
.output_width
;
9378 height
= img
->height
= cinfo
.output_height
;
9380 /* Create X image and pixmap. */
9381 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9382 longjmp (mgr
.setjmp_buffer
, 2);
9384 /* Allocate colors. When color quantization is used,
9385 cinfo.actual_number_of_colors has been set with the number of
9386 colors generated, and cinfo.colormap is a two-dimensional array
9387 of color indices in the range 0..cinfo.actual_number_of_colors.
9388 No more than 255 colors will be generated. */
9392 if (cinfo
.out_color_components
> 2)
9393 ir
= 0, ig
= 1, ib
= 2;
9394 else if (cinfo
.out_color_components
> 1)
9395 ir
= 0, ig
= 1, ib
= 0;
9397 ir
= 0, ig
= 0, ib
= 0;
9399 /* Use the color table mechanism because it handles colors that
9400 cannot be allocated nicely. Such colors will be replaced with
9401 a default color, and we don't have to care about which colors
9402 can be freed safely, and which can't. */
9403 init_color_table ();
9404 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9407 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9409 /* Multiply RGB values with 255 because X expects RGB values
9410 in the range 0..0xffff. */
9411 int r
= cinfo
.colormap
[ir
][i
] << 8;
9412 int g
= cinfo
.colormap
[ig
][i
] << 8;
9413 int b
= cinfo
.colormap
[ib
][i
] << 8;
9414 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9417 /* Remember those colors actually allocated. */
9418 img
->colors
= colors_in_color_table (&img
->ncolors
);
9419 free_color_table ();
9423 row_stride
= width
* cinfo
.output_components
;
9424 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9426 for (y
= 0; y
< height
; ++y
)
9428 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9429 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9430 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9434 jpeg_finish_decompress (&cinfo
);
9435 jpeg_destroy_decompress (&cinfo
);
9437 fclose ((FILE *) fp
);
9439 /* Maybe fill in the background field while we have ximg handy. */
9440 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9441 IMAGE_BACKGROUND (img
, f
, ximg
);
9443 /* Put the image into the pixmap. */
9444 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9445 x_destroy_x_image (ximg
);
9450 #endif /* HAVE_JPEG */
9454 /***********************************************************************
9456 ***********************************************************************/
9462 static int tiff_image_p
P_ ((Lisp_Object object
));
9463 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9465 /* The symbol `tiff' identifying images of this type. */
9469 /* Indices of image specification fields in tiff_format, below. */
9471 enum tiff_keyword_index
9480 TIFF_HEURISTIC_MASK
,
9486 /* Vector of image_keyword structures describing the format
9487 of valid user-defined image specifications. */
9489 static struct image_keyword tiff_format
[TIFF_LAST
] =
9491 {":type", IMAGE_SYMBOL_VALUE
, 1},
9492 {":data", IMAGE_STRING_VALUE
, 0},
9493 {":file", IMAGE_STRING_VALUE
, 0},
9494 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9495 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9496 {":relief", IMAGE_INTEGER_VALUE
, 0},
9497 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9498 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9499 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9500 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9503 /* Structure describing the image type `tiff'. */
9505 static struct image_type tiff_type
=
9515 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9518 tiff_image_p (object
)
9521 struct image_keyword fmt
[TIFF_LAST
];
9522 bcopy (tiff_format
, fmt
, sizeof fmt
);
9524 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9527 /* Must specify either the :data or :file keyword. */
9528 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9532 /* Reading from a memory buffer for TIFF images Based on the PNG
9533 memory source, but we have to provide a lot of extra functions.
9536 We really only need to implement read and seek, but I am not
9537 convinced that the TIFF library is smart enough not to destroy
9538 itself if we only hand it the function pointers we need to
9543 unsigned char *bytes
;
9551 tiff_read_from_memory (data
, buf
, size
)
9556 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9558 if (size
> src
->len
- src
->index
)
9560 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9567 tiff_write_from_memory (data
, buf
, size
)
9577 tiff_seek_in_memory (data
, off
, whence
)
9582 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9587 case SEEK_SET
: /* Go from beginning of source. */
9591 case SEEK_END
: /* Go from end of source. */
9592 idx
= src
->len
+ off
;
9595 case SEEK_CUR
: /* Go from current position. */
9596 idx
= src
->index
+ off
;
9599 default: /* Invalid `whence'. */
9603 if (idx
> src
->len
|| idx
< 0)
9612 tiff_close_memory (data
)
9621 tiff_mmap_memory (data
, pbase
, psize
)
9626 /* It is already _IN_ memory. */
9632 tiff_unmap_memory (data
, base
, size
)
9637 /* We don't need to do this. */
9642 tiff_size_of_memory (data
)
9645 return ((tiff_memory_source
*) data
)->len
;
9650 tiff_error_handler (title
, format
, ap
)
9651 const char *title
, *format
;
9657 len
= sprintf (buf
, "TIFF error: %s ", title
);
9658 vsprintf (buf
+ len
, format
, ap
);
9659 add_to_log (buf
, Qnil
, Qnil
);
9664 tiff_warning_handler (title
, format
, ap
)
9665 const char *title
, *format
;
9671 len
= sprintf (buf
, "TIFF warning: %s ", title
);
9672 vsprintf (buf
+ len
, format
, ap
);
9673 add_to_log (buf
, Qnil
, Qnil
);
9677 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9685 Lisp_Object file
, specified_file
;
9686 Lisp_Object specified_data
;
9688 int width
, height
, x
, y
;
9692 struct gcpro gcpro1
;
9693 tiff_memory_source memsrc
;
9695 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9696 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9700 TIFFSetErrorHandler (tiff_error_handler
);
9701 TIFFSetWarningHandler (tiff_warning_handler
);
9703 if (NILP (specified_data
))
9705 /* Read from a file */
9706 file
= x_find_image_file (specified_file
);
9707 if (!STRINGP (file
))
9709 image_error ("Cannot find image file `%s'", file
, Qnil
);
9714 /* Try to open the image file. */
9715 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9718 image_error ("Cannot open `%s'", file
, Qnil
);
9725 /* Memory source! */
9726 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9727 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9730 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9731 (TIFFReadWriteProc
) tiff_read_from_memory
,
9732 (TIFFReadWriteProc
) tiff_write_from_memory
,
9733 tiff_seek_in_memory
,
9735 tiff_size_of_memory
,
9741 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9747 /* Get width and height of the image, and allocate a raster buffer
9748 of width x height 32-bit values. */
9749 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9750 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9751 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9753 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9757 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9763 /* Create the X image and pixmap. */
9764 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9771 /* Initialize the color table. */
9772 init_color_table ();
9774 /* Process the pixel raster. Origin is in the lower-left corner. */
9775 for (y
= 0; y
< height
; ++y
)
9777 uint32
*row
= buf
+ y
* width
;
9779 for (x
= 0; x
< width
; ++x
)
9781 uint32 abgr
= row
[x
];
9782 int r
= TIFFGetR (abgr
) << 8;
9783 int g
= TIFFGetG (abgr
) << 8;
9784 int b
= TIFFGetB (abgr
) << 8;
9785 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9789 /* Remember the colors allocated for the image. Free the color table. */
9790 img
->colors
= colors_in_color_table (&img
->ncolors
);
9791 free_color_table ();
9794 img
->height
= height
;
9796 /* Maybe fill in the background field while we have ximg handy. */
9797 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9798 IMAGE_BACKGROUND (img
, f
, ximg
);
9800 /* Put the image into the pixmap, then free the X image and its buffer. */
9801 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9802 x_destroy_x_image (ximg
);
9809 #endif /* HAVE_TIFF != 0 */
9813 /***********************************************************************
9815 ***********************************************************************/
9819 #include <gif_lib.h>
9821 static int gif_image_p
P_ ((Lisp_Object object
));
9822 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9824 /* The symbol `gif' identifying images of this type. */
9828 /* Indices of image specification fields in gif_format, below. */
9830 enum gif_keyword_index
9846 /* Vector of image_keyword structures describing the format
9847 of valid user-defined image specifications. */
9849 static struct image_keyword gif_format
[GIF_LAST
] =
9851 {":type", IMAGE_SYMBOL_VALUE
, 1},
9852 {":data", IMAGE_STRING_VALUE
, 0},
9853 {":file", IMAGE_STRING_VALUE
, 0},
9854 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9855 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9856 {":relief", IMAGE_INTEGER_VALUE
, 0},
9857 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9858 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9859 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9860 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9861 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9864 /* Structure describing the image type `gif'. */
9866 static struct image_type gif_type
=
9876 /* Return non-zero if OBJECT is a valid GIF image specification. */
9879 gif_image_p (object
)
9882 struct image_keyword fmt
[GIF_LAST
];
9883 bcopy (gif_format
, fmt
, sizeof fmt
);
9885 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9888 /* Must specify either the :data or :file keyword. */
9889 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9893 /* Reading a GIF image from memory
9894 Based on the PNG memory stuff to a certain extent. */
9898 unsigned char *bytes
;
9905 /* Make the current memory source available to gif_read_from_memory.
9906 It's done this way because not all versions of libungif support
9907 a UserData field in the GifFileType structure. */
9908 static gif_memory_source
*current_gif_memory_src
;
9911 gif_read_from_memory (file
, buf
, len
)
9916 gif_memory_source
*src
= current_gif_memory_src
;
9918 if (len
> src
->len
- src
->index
)
9921 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9927 /* Load GIF image IMG for use on frame F. Value is non-zero if
9935 Lisp_Object file
, specified_file
;
9936 Lisp_Object specified_data
;
9937 int rc
, width
, height
, x
, y
, i
;
9939 ColorMapObject
*gif_color_map
;
9940 unsigned long pixel_colors
[256];
9942 struct gcpro gcpro1
;
9944 int ino
, image_left
, image_top
, image_width
, image_height
;
9945 gif_memory_source memsrc
;
9946 unsigned char *raster
;
9948 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9949 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9953 if (NILP (specified_data
))
9955 file
= x_find_image_file (specified_file
);
9956 if (!STRINGP (file
))
9958 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9963 /* Open the GIF file. */
9964 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9967 image_error ("Cannot open `%s'", file
, Qnil
);
9974 /* Read from memory! */
9975 current_gif_memory_src
= &memsrc
;
9976 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9977 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9980 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9983 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9989 /* Read entire contents. */
9990 rc
= DGifSlurp (gif
);
9991 if (rc
== GIF_ERROR
)
9993 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9994 DGifCloseFile (gif
);
9999 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
10000 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
10001 if (ino
>= gif
->ImageCount
)
10003 image_error ("Invalid image number `%s' in image `%s'",
10005 DGifCloseFile (gif
);
10010 width
= img
->width
= gif
->SWidth
;
10011 height
= img
->height
= gif
->SHeight
;
10013 /* Create the X image and pixmap. */
10014 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
10016 DGifCloseFile (gif
);
10021 /* Allocate colors. */
10022 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
10023 if (!gif_color_map
)
10024 gif_color_map
= gif
->SColorMap
;
10025 init_color_table ();
10026 bzero (pixel_colors
, sizeof pixel_colors
);
10028 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
10030 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
10031 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
10032 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
10033 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
10036 img
->colors
= colors_in_color_table (&img
->ncolors
);
10037 free_color_table ();
10039 /* Clear the part of the screen image that are not covered by
10040 the image from the GIF file. Full animated GIF support
10041 requires more than can be done here (see the gif89 spec,
10042 disposal methods). Let's simply assume that the part
10043 not covered by a sub-image is in the frame's background color. */
10044 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
10045 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
10046 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
10047 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
10049 for (y
= 0; y
< image_top
; ++y
)
10050 for (x
= 0; x
< width
; ++x
)
10051 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10053 for (y
= image_top
+ image_height
; y
< height
; ++y
)
10054 for (x
= 0; x
< width
; ++x
)
10055 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10057 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
10059 for (x
= 0; x
< image_left
; ++x
)
10060 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10061 for (x
= image_left
+ image_width
; x
< width
; ++x
)
10062 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10065 /* Read the GIF image into the X image. We use a local variable
10066 `raster' here because RasterBits below is a char *, and invites
10067 problems with bytes >= 0x80. */
10068 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
10070 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
10072 static int interlace_start
[] = {0, 4, 2, 1};
10073 static int interlace_increment
[] = {8, 8, 4, 2};
10075 int row
= interlace_start
[0];
10079 for (y
= 0; y
< image_height
; y
++)
10081 if (row
>= image_height
)
10083 row
= interlace_start
[++pass
];
10084 while (row
>= image_height
)
10085 row
= interlace_start
[++pass
];
10088 for (x
= 0; x
< image_width
; x
++)
10090 int i
= raster
[(y
* image_width
) + x
];
10091 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
10095 row
+= interlace_increment
[pass
];
10100 for (y
= 0; y
< image_height
; ++y
)
10101 for (x
= 0; x
< image_width
; ++x
)
10103 int i
= raster
[y
* image_width
+ x
];
10104 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
10108 DGifCloseFile (gif
);
10110 /* Maybe fill in the background field while we have ximg handy. */
10111 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10112 IMAGE_BACKGROUND (img
, f
, ximg
);
10114 /* Put the image into the pixmap, then free the X image and its buffer. */
10115 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10116 x_destroy_x_image (ximg
);
10122 #endif /* HAVE_GIF != 0 */
10126 /***********************************************************************
10128 ***********************************************************************/
10130 static int gs_image_p
P_ ((Lisp_Object object
));
10131 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
10132 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
10134 /* The symbol `postscript' identifying images of this type. */
10136 Lisp_Object Qpostscript
;
10138 /* Keyword symbols. */
10140 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
10142 /* Indices of image specification fields in gs_format, below. */
10144 enum gs_keyword_index
10162 /* Vector of image_keyword structures describing the format
10163 of valid user-defined image specifications. */
10165 static struct image_keyword gs_format
[GS_LAST
] =
10167 {":type", IMAGE_SYMBOL_VALUE
, 1},
10168 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10169 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10170 {":file", IMAGE_STRING_VALUE
, 1},
10171 {":loader", IMAGE_FUNCTION_VALUE
, 0},
10172 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
10173 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10174 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10175 {":relief", IMAGE_INTEGER_VALUE
, 0},
10176 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10177 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10178 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10179 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10182 /* Structure describing the image type `ghostscript'. */
10184 static struct image_type gs_type
=
10194 /* Free X resources of Ghostscript image IMG which is used on frame F. */
10197 gs_clear_image (f
, img
)
10201 /* IMG->data.ptr_val may contain a recorded colormap. */
10202 xfree (img
->data
.ptr_val
);
10203 x_clear_image (f
, img
);
10207 /* Return non-zero if OBJECT is a valid Ghostscript image
10211 gs_image_p (object
)
10212 Lisp_Object object
;
10214 struct image_keyword fmt
[GS_LAST
];
10218 bcopy (gs_format
, fmt
, sizeof fmt
);
10220 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
10223 /* Bounding box must be a list or vector containing 4 integers. */
10224 tem
= fmt
[GS_BOUNDING_BOX
].value
;
10227 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
10228 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
10233 else if (VECTORP (tem
))
10235 if (XVECTOR (tem
)->size
!= 4)
10237 for (i
= 0; i
< 4; ++i
)
10238 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
10248 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
10257 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
10258 struct gcpro gcpro1
, gcpro2
;
10260 double in_width
, in_height
;
10261 Lisp_Object pixel_colors
= Qnil
;
10263 /* Compute pixel size of pixmap needed from the given size in the
10264 image specification. Sizes in the specification are in pt. 1 pt
10265 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10267 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
10268 in_width
= XFASTINT (pt_width
) / 72.0;
10269 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
10270 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
10271 in_height
= XFASTINT (pt_height
) / 72.0;
10272 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
10274 /* Create the pixmap. */
10275 xassert (img
->pixmap
== None
);
10276 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10277 img
->width
, img
->height
,
10278 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
10282 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
10286 /* Call the loader to fill the pixmap. It returns a process object
10287 if successful. We do not record_unwind_protect here because
10288 other places in redisplay like calling window scroll functions
10289 don't either. Let the Lisp loader use `unwind-protect' instead. */
10290 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
10292 sprintf (buffer
, "%lu %lu",
10293 (unsigned long) FRAME_X_WINDOW (f
),
10294 (unsigned long) img
->pixmap
);
10295 window_and_pixmap_id
= build_string (buffer
);
10297 sprintf (buffer
, "%lu %lu",
10298 FRAME_FOREGROUND_PIXEL (f
),
10299 FRAME_BACKGROUND_PIXEL (f
));
10300 pixel_colors
= build_string (buffer
);
10302 XSETFRAME (frame
, f
);
10303 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
10305 loader
= intern ("gs-load-image");
10307 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10308 make_number (img
->width
),
10309 make_number (img
->height
),
10310 window_and_pixmap_id
,
10313 return PROCESSP (img
->data
.lisp_val
);
10317 /* Kill the Ghostscript process that was started to fill PIXMAP on
10318 frame F. Called from XTread_socket when receiving an event
10319 telling Emacs that Ghostscript has finished drawing. */
10322 x_kill_gs_process (pixmap
, f
)
10326 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10330 /* Find the image containing PIXMAP. */
10331 for (i
= 0; i
< c
->used
; ++i
)
10332 if (c
->images
[i
]->pixmap
== pixmap
)
10335 /* Should someone in between have cleared the image cache, for
10336 instance, give up. */
10340 /* Kill the GS process. We should have found PIXMAP in the image
10341 cache and its image should contain a process object. */
10342 img
= c
->images
[i
];
10343 xassert (PROCESSP (img
->data
.lisp_val
));
10344 Fkill_process (img
->data
.lisp_val
, Qnil
);
10345 img
->data
.lisp_val
= Qnil
;
10347 /* On displays with a mutable colormap, figure out the colors
10348 allocated for the image by looking at the pixels of an XImage for
10350 class = FRAME_X_VISUAL (f
)->class;
10351 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10357 /* Try to get an XImage for img->pixmep. */
10358 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10359 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10364 /* Initialize the color table. */
10365 init_color_table ();
10367 /* For each pixel of the image, look its color up in the
10368 color table. After having done so, the color table will
10369 contain an entry for each color used by the image. */
10370 for (y
= 0; y
< img
->height
; ++y
)
10371 for (x
= 0; x
< img
->width
; ++x
)
10373 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10374 lookup_pixel_color (f
, pixel
);
10377 /* Record colors in the image. Free color table and XImage. */
10378 img
->colors
= colors_in_color_table (&img
->ncolors
);
10379 free_color_table ();
10380 XDestroyImage (ximg
);
10382 #if 0 /* This doesn't seem to be the case. If we free the colors
10383 here, we get a BadAccess later in x_clear_image when
10384 freeing the colors. */
10385 /* We have allocated colors once, but Ghostscript has also
10386 allocated colors on behalf of us. So, to get the
10387 reference counts right, free them once. */
10389 x_free_colors (f
, img
->colors
, img
->ncolors
);
10393 image_error ("Cannot get X image of `%s'; colors will not be freed",
10399 /* Now that we have the pixmap, compute mask and transform the
10400 image if requested. */
10402 postprocess_image (f
, img
);
10408 /***********************************************************************
10410 ***********************************************************************/
10412 DEFUN ("x-change-window-property", Fx_change_window_property
,
10413 Sx_change_window_property
, 2, 3, 0,
10414 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
10415 PROP and VALUE must be strings. FRAME nil or omitted means use the
10416 selected frame. Value is VALUE. */)
10417 (prop
, value
, frame
)
10418 Lisp_Object frame
, prop
, value
;
10420 struct frame
*f
= check_x_frame (frame
);
10423 CHECK_STRING (prop
);
10424 CHECK_STRING (value
);
10427 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10428 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10429 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10430 XSTRING (value
)->data
, XSTRING (value
)->size
);
10432 /* Make sure the property is set when we return. */
10433 XFlush (FRAME_X_DISPLAY (f
));
10440 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10441 Sx_delete_window_property
, 1, 2, 0,
10442 doc
: /* Remove window property PROP from X window of FRAME.
10443 FRAME nil or omitted means use the selected frame. Value is PROP. */)
10445 Lisp_Object prop
, frame
;
10447 struct frame
*f
= check_x_frame (frame
);
10450 CHECK_STRING (prop
);
10452 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10453 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10455 /* Make sure the property is removed when we return. */
10456 XFlush (FRAME_X_DISPLAY (f
));
10463 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10465 doc
: /* Value is the value of window property PROP on FRAME.
10466 If FRAME is nil or omitted, use the selected frame. Value is nil
10467 if FRAME hasn't a property with name PROP or if PROP has no string
10470 Lisp_Object prop
, frame
;
10472 struct frame
*f
= check_x_frame (frame
);
10475 Lisp_Object prop_value
= Qnil
;
10476 char *tmp_data
= NULL
;
10479 unsigned long actual_size
, bytes_remaining
;
10481 CHECK_STRING (prop
);
10483 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10484 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10485 prop_atom
, 0, 0, False
, XA_STRING
,
10486 &actual_type
, &actual_format
, &actual_size
,
10487 &bytes_remaining
, (unsigned char **) &tmp_data
);
10490 int size
= bytes_remaining
;
10495 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10496 prop_atom
, 0, bytes_remaining
,
10498 &actual_type
, &actual_format
,
10499 &actual_size
, &bytes_remaining
,
10500 (unsigned char **) &tmp_data
);
10501 if (rc
== Success
&& tmp_data
)
10502 prop_value
= make_string (tmp_data
, size
);
10513 /***********************************************************************
10515 ***********************************************************************/
10517 /* If non-null, an asynchronous timer that, when it expires, displays
10518 an hourglass cursor on all frames. */
10520 static struct atimer
*hourglass_atimer
;
10522 /* Non-zero means an hourglass cursor is currently shown. */
10524 static int hourglass_shown_p
;
10526 /* Number of seconds to wait before displaying an hourglass cursor. */
10528 static Lisp_Object Vhourglass_delay
;
10530 /* Default number of seconds to wait before displaying an hourglass
10533 #define DEFAULT_HOURGLASS_DELAY 1
10535 /* Function prototypes. */
10537 static void show_hourglass
P_ ((struct atimer
*));
10538 static void hide_hourglass
P_ ((void));
10541 /* Cancel a currently active hourglass timer, and start a new one. */
10547 int secs
, usecs
= 0;
10549 cancel_hourglass ();
10551 if (INTEGERP (Vhourglass_delay
)
10552 && XINT (Vhourglass_delay
) > 0)
10553 secs
= XFASTINT (Vhourglass_delay
);
10554 else if (FLOATP (Vhourglass_delay
)
10555 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10558 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10559 secs
= XFASTINT (tem
);
10560 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10563 secs
= DEFAULT_HOURGLASS_DELAY
;
10565 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10566 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10567 show_hourglass
, NULL
);
10571 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10575 cancel_hourglass ()
10577 if (hourglass_atimer
)
10579 cancel_atimer (hourglass_atimer
);
10580 hourglass_atimer
= NULL
;
10583 if (hourglass_shown_p
)
10588 /* Timer function of hourglass_atimer. TIMER is equal to
10591 Display an hourglass pointer on all frames by mapping the frames'
10592 hourglass_window. Set the hourglass_p flag in the frames'
10593 output_data.x structure to indicate that an hourglass cursor is
10594 shown on the frames. */
10597 show_hourglass (timer
)
10598 struct atimer
*timer
;
10600 /* The timer implementation will cancel this timer automatically
10601 after this function has run. Set hourglass_atimer to null
10602 so that we know the timer doesn't have to be canceled. */
10603 hourglass_atimer
= NULL
;
10605 if (!hourglass_shown_p
)
10607 Lisp_Object rest
, frame
;
10611 FOR_EACH_FRAME (rest
, frame
)
10613 struct frame
*f
= XFRAME (frame
);
10615 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10617 Display
*dpy
= FRAME_X_DISPLAY (f
);
10619 #ifdef USE_X_TOOLKIT
10620 if (f
->output_data
.x
->widget
)
10622 if (FRAME_OUTER_WINDOW (f
))
10625 f
->output_data
.x
->hourglass_p
= 1;
10627 if (!f
->output_data
.x
->hourglass_window
)
10629 unsigned long mask
= CWCursor
;
10630 XSetWindowAttributes attrs
;
10632 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10634 f
->output_data
.x
->hourglass_window
10635 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10636 0, 0, 32000, 32000, 0, 0,
10642 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10648 hourglass_shown_p
= 1;
10654 /* Hide the hourglass pointer on all frames, if it is currently
10660 if (hourglass_shown_p
)
10662 Lisp_Object rest
, frame
;
10665 FOR_EACH_FRAME (rest
, frame
)
10667 struct frame
*f
= XFRAME (frame
);
10670 /* Watch out for newly created frames. */
10671 && f
->output_data
.x
->hourglass_window
)
10673 XUnmapWindow (FRAME_X_DISPLAY (f
),
10674 f
->output_data
.x
->hourglass_window
);
10675 /* Sync here because XTread_socket looks at the
10676 hourglass_p flag that is reset to zero below. */
10677 XSync (FRAME_X_DISPLAY (f
), False
);
10678 f
->output_data
.x
->hourglass_p
= 0;
10682 hourglass_shown_p
= 0;
10689 /***********************************************************************
10691 ***********************************************************************/
10693 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10694 Lisp_Object
, Lisp_Object
));
10695 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10696 Lisp_Object
, int, int, int *, int *));
10698 /* The frame of a currently visible tooltip. */
10700 Lisp_Object tip_frame
;
10702 /* If non-nil, a timer started that hides the last tooltip when it
10705 Lisp_Object tip_timer
;
10708 /* If non-nil, a vector of 3 elements containing the last args
10709 with which x-show-tip was called. See there. */
10711 Lisp_Object last_show_tip_args
;
10713 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
10715 Lisp_Object Vx_max_tooltip_size
;
10719 unwind_create_tip_frame (frame
)
10722 Lisp_Object deleted
;
10724 deleted
= unwind_create_frame (frame
);
10725 if (EQ (deleted
, Qt
))
10735 /* Create a frame for a tooltip on the display described by DPYINFO.
10736 PARMS is a list of frame parameters. TEXT is the string to
10737 display in the tip frame. Value is the frame.
10739 Note that functions called here, esp. x_default_parameter can
10740 signal errors, for instance when a specified color name is
10741 undefined. We have to make sure that we're in a consistent state
10742 when this happens. */
10745 x_create_tip_frame (dpyinfo
, parms
, text
)
10746 struct x_display_info
*dpyinfo
;
10747 Lisp_Object parms
, text
;
10750 Lisp_Object frame
, tem
;
10752 long window_prompting
= 0;
10754 int count
= BINDING_STACK_SIZE ();
10755 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10757 int face_change_count_before
= face_change_count
;
10758 Lisp_Object buffer
;
10759 struct buffer
*old_buffer
;
10763 /* Use this general default value to start with until we know if
10764 this frame has a specified name. */
10765 Vx_resource_name
= Vinvocation_name
;
10767 #ifdef MULTI_KBOARD
10768 kb
= dpyinfo
->kboard
;
10770 kb
= &the_only_kboard
;
10773 /* Get the name of the frame to use for resource lookup. */
10774 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10775 if (!STRINGP (name
)
10776 && !EQ (name
, Qunbound
)
10778 error ("Invalid frame name--not a string or nil");
10779 Vx_resource_name
= name
;
10782 GCPRO3 (parms
, name
, frame
);
10783 f
= make_frame (1);
10784 XSETFRAME (frame
, f
);
10786 buffer
= Fget_buffer_create (build_string (" *tip*"));
10787 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10788 old_buffer
= current_buffer
;
10789 set_buffer_internal_1 (XBUFFER (buffer
));
10790 current_buffer
->truncate_lines
= Qnil
;
10792 Finsert (1, &text
);
10793 set_buffer_internal_1 (old_buffer
);
10795 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10796 record_unwind_protect (unwind_create_tip_frame
, frame
);
10798 /* By setting the output method, we're essentially saying that
10799 the frame is live, as per FRAME_LIVE_P. If we get a signal
10800 from this point on, x_destroy_window might screw up reference
10802 f
->output_method
= output_x_window
;
10803 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10804 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10805 f
->output_data
.x
->icon_bitmap
= -1;
10806 f
->output_data
.x
->fontset
= -1;
10807 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10808 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10809 #ifdef USE_TOOLKIT_SCROLL_BARS
10810 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
10811 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
10812 #endif /* USE_TOOLKIT_SCROLL_BARS */
10813 f
->icon_name
= Qnil
;
10814 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10816 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10817 dpyinfo_refcount
= dpyinfo
->reference_count
;
10818 #endif /* GLYPH_DEBUG */
10819 #ifdef MULTI_KBOARD
10820 FRAME_KBOARD (f
) = kb
;
10822 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10823 f
->output_data
.x
->explicit_parent
= 0;
10825 /* These colors will be set anyway later, but it's important
10826 to get the color reference counts right, so initialize them! */
10829 struct gcpro gcpro1
;
10831 black
= build_string ("black");
10833 f
->output_data
.x
->foreground_pixel
10834 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10835 f
->output_data
.x
->background_pixel
10836 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10837 f
->output_data
.x
->cursor_pixel
10838 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10839 f
->output_data
.x
->cursor_foreground_pixel
10840 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10841 f
->output_data
.x
->border_pixel
10842 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10843 f
->output_data
.x
->mouse_pixel
10844 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10848 /* Set the name; the functions to which we pass f expect the name to
10850 if (EQ (name
, Qunbound
) || NILP (name
))
10852 f
->name
= build_string (dpyinfo
->x_id_name
);
10853 f
->explicit_name
= 0;
10858 f
->explicit_name
= 1;
10859 /* use the frame's title when getting resources for this frame. */
10860 specbind (Qx_resource_name
, name
);
10863 /* Extract the window parameters from the supplied values that are
10864 needed to determine window geometry. */
10868 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10871 /* First, try whatever font the caller has specified. */
10872 if (STRINGP (font
))
10874 tem
= Fquery_fontset (font
, Qnil
);
10876 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10878 font
= x_new_font (f
, XSTRING (font
)->data
);
10881 /* Try out a font which we hope has bold and italic variations. */
10882 if (!STRINGP (font
))
10883 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10884 if (!STRINGP (font
))
10885 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10886 if (! STRINGP (font
))
10887 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10888 if (! STRINGP (font
))
10889 /* This was formerly the first thing tried, but it finds too many fonts
10890 and takes too long. */
10891 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10892 /* If those didn't work, look for something which will at least work. */
10893 if (! STRINGP (font
))
10894 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10896 if (! STRINGP (font
))
10897 font
= build_string ("fixed");
10899 x_default_parameter (f
, parms
, Qfont
, font
,
10900 "font", "Font", RES_TYPE_STRING
);
10903 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10904 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10906 /* This defaults to 2 in order to match xterm. We recognize either
10907 internalBorderWidth or internalBorder (which is what xterm calls
10909 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10913 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10914 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10915 if (! EQ (value
, Qunbound
))
10916 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10920 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10921 "internalBorderWidth", "internalBorderWidth",
10924 /* Also do the stuff which must be set before the window exists. */
10925 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10926 "foreground", "Foreground", RES_TYPE_STRING
);
10927 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10928 "background", "Background", RES_TYPE_STRING
);
10929 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10930 "pointerColor", "Foreground", RES_TYPE_STRING
);
10931 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10932 "cursorColor", "Foreground", RES_TYPE_STRING
);
10933 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10934 "borderColor", "BorderColor", RES_TYPE_STRING
);
10936 /* Init faces before x_default_parameter is called for scroll-bar
10937 parameters because that function calls x_set_scroll_bar_width,
10938 which calls change_frame_size, which calls Fset_window_buffer,
10939 which runs hooks, which call Fvertical_motion. At the end, we
10940 end up in init_iterator with a null face cache, which should not
10942 init_frame_faces (f
);
10944 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10945 window_prompting
= x_figure_window_size (f
, parms
);
10947 if (window_prompting
& XNegative
)
10949 if (window_prompting
& YNegative
)
10950 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10952 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10956 if (window_prompting
& YNegative
)
10957 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10959 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10962 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10964 XSetWindowAttributes attrs
;
10965 unsigned long mask
;
10968 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10969 if (DoesSaveUnders (dpyinfo
->screen
))
10970 mask
|= CWSaveUnder
;
10972 /* Window managers look at the override-redirect flag to determine
10973 whether or net to give windows a decoration (Xlib spec, chapter
10975 attrs
.override_redirect
= True
;
10976 attrs
.save_under
= True
;
10977 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10978 /* Arrange for getting MapNotify and UnmapNotify events. */
10979 attrs
.event_mask
= StructureNotifyMask
;
10981 = FRAME_X_WINDOW (f
)
10982 = XCreateWindow (FRAME_X_DISPLAY (f
),
10983 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10984 /* x, y, width, height */
10988 CopyFromParent
, InputOutput
, CopyFromParent
,
10995 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10996 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10997 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10998 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10999 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
11000 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
11002 /* Dimensions, especially f->height, must be done via change_frame_size.
11003 Change will not be effected unless different from the current
11006 height
= f
->height
;
11008 SET_FRAME_WIDTH (f
, 0);
11009 change_frame_size (f
, height
, width
, 1, 0, 0);
11011 /* Set up faces after all frame parameters are known. This call
11012 also merges in face attributes specified for new frames.
11014 Frame parameters may be changed if .Xdefaults contains
11015 specifications for the default font. For example, if there is an
11016 `Emacs.default.attributeBackground: pink', the `background-color'
11017 attribute of the frame get's set, which let's the internal border
11018 of the tooltip frame appear in pink. Prevent this. */
11020 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
11022 /* Set tip_frame here, so that */
11024 call1 (Qface_set_after_frame_default
, frame
);
11026 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
11027 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
11035 /* It is now ok to make the frame official even if we get an error
11036 below. And the frame needs to be on Vframe_list or making it
11037 visible won't work. */
11038 Vframe_list
= Fcons (frame
, Vframe_list
);
11040 /* Now that the frame is official, it counts as a reference to
11042 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
11044 /* Setting attributes of faces of the tooltip frame from resources
11045 and similar will increment face_change_count, which leads to the
11046 clearing of all current matrices. Since this isn't necessary
11047 here, avoid it by resetting face_change_count to the value it
11048 had before we created the tip frame. */
11049 face_change_count
= face_change_count_before
;
11051 /* Discard the unwind_protect. */
11052 return unbind_to (count
, frame
);
11056 /* Compute where to display tip frame F. PARMS is the list of frame
11057 parameters for F. DX and DY are specified offsets from the current
11058 location of the mouse. WIDTH and HEIGHT are the width and height
11059 of the tooltip. Return coordinates relative to the root window of
11060 the display in *ROOT_X, and *ROOT_Y. */
11063 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
11065 Lisp_Object parms
, dx
, dy
;
11067 int *root_x
, *root_y
;
11069 Lisp_Object left
, top
;
11071 Window root
, child
;
11074 /* User-specified position? */
11075 left
= Fcdr (Fassq (Qleft
, parms
));
11076 top
= Fcdr (Fassq (Qtop
, parms
));
11078 /* Move the tooltip window where the mouse pointer is. Resize and
11080 if (!INTEGERP (left
) && !INTEGERP (top
))
11083 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
11084 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
11088 if (INTEGERP (top
))
11089 *root_y
= XINT (top
);
11090 else if (*root_y
+ XINT (dy
) - height
< 0)
11091 *root_y
-= XINT (dy
);
11095 *root_y
+= XINT (dy
);
11098 if (INTEGERP (left
))
11099 *root_x
= XINT (left
);
11100 else if (*root_x
+ XINT (dx
) + width
> FRAME_X_DISPLAY_INFO (f
)->width
)
11101 *root_x
-= width
+ XINT (dx
);
11103 *root_x
+= XINT (dx
);
11107 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
11108 doc
: /* Show STRING in a "tooltip" window on frame FRAME.
11109 A tooltip window is a small X window displaying a string.
11111 FRAME nil or omitted means use the selected frame.
11113 PARMS is an optional list of frame parameters which can be used to
11114 change the tooltip's appearance.
11116 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
11117 means use the default timeout of 5 seconds.
11119 If the list of frame parameters PARAMS contains a `left' parameters,
11120 the tooltip is displayed at that x-position. Otherwise it is
11121 displayed at the mouse position, with offset DX added (default is 5 if
11122 DX isn't specified). Likewise for the y-position; if a `top' frame
11123 parameter is specified, it determines the y-position of the tooltip
11124 window, otherwise it is displayed at the mouse position, with offset
11125 DY added (default is -10).
11127 A tooltip's maximum size is specified by `x-max-tooltip-size'.
11128 Text larger than the specified size is clipped. */)
11129 (string
, frame
, parms
, timeout
, dx
, dy
)
11130 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
11134 int root_x
, root_y
;
11135 struct buffer
*old_buffer
;
11136 struct text_pos pos
;
11137 int i
, width
, height
;
11138 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
11139 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
11140 int count
= BINDING_STACK_SIZE ();
11142 specbind (Qinhibit_redisplay
, Qt
);
11144 GCPRO4 (string
, parms
, frame
, timeout
);
11146 CHECK_STRING (string
);
11147 f
= check_x_frame (frame
);
11148 if (NILP (timeout
))
11149 timeout
= make_number (5);
11151 CHECK_NATNUM (timeout
);
11154 dx
= make_number (5);
11159 dy
= make_number (-10);
11163 if (NILP (last_show_tip_args
))
11164 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
11166 if (!NILP (tip_frame
))
11168 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
11169 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
11170 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
11172 if (EQ (frame
, last_frame
)
11173 && !NILP (Fequal (last_string
, string
))
11174 && !NILP (Fequal (last_parms
, parms
)))
11176 struct frame
*f
= XFRAME (tip_frame
);
11178 /* Only DX and DY have changed. */
11179 if (!NILP (tip_timer
))
11181 Lisp_Object timer
= tip_timer
;
11183 call1 (Qcancel_timer
, timer
);
11187 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
11188 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
11189 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11196 /* Hide a previous tip, if any. */
11199 ASET (last_show_tip_args
, 0, string
);
11200 ASET (last_show_tip_args
, 1, frame
);
11201 ASET (last_show_tip_args
, 2, parms
);
11203 /* Add default values to frame parameters. */
11204 if (NILP (Fassq (Qname
, parms
)))
11205 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
11206 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11207 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
11208 if (NILP (Fassq (Qborder_width
, parms
)))
11209 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
11210 if (NILP (Fassq (Qborder_color
, parms
)))
11211 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
11212 if (NILP (Fassq (Qbackground_color
, parms
)))
11213 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
11216 /* Create a frame for the tooltip, and record it in the global
11217 variable tip_frame. */
11218 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
, string
);
11219 f
= XFRAME (frame
);
11221 /* Set up the frame's root window. */
11222 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
11223 w
->left
= w
->top
= make_number (0);
11225 if (CONSP (Vx_max_tooltip_size
)
11226 && INTEGERP (XCAR (Vx_max_tooltip_size
))
11227 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
11228 && INTEGERP (XCDR (Vx_max_tooltip_size
))
11229 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
11231 w
->width
= XCAR (Vx_max_tooltip_size
);
11232 w
->height
= XCDR (Vx_max_tooltip_size
);
11236 w
->width
= make_number (80);
11237 w
->height
= make_number (40);
11240 f
->window_width
= XINT (w
->width
);
11242 w
->pseudo_window_p
= 1;
11244 /* Display the tooltip text in a temporary buffer. */
11245 old_buffer
= current_buffer
;
11246 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
11247 current_buffer
->truncate_lines
= Qnil
;
11248 clear_glyph_matrix (w
->desired_matrix
);
11249 clear_glyph_matrix (w
->current_matrix
);
11250 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
11251 try_window (FRAME_ROOT_WINDOW (f
), pos
);
11253 /* Compute width and height of the tooltip. */
11254 width
= height
= 0;
11255 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
11257 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
11258 struct glyph
*last
;
11261 /* Stop at the first empty row at the end. */
11262 if (!row
->enabled_p
|| !row
->displays_text_p
)
11265 /* Let the row go over the full width of the frame. */
11266 row
->full_width_p
= 1;
11268 /* There's a glyph at the end of rows that is used to place
11269 the cursor there. Don't include the width of this glyph. */
11270 if (row
->used
[TEXT_AREA
])
11272 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
11273 row_width
= row
->pixel_width
- last
->pixel_width
;
11276 row_width
= row
->pixel_width
;
11278 height
+= row
->height
;
11279 width
= max (width
, row_width
);
11282 /* Add the frame's internal border to the width and height the X
11283 window should have. */
11284 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11285 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11287 /* Move the tooltip window where the mouse pointer is. Resize and
11289 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
11292 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11293 root_x
, root_y
, width
, height
);
11294 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
11297 /* Draw into the window. */
11298 w
->must_be_updated_p
= 1;
11299 update_single_window (w
, 1);
11301 /* Restore original current buffer. */
11302 set_buffer_internal_1 (old_buffer
);
11303 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
11306 /* Let the tip disappear after timeout seconds. */
11307 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
11308 intern ("x-hide-tip"));
11311 return unbind_to (count
, Qnil
);
11315 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
11316 doc
: /* Hide the current tooltip window, if there is any.
11317 Value is t if tooltip was open, nil otherwise. */)
11321 Lisp_Object deleted
, frame
, timer
;
11322 struct gcpro gcpro1
, gcpro2
;
11324 /* Return quickly if nothing to do. */
11325 if (NILP (tip_timer
) && NILP (tip_frame
))
11330 GCPRO2 (frame
, timer
);
11331 tip_frame
= tip_timer
= deleted
= Qnil
;
11333 count
= BINDING_STACK_SIZE ();
11334 specbind (Qinhibit_redisplay
, Qt
);
11335 specbind (Qinhibit_quit
, Qt
);
11338 call1 (Qcancel_timer
, timer
);
11340 if (FRAMEP (frame
))
11342 Fdelete_frame (frame
, Qnil
);
11346 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11347 redisplay procedure is not called when a tip frame over menu
11348 items is unmapped. Redisplay the menu manually... */
11350 struct frame
*f
= SELECTED_FRAME ();
11351 Widget w
= f
->output_data
.x
->menubar_widget
;
11352 extern void xlwmenu_redisplay
P_ ((Widget
));
11354 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
11358 xlwmenu_redisplay (w
);
11362 #endif /* USE_LUCID */
11366 return unbind_to (count
, deleted
);
11371 /***********************************************************************
11372 File selection dialog
11373 ***********************************************************************/
11377 /* Callback for "OK" and "Cancel" on file selection dialog. */
11380 file_dialog_cb (widget
, client_data
, call_data
)
11382 XtPointer call_data
, client_data
;
11384 int *result
= (int *) client_data
;
11385 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11386 *result
= cb
->reason
;
11390 /* Callback for unmapping a file selection dialog. This is used to
11391 capture the case where a dialog is closed via a window manager's
11392 closer button, for example. Using a XmNdestroyCallback didn't work
11396 file_dialog_unmap_cb (widget
, client_data
, call_data
)
11398 XtPointer call_data
, client_data
;
11400 int *result
= (int *) client_data
;
11401 *result
= XmCR_CANCEL
;
11405 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11406 doc
: /* Read file name, prompting with PROMPT in directory DIR.
11407 Use a file selection dialog.
11408 Select DEFAULT-FILENAME in the dialog's file selection box, if
11409 specified. Don't let the user enter a file name in the file
11410 selection dialog's entry field, if MUSTMATCH is non-nil. */)
11411 (prompt
, dir
, default_filename
, mustmatch
)
11412 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11415 struct frame
*f
= SELECTED_FRAME ();
11416 Lisp_Object file
= Qnil
;
11417 Widget dialog
, text
, list
, help
;
11420 extern XtAppContext Xt_app_con
;
11421 XmString dir_xmstring
, pattern_xmstring
;
11422 int count
= specpdl_ptr
- specpdl
;
11423 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11425 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11426 CHECK_STRING (prompt
);
11427 CHECK_STRING (dir
);
11429 /* Prevent redisplay. */
11430 specbind (Qinhibit_redisplay
, Qt
);
11434 /* Create the dialog with PROMPT as title, using DIR as initial
11435 directory and using "*" as pattern. */
11436 dir
= Fexpand_file_name (dir
, Qnil
);
11437 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11438 pattern_xmstring
= XmStringCreateLocalized ("*");
11440 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11441 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11442 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11443 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11444 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11445 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11447 XmStringFree (dir_xmstring
);
11448 XmStringFree (pattern_xmstring
);
11450 /* Add callbacks for OK and Cancel. */
11451 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11452 (XtPointer
) &result
);
11453 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11454 (XtPointer
) &result
);
11455 XtAddCallback (dialog
, XmNunmapCallback
, file_dialog_unmap_cb
,
11456 (XtPointer
) &result
);
11458 /* Disable the help button since we can't display help. */
11459 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11460 XtSetSensitive (help
, False
);
11462 /* Mark OK button as default. */
11463 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11464 XmNshowAsDefault
, True
, NULL
);
11466 /* If MUSTMATCH is non-nil, disable the file entry field of the
11467 dialog, so that the user must select a file from the files list
11468 box. We can't remove it because we wouldn't have a way to get at
11469 the result file name, then. */
11470 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11471 if (!NILP (mustmatch
))
11474 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11475 XtSetSensitive (text
, False
);
11476 XtSetSensitive (label
, False
);
11479 /* Manage the dialog, so that list boxes get filled. */
11480 XtManageChild (dialog
);
11482 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11483 must include the path for this to work. */
11484 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11485 if (STRINGP (default_filename
))
11487 XmString default_xmstring
;
11491 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11493 if (!XmListItemExists (list
, default_xmstring
))
11495 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11496 XmListAddItem (list
, default_xmstring
, 0);
11500 item_pos
= XmListItemPos (list
, default_xmstring
);
11501 XmStringFree (default_xmstring
);
11503 /* Select the item and scroll it into view. */
11504 XmListSelectPos (list
, item_pos
, True
);
11505 XmListSetPos (list
, item_pos
);
11508 /* Process events until the user presses Cancel or OK. Block
11509 and unblock input here so that we get a chance of processing
11513 while (result
== 0)
11516 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11521 /* Get the result. */
11522 if (result
== XmCR_OK
)
11527 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11528 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11529 XmStringFree (text
);
11530 file
= build_string (data
);
11537 XtUnmanageChild (dialog
);
11538 XtDestroyWidget (dialog
);
11542 /* Make "Cancel" equivalent to C-g. */
11544 Fsignal (Qquit
, Qnil
);
11546 return unbind_to (count
, file
);
11549 #endif /* USE_MOTIF */
11553 /***********************************************************************
11555 ***********************************************************************/
11557 #ifdef HAVE_XKBGETKEYBOARD
11558 #include <X11/XKBlib.h>
11559 #include <X11/keysym.h>
11562 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11563 Sx_backspace_delete_keys_p
, 0, 1, 0,
11564 doc
: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
11565 FRAME nil means use the selected frame.
11566 Value is t if we know that both keys are present, and are mapped to the
11567 usual X keysyms. */)
11571 #ifdef HAVE_XKBGETKEYBOARD
11573 struct frame
*f
= check_x_frame (frame
);
11574 Display
*dpy
= FRAME_X_DISPLAY (f
);
11575 Lisp_Object have_keys
;
11576 int major
, minor
, op
, event
, error
;
11580 /* Check library version in case we're dynamically linked. */
11581 major
= XkbMajorVersion
;
11582 minor
= XkbMinorVersion
;
11583 if (!XkbLibraryVersion (&major
, &minor
))
11589 /* Check that the server supports XKB. */
11590 major
= XkbMajorVersion
;
11591 minor
= XkbMinorVersion
;
11592 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11599 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11602 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11604 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11606 for (i
= kb
->min_key_code
;
11607 (i
< kb
->max_key_code
11608 && (delete_keycode
== 0 || backspace_keycode
== 0));
11611 /* The XKB symbolic key names can be seen most easily in
11612 the PS file generated by `xkbprint -label name
11614 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11615 delete_keycode
= i
;
11616 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11617 backspace_keycode
= i
;
11620 XkbFreeNames (kb
, 0, True
);
11623 XkbFreeClientMap (kb
, 0, True
);
11626 && backspace_keycode
11627 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11628 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11633 #else /* not HAVE_XKBGETKEYBOARD */
11635 #endif /* not HAVE_XKBGETKEYBOARD */
11640 /***********************************************************************
11642 ***********************************************************************/
11647 /* This is zero if not using X windows. */
11650 /* The section below is built by the lisp expression at the top of the file,
11651 just above where these variables are declared. */
11652 /*&&& init symbols here &&&*/
11653 Qauto_raise
= intern ("auto-raise");
11654 staticpro (&Qauto_raise
);
11655 Qauto_lower
= intern ("auto-lower");
11656 staticpro (&Qauto_lower
);
11657 Qbar
= intern ("bar");
11659 Qborder_color
= intern ("border-color");
11660 staticpro (&Qborder_color
);
11661 Qborder_width
= intern ("border-width");
11662 staticpro (&Qborder_width
);
11663 Qbox
= intern ("box");
11665 Qcursor_color
= intern ("cursor-color");
11666 staticpro (&Qcursor_color
);
11667 Qcursor_type
= intern ("cursor-type");
11668 staticpro (&Qcursor_type
);
11669 Qgeometry
= intern ("geometry");
11670 staticpro (&Qgeometry
);
11671 Qicon_left
= intern ("icon-left");
11672 staticpro (&Qicon_left
);
11673 Qicon_top
= intern ("icon-top");
11674 staticpro (&Qicon_top
);
11675 Qicon_type
= intern ("icon-type");
11676 staticpro (&Qicon_type
);
11677 Qicon_name
= intern ("icon-name");
11678 staticpro (&Qicon_name
);
11679 Qinternal_border_width
= intern ("internal-border-width");
11680 staticpro (&Qinternal_border_width
);
11681 Qleft
= intern ("left");
11682 staticpro (&Qleft
);
11683 Qright
= intern ("right");
11684 staticpro (&Qright
);
11685 Qmouse_color
= intern ("mouse-color");
11686 staticpro (&Qmouse_color
);
11687 Qnone
= intern ("none");
11688 staticpro (&Qnone
);
11689 Qparent_id
= intern ("parent-id");
11690 staticpro (&Qparent_id
);
11691 Qscroll_bar_width
= intern ("scroll-bar-width");
11692 staticpro (&Qscroll_bar_width
);
11693 Qsuppress_icon
= intern ("suppress-icon");
11694 staticpro (&Qsuppress_icon
);
11695 Qundefined_color
= intern ("undefined-color");
11696 staticpro (&Qundefined_color
);
11697 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11698 staticpro (&Qvertical_scroll_bars
);
11699 Qvisibility
= intern ("visibility");
11700 staticpro (&Qvisibility
);
11701 Qwindow_id
= intern ("window-id");
11702 staticpro (&Qwindow_id
);
11703 Qouter_window_id
= intern ("outer-window-id");
11704 staticpro (&Qouter_window_id
);
11705 Qx_frame_parameter
= intern ("x-frame-parameter");
11706 staticpro (&Qx_frame_parameter
);
11707 Qx_resource_name
= intern ("x-resource-name");
11708 staticpro (&Qx_resource_name
);
11709 Quser_position
= intern ("user-position");
11710 staticpro (&Quser_position
);
11711 Quser_size
= intern ("user-size");
11712 staticpro (&Quser_size
);
11713 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11714 staticpro (&Qscroll_bar_foreground
);
11715 Qscroll_bar_background
= intern ("scroll-bar-background");
11716 staticpro (&Qscroll_bar_background
);
11717 Qscreen_gamma
= intern ("screen-gamma");
11718 staticpro (&Qscreen_gamma
);
11719 Qline_spacing
= intern ("line-spacing");
11720 staticpro (&Qline_spacing
);
11721 Qcenter
= intern ("center");
11722 staticpro (&Qcenter
);
11723 Qcompound_text
= intern ("compound-text");
11724 staticpro (&Qcompound_text
);
11725 Qcancel_timer
= intern ("cancel-timer");
11726 staticpro (&Qcancel_timer
);
11727 Qwait_for_wm
= intern ("wait-for-wm");
11728 staticpro (&Qwait_for_wm
);
11729 /* This is the end of symbol initialization. */
11731 /* Text property `display' should be nonsticky by default. */
11732 Vtext_property_default_nonsticky
11733 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11736 Qlaplace
= intern ("laplace");
11737 staticpro (&Qlaplace
);
11738 Qemboss
= intern ("emboss");
11739 staticpro (&Qemboss
);
11740 Qedge_detection
= intern ("edge-detection");
11741 staticpro (&Qedge_detection
);
11742 Qheuristic
= intern ("heuristic");
11743 staticpro (&Qheuristic
);
11744 QCmatrix
= intern (":matrix");
11745 staticpro (&QCmatrix
);
11746 QCcolor_adjustment
= intern (":color-adjustment");
11747 staticpro (&QCcolor_adjustment
);
11748 QCmask
= intern (":mask");
11749 staticpro (&QCmask
);
11751 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11752 staticpro (&Qface_set_after_frame_default
);
11754 Fput (Qundefined_color
, Qerror_conditions
,
11755 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11756 Fput (Qundefined_color
, Qerror_message
,
11757 build_string ("Undefined color"));
11759 init_x_parm_symbols ();
11761 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11762 doc
: /* Non-nil means always draw a cross over disabled images.
11763 Disabled images are those having an `:conversion disabled' property.
11764 A cross is always drawn on black & white displays. */);
11765 cross_disabled_images
= 0;
11767 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11768 doc
: /* List of directories to search for bitmap files for X. */);
11769 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11771 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11772 doc
: /* The shape of the pointer when over text.
11773 Changing the value does not affect existing frames
11774 unless you set the mouse color. */);
11775 Vx_pointer_shape
= Qnil
;
11777 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11778 doc
: /* The name Emacs uses to look up X resources.
11779 `x-get-resource' uses this as the first component of the instance name
11780 when requesting resource values.
11781 Emacs initially sets `x-resource-name' to the name under which Emacs
11782 was invoked, or to the value specified with the `-name' or `-rn'
11783 switches, if present.
11785 It may be useful to bind this variable locally around a call
11786 to `x-get-resource'. See also the variable `x-resource-class'. */);
11787 Vx_resource_name
= Qnil
;
11789 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11790 doc
: /* The class Emacs uses to look up X resources.
11791 `x-get-resource' uses this as the first component of the instance class
11792 when requesting resource values.
11794 Emacs initially sets `x-resource-class' to "Emacs".
11796 Setting this variable permanently is not a reasonable thing to do,
11797 but binding this variable locally around a call to `x-get-resource'
11798 is a reasonable practice. See also the variable `x-resource-name'. */);
11799 Vx_resource_class
= build_string (EMACS_CLASS
);
11801 #if 0 /* This doesn't really do anything. */
11802 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11803 doc
: /* The shape of the pointer when not over text.
11804 This variable takes effect when you create a new frame
11805 or when you set the mouse color. */);
11807 Vx_nontext_pointer_shape
= Qnil
;
11809 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
11810 doc
: /* The shape of the pointer when Emacs is busy.
11811 This variable takes effect when you create a new frame
11812 or when you set the mouse color. */);
11813 Vx_hourglass_pointer_shape
= Qnil
;
11815 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
11816 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
11817 display_hourglass_p
= 1;
11819 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
11820 doc
: /* *Seconds to wait before displaying an hourglass pointer.
11821 Value must be an integer or float. */);
11822 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
11824 #if 0 /* This doesn't really do anything. */
11825 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11826 doc
: /* The shape of the pointer when over the mode line.
11827 This variable takes effect when you create a new frame
11828 or when you set the mouse color. */);
11830 Vx_mode_pointer_shape
= Qnil
;
11832 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11833 &Vx_sensitive_text_pointer_shape
,
11834 doc
: /* The shape of the pointer when over mouse-sensitive text.
11835 This variable takes effect when you create a new frame
11836 or when you set the mouse color. */);
11837 Vx_sensitive_text_pointer_shape
= Qnil
;
11839 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11840 &Vx_window_horizontal_drag_shape
,
11841 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
11842 This variable takes effect when you create a new frame
11843 or when you set the mouse color. */);
11844 Vx_window_horizontal_drag_shape
= Qnil
;
11846 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11847 doc
: /* A string indicating the foreground color of the cursor box. */);
11848 Vx_cursor_fore_pixel
= Qnil
;
11850 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
11851 doc
: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
11852 Text larger than this is clipped. */);
11853 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
11855 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11856 doc
: /* Non-nil if no X window manager is in use.
11857 Emacs doesn't try to figure this out; this is always nil
11858 unless you set it to something else. */);
11859 /* We don't have any way to find this out, so set it to nil
11860 and maybe the user would like to set it to t. */
11861 Vx_no_window_manager
= Qnil
;
11863 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11864 &Vx_pixel_size_width_font_regexp
,
11865 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
11867 Since Emacs gets width of a font matching with this regexp from
11868 PIXEL_SIZE field of the name, font finding mechanism gets faster for
11869 such a font. This is especially effective for such large fonts as
11870 Chinese, Japanese, and Korean. */);
11871 Vx_pixel_size_width_font_regexp
= Qnil
;
11873 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11874 doc
: /* Time after which cached images are removed from the cache.
11875 When an image has not been displayed this many seconds, remove it
11876 from the image cache. Value must be an integer or nil with nil
11877 meaning don't clear the cache. */);
11878 Vimage_cache_eviction_delay
= make_number (30 * 60);
11880 #ifdef USE_X_TOOLKIT
11881 Fprovide (intern ("x-toolkit"), Qnil
);
11883 Fprovide (intern ("motif"), Qnil
);
11885 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string
,
11886 doc
: /* Version info for LessTif/Motif. */);
11887 Vmotif_version_string
= build_string (XmVERSION_STRING
);
11888 #endif /* USE_MOTIF */
11889 #endif /* USE_X_TOOLKIT */
11891 defsubr (&Sx_get_resource
);
11893 /* X window properties. */
11894 defsubr (&Sx_change_window_property
);
11895 defsubr (&Sx_delete_window_property
);
11896 defsubr (&Sx_window_property
);
11898 defsubr (&Sxw_display_color_p
);
11899 defsubr (&Sx_display_grayscale_p
);
11900 defsubr (&Sxw_color_defined_p
);
11901 defsubr (&Sxw_color_values
);
11902 defsubr (&Sx_server_max_request_size
);
11903 defsubr (&Sx_server_vendor
);
11904 defsubr (&Sx_server_version
);
11905 defsubr (&Sx_display_pixel_width
);
11906 defsubr (&Sx_display_pixel_height
);
11907 defsubr (&Sx_display_mm_width
);
11908 defsubr (&Sx_display_mm_height
);
11909 defsubr (&Sx_display_screens
);
11910 defsubr (&Sx_display_planes
);
11911 defsubr (&Sx_display_color_cells
);
11912 defsubr (&Sx_display_visual_class
);
11913 defsubr (&Sx_display_backing_store
);
11914 defsubr (&Sx_display_save_under
);
11915 defsubr (&Sx_parse_geometry
);
11916 defsubr (&Sx_create_frame
);
11917 defsubr (&Sx_open_connection
);
11918 defsubr (&Sx_close_connection
);
11919 defsubr (&Sx_display_list
);
11920 defsubr (&Sx_synchronize
);
11921 defsubr (&Sx_focus_frame
);
11922 defsubr (&Sx_backspace_delete_keys_p
);
11924 /* Setting callback functions for fontset handler. */
11925 get_font_info_func
= x_get_font_info
;
11927 #if 0 /* This function pointer doesn't seem to be used anywhere.
11928 And the pointer assigned has the wrong type, anyway. */
11929 list_fonts_func
= x_list_fonts
;
11932 load_font_func
= x_load_font
;
11933 find_ccl_program_func
= x_find_ccl_program
;
11934 query_font_func
= x_query_font
;
11935 set_frame_fontset_func
= x_set_font
;
11936 check_window_system_func
= check_x
;
11939 Qxbm
= intern ("xbm");
11941 QCtype
= intern (":type");
11942 staticpro (&QCtype
);
11943 QCconversion
= intern (":conversion");
11944 staticpro (&QCconversion
);
11945 QCheuristic_mask
= intern (":heuristic-mask");
11946 staticpro (&QCheuristic_mask
);
11947 QCcolor_symbols
= intern (":color-symbols");
11948 staticpro (&QCcolor_symbols
);
11949 QCascent
= intern (":ascent");
11950 staticpro (&QCascent
);
11951 QCmargin
= intern (":margin");
11952 staticpro (&QCmargin
);
11953 QCrelief
= intern (":relief");
11954 staticpro (&QCrelief
);
11955 Qpostscript
= intern ("postscript");
11956 staticpro (&Qpostscript
);
11957 QCloader
= intern (":loader");
11958 staticpro (&QCloader
);
11959 QCbounding_box
= intern (":bounding-box");
11960 staticpro (&QCbounding_box
);
11961 QCpt_width
= intern (":pt-width");
11962 staticpro (&QCpt_width
);
11963 QCpt_height
= intern (":pt-height");
11964 staticpro (&QCpt_height
);
11965 QCindex
= intern (":index");
11966 staticpro (&QCindex
);
11967 Qpbm
= intern ("pbm");
11971 Qxpm
= intern ("xpm");
11976 Qjpeg
= intern ("jpeg");
11977 staticpro (&Qjpeg
);
11981 Qtiff
= intern ("tiff");
11982 staticpro (&Qtiff
);
11986 Qgif
= intern ("gif");
11991 Qpng
= intern ("png");
11995 defsubr (&Sclear_image_cache
);
11996 defsubr (&Simage_size
);
11997 defsubr (&Simage_mask_p
);
11999 hourglass_atimer
= NULL
;
12000 hourglass_shown_p
= 0;
12002 defsubr (&Sx_show_tip
);
12003 defsubr (&Sx_hide_tip
);
12005 staticpro (&tip_timer
);
12007 staticpro (&tip_frame
);
12009 last_show_tip_args
= Qnil
;
12010 staticpro (&last_show_tip_args
);
12013 defsubr (&Sx_file_dialog
);
12021 image_types
= NULL
;
12022 Vimage_types
= Qnil
;
12024 define_image_type (&xbm_type
);
12025 define_image_type (&gs_type
);
12026 define_image_type (&pbm_type
);
12029 define_image_type (&xpm_type
);
12033 define_image_type (&jpeg_type
);
12037 define_image_type (&tiff_type
);
12041 define_image_type (&gif_type
);
12045 define_image_type (&png_type
);
12049 #endif /* HAVE_X_WINDOWS */