1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999, 2000, 2001
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
27 /* This makes the fields of a Display accessible, in Xlib header files. */
29 #define XLIB_ILLEGAL_ACCESS
36 #include "intervals.h"
37 #include "dispextern.h"
39 #include "blockinput.h"
45 #include "termhooks.h"
51 #include <sys/types.h>
55 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
56 #include "bitmaps/gray.xbm"
58 #include <X11/bitmaps/gray>
61 #include "[.bitmaps]gray.xbm"
65 #include <X11/Shell.h>
68 #include <X11/Xaw/Paned.h>
69 #include <X11/Xaw/Label.h>
70 #endif /* USE_MOTIF */
73 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
82 #include "../lwlib/lwlib.h"
86 #include <Xm/DialogS.h>
87 #include <Xm/FileSB.h>
90 /* Do the EDITRES protocol if running X11R5
91 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
93 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
95 extern void _XEditResCheckMessages ();
96 #endif /* R5 + Athena */
98 /* Unique id counter for widgets created by the Lucid Widget Library. */
100 extern LWLIB_ID widget_id_tick
;
103 /* This is part of a kludge--see lwlib/xlwmenu.c. */
104 extern XFontStruct
*xlwmenu_default_font
;
107 extern void free_frame_menubar ();
108 extern double atof ();
110 #endif /* USE_X_TOOLKIT */
112 #define min(a,b) ((a) < (b) ? (a) : (b))
113 #define max(a,b) ((a) > (b) ? (a) : (b))
116 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
118 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
121 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
122 it, and including `bitmaps/gray' more than once is a problem when
123 config.h defines `static' as an empty replacement string. */
125 int gray_bitmap_width
= gray_width
;
126 int gray_bitmap_height
= gray_height
;
127 char *gray_bitmap_bits
= gray_bits
;
129 /* The name we're using in resource queries. Most often "emacs". */
131 Lisp_Object Vx_resource_name
;
133 /* The application class we're using in resource queries.
136 Lisp_Object Vx_resource_class
;
138 /* Non-zero means we're allowed to display an hourglass cursor. */
140 int display_hourglass_p
;
142 /* The background and shape of the mouse pointer, and shape when not
143 over text or in the modeline. */
145 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
146 Lisp_Object Vx_hourglass_pointer_shape
;
148 /* The shape when over mouse-sensitive text. */
150 Lisp_Object Vx_sensitive_text_pointer_shape
;
152 /* If non-nil, the pointer shape to indicate that windows can be
153 dragged horizontally. */
155 Lisp_Object Vx_window_horizontal_drag_shape
;
157 /* Color of chars displayed in cursor box. */
159 Lisp_Object Vx_cursor_fore_pixel
;
161 /* Nonzero if using X. */
165 /* Non nil if no window manager is in use. */
167 Lisp_Object Vx_no_window_manager
;
169 /* Search path for bitmap files. */
171 Lisp_Object Vx_bitmap_file_path
;
173 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
175 Lisp_Object Vx_pixel_size_width_font_regexp
;
177 Lisp_Object Qauto_raise
;
178 Lisp_Object Qauto_lower
;
180 Lisp_Object Qborder_color
;
181 Lisp_Object Qborder_width
;
183 Lisp_Object Qcursor_color
;
184 Lisp_Object Qcursor_type
;
185 Lisp_Object Qgeometry
;
186 Lisp_Object Qicon_left
;
187 Lisp_Object Qicon_top
;
188 Lisp_Object Qicon_type
;
189 Lisp_Object Qicon_name
;
190 Lisp_Object Qinternal_border_width
;
193 Lisp_Object Qmouse_color
;
195 Lisp_Object Qouter_window_id
;
196 Lisp_Object Qparent_id
;
197 Lisp_Object Qscroll_bar_width
;
198 Lisp_Object Qsuppress_icon
;
199 extern Lisp_Object Qtop
;
200 Lisp_Object Qundefined_color
;
201 Lisp_Object Qvertical_scroll_bars
;
202 Lisp_Object Qvisibility
;
203 Lisp_Object Qwindow_id
;
204 Lisp_Object Qx_frame_parameter
;
205 Lisp_Object Qx_resource_name
;
206 Lisp_Object Quser_position
;
207 Lisp_Object Quser_size
;
208 extern Lisp_Object Qdisplay
;
209 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
210 Lisp_Object Qscreen_gamma
, Qline_spacing
, Qcenter
;
211 Lisp_Object Qcompound_text
, Qcancel_timer
;
213 /* The below are defined in frame.c. */
215 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
216 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
217 extern Lisp_Object Qtool_bar_lines
;
219 extern Lisp_Object Vwindow_system_version
;
221 Lisp_Object Qface_set_after_frame_default
;
224 int image_cache_refcount
, dpyinfo_refcount
;
229 /* Error if we are not connected to X. */
235 error ("X windows are not in use or not initialized");
238 /* Nonzero if we can use mouse menus.
239 You should not call this unless HAVE_MENUS is defined. */
247 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
248 and checking validity for X. */
251 check_x_frame (frame
)
257 frame
= selected_frame
;
258 CHECK_LIVE_FRAME (frame
, 0);
261 error ("Non-X frame used");
265 /* Let the user specify an X display with a frame.
266 nil stands for the selected frame--or, if that is not an X frame,
267 the first X display on the list. */
269 static struct x_display_info
*
270 check_x_display_info (frame
)
273 struct x_display_info
*dpyinfo
= NULL
;
277 struct frame
*sf
= XFRAME (selected_frame
);
279 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
280 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
281 else if (x_display_list
!= 0)
282 dpyinfo
= x_display_list
;
284 error ("X windows are not in use or not initialized");
286 else if (STRINGP (frame
))
287 dpyinfo
= x_display_info_for_name (frame
);
292 CHECK_LIVE_FRAME (frame
, 0);
295 error ("Non-X frame used");
296 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
303 /* Return the Emacs frame-object corresponding to an X window.
304 It could be the frame's main window or an icon window. */
306 /* This function can be called during GC, so use GC_xxx type test macros. */
309 x_window_to_frame (dpyinfo
, wdesc
)
310 struct x_display_info
*dpyinfo
;
313 Lisp_Object tail
, frame
;
316 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
319 if (!GC_FRAMEP (frame
))
322 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
324 if (f
->output_data
.x
->hourglass_window
== wdesc
)
327 if ((f
->output_data
.x
->edit_widget
328 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
329 /* A tooltip frame? */
330 || (!f
->output_data
.x
->edit_widget
331 && FRAME_X_WINDOW (f
) == wdesc
)
332 || f
->output_data
.x
->icon_desc
== wdesc
)
334 #else /* not USE_X_TOOLKIT */
335 if (FRAME_X_WINDOW (f
) == wdesc
336 || f
->output_data
.x
->icon_desc
== wdesc
)
338 #endif /* not USE_X_TOOLKIT */
344 /* Like x_window_to_frame but also compares the window with the widget's
348 x_any_window_to_frame (dpyinfo
, wdesc
)
349 struct x_display_info
*dpyinfo
;
352 Lisp_Object tail
, frame
;
353 struct frame
*f
, *found
;
357 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
360 if (!GC_FRAMEP (frame
))
364 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
366 /* This frame matches if the window is any of its widgets. */
367 x
= f
->output_data
.x
;
368 if (x
->hourglass_window
== wdesc
)
372 if (wdesc
== XtWindow (x
->widget
)
373 || wdesc
== XtWindow (x
->column_widget
)
374 || wdesc
== XtWindow (x
->edit_widget
))
376 /* Match if the window is this frame's menubar. */
377 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
380 else if (FRAME_X_WINDOW (f
) == wdesc
)
381 /* A tooltip frame. */
389 /* Likewise, but exclude the menu bar widget. */
392 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
393 struct x_display_info
*dpyinfo
;
396 Lisp_Object tail
, frame
;
400 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
403 if (!GC_FRAMEP (frame
))
406 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
408 x
= f
->output_data
.x
;
409 /* This frame matches if the window is any of its widgets. */
410 if (x
->hourglass_window
== wdesc
)
414 if (wdesc
== XtWindow (x
->widget
)
415 || wdesc
== XtWindow (x
->column_widget
)
416 || wdesc
== XtWindow (x
->edit_widget
))
419 else if (FRAME_X_WINDOW (f
) == wdesc
)
420 /* A tooltip frame. */
426 /* Likewise, but consider only the menu bar widget. */
429 x_menubar_window_to_frame (dpyinfo
, wdesc
)
430 struct x_display_info
*dpyinfo
;
433 Lisp_Object tail
, frame
;
437 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
440 if (!GC_FRAMEP (frame
))
443 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
445 x
= f
->output_data
.x
;
446 /* Match if the window is this frame's menubar. */
447 if (x
->menubar_widget
448 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
454 /* Return the frame whose principal (outermost) window is WDESC.
455 If WDESC is some other (smaller) window, we return 0. */
458 x_top_window_to_frame (dpyinfo
, wdesc
)
459 struct x_display_info
*dpyinfo
;
462 Lisp_Object tail
, frame
;
466 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
469 if (!GC_FRAMEP (frame
))
472 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
474 x
= f
->output_data
.x
;
478 /* This frame matches if the window is its topmost widget. */
479 if (wdesc
== XtWindow (x
->widget
))
481 #if 0 /* I don't know why it did this,
482 but it seems logically wrong,
483 and it causes trouble for MapNotify events. */
484 /* Match if the window is this frame's menubar. */
485 if (x
->menubar_widget
486 && wdesc
== XtWindow (x
->menubar_widget
))
490 else if (FRAME_X_WINDOW (f
) == wdesc
)
496 #endif /* USE_X_TOOLKIT */
500 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
501 id, which is just an int that this section returns. Bitmaps are
502 reference counted so they can be shared among frames.
504 Bitmap indices are guaranteed to be > 0, so a negative number can
505 be used to indicate no bitmap.
507 If you use x_create_bitmap_from_data, then you must keep track of
508 the bitmaps yourself. That is, creating a bitmap from the same
509 data more than once will not be caught. */
512 /* Functions to access the contents of a bitmap, given an id. */
515 x_bitmap_height (f
, id
)
519 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
523 x_bitmap_width (f
, id
)
527 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
531 x_bitmap_pixmap (f
, id
)
535 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
539 /* Allocate a new bitmap record. Returns index of new record. */
542 x_allocate_bitmap_record (f
)
545 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
548 if (dpyinfo
->bitmaps
== NULL
)
550 dpyinfo
->bitmaps_size
= 10;
552 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
553 dpyinfo
->bitmaps_last
= 1;
557 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
558 return ++dpyinfo
->bitmaps_last
;
560 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
561 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
564 dpyinfo
->bitmaps_size
*= 2;
566 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
567 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
568 return ++dpyinfo
->bitmaps_last
;
571 /* Add one reference to the reference count of the bitmap with id ID. */
574 x_reference_bitmap (f
, id
)
578 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
581 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
584 x_create_bitmap_from_data (f
, bits
, width
, height
)
587 unsigned int width
, height
;
589 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
593 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
594 bits
, width
, height
);
599 id
= x_allocate_bitmap_record (f
);
600 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
601 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
602 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
603 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
604 dpyinfo
->bitmaps
[id
- 1].height
= height
;
605 dpyinfo
->bitmaps
[id
- 1].width
= width
;
610 /* Create bitmap from file FILE for frame F. */
613 x_create_bitmap_from_file (f
, file
)
617 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
618 unsigned int width
, height
;
620 int xhot
, yhot
, result
, id
;
625 /* Look for an existing bitmap with the same name. */
626 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
628 if (dpyinfo
->bitmaps
[id
].refcount
629 && dpyinfo
->bitmaps
[id
].file
630 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
632 ++dpyinfo
->bitmaps
[id
].refcount
;
637 /* Search bitmap-file-path for the file, if appropriate. */
638 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
643 filename
= (char *) XSTRING (found
)->data
;
645 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
646 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
647 if (result
!= BitmapSuccess
)
650 id
= x_allocate_bitmap_record (f
);
651 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
652 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
653 dpyinfo
->bitmaps
[id
- 1].file
654 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
655 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
656 dpyinfo
->bitmaps
[id
- 1].height
= height
;
657 dpyinfo
->bitmaps
[id
- 1].width
= width
;
658 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
663 /* Remove reference to bitmap with id number ID. */
666 x_destroy_bitmap (f
, id
)
670 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
674 --dpyinfo
->bitmaps
[id
- 1].refcount
;
675 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
678 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
679 if (dpyinfo
->bitmaps
[id
- 1].file
)
681 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
682 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
689 /* Free all the bitmaps for the display specified by DPYINFO. */
692 x_destroy_all_bitmaps (dpyinfo
)
693 struct x_display_info
*dpyinfo
;
696 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
697 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
699 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
700 if (dpyinfo
->bitmaps
[i
].file
)
701 xfree (dpyinfo
->bitmaps
[i
].file
);
703 dpyinfo
->bitmaps_last
= 0;
706 /* Connect the frame-parameter names for X frames
707 to the ways of passing the parameter values to the window system.
709 The name of a parameter, as a Lisp symbol,
710 has an `x-frame-parameter' property which is an integer in Lisp
711 that is an index in this table. */
713 struct x_frame_parm_table
716 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
719 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
720 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
721 static void x_change_window_heights
P_ ((Lisp_Object
, int));
722 static void x_disable_image
P_ ((struct frame
*, struct image
*));
723 static void x_create_im
P_ ((struct frame
*));
724 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
725 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
726 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
727 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
728 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
729 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
730 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
731 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
732 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
733 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
734 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
735 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
737 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
738 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
739 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
740 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
742 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
743 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
744 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
745 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
746 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
750 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
752 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
757 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
760 static void init_color_table
P_ ((void));
761 static void free_color_table
P_ ((void));
762 static unsigned long *colors_in_color_table
P_ ((int *n
));
763 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
764 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
768 static struct x_frame_parm_table x_frame_parms
[] =
770 "auto-raise", x_set_autoraise
,
771 "auto-lower", x_set_autolower
,
772 "background-color", x_set_background_color
,
773 "border-color", x_set_border_color
,
774 "border-width", x_set_border_width
,
775 "cursor-color", x_set_cursor_color
,
776 "cursor-type", x_set_cursor_type
,
778 "foreground-color", x_set_foreground_color
,
779 "icon-name", x_set_icon_name
,
780 "icon-type", x_set_icon_type
,
781 "internal-border-width", x_set_internal_border_width
,
782 "menu-bar-lines", x_set_menu_bar_lines
,
783 "mouse-color", x_set_mouse_color
,
784 "name", x_explicitly_set_name
,
785 "scroll-bar-width", x_set_scroll_bar_width
,
786 "title", x_set_title
,
787 "unsplittable", x_set_unsplittable
,
788 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
789 "visibility", x_set_visibility
,
790 "tool-bar-lines", x_set_tool_bar_lines
,
791 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
792 "scroll-bar-background", x_set_scroll_bar_background
,
793 "screen-gamma", x_set_screen_gamma
,
794 "line-spacing", x_set_line_spacing
797 /* Attach the `x-frame-parameter' properties to
798 the Lisp symbol names of parameters relevant to X. */
801 init_x_parm_symbols ()
805 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
806 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
810 /* Change the parameters of frame F as specified by ALIST.
811 If a parameter is not specially recognized, do nothing special;
812 otherwise call the `x_set_...' function for that parameter.
813 Except for certain geometry properties, always call store_frame_param
814 to store the new value in the parameter alist. */
817 x_set_frame_parameters (f
, alist
)
823 /* If both of these parameters are present, it's more efficient to
824 set them both at once. So we wait until we've looked at the
825 entire list before we set them. */
829 Lisp_Object left
, top
;
831 /* Same with these. */
832 Lisp_Object icon_left
, icon_top
;
834 /* Record in these vectors all the parms specified. */
838 int left_no_change
= 0, top_no_change
= 0;
839 int icon_left_no_change
= 0, icon_top_no_change
= 0;
841 struct gcpro gcpro1
, gcpro2
;
844 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
847 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
848 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
850 /* Extract parm names and values into those vectors. */
853 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
858 parms
[i
] = Fcar (elt
);
859 values
[i
] = Fcdr (elt
);
862 /* TAIL and ALIST are not used again below here. */
865 GCPRO2 (*parms
, *values
);
869 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
870 because their values appear in VALUES and strings are not valid. */
871 top
= left
= Qunbound
;
872 icon_left
= icon_top
= Qunbound
;
874 /* Provide default values for HEIGHT and WIDTH. */
875 if (FRAME_NEW_WIDTH (f
))
876 width
= FRAME_NEW_WIDTH (f
);
878 width
= FRAME_WIDTH (f
);
880 if (FRAME_NEW_HEIGHT (f
))
881 height
= FRAME_NEW_HEIGHT (f
);
883 height
= FRAME_HEIGHT (f
);
885 /* Process foreground_color and background_color before anything else.
886 They are independent of other properties, but other properties (e.g.,
887 cursor_color) are dependent upon them. */
888 for (p
= 0; p
< i
; p
++)
890 Lisp_Object prop
, val
;
894 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
896 register Lisp_Object param_index
, old_value
;
898 param_index
= Fget (prop
, Qx_frame_parameter
);
899 old_value
= get_frame_param (f
, prop
);
900 store_frame_param (f
, prop
, val
);
901 if (NATNUMP (param_index
)
902 && (XFASTINT (param_index
)
903 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
904 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
908 /* Now process them in reverse of specified order. */
909 for (i
--; i
>= 0; i
--)
911 Lisp_Object prop
, val
;
916 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
917 width
= XFASTINT (val
);
918 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
919 height
= XFASTINT (val
);
920 else if (EQ (prop
, Qtop
))
922 else if (EQ (prop
, Qleft
))
924 else if (EQ (prop
, Qicon_top
))
926 else if (EQ (prop
, Qicon_left
))
928 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
929 /* Processed above. */
933 register Lisp_Object param_index
, old_value
;
935 param_index
= Fget (prop
, Qx_frame_parameter
);
936 old_value
= get_frame_param (f
, prop
);
937 store_frame_param (f
, prop
, val
);
938 if (NATNUMP (param_index
)
939 && (XFASTINT (param_index
)
940 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
941 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
945 /* Don't die if just one of these was set. */
946 if (EQ (left
, Qunbound
))
949 if (f
->output_data
.x
->left_pos
< 0)
950 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
952 XSETINT (left
, f
->output_data
.x
->left_pos
);
954 if (EQ (top
, Qunbound
))
957 if (f
->output_data
.x
->top_pos
< 0)
958 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
960 XSETINT (top
, f
->output_data
.x
->top_pos
);
963 /* If one of the icon positions was not set, preserve or default it. */
964 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
966 icon_left_no_change
= 1;
967 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
968 if (NILP (icon_left
))
969 XSETINT (icon_left
, 0);
971 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
973 icon_top_no_change
= 1;
974 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
976 XSETINT (icon_top
, 0);
979 /* Don't set these parameters unless they've been explicitly
980 specified. The window might be mapped or resized while we're in
981 this function, and we don't want to override that unless the lisp
982 code has asked for it.
984 Don't set these parameters unless they actually differ from the
985 window's current parameters; the window may not actually exist
990 check_frame_size (f
, &height
, &width
);
992 XSETFRAME (frame
, f
);
994 if (width
!= FRAME_WIDTH (f
)
995 || height
!= FRAME_HEIGHT (f
)
996 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
997 Fset_frame_size (frame
, make_number (width
), make_number (height
));
999 if ((!NILP (left
) || !NILP (top
))
1000 && ! (left_no_change
&& top_no_change
)
1001 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1002 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1007 /* Record the signs. */
1008 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1009 if (EQ (left
, Qminus
))
1010 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1011 else if (INTEGERP (left
))
1013 leftpos
= XINT (left
);
1015 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1017 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1018 && CONSP (XCDR (left
))
1019 && INTEGERP (XCAR (XCDR (left
))))
1021 leftpos
= - XINT (XCAR (XCDR (left
)));
1022 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1024 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1025 && CONSP (XCDR (left
))
1026 && INTEGERP (XCAR (XCDR (left
))))
1028 leftpos
= XINT (XCAR (XCDR (left
)));
1031 if (EQ (top
, Qminus
))
1032 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1033 else if (INTEGERP (top
))
1035 toppos
= XINT (top
);
1037 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1039 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1040 && CONSP (XCDR (top
))
1041 && INTEGERP (XCAR (XCDR (top
))))
1043 toppos
= - XINT (XCAR (XCDR (top
)));
1044 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1046 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1047 && CONSP (XCDR (top
))
1048 && INTEGERP (XCAR (XCDR (top
))))
1050 toppos
= XINT (XCAR (XCDR (top
)));
1054 /* Store the numeric value of the position. */
1055 f
->output_data
.x
->top_pos
= toppos
;
1056 f
->output_data
.x
->left_pos
= leftpos
;
1058 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1060 /* Actually set that position, and convert to absolute. */
1061 x_set_offset (f
, leftpos
, toppos
, -1);
1064 if ((!NILP (icon_left
) || !NILP (icon_top
))
1065 && ! (icon_left_no_change
&& icon_top_no_change
))
1066 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1072 /* Store the screen positions of frame F into XPTR and YPTR.
1073 These are the positions of the containing window manager window,
1074 not Emacs's own window. */
1077 x_real_positions (f
, xptr
, yptr
)
1084 /* This is pretty gross, but seems to be the easiest way out of
1085 the problem that arises when restarting window-managers. */
1087 #ifdef USE_X_TOOLKIT
1088 Window outer
= (f
->output_data
.x
->widget
1089 ? XtWindow (f
->output_data
.x
->widget
)
1090 : FRAME_X_WINDOW (f
));
1092 Window outer
= f
->output_data
.x
->window_desc
;
1094 Window tmp_root_window
;
1095 Window
*tmp_children
;
1096 unsigned int tmp_nchildren
;
1100 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1101 Window outer_window
;
1103 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1104 &f
->output_data
.x
->parent_desc
,
1105 &tmp_children
, &tmp_nchildren
);
1106 XFree ((char *) tmp_children
);
1110 /* Find the position of the outside upper-left corner of
1111 the inner window, with respect to the outer window. */
1112 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1113 outer_window
= f
->output_data
.x
->parent_desc
;
1115 outer_window
= outer
;
1117 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1119 /* From-window, to-window. */
1121 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1123 /* From-position, to-position. */
1124 0, 0, &win_x
, &win_y
,
1129 /* It is possible for the window returned by the XQueryNotify
1130 to become invalid by the time we call XTranslateCoordinates.
1131 That can happen when you restart some window managers.
1132 If so, we get an error in XTranslateCoordinates.
1133 Detect that and try the whole thing over. */
1134 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1136 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1140 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1147 /* Insert a description of internally-recorded parameters of frame X
1148 into the parameter alist *ALISTPTR that is to be given to the user.
1149 Only parameters that are specific to the X window system
1150 and whose values are not correctly recorded in the frame's
1151 param_alist need to be considered here. */
1154 x_report_frame_params (f
, alistptr
)
1156 Lisp_Object
*alistptr
;
1161 /* Represent negative positions (off the top or left screen edge)
1162 in a way that Fmodify_frame_parameters will understand correctly. */
1163 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1164 if (f
->output_data
.x
->left_pos
>= 0)
1165 store_in_alist (alistptr
, Qleft
, tem
);
1167 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1169 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1170 if (f
->output_data
.x
->top_pos
>= 0)
1171 store_in_alist (alistptr
, Qtop
, tem
);
1173 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1175 store_in_alist (alistptr
, Qborder_width
,
1176 make_number (f
->output_data
.x
->border_width
));
1177 store_in_alist (alistptr
, Qinternal_border_width
,
1178 make_number (f
->output_data
.x
->internal_border_width
));
1179 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1180 store_in_alist (alistptr
, Qwindow_id
,
1181 build_string (buf
));
1182 #ifdef USE_X_TOOLKIT
1183 /* Tooltip frame may not have this widget. */
1184 if (f
->output_data
.x
->widget
)
1186 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1187 store_in_alist (alistptr
, Qouter_window_id
,
1188 build_string (buf
));
1189 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1190 FRAME_SAMPLE_VISIBILITY (f
);
1191 store_in_alist (alistptr
, Qvisibility
,
1192 (FRAME_VISIBLE_P (f
) ? Qt
1193 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1194 store_in_alist (alistptr
, Qdisplay
,
1195 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1197 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1200 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1201 store_in_alist (alistptr
, Qparent_id
, tem
);
1206 /* Gamma-correct COLOR on frame F. */
1209 gamma_correct (f
, color
)
1215 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1216 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1217 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1222 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1223 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1224 allocate the color. Value is zero if COLOR_NAME is invalid, or
1225 no color could be allocated. */
1228 x_defined_color (f
, color_name
, color
, alloc_p
)
1235 Display
*dpy
= FRAME_X_DISPLAY (f
);
1236 Colormap cmap
= FRAME_X_COLORMAP (f
);
1239 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1240 if (success_p
&& alloc_p
)
1241 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1248 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1249 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1250 Signal an error if color can't be allocated. */
1253 x_decode_color (f
, color_name
, mono_color
)
1255 Lisp_Object color_name
;
1260 CHECK_STRING (color_name
, 0);
1262 #if 0 /* Don't do this. It's wrong when we're not using the default
1263 colormap, it makes freeing difficult, and it's probably not
1264 an important optimization. */
1265 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1266 return BLACK_PIX_DEFAULT (f
);
1267 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1268 return WHITE_PIX_DEFAULT (f
);
1271 /* Return MONO_COLOR for monochrome frames. */
1272 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1275 /* x_defined_color is responsible for coping with failures
1276 by looking for a near-miss. */
1277 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1280 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1281 Fcons (color_name
, Qnil
)));
1287 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1288 the previous value of that parameter, NEW_VALUE is the new value. */
1291 x_set_line_spacing (f
, new_value
, old_value
)
1293 Lisp_Object new_value
, old_value
;
1295 if (NILP (new_value
))
1296 f
->extra_line_spacing
= 0;
1297 else if (NATNUMP (new_value
))
1298 f
->extra_line_spacing
= XFASTINT (new_value
);
1300 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1301 Fcons (new_value
, Qnil
)));
1302 if (FRAME_VISIBLE_P (f
))
1307 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1308 the previous value of that parameter, NEW_VALUE is the new value. */
1311 x_set_screen_gamma (f
, new_value
, old_value
)
1313 Lisp_Object new_value
, old_value
;
1315 if (NILP (new_value
))
1317 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1318 /* The value 0.4545 is the normal viewing gamma. */
1319 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1321 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1322 Fcons (new_value
, Qnil
)));
1324 clear_face_cache (0);
1328 /* Functions called only from `x_set_frame_param'
1329 to set individual parameters.
1331 If FRAME_X_WINDOW (f) is 0,
1332 the frame is being created and its X-window does not exist yet.
1333 In that case, just record the parameter's new value
1334 in the standard place; do not attempt to change the window. */
1337 x_set_foreground_color (f
, arg
, oldval
)
1339 Lisp_Object arg
, oldval
;
1341 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1343 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1344 f
->output_data
.x
->foreground_pixel
= pixel
;
1346 if (FRAME_X_WINDOW (f
) != 0)
1349 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1350 f
->output_data
.x
->foreground_pixel
);
1351 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1352 f
->output_data
.x
->foreground_pixel
);
1354 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1355 if (FRAME_VISIBLE_P (f
))
1361 x_set_background_color (f
, arg
, oldval
)
1363 Lisp_Object arg
, oldval
;
1365 unsigned long pixel
= x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1367 unload_color (f
, f
->output_data
.x
->background_pixel
);
1368 f
->output_data
.x
->background_pixel
= pixel
;
1370 if (FRAME_X_WINDOW (f
) != 0)
1373 /* The main frame area. */
1374 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1375 f
->output_data
.x
->background_pixel
);
1376 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1377 f
->output_data
.x
->background_pixel
);
1378 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1379 f
->output_data
.x
->background_pixel
);
1380 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1381 f
->output_data
.x
->background_pixel
);
1384 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1385 bar
= XSCROLL_BAR (bar
)->next
)
1386 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1387 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1388 f
->output_data
.x
->background_pixel
);
1392 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1394 if (FRAME_VISIBLE_P (f
))
1400 x_set_mouse_color (f
, arg
, oldval
)
1402 Lisp_Object arg
, oldval
;
1404 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1405 Cursor hourglass_cursor
, horizontal_drag_cursor
;
1407 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1408 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1410 /* Don't let pointers be invisible. */
1411 if (mask_color
== pixel
1412 && mask_color
== f
->output_data
.x
->background_pixel
)
1414 x_free_colors (f
, &pixel
, 1);
1415 pixel
= x_copy_color (f
, f
->output_data
.x
->foreground_pixel
);
1418 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1419 f
->output_data
.x
->mouse_pixel
= pixel
;
1423 /* It's not okay to crash if the user selects a screwy cursor. */
1424 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1426 if (!EQ (Qnil
, Vx_pointer_shape
))
1428 CHECK_NUMBER (Vx_pointer_shape
, 0);
1429 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1432 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1433 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1435 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1437 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1438 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1439 XINT (Vx_nontext_pointer_shape
));
1442 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1443 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1445 if (!EQ (Qnil
, Vx_hourglass_pointer_shape
))
1447 CHECK_NUMBER (Vx_hourglass_pointer_shape
, 0);
1448 hourglass_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1449 XINT (Vx_hourglass_pointer_shape
));
1452 hourglass_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1453 x_check_errors (FRAME_X_DISPLAY (f
), "bad hourglass pointer cursor: %s");
1455 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1456 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1458 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1459 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1460 XINT (Vx_mode_pointer_shape
));
1463 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1464 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1466 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1468 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1470 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1471 XINT (Vx_sensitive_text_pointer_shape
));
1474 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1476 if (!NILP (Vx_window_horizontal_drag_shape
))
1478 CHECK_NUMBER (Vx_window_horizontal_drag_shape
, 0);
1479 horizontal_drag_cursor
1480 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1481 XINT (Vx_window_horizontal_drag_shape
));
1484 horizontal_drag_cursor
1485 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
1487 /* Check and report errors with the above calls. */
1488 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1489 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1492 XColor fore_color
, back_color
;
1494 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1495 x_query_color (f
, &fore_color
);
1496 back_color
.pixel
= mask_color
;
1497 x_query_color (f
, &back_color
);
1499 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1500 &fore_color
, &back_color
);
1501 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1502 &fore_color
, &back_color
);
1503 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1504 &fore_color
, &back_color
);
1505 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1506 &fore_color
, &back_color
);
1507 XRecolorCursor (FRAME_X_DISPLAY (f
), hourglass_cursor
,
1508 &fore_color
, &back_color
);
1509 XRecolorCursor (FRAME_X_DISPLAY (f
), horizontal_drag_cursor
,
1510 &fore_color
, &back_color
);
1513 if (FRAME_X_WINDOW (f
) != 0)
1514 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1516 if (cursor
!= f
->output_data
.x
->text_cursor
1517 && f
->output_data
.x
->text_cursor
!= 0)
1518 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1519 f
->output_data
.x
->text_cursor
= cursor
;
1521 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1522 && f
->output_data
.x
->nontext_cursor
!= 0)
1523 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1524 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1526 if (hourglass_cursor
!= f
->output_data
.x
->hourglass_cursor
1527 && f
->output_data
.x
->hourglass_cursor
!= 0)
1528 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->hourglass_cursor
);
1529 f
->output_data
.x
->hourglass_cursor
= hourglass_cursor
;
1531 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1532 && f
->output_data
.x
->modeline_cursor
!= 0)
1533 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1534 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1536 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1537 && f
->output_data
.x
->cross_cursor
!= 0)
1538 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1539 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1541 if (horizontal_drag_cursor
!= f
->output_data
.x
->horizontal_drag_cursor
1542 && f
->output_data
.x
->horizontal_drag_cursor
!= 0)
1543 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->horizontal_drag_cursor
);
1544 f
->output_data
.x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1546 XFlush (FRAME_X_DISPLAY (f
));
1549 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1553 x_set_cursor_color (f
, arg
, oldval
)
1555 Lisp_Object arg
, oldval
;
1557 unsigned long fore_pixel
, pixel
;
1558 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1560 if (!NILP (Vx_cursor_fore_pixel
))
1562 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1563 WHITE_PIX_DEFAULT (f
));
1564 fore_pixel_allocated_p
= 1;
1567 fore_pixel
= f
->output_data
.x
->background_pixel
;
1569 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1570 pixel_allocated_p
= 1;
1572 /* Make sure that the cursor color differs from the background color. */
1573 if (pixel
== f
->output_data
.x
->background_pixel
)
1575 if (pixel_allocated_p
)
1577 x_free_colors (f
, &pixel
, 1);
1578 pixel_allocated_p
= 0;
1581 pixel
= f
->output_data
.x
->mouse_pixel
;
1582 if (pixel
== fore_pixel
)
1584 if (fore_pixel_allocated_p
)
1586 x_free_colors (f
, &fore_pixel
, 1);
1587 fore_pixel_allocated_p
= 0;
1589 fore_pixel
= f
->output_data
.x
->background_pixel
;
1593 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1594 if (!fore_pixel_allocated_p
)
1595 fore_pixel
= x_copy_color (f
, fore_pixel
);
1596 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1598 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1599 if (!pixel_allocated_p
)
1600 pixel
= x_copy_color (f
, pixel
);
1601 f
->output_data
.x
->cursor_pixel
= pixel
;
1603 if (FRAME_X_WINDOW (f
) != 0)
1606 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1607 f
->output_data
.x
->cursor_pixel
);
1608 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1612 if (FRAME_VISIBLE_P (f
))
1614 x_update_cursor (f
, 0);
1615 x_update_cursor (f
, 1);
1619 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1622 /* Set the border-color of frame F to value described by ARG.
1623 ARG can be a string naming a color.
1624 The border-color is used for the border that is drawn by the X server.
1625 Note that this does not fully take effect if done before
1626 F has an x-window; it must be redone when the window is created.
1628 Note: this is done in two routines because of the way X10 works.
1630 Note: under X11, this is normally the province of the window manager,
1631 and so emacs' border colors may be overridden. */
1634 x_set_border_color (f
, arg
, oldval
)
1636 Lisp_Object arg
, oldval
;
1640 CHECK_STRING (arg
, 0);
1641 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1642 x_set_border_pixel (f
, pix
);
1643 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1646 /* Set the border-color of frame F to pixel value PIX.
1647 Note that this does not fully take effect if done before
1648 F has an x-window. */
1651 x_set_border_pixel (f
, pix
)
1655 unload_color (f
, f
->output_data
.x
->border_pixel
);
1656 f
->output_data
.x
->border_pixel
= pix
;
1658 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1661 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1662 (unsigned long)pix
);
1665 if (FRAME_VISIBLE_P (f
))
1671 /* Value is the internal representation of the specified cursor type
1672 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1673 of the bar cursor. */
1675 enum text_cursor_kinds
1676 x_specified_cursor_type (arg
, width
)
1680 enum text_cursor_kinds type
;
1687 else if (CONSP (arg
)
1688 && EQ (XCAR (arg
), Qbar
)
1689 && INTEGERP (XCDR (arg
))
1690 && XINT (XCDR (arg
)) >= 0)
1693 *width
= XINT (XCDR (arg
));
1695 else if (NILP (arg
))
1698 /* Treat anything unknown as "box cursor".
1699 It was bad to signal an error; people have trouble fixing
1700 .Xdefaults with Emacs, when it has something bad in it. */
1701 type
= FILLED_BOX_CURSOR
;
1707 x_set_cursor_type (f
, arg
, oldval
)
1709 Lisp_Object arg
, oldval
;
1713 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1714 f
->output_data
.x
->cursor_width
= width
;
1716 /* Make sure the cursor gets redrawn. This is overkill, but how
1717 often do people change cursor types? */
1718 update_mode_lines
++;
1722 x_set_icon_type (f
, arg
, oldval
)
1724 Lisp_Object arg
, oldval
;
1730 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1733 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1738 result
= x_text_icon (f
,
1739 (char *) XSTRING ((!NILP (f
->icon_name
)
1743 result
= x_bitmap_icon (f
, arg
);
1748 error ("No icon window available");
1751 XFlush (FRAME_X_DISPLAY (f
));
1755 /* Return non-nil if frame F wants a bitmap icon. */
1763 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1771 x_set_icon_name (f
, arg
, oldval
)
1773 Lisp_Object arg
, oldval
;
1779 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1782 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1787 if (f
->output_data
.x
->icon_bitmap
!= 0)
1792 result
= x_text_icon (f
,
1793 (char *) XSTRING ((!NILP (f
->icon_name
)
1802 error ("No icon window available");
1805 XFlush (FRAME_X_DISPLAY (f
));
1810 x_set_font (f
, arg
, oldval
)
1812 Lisp_Object arg
, oldval
;
1815 Lisp_Object fontset_name
;
1817 int old_fontset
= f
->output_data
.x
->fontset
;
1819 CHECK_STRING (arg
, 1);
1821 fontset_name
= Fquery_fontset (arg
, Qnil
);
1824 result
= (STRINGP (fontset_name
)
1825 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1826 : x_new_font (f
, XSTRING (arg
)->data
));
1829 if (EQ (result
, Qnil
))
1830 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1831 else if (EQ (result
, Qt
))
1832 error ("The characters of the given font have varying widths");
1833 else if (STRINGP (result
))
1835 if (STRINGP (fontset_name
))
1837 /* Fontset names are built from ASCII font names, so the
1838 names may be equal despite there was a change. */
1839 if (old_fontset
== f
->output_data
.x
->fontset
)
1842 else if (!NILP (Fequal (result
, oldval
)))
1845 store_frame_param (f
, Qfont
, result
);
1846 recompute_basic_faces (f
);
1851 do_pending_window_change (0);
1853 /* Don't call `face-set-after-frame-default' when faces haven't been
1854 initialized yet. This is the case when called from
1855 Fx_create_frame. In that case, the X widget or window doesn't
1856 exist either, and we can end up in x_report_frame_params with a
1857 null widget which gives a segfault. */
1858 if (FRAME_FACE_CACHE (f
))
1860 XSETFRAME (frame
, f
);
1861 call1 (Qface_set_after_frame_default
, frame
);
1866 x_set_border_width (f
, arg
, oldval
)
1868 Lisp_Object arg
, oldval
;
1870 CHECK_NUMBER (arg
, 0);
1872 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1875 if (FRAME_X_WINDOW (f
) != 0)
1876 error ("Cannot change the border width of a window");
1878 f
->output_data
.x
->border_width
= XINT (arg
);
1882 x_set_internal_border_width (f
, arg
, oldval
)
1884 Lisp_Object arg
, oldval
;
1886 int old
= f
->output_data
.x
->internal_border_width
;
1888 CHECK_NUMBER (arg
, 0);
1889 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1890 if (f
->output_data
.x
->internal_border_width
< 0)
1891 f
->output_data
.x
->internal_border_width
= 0;
1893 #ifdef USE_X_TOOLKIT
1894 if (f
->output_data
.x
->edit_widget
)
1895 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1898 if (f
->output_data
.x
->internal_border_width
== old
)
1901 if (FRAME_X_WINDOW (f
) != 0)
1903 x_set_window_size (f
, 0, f
->width
, f
->height
);
1904 SET_FRAME_GARBAGED (f
);
1905 do_pending_window_change (0);
1910 x_set_visibility (f
, value
, oldval
)
1912 Lisp_Object value
, oldval
;
1915 XSETFRAME (frame
, f
);
1918 Fmake_frame_invisible (frame
, Qt
);
1919 else if (EQ (value
, Qicon
))
1920 Ficonify_frame (frame
);
1922 Fmake_frame_visible (frame
);
1926 /* Change window heights in windows rooted in WINDOW by N lines. */
1929 x_change_window_heights (window
, n
)
1933 struct window
*w
= XWINDOW (window
);
1935 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1936 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1938 if (INTEGERP (w
->orig_top
))
1939 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1940 if (INTEGERP (w
->orig_height
))
1941 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1943 /* Handle just the top child in a vertical split. */
1944 if (!NILP (w
->vchild
))
1945 x_change_window_heights (w
->vchild
, n
);
1947 /* Adjust all children in a horizontal split. */
1948 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1950 w
= XWINDOW (window
);
1951 x_change_window_heights (window
, n
);
1956 x_set_menu_bar_lines (f
, value
, oldval
)
1958 Lisp_Object value
, oldval
;
1961 #ifndef USE_X_TOOLKIT
1962 int olines
= FRAME_MENU_BAR_LINES (f
);
1965 /* Right now, menu bars don't work properly in minibuf-only frames;
1966 most of the commands try to apply themselves to the minibuffer
1967 frame itself, and get an error because you can't switch buffers
1968 in or split the minibuffer window. */
1969 if (FRAME_MINIBUF_ONLY_P (f
))
1972 if (INTEGERP (value
))
1973 nlines
= XINT (value
);
1977 /* Make sure we redisplay all windows in this frame. */
1978 windows_or_buffers_changed
++;
1980 #ifdef USE_X_TOOLKIT
1981 FRAME_MENU_BAR_LINES (f
) = 0;
1984 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1985 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1986 /* Make sure next redisplay shows the menu bar. */
1987 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1991 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1992 free_frame_menubar (f
);
1993 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1995 f
->output_data
.x
->menubar_widget
= 0;
1997 #else /* not USE_X_TOOLKIT */
1998 FRAME_MENU_BAR_LINES (f
) = nlines
;
1999 x_change_window_heights (f
->root_window
, nlines
- olines
);
2000 #endif /* not USE_X_TOOLKIT */
2005 /* Set the number of lines used for the tool bar of frame F to VALUE.
2006 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2007 is the old number of tool bar lines. This function changes the
2008 height of all windows on frame F to match the new tool bar height.
2009 The frame's height doesn't change. */
2012 x_set_tool_bar_lines (f
, value
, oldval
)
2014 Lisp_Object value
, oldval
;
2016 int delta
, nlines
, root_height
;
2017 Lisp_Object root_window
;
2019 /* Treat tool bars like menu bars. */
2020 if (FRAME_MINIBUF_ONLY_P (f
))
2023 /* Use VALUE only if an integer >= 0. */
2024 if (INTEGERP (value
) && XINT (value
) >= 0)
2025 nlines
= XFASTINT (value
);
2029 /* Make sure we redisplay all windows in this frame. */
2030 ++windows_or_buffers_changed
;
2032 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2034 /* Don't resize the tool-bar to more than we have room for. */
2035 root_window
= FRAME_ROOT_WINDOW (f
);
2036 root_height
= XINT (XWINDOW (root_window
)->height
);
2037 if (root_height
- delta
< 1)
2039 delta
= root_height
- 1;
2040 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2043 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2044 x_change_window_heights (root_window
, delta
);
2047 /* We also have to make sure that the internal border at the top of
2048 the frame, below the menu bar or tool bar, is redrawn when the
2049 tool bar disappears. This is so because the internal border is
2050 below the tool bar if one is displayed, but is below the menu bar
2051 if there isn't a tool bar. The tool bar draws into the area
2052 below the menu bar. */
2053 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2057 clear_current_matrices (f
);
2058 updating_frame
= NULL
;
2061 /* If the tool bar gets smaller, the internal border below it
2062 has to be cleared. It was formerly part of the display
2063 of the larger tool bar, and updating windows won't clear it. */
2066 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2067 int width
= PIXEL_WIDTH (f
);
2068 int y
= nlines
* CANON_Y_UNIT (f
);
2071 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2072 0, y
, width
, height
, False
);
2078 /* Set the foreground color for scroll bars on frame F to VALUE.
2079 VALUE should be a string, a color name. If it isn't a string or
2080 isn't a valid color name, do nothing. OLDVAL is the old value of
2081 the frame parameter. */
2084 x_set_scroll_bar_foreground (f
, value
, oldval
)
2086 Lisp_Object value
, oldval
;
2088 unsigned long pixel
;
2090 if (STRINGP (value
))
2091 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2095 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2096 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2098 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2099 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2101 /* Remove all scroll bars because they have wrong colors. */
2102 if (condemn_scroll_bars_hook
)
2103 (*condemn_scroll_bars_hook
) (f
);
2104 if (judge_scroll_bars_hook
)
2105 (*judge_scroll_bars_hook
) (f
);
2107 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2113 /* Set the background color for scroll bars on frame F to VALUE VALUE
2114 should be a string, a color name. If it isn't a string or isn't a
2115 valid color name, do nothing. OLDVAL is the old value of the frame
2119 x_set_scroll_bar_background (f
, value
, oldval
)
2121 Lisp_Object value
, oldval
;
2123 unsigned long pixel
;
2125 if (STRINGP (value
))
2126 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2130 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2131 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2133 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2134 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2136 /* Remove all scroll bars because they have wrong colors. */
2137 if (condemn_scroll_bars_hook
)
2138 (*condemn_scroll_bars_hook
) (f
);
2139 if (judge_scroll_bars_hook
)
2140 (*judge_scroll_bars_hook
) (f
);
2142 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2148 /* Encode Lisp string STRING as a text in a format appropriate for
2149 XICCC (X Inter Client Communication Conventions).
2151 If STRING contains only ASCII characters, do no conversion and
2152 return the string data of STRING. Otherwise, encode the text by
2153 CODING_SYSTEM, and return a newly allocated memory area which
2154 should be freed by `xfree' by a caller.
2156 Store the byte length of resulting text in *TEXT_BYTES.
2158 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2159 which means that the `encoding' of the result can be `STRING'.
2160 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2161 the result should be `COMPOUND_TEXT'. */
2164 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2165 Lisp_Object string
, coding_system
;
2166 int *text_bytes
, *stringp
;
2168 unsigned char *str
= XSTRING (string
)->data
;
2169 int chars
= XSTRING (string
)->size
;
2170 int bytes
= STRING_BYTES (XSTRING (string
));
2174 struct coding_system coding
;
2176 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2177 if (charset_info
== 0)
2179 /* No multibyte character in OBJ. We need not encode it. */
2180 *text_bytes
= bytes
;
2185 setup_coding_system (coding_system
, &coding
);
2186 coding
.src_multibyte
= 1;
2187 coding
.dst_multibyte
= 0;
2188 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2189 if (coding
.type
== coding_type_iso2022
)
2190 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2191 /* We suppress producing escape sequences for composition. */
2192 coding
.composing
= COMPOSITION_DISABLED
;
2193 bufsize
= encoding_buffer_size (&coding
, bytes
);
2194 buf
= (unsigned char *) xmalloc (bufsize
);
2195 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2196 *text_bytes
= coding
.produced
;
2197 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2202 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2205 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2206 name; if NAME is a string, set F's name to NAME and set
2207 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2209 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2210 suggesting a new name, which lisp code should override; if
2211 F->explicit_name is set, ignore the new name; otherwise, set it. */
2214 x_set_name (f
, name
, explicit)
2219 /* Make sure that requests from lisp code override requests from
2220 Emacs redisplay code. */
2223 /* If we're switching from explicit to implicit, we had better
2224 update the mode lines and thereby update the title. */
2225 if (f
->explicit_name
&& NILP (name
))
2226 update_mode_lines
= 1;
2228 f
->explicit_name
= ! NILP (name
);
2230 else if (f
->explicit_name
)
2233 /* If NAME is nil, set the name to the x_id_name. */
2236 /* Check for no change needed in this very common case
2237 before we do any consing. */
2238 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2239 XSTRING (f
->name
)->data
))
2241 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2244 CHECK_STRING (name
, 0);
2246 /* Don't change the name if it's already NAME. */
2247 if (! NILP (Fstring_equal (name
, f
->name
)))
2252 /* For setting the frame title, the title parameter should override
2253 the name parameter. */
2254 if (! NILP (f
->title
))
2257 if (FRAME_X_WINDOW (f
))
2262 XTextProperty text
, icon
;
2264 Lisp_Object coding_system
;
2266 coding_system
= Vlocale_coding_system
;
2267 if (NILP (coding_system
))
2268 coding_system
= Qcompound_text
;
2269 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2270 text
.encoding
= (stringp
? XA_STRING
2271 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2273 text
.nitems
= bytes
;
2275 if (NILP (f
->icon_name
))
2281 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2283 icon
.encoding
= (stringp
? XA_STRING
2284 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2286 icon
.nitems
= bytes
;
2288 #ifdef USE_X_TOOLKIT
2289 XSetWMName (FRAME_X_DISPLAY (f
),
2290 XtWindow (f
->output_data
.x
->widget
), &text
);
2291 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2293 #else /* not USE_X_TOOLKIT */
2294 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2295 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2296 #endif /* not USE_X_TOOLKIT */
2297 if (!NILP (f
->icon_name
)
2298 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2300 if (text
.value
!= XSTRING (name
)->data
)
2303 #else /* not HAVE_X11R4 */
2304 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2305 XSTRING (name
)->data
);
2306 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2307 XSTRING (name
)->data
);
2308 #endif /* not HAVE_X11R4 */
2313 /* This function should be called when the user's lisp code has
2314 specified a name for the frame; the name will override any set by the
2317 x_explicitly_set_name (f
, arg
, oldval
)
2319 Lisp_Object arg
, oldval
;
2321 x_set_name (f
, arg
, 1);
2324 /* This function should be called by Emacs redisplay code to set the
2325 name; names set this way will never override names set by the user's
2328 x_implicitly_set_name (f
, arg
, oldval
)
2330 Lisp_Object arg
, oldval
;
2332 x_set_name (f
, arg
, 0);
2335 /* Change the title of frame F to NAME.
2336 If NAME is nil, use the frame name as the title.
2338 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2339 name; if NAME is a string, set F's name to NAME and set
2340 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2342 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2343 suggesting a new name, which lisp code should override; if
2344 F->explicit_name is set, ignore the new name; otherwise, set it. */
2347 x_set_title (f
, name
, old_name
)
2349 Lisp_Object name
, old_name
;
2351 /* Don't change the title if it's already NAME. */
2352 if (EQ (name
, f
->title
))
2355 update_mode_lines
= 1;
2362 CHECK_STRING (name
, 0);
2364 if (FRAME_X_WINDOW (f
))
2369 XTextProperty text
, icon
;
2371 Lisp_Object coding_system
;
2373 coding_system
= Vlocale_coding_system
;
2374 if (NILP (coding_system
))
2375 coding_system
= Qcompound_text
;
2376 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2377 text
.encoding
= (stringp
? XA_STRING
2378 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2380 text
.nitems
= bytes
;
2382 if (NILP (f
->icon_name
))
2388 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2390 icon
.encoding
= (stringp
? XA_STRING
2391 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2393 icon
.nitems
= bytes
;
2395 #ifdef USE_X_TOOLKIT
2396 XSetWMName (FRAME_X_DISPLAY (f
),
2397 XtWindow (f
->output_data
.x
->widget
), &text
);
2398 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2400 #else /* not USE_X_TOOLKIT */
2401 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2402 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2403 #endif /* not USE_X_TOOLKIT */
2404 if (!NILP (f
->icon_name
)
2405 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2407 if (text
.value
!= XSTRING (name
)->data
)
2410 #else /* not HAVE_X11R4 */
2411 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2412 XSTRING (name
)->data
);
2413 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2414 XSTRING (name
)->data
);
2415 #endif /* not HAVE_X11R4 */
2421 x_set_autoraise (f
, arg
, oldval
)
2423 Lisp_Object arg
, oldval
;
2425 f
->auto_raise
= !EQ (Qnil
, arg
);
2429 x_set_autolower (f
, arg
, oldval
)
2431 Lisp_Object arg
, oldval
;
2433 f
->auto_lower
= !EQ (Qnil
, arg
);
2437 x_set_unsplittable (f
, arg
, oldval
)
2439 Lisp_Object arg
, oldval
;
2441 f
->no_split
= !NILP (arg
);
2445 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2447 Lisp_Object arg
, oldval
;
2449 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2450 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2451 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2452 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2454 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2456 ? vertical_scroll_bar_none
2458 ? vertical_scroll_bar_right
2459 : vertical_scroll_bar_left
);
2461 /* We set this parameter before creating the X window for the
2462 frame, so we can get the geometry right from the start.
2463 However, if the window hasn't been created yet, we shouldn't
2464 call x_set_window_size. */
2465 if (FRAME_X_WINDOW (f
))
2466 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2467 do_pending_window_change (0);
2472 x_set_scroll_bar_width (f
, arg
, oldval
)
2474 Lisp_Object arg
, oldval
;
2476 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2480 #ifdef USE_TOOLKIT_SCROLL_BARS
2481 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2482 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2483 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2484 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2486 /* Make the actual width at least 14 pixels and a multiple of a
2488 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2490 /* Use all of that space (aside from required margins) for the
2492 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2495 if (FRAME_X_WINDOW (f
))
2496 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2497 do_pending_window_change (0);
2499 else if (INTEGERP (arg
) && XINT (arg
) > 0
2500 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2502 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2503 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2505 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2506 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2507 if (FRAME_X_WINDOW (f
))
2508 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2511 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2512 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2513 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2518 /* Subroutines of creating an X frame. */
2520 /* Make sure that Vx_resource_name is set to a reasonable value.
2521 Fix it up, or set it to `emacs' if it is too hopeless. */
2524 validate_x_resource_name ()
2527 /* Number of valid characters in the resource name. */
2529 /* Number of invalid characters in the resource name. */
2534 if (!STRINGP (Vx_resource_class
))
2535 Vx_resource_class
= build_string (EMACS_CLASS
);
2537 if (STRINGP (Vx_resource_name
))
2539 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2542 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2544 /* Only letters, digits, - and _ are valid in resource names.
2545 Count the valid characters and count the invalid ones. */
2546 for (i
= 0; i
< len
; i
++)
2549 if (! ((c
>= 'a' && c
<= 'z')
2550 || (c
>= 'A' && c
<= 'Z')
2551 || (c
>= '0' && c
<= '9')
2552 || c
== '-' || c
== '_'))
2559 /* Not a string => completely invalid. */
2560 bad_count
= 5, good_count
= 0;
2562 /* If name is valid already, return. */
2566 /* If name is entirely invalid, or nearly so, use `emacs'. */
2568 || (good_count
== 1 && bad_count
> 0))
2570 Vx_resource_name
= build_string ("emacs");
2574 /* Name is partly valid. Copy it and replace the invalid characters
2575 with underscores. */
2577 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2579 for (i
= 0; i
< len
; i
++)
2581 int c
= XSTRING (new)->data
[i
];
2582 if (! ((c
>= 'a' && c
<= 'z')
2583 || (c
>= 'A' && c
<= 'Z')
2584 || (c
>= '0' && c
<= '9')
2585 || c
== '-' || c
== '_'))
2586 XSTRING (new)->data
[i
] = '_';
2591 extern char *x_get_string_resource ();
2593 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2594 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2595 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2596 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2597 the name specified by the `-name' or `-rn' command-line arguments.\n\
2599 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2600 class, respectively. You must specify both of them or neither.\n\
2601 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2602 and the class is `Emacs.CLASS.SUBCLASS'.")
2603 (attribute
, class, component
, subclass
)
2604 Lisp_Object attribute
, class, component
, subclass
;
2606 register char *value
;
2612 CHECK_STRING (attribute
, 0);
2613 CHECK_STRING (class, 0);
2615 if (!NILP (component
))
2616 CHECK_STRING (component
, 1);
2617 if (!NILP (subclass
))
2618 CHECK_STRING (subclass
, 2);
2619 if (NILP (component
) != NILP (subclass
))
2620 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2622 validate_x_resource_name ();
2624 /* Allocate space for the components, the dots which separate them,
2625 and the final '\0'. Make them big enough for the worst case. */
2626 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2627 + (STRINGP (component
)
2628 ? STRING_BYTES (XSTRING (component
)) : 0)
2629 + STRING_BYTES (XSTRING (attribute
))
2632 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2633 + STRING_BYTES (XSTRING (class))
2634 + (STRINGP (subclass
)
2635 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2638 /* Start with emacs.FRAMENAME for the name (the specific one)
2639 and with `Emacs' for the class key (the general one). */
2640 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2641 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2643 strcat (class_key
, ".");
2644 strcat (class_key
, XSTRING (class)->data
);
2646 if (!NILP (component
))
2648 strcat (class_key
, ".");
2649 strcat (class_key
, XSTRING (subclass
)->data
);
2651 strcat (name_key
, ".");
2652 strcat (name_key
, XSTRING (component
)->data
);
2655 strcat (name_key
, ".");
2656 strcat (name_key
, XSTRING (attribute
)->data
);
2658 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2659 name_key
, class_key
);
2661 if (value
!= (char *) 0)
2662 return build_string (value
);
2667 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2670 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2671 struct x_display_info
*dpyinfo
;
2672 Lisp_Object attribute
, class, component
, subclass
;
2674 register char *value
;
2678 CHECK_STRING (attribute
, 0);
2679 CHECK_STRING (class, 0);
2681 if (!NILP (component
))
2682 CHECK_STRING (component
, 1);
2683 if (!NILP (subclass
))
2684 CHECK_STRING (subclass
, 2);
2685 if (NILP (component
) != NILP (subclass
))
2686 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2688 validate_x_resource_name ();
2690 /* Allocate space for the components, the dots which separate them,
2691 and the final '\0'. Make them big enough for the worst case. */
2692 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2693 + (STRINGP (component
)
2694 ? STRING_BYTES (XSTRING (component
)) : 0)
2695 + STRING_BYTES (XSTRING (attribute
))
2698 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2699 + STRING_BYTES (XSTRING (class))
2700 + (STRINGP (subclass
)
2701 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2704 /* Start with emacs.FRAMENAME for the name (the specific one)
2705 and with `Emacs' for the class key (the general one). */
2706 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2707 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2709 strcat (class_key
, ".");
2710 strcat (class_key
, XSTRING (class)->data
);
2712 if (!NILP (component
))
2714 strcat (class_key
, ".");
2715 strcat (class_key
, XSTRING (subclass
)->data
);
2717 strcat (name_key
, ".");
2718 strcat (name_key
, XSTRING (component
)->data
);
2721 strcat (name_key
, ".");
2722 strcat (name_key
, XSTRING (attribute
)->data
);
2724 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2726 if (value
!= (char *) 0)
2727 return build_string (value
);
2732 /* Used when C code wants a resource value. */
2735 x_get_resource_string (attribute
, class)
2736 char *attribute
, *class;
2740 struct frame
*sf
= SELECTED_FRAME ();
2742 /* Allocate space for the components, the dots which separate them,
2743 and the final '\0'. */
2744 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2745 + strlen (attribute
) + 2);
2746 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2747 + strlen (class) + 2);
2749 sprintf (name_key
, "%s.%s",
2750 XSTRING (Vinvocation_name
)->data
,
2752 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2754 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2755 name_key
, class_key
);
2758 /* Types we might convert a resource string into. */
2768 /* Return the value of parameter PARAM.
2770 First search ALIST, then Vdefault_frame_alist, then the X defaults
2771 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2773 Convert the resource to the type specified by desired_type.
2775 If no default is specified, return Qunbound. If you call
2776 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2777 and don't let it get stored in any Lisp-visible variables! */
2780 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2781 struct x_display_info
*dpyinfo
;
2782 Lisp_Object alist
, param
;
2785 enum resource_types type
;
2787 register Lisp_Object tem
;
2789 tem
= Fassq (param
, alist
);
2791 tem
= Fassq (param
, Vdefault_frame_alist
);
2797 tem
= display_x_get_resource (dpyinfo
,
2798 build_string (attribute
),
2799 build_string (class),
2807 case RES_TYPE_NUMBER
:
2808 return make_number (atoi (XSTRING (tem
)->data
));
2810 case RES_TYPE_FLOAT
:
2811 return make_float (atof (XSTRING (tem
)->data
));
2813 case RES_TYPE_BOOLEAN
:
2814 tem
= Fdowncase (tem
);
2815 if (!strcmp (XSTRING (tem
)->data
, "on")
2816 || !strcmp (XSTRING (tem
)->data
, "true"))
2821 case RES_TYPE_STRING
:
2824 case RES_TYPE_SYMBOL
:
2825 /* As a special case, we map the values `true' and `on'
2826 to Qt, and `false' and `off' to Qnil. */
2829 lower
= Fdowncase (tem
);
2830 if (!strcmp (XSTRING (lower
)->data
, "on")
2831 || !strcmp (XSTRING (lower
)->data
, "true"))
2833 else if (!strcmp (XSTRING (lower
)->data
, "off")
2834 || !strcmp (XSTRING (lower
)->data
, "false"))
2837 return Fintern (tem
, Qnil
);
2850 /* Like x_get_arg, but also record the value in f->param_alist. */
2853 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2855 Lisp_Object alist
, param
;
2858 enum resource_types type
;
2862 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2863 attribute
, class, type
);
2865 store_frame_param (f
, param
, value
);
2870 /* Record in frame F the specified or default value according to ALIST
2871 of the parameter named PROP (a Lisp symbol).
2872 If no value is specified for PROP, look for an X default for XPROP
2873 on the frame named NAME.
2874 If that is not found either, use the value DEFLT. */
2877 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2884 enum resource_types type
;
2888 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2889 if (EQ (tem
, Qunbound
))
2891 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2896 /* Record in frame F the specified or default value according to ALIST
2897 of the parameter named PROP (a Lisp symbol). If no value is
2898 specified for PROP, look for an X default for XPROP on the frame
2899 named NAME. If that is not found either, use the value DEFLT. */
2902 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2911 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2914 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2915 if (EQ (tem
, Qunbound
))
2917 #ifdef USE_TOOLKIT_SCROLL_BARS
2919 /* See if an X resource for the scroll bar color has been
2921 tem
= display_x_get_resource (dpyinfo
,
2922 build_string (foreground_p
2926 build_string ("verticalScrollBar"),
2930 /* If nothing has been specified, scroll bars will use a
2931 toolkit-dependent default. Because these defaults are
2932 difficult to get at without actually creating a scroll
2933 bar, use nil to indicate that no color has been
2938 #else /* not USE_TOOLKIT_SCROLL_BARS */
2942 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2945 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2951 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2952 "Parse an X-style geometry string STRING.\n\
2953 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2954 The properties returned may include `top', `left', `height', and `width'.\n\
2955 The value of `left' or `top' may be an integer,\n\
2956 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2957 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2962 unsigned int width
, height
;
2965 CHECK_STRING (string
, 0);
2967 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2968 &x
, &y
, &width
, &height
);
2971 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2972 error ("Must specify both x and y position, or neither");
2976 if (geometry
& XValue
)
2978 Lisp_Object element
;
2980 if (x
>= 0 && (geometry
& XNegative
))
2981 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2982 else if (x
< 0 && ! (geometry
& XNegative
))
2983 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2985 element
= Fcons (Qleft
, make_number (x
));
2986 result
= Fcons (element
, result
);
2989 if (geometry
& YValue
)
2991 Lisp_Object element
;
2993 if (y
>= 0 && (geometry
& YNegative
))
2994 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2995 else if (y
< 0 && ! (geometry
& YNegative
))
2996 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2998 element
= Fcons (Qtop
, make_number (y
));
2999 result
= Fcons (element
, result
);
3002 if (geometry
& WidthValue
)
3003 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3004 if (geometry
& HeightValue
)
3005 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3010 /* Calculate the desired size and position of this window,
3011 and return the flags saying which aspects were specified.
3013 This function does not make the coordinates positive. */
3015 #define DEFAULT_ROWS 40
3016 #define DEFAULT_COLS 80
3019 x_figure_window_size (f
, parms
)
3023 register Lisp_Object tem0
, tem1
, tem2
;
3024 long window_prompting
= 0;
3025 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3027 /* Default values if we fall through.
3028 Actually, if that happens we should get
3029 window manager prompting. */
3030 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3031 f
->height
= DEFAULT_ROWS
;
3032 /* Window managers expect that if program-specified
3033 positions are not (0,0), they're intentional, not defaults. */
3034 f
->output_data
.x
->top_pos
= 0;
3035 f
->output_data
.x
->left_pos
= 0;
3037 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3038 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3039 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3040 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3042 if (!EQ (tem0
, Qunbound
))
3044 CHECK_NUMBER (tem0
, 0);
3045 f
->height
= XINT (tem0
);
3047 if (!EQ (tem1
, Qunbound
))
3049 CHECK_NUMBER (tem1
, 0);
3050 SET_FRAME_WIDTH (f
, XINT (tem1
));
3052 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3053 window_prompting
|= USSize
;
3055 window_prompting
|= PSize
;
3058 f
->output_data
.x
->vertical_scroll_bar_extra
3059 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3061 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3062 f
->output_data
.x
->flags_areas_extra
3063 = FRAME_FLAGS_AREA_WIDTH (f
);
3064 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3065 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3067 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3068 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3069 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3070 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3072 if (EQ (tem0
, Qminus
))
3074 f
->output_data
.x
->top_pos
= 0;
3075 window_prompting
|= YNegative
;
3077 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3078 && CONSP (XCDR (tem0
))
3079 && INTEGERP (XCAR (XCDR (tem0
))))
3081 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3082 window_prompting
|= YNegative
;
3084 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3085 && CONSP (XCDR (tem0
))
3086 && INTEGERP (XCAR (XCDR (tem0
))))
3088 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3090 else if (EQ (tem0
, Qunbound
))
3091 f
->output_data
.x
->top_pos
= 0;
3094 CHECK_NUMBER (tem0
, 0);
3095 f
->output_data
.x
->top_pos
= XINT (tem0
);
3096 if (f
->output_data
.x
->top_pos
< 0)
3097 window_prompting
|= YNegative
;
3100 if (EQ (tem1
, Qminus
))
3102 f
->output_data
.x
->left_pos
= 0;
3103 window_prompting
|= XNegative
;
3105 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3106 && CONSP (XCDR (tem1
))
3107 && INTEGERP (XCAR (XCDR (tem1
))))
3109 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3110 window_prompting
|= XNegative
;
3112 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3113 && CONSP (XCDR (tem1
))
3114 && INTEGERP (XCAR (XCDR (tem1
))))
3116 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3118 else if (EQ (tem1
, Qunbound
))
3119 f
->output_data
.x
->left_pos
= 0;
3122 CHECK_NUMBER (tem1
, 0);
3123 f
->output_data
.x
->left_pos
= XINT (tem1
);
3124 if (f
->output_data
.x
->left_pos
< 0)
3125 window_prompting
|= XNegative
;
3128 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3129 window_prompting
|= USPosition
;
3131 window_prompting
|= PPosition
;
3134 return window_prompting
;
3137 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3140 XSetWMProtocols (dpy
, w
, protocols
, count
)
3147 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3148 if (prop
== None
) return False
;
3149 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3150 (unsigned char *) protocols
, count
);
3153 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3155 #ifdef USE_X_TOOLKIT
3157 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3158 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3159 already be present because of the toolkit (Motif adds some of them,
3160 for example, but Xt doesn't). */
3163 hack_wm_protocols (f
, widget
)
3167 Display
*dpy
= XtDisplay (widget
);
3168 Window w
= XtWindow (widget
);
3169 int need_delete
= 1;
3175 Atom type
, *atoms
= 0;
3177 unsigned long nitems
= 0;
3178 unsigned long bytes_after
;
3180 if ((XGetWindowProperty (dpy
, w
,
3181 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3182 (long)0, (long)100, False
, XA_ATOM
,
3183 &type
, &format
, &nitems
, &bytes_after
,
3184 (unsigned char **) &atoms
)
3186 && format
== 32 && type
== XA_ATOM
)
3190 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3192 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3194 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3197 if (atoms
) XFree ((char *) atoms
);
3203 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3205 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3207 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3209 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3210 XA_ATOM
, 32, PropModeAppend
,
3211 (unsigned char *) props
, count
);
3219 /* Support routines for XIC (X Input Context). */
3223 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3224 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3227 /* Supported XIM styles, ordered by preferenc. */
3229 static XIMStyle supported_xim_styles
[] =
3231 XIMPreeditPosition
| XIMStatusArea
,
3232 XIMPreeditPosition
| XIMStatusNothing
,
3233 XIMPreeditPosition
| XIMStatusNone
,
3234 XIMPreeditNothing
| XIMStatusArea
,
3235 XIMPreeditNothing
| XIMStatusNothing
,
3236 XIMPreeditNothing
| XIMStatusNone
,
3237 XIMPreeditNone
| XIMStatusArea
,
3238 XIMPreeditNone
| XIMStatusNothing
,
3239 XIMPreeditNone
| XIMStatusNone
,
3244 /* Create an X fontset on frame F with base font name
3248 xic_create_xfontset (f
, base_fontname
)
3250 char *base_fontname
;
3253 char **missing_list
;
3257 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3258 base_fontname
, &missing_list
,
3259 &missing_count
, &def_string
);
3261 XFreeStringList (missing_list
);
3263 /* No need to free def_string. */
3268 /* Value is the best input style, given user preferences USER (already
3269 checked to be supported by Emacs), and styles supported by the
3270 input method XIM. */
3273 best_xim_style (user
, xim
)
3279 for (i
= 0; i
< user
->count_styles
; ++i
)
3280 for (j
= 0; j
< xim
->count_styles
; ++j
)
3281 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3282 return user
->supported_styles
[i
];
3284 /* Return the default style. */
3285 return XIMPreeditNothing
| XIMStatusNothing
;
3288 /* Create XIC for frame F. */
3290 static XIMStyle xic_style
;
3293 create_frame_xic (f
)
3298 XFontSet xfs
= NULL
;
3303 xim
= FRAME_X_XIM (f
);
3308 XVaNestedList preedit_attr
;
3309 XVaNestedList status_attr
;
3310 char *base_fontname
;
3313 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3314 spot
.x
= 0; spot
.y
= 1;
3315 /* Create X fontset. */
3316 fontset
= FRAME_FONTSET (f
);
3318 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3321 /* Determine the base fontname from the ASCII font name of
3323 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3324 char *p
= ascii_font
;
3327 for (i
= 0; *p
; p
++)
3330 /* As the font name doesn't conform to XLFD, we can't
3331 modify it to get a suitable base fontname for the
3333 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3336 int len
= strlen (ascii_font
) + 1;
3339 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3348 base_fontname
= (char *) alloca (len
);
3349 bzero (base_fontname
, len
);
3350 strcpy (base_fontname
, "-*-*-");
3351 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3352 strcat (base_fontname
, "*-*-*-*-*-*-*");
3355 xfs
= xic_create_xfontset (f
, base_fontname
);
3357 /* Determine XIC style. */
3360 XIMStyles supported_list
;
3361 supported_list
.count_styles
= (sizeof supported_xim_styles
3362 / sizeof supported_xim_styles
[0]);
3363 supported_list
.supported_styles
= supported_xim_styles
;
3364 xic_style
= best_xim_style (&supported_list
,
3365 FRAME_X_XIM_STYLES (f
));
3368 preedit_attr
= XVaCreateNestedList (0,
3371 FRAME_FOREGROUND_PIXEL (f
),
3373 FRAME_BACKGROUND_PIXEL (f
),
3374 (xic_style
& XIMPreeditPosition
3379 status_attr
= XVaCreateNestedList (0,
3385 FRAME_FOREGROUND_PIXEL (f
),
3387 FRAME_BACKGROUND_PIXEL (f
),
3390 xic
= XCreateIC (xim
,
3391 XNInputStyle
, xic_style
,
3392 XNClientWindow
, FRAME_X_WINDOW(f
),
3393 XNFocusWindow
, FRAME_X_WINDOW(f
),
3394 XNStatusAttributes
, status_attr
,
3395 XNPreeditAttributes
, preedit_attr
,
3397 XFree (preedit_attr
);
3398 XFree (status_attr
);
3401 FRAME_XIC (f
) = xic
;
3402 FRAME_XIC_STYLE (f
) = xic_style
;
3403 FRAME_XIC_FONTSET (f
) = xfs
;
3407 /* Destroy XIC and free XIC fontset of frame F, if any. */
3413 if (FRAME_XIC (f
) == NULL
)
3416 XDestroyIC (FRAME_XIC (f
));
3417 if (FRAME_XIC_FONTSET (f
))
3418 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3420 FRAME_XIC (f
) = NULL
;
3421 FRAME_XIC_FONTSET (f
) = NULL
;
3425 /* Place preedit area for XIC of window W's frame to specified
3426 pixel position X/Y. X and Y are relative to window W. */
3429 xic_set_preeditarea (w
, x
, y
)
3433 struct frame
*f
= XFRAME (w
->frame
);
3437 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3438 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3439 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3440 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3445 /* Place status area for XIC in bottom right corner of frame F.. */
3448 xic_set_statusarea (f
)
3451 XIC xic
= FRAME_XIC (f
);
3456 /* Negotiate geometry of status area. If input method has existing
3457 status area, use its current size. */
3458 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3459 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3460 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3463 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3464 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3467 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3469 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3470 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3474 area
.width
= needed
->width
;
3475 area
.height
= needed
->height
;
3476 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3477 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3478 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3481 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3482 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3487 /* Set X fontset for XIC of frame F, using base font name
3488 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3491 xic_set_xfontset (f
, base_fontname
)
3493 char *base_fontname
;
3498 xfs
= xic_create_xfontset (f
, base_fontname
);
3500 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3501 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3502 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3503 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3504 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3507 if (FRAME_XIC_FONTSET (f
))
3508 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3509 FRAME_XIC_FONTSET (f
) = xfs
;
3512 #endif /* HAVE_X_I18N */
3516 #ifdef USE_X_TOOLKIT
3518 /* Create and set up the X widget for frame F. */
3521 x_window (f
, window_prompting
, minibuffer_only
)
3523 long window_prompting
;
3524 int minibuffer_only
;
3526 XClassHint class_hints
;
3527 XSetWindowAttributes attributes
;
3528 unsigned long attribute_mask
;
3529 Widget shell_widget
;
3531 Widget frame_widget
;
3537 /* Use the resource name as the top-level widget name
3538 for looking up resources. Make a non-Lisp copy
3539 for the window manager, so GC relocation won't bother it.
3541 Elsewhere we specify the window name for the window manager. */
3544 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3545 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3546 strcpy (f
->namebuf
, str
);
3550 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3551 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3552 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3553 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3554 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3555 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3556 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3557 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3558 applicationShellWidgetClass
,
3559 FRAME_X_DISPLAY (f
), al
, ac
);
3561 f
->output_data
.x
->widget
= shell_widget
;
3562 /* maybe_set_screen_title_format (shell_widget); */
3564 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3565 (widget_value
*) NULL
,
3566 shell_widget
, False
,
3570 (lw_callback
) NULL
);
3573 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3574 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3575 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3576 XtSetValues (pane_widget
, al
, ac
);
3577 f
->output_data
.x
->column_widget
= pane_widget
;
3579 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3580 the emacs screen when changing menubar. This reduces flickering. */
3583 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3584 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3585 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3586 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3587 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3588 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3589 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3590 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3591 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3594 f
->output_data
.x
->edit_widget
= frame_widget
;
3596 XtManageChild (frame_widget
);
3598 /* Do some needed geometry management. */
3601 char *tem
, shell_position
[32];
3604 int extra_borders
= 0;
3606 = (f
->output_data
.x
->menubar_widget
3607 ? (f
->output_data
.x
->menubar_widget
->core
.height
3608 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3611 #if 0 /* Experimentally, we now get the right results
3612 for -geometry -0-0 without this. 24 Aug 96, rms. */
3613 if (FRAME_EXTERNAL_MENU_BAR (f
))
3616 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3617 menubar_size
+= ibw
;
3621 f
->output_data
.x
->menubar_height
= menubar_size
;
3624 /* Motif seems to need this amount added to the sizes
3625 specified for the shell widget. The Athena/Lucid widgets don't.
3626 Both conclusions reached experimentally. -- rms. */
3627 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3628 &extra_borders
, NULL
);
3632 /* Convert our geometry parameters into a geometry string
3634 Note that we do not specify here whether the position
3635 is a user-specified or program-specified one.
3636 We pass that information later, in x_wm_set_size_hints. */
3638 int left
= f
->output_data
.x
->left_pos
;
3639 int xneg
= window_prompting
& XNegative
;
3640 int top
= f
->output_data
.x
->top_pos
;
3641 int yneg
= window_prompting
& YNegative
;
3647 if (window_prompting
& USPosition
)
3648 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3649 PIXEL_WIDTH (f
) + extra_borders
,
3650 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3651 (xneg
? '-' : '+'), left
,
3652 (yneg
? '-' : '+'), top
);
3654 sprintf (shell_position
, "=%dx%d",
3655 PIXEL_WIDTH (f
) + extra_borders
,
3656 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3659 len
= strlen (shell_position
) + 1;
3660 /* We don't free this because we don't know whether
3661 it is safe to free it while the frame exists.
3662 It isn't worth the trouble of arranging to free it
3663 when the frame is deleted. */
3664 tem
= (char *) xmalloc (len
);
3665 strncpy (tem
, shell_position
, len
);
3666 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3667 XtSetValues (shell_widget
, al
, ac
);
3670 XtManageChild (pane_widget
);
3671 XtRealizeWidget (shell_widget
);
3673 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3675 validate_x_resource_name ();
3677 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3678 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3679 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3682 FRAME_XIC (f
) = NULL
;
3684 create_frame_xic (f
);
3688 f
->output_data
.x
->wm_hints
.input
= True
;
3689 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3690 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3691 &f
->output_data
.x
->wm_hints
);
3693 hack_wm_protocols (f
, shell_widget
);
3696 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3699 /* Do a stupid property change to force the server to generate a
3700 PropertyNotify event so that the event_stream server timestamp will
3701 be initialized to something relevant to the time we created the window.
3703 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3704 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3705 XA_ATOM
, 32, PropModeAppend
,
3706 (unsigned char*) NULL
, 0);
3708 /* Make all the standard events reach the Emacs frame. */
3709 attributes
.event_mask
= STANDARD_EVENT_SET
;
3714 /* XIM server might require some X events. */
3715 unsigned long fevent
= NoEventMask
;
3716 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3717 attributes
.event_mask
|= fevent
;
3719 #endif /* HAVE_X_I18N */
3721 attribute_mask
= CWEventMask
;
3722 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3723 attribute_mask
, &attributes
);
3725 XtMapWidget (frame_widget
);
3727 /* x_set_name normally ignores requests to set the name if the
3728 requested name is the same as the current name. This is the one
3729 place where that assumption isn't correct; f->name is set, but
3730 the X server hasn't been told. */
3733 int explicit = f
->explicit_name
;
3735 f
->explicit_name
= 0;
3738 x_set_name (f
, name
, explicit);
3741 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3742 f
->output_data
.x
->text_cursor
);
3746 /* This is a no-op, except under Motif. Make sure main areas are
3747 set to something reasonable, in case we get an error later. */
3748 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3751 #else /* not USE_X_TOOLKIT */
3753 /* Create and set up the X window for frame F. */
3760 XClassHint class_hints
;
3761 XSetWindowAttributes attributes
;
3762 unsigned long attribute_mask
;
3764 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3765 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3766 attributes
.bit_gravity
= StaticGravity
;
3767 attributes
.backing_store
= NotUseful
;
3768 attributes
.save_under
= True
;
3769 attributes
.event_mask
= STANDARD_EVENT_SET
;
3770 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3771 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3776 = XCreateWindow (FRAME_X_DISPLAY (f
),
3777 f
->output_data
.x
->parent_desc
,
3778 f
->output_data
.x
->left_pos
,
3779 f
->output_data
.x
->top_pos
,
3780 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3781 f
->output_data
.x
->border_width
,
3782 CopyFromParent
, /* depth */
3783 InputOutput
, /* class */
3785 attribute_mask
, &attributes
);
3789 create_frame_xic (f
);
3792 /* XIM server might require some X events. */
3793 unsigned long fevent
= NoEventMask
;
3794 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3795 attributes
.event_mask
|= fevent
;
3796 attribute_mask
= CWEventMask
;
3797 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3798 attribute_mask
, &attributes
);
3801 #endif /* HAVE_X_I18N */
3803 validate_x_resource_name ();
3805 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3806 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3807 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3809 /* The menubar is part of the ordinary display;
3810 it does not count in addition to the height of the window. */
3811 f
->output_data
.x
->menubar_height
= 0;
3813 /* This indicates that we use the "Passive Input" input model.
3814 Unless we do this, we don't get the Focus{In,Out} events that we
3815 need to draw the cursor correctly. Accursed bureaucrats.
3816 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3818 f
->output_data
.x
->wm_hints
.input
= True
;
3819 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3820 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3821 &f
->output_data
.x
->wm_hints
);
3822 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3824 /* Request "save yourself" and "delete window" commands from wm. */
3827 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3828 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3829 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3832 /* x_set_name normally ignores requests to set the name if the
3833 requested name is the same as the current name. This is the one
3834 place where that assumption isn't correct; f->name is set, but
3835 the X server hasn't been told. */
3838 int explicit = f
->explicit_name
;
3840 f
->explicit_name
= 0;
3843 x_set_name (f
, name
, explicit);
3846 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3847 f
->output_data
.x
->text_cursor
);
3851 if (FRAME_X_WINDOW (f
) == 0)
3852 error ("Unable to create window");
3855 #endif /* not USE_X_TOOLKIT */
3857 /* Handle the icon stuff for this window. Perhaps later we might
3858 want an x_set_icon_position which can be called interactively as
3866 Lisp_Object icon_x
, icon_y
;
3867 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3869 /* Set the position of the icon. Note that twm groups all
3870 icons in an icon window. */
3871 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3872 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3873 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3875 CHECK_NUMBER (icon_x
, 0);
3876 CHECK_NUMBER (icon_y
, 0);
3878 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3879 error ("Both left and top icon corners of icon must be specified");
3883 if (! EQ (icon_x
, Qunbound
))
3884 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3886 /* Start up iconic or window? */
3887 x_wm_set_window_state
3888 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3893 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3900 /* Make the GCs needed for this window, setting the
3901 background, border and mouse colors; also create the
3902 mouse cursor and the gray border tile. */
3904 static char cursor_bits
[] =
3906 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3907 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3908 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3909 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3916 XGCValues gc_values
;
3920 /* Create the GCs of this frame.
3921 Note that many default values are used. */
3924 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3925 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3926 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3927 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3928 f
->output_data
.x
->normal_gc
3929 = XCreateGC (FRAME_X_DISPLAY (f
),
3931 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
3934 /* Reverse video style. */
3935 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3936 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3937 f
->output_data
.x
->reverse_gc
3938 = XCreateGC (FRAME_X_DISPLAY (f
),
3940 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
3943 /* Cursor has cursor-color background, background-color foreground. */
3944 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3945 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3946 gc_values
.fill_style
= FillOpaqueStippled
;
3948 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3949 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3950 cursor_bits
, 16, 16);
3951 f
->output_data
.x
->cursor_gc
3952 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3953 (GCFont
| GCForeground
| GCBackground
3954 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3958 f
->output_data
.x
->white_relief
.gc
= 0;
3959 f
->output_data
.x
->black_relief
.gc
= 0;
3961 /* Create the gray border tile used when the pointer is not in
3962 the frame. Since this depends on the frame's pixel values,
3963 this must be done on a per-frame basis. */
3964 f
->output_data
.x
->border_tile
3965 = (XCreatePixmapFromBitmapData
3966 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3967 gray_bits
, gray_width
, gray_height
,
3968 f
->output_data
.x
->foreground_pixel
,
3969 f
->output_data
.x
->background_pixel
,
3970 DefaultDepth (FRAME_X_DISPLAY (f
),
3971 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3977 /* Free what was was allocated in x_make_gc. */
3983 Display
*dpy
= FRAME_X_DISPLAY (f
);
3987 if (f
->output_data
.x
->normal_gc
)
3989 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
3990 f
->output_data
.x
->normal_gc
= 0;
3993 if (f
->output_data
.x
->reverse_gc
)
3995 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
3996 f
->output_data
.x
->reverse_gc
= 0;
3999 if (f
->output_data
.x
->cursor_gc
)
4001 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4002 f
->output_data
.x
->cursor_gc
= 0;
4005 if (f
->output_data
.x
->border_tile
)
4007 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4008 f
->output_data
.x
->border_tile
= 0;
4015 /* Handler for signals raised during x_create_frame and
4016 x_create_top_frame. FRAME is the frame which is partially
4020 unwind_create_frame (frame
)
4023 struct frame
*f
= XFRAME (frame
);
4025 /* If frame is ``official'', nothing to do. */
4026 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4029 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4032 x_free_frame_resources (f
);
4034 /* Check that reference counts are indeed correct. */
4035 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4036 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4044 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4046 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
4047 Returns an Emacs frame object.\n\
4048 ALIST is an alist of frame parameters.\n\
4049 If the parameters specify that the frame should not have a minibuffer,\n\
4050 and do not specify a specific minibuffer window to use,\n\
4051 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4052 be shared by the new frame.\n\
4054 This function is an internal primitive--use `make-frame' instead.")
4059 Lisp_Object frame
, tem
;
4061 int minibuffer_only
= 0;
4062 long window_prompting
= 0;
4064 int count
= BINDING_STACK_SIZE ();
4065 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4066 Lisp_Object display
;
4067 struct x_display_info
*dpyinfo
= NULL
;
4073 /* Use this general default value to start with
4074 until we know if this frame has a specified name. */
4075 Vx_resource_name
= Vinvocation_name
;
4077 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4078 if (EQ (display
, Qunbound
))
4080 dpyinfo
= check_x_display_info (display
);
4082 kb
= dpyinfo
->kboard
;
4084 kb
= &the_only_kboard
;
4087 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4089 && ! EQ (name
, Qunbound
)
4091 error ("Invalid frame name--not a string or nil");
4094 Vx_resource_name
= name
;
4096 /* See if parent window is specified. */
4097 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4098 if (EQ (parent
, Qunbound
))
4100 if (! NILP (parent
))
4101 CHECK_NUMBER (parent
, 0);
4103 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4104 /* No need to protect DISPLAY because that's not used after passing
4105 it to make_frame_without_minibuffer. */
4107 GCPRO4 (parms
, parent
, name
, frame
);
4108 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4110 if (EQ (tem
, Qnone
) || NILP (tem
))
4111 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4112 else if (EQ (tem
, Qonly
))
4114 f
= make_minibuffer_frame ();
4115 minibuffer_only
= 1;
4117 else if (WINDOWP (tem
))
4118 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4122 XSETFRAME (frame
, f
);
4124 /* Note that X Windows does support scroll bars. */
4125 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4127 f
->output_method
= output_x_window
;
4128 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4129 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4130 f
->output_data
.x
->icon_bitmap
= -1;
4131 f
->output_data
.x
->fontset
= -1;
4132 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4133 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4134 record_unwind_protect (unwind_create_frame
, frame
);
4137 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4139 if (! STRINGP (f
->icon_name
))
4140 f
->icon_name
= Qnil
;
4142 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4144 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4145 dpyinfo_refcount
= dpyinfo
->reference_count
;
4146 #endif /* GLYPH_DEBUG */
4148 FRAME_KBOARD (f
) = kb
;
4151 /* These colors will be set anyway later, but it's important
4152 to get the color reference counts right, so initialize them! */
4155 struct gcpro gcpro1
;
4157 black
= build_string ("black");
4159 f
->output_data
.x
->foreground_pixel
4160 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4161 f
->output_data
.x
->background_pixel
4162 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4163 f
->output_data
.x
->cursor_pixel
4164 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4165 f
->output_data
.x
->cursor_foreground_pixel
4166 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4167 f
->output_data
.x
->border_pixel
4168 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4169 f
->output_data
.x
->mouse_pixel
4170 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4174 /* Specify the parent under which to make this X window. */
4178 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4179 f
->output_data
.x
->explicit_parent
= 1;
4183 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4184 f
->output_data
.x
->explicit_parent
= 0;
4187 /* Set the name; the functions to which we pass f expect the name to
4189 if (EQ (name
, Qunbound
) || NILP (name
))
4191 f
->name
= build_string (dpyinfo
->x_id_name
);
4192 f
->explicit_name
= 0;
4197 f
->explicit_name
= 1;
4198 /* use the frame's title when getting resources for this frame. */
4199 specbind (Qx_resource_name
, name
);
4202 /* Extract the window parameters from the supplied values
4203 that are needed to determine window geometry. */
4207 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4210 /* First, try whatever font the caller has specified. */
4213 tem
= Fquery_fontset (font
, Qnil
);
4215 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4217 font
= x_new_font (f
, XSTRING (font
)->data
);
4220 /* Try out a font which we hope has bold and italic variations. */
4221 if (!STRINGP (font
))
4222 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4223 if (!STRINGP (font
))
4224 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4225 if (! STRINGP (font
))
4226 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4227 if (! STRINGP (font
))
4228 /* This was formerly the first thing tried, but it finds too many fonts
4229 and takes too long. */
4230 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4231 /* If those didn't work, look for something which will at least work. */
4232 if (! STRINGP (font
))
4233 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4235 if (! STRINGP (font
))
4236 font
= build_string ("fixed");
4238 x_default_parameter (f
, parms
, Qfont
, font
,
4239 "font", "Font", RES_TYPE_STRING
);
4243 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4244 whereby it fails to get any font. */
4245 xlwmenu_default_font
= f
->output_data
.x
->font
;
4248 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4249 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4251 /* This defaults to 2 in order to match xterm. We recognize either
4252 internalBorderWidth or internalBorder (which is what xterm calls
4254 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4258 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4259 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4260 if (! EQ (value
, Qunbound
))
4261 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4264 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4265 "internalBorderWidth", "internalBorderWidth",
4267 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4268 "verticalScrollBars", "ScrollBars",
4271 /* Also do the stuff which must be set before the window exists. */
4272 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4273 "foreground", "Foreground", RES_TYPE_STRING
);
4274 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4275 "background", "Background", RES_TYPE_STRING
);
4276 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4277 "pointerColor", "Foreground", RES_TYPE_STRING
);
4278 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4279 "cursorColor", "Foreground", RES_TYPE_STRING
);
4280 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4281 "borderColor", "BorderColor", RES_TYPE_STRING
);
4282 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4283 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4284 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4285 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4287 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4288 "scrollBarForeground",
4289 "ScrollBarForeground", 1);
4290 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4291 "scrollBarBackground",
4292 "ScrollBarBackground", 0);
4294 /* Init faces before x_default_parameter is called for scroll-bar
4295 parameters because that function calls x_set_scroll_bar_width,
4296 which calls change_frame_size, which calls Fset_window_buffer,
4297 which runs hooks, which call Fvertical_motion. At the end, we
4298 end up in init_iterator with a null face cache, which should not
4300 init_frame_faces (f
);
4302 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4303 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4304 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4305 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4306 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4307 "bufferPredicate", "BufferPredicate",
4309 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4310 "title", "Title", RES_TYPE_STRING
);
4312 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4313 window_prompting
= x_figure_window_size (f
, parms
);
4315 if (window_prompting
& XNegative
)
4317 if (window_prompting
& YNegative
)
4318 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4320 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4324 if (window_prompting
& YNegative
)
4325 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4327 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4330 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4332 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4333 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4335 /* Create the X widget or window. */
4336 #ifdef USE_X_TOOLKIT
4337 x_window (f
, window_prompting
, minibuffer_only
);
4345 /* Now consider the frame official. */
4346 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4347 Vframe_list
= Fcons (frame
, Vframe_list
);
4349 /* We need to do this after creating the X window, so that the
4350 icon-creation functions can say whose icon they're describing. */
4351 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4352 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4354 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4355 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4356 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4357 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4358 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4359 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4360 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4361 "scrollBarWidth", "ScrollBarWidth",
4364 /* Dimensions, especially f->height, must be done via change_frame_size.
4365 Change will not be effected unless different from the current
4370 /* Add the tool-bar height to the initial frame height so that the
4371 user gets a text display area of the size he specified with -g or
4372 via .Xdefaults. Later changes of the tool-bar height don't
4373 change the frame size. This is done so that users can create
4374 tall Emacs frames without having to guess how tall the tool-bar
4376 if (FRAME_TOOL_BAR_LINES (f
))
4378 int margin
, relief
, bar_height
;
4380 relief
= (tool_bar_button_relief
> 0
4381 ? tool_bar_button_relief
4382 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4384 if (INTEGERP (Vtool_bar_button_margin
)
4385 && XINT (Vtool_bar_button_margin
) > 0)
4386 margin
= XFASTINT (Vtool_bar_button_margin
);
4387 else if (CONSP (Vtool_bar_button_margin
)
4388 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4389 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4390 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4394 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4395 height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4399 SET_FRAME_WIDTH (f
, 0);
4400 change_frame_size (f
, height
, width
, 1, 0, 0);
4402 /* Set up faces after all frame parameters are known. This call
4403 also merges in face attributes specified for new frames. If we
4404 don't do this, the `menu' face for instance won't have the right
4405 colors, and the menu bar won't appear in the specified colors for
4407 call1 (Qface_set_after_frame_default
, frame
);
4409 #ifdef USE_X_TOOLKIT
4410 /* Create the menu bar. */
4411 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4413 /* If this signals an error, we haven't set size hints for the
4414 frame and we didn't make it visible. */
4415 initialize_frame_menubar (f
);
4417 /* This is a no-op, except under Motif where it arranges the
4418 main window for the widgets on it. */
4419 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4420 f
->output_data
.x
->menubar_widget
,
4421 f
->output_data
.x
->edit_widget
);
4423 #endif /* USE_X_TOOLKIT */
4425 /* Tell the server what size and position, etc, we want, and how
4426 badly we want them. This should be done after we have the menu
4427 bar so that its size can be taken into account. */
4429 x_wm_set_size_hint (f
, window_prompting
, 0);
4432 /* Make the window appear on the frame and enable display, unless
4433 the caller says not to. However, with explicit parent, Emacs
4434 cannot control visibility, so don't try. */
4435 if (! f
->output_data
.x
->explicit_parent
)
4437 Lisp_Object visibility
;
4439 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4441 if (EQ (visibility
, Qunbound
))
4444 if (EQ (visibility
, Qicon
))
4445 x_iconify_frame (f
);
4446 else if (! NILP (visibility
))
4447 x_make_frame_visible (f
);
4449 /* Must have been Qnil. */
4454 return unbind_to (count
, frame
);
4458 /* FRAME is used only to get a handle on the X display. We don't pass the
4459 display info directly because we're called from frame.c, which doesn't
4460 know about that structure. */
4463 x_get_focus_frame (frame
)
4464 struct frame
*frame
;
4466 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4468 if (! dpyinfo
->x_focus_frame
)
4471 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4476 /* In certain situations, when the window manager follows a
4477 click-to-focus policy, there seems to be no way around calling
4478 XSetInputFocus to give another frame the input focus .
4480 In an ideal world, XSetInputFocus should generally be avoided so
4481 that applications don't interfere with the window manager's focus
4482 policy. But I think it's okay to use when it's clearly done
4483 following a user-command. */
4485 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4486 "Set the input focus to FRAME.\n\
4487 FRAME nil means use the selected frame.")
4491 struct frame
*f
= check_x_frame (frame
);
4492 Display
*dpy
= FRAME_X_DISPLAY (f
);
4496 count
= x_catch_errors (dpy
);
4497 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4498 RevertToParent
, CurrentTime
);
4499 x_uncatch_errors (dpy
, count
);
4506 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4507 "Internal function called by `color-defined-p', which see.")
4509 Lisp_Object color
, frame
;
4512 FRAME_PTR f
= check_x_frame (frame
);
4514 CHECK_STRING (color
, 1);
4516 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4522 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4523 "Internal function called by `color-values', which see.")
4525 Lisp_Object color
, frame
;
4528 FRAME_PTR f
= check_x_frame (frame
);
4530 CHECK_STRING (color
, 1);
4532 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4536 rgb
[0] = make_number (foo
.red
);
4537 rgb
[1] = make_number (foo
.green
);
4538 rgb
[2] = make_number (foo
.blue
);
4539 return Flist (3, rgb
);
4545 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4546 "Internal function called by `display-color-p', which see.")
4548 Lisp_Object display
;
4550 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4552 if (dpyinfo
->n_planes
<= 2)
4555 switch (dpyinfo
->visual
->class)
4568 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4570 "Return t if the X display supports shades of gray.\n\
4571 Note that color displays do support shades of gray.\n\
4572 The optional argument DISPLAY specifies which display to ask about.\n\
4573 DISPLAY should be either a frame or a display name (a string).\n\
4574 If omitted or nil, that stands for the selected frame's display.")
4576 Lisp_Object display
;
4578 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4580 if (dpyinfo
->n_planes
<= 1)
4583 switch (dpyinfo
->visual
->class)
4598 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4600 "Returns the width in pixels of the X display DISPLAY.\n\
4601 The optional argument DISPLAY specifies which display to ask about.\n\
4602 DISPLAY should be either a frame or a display name (a string).\n\
4603 If omitted or nil, that stands for the selected frame's display.")
4605 Lisp_Object display
;
4607 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4609 return make_number (dpyinfo
->width
);
4612 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4613 Sx_display_pixel_height
, 0, 1, 0,
4614 "Returns the height in pixels of the X display DISPLAY.\n\
4615 The optional argument DISPLAY specifies which display to ask about.\n\
4616 DISPLAY should be either a frame or a display name (a string).\n\
4617 If omitted or nil, that stands for the selected frame's display.")
4619 Lisp_Object display
;
4621 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4623 return make_number (dpyinfo
->height
);
4626 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4628 "Returns the number of bitplanes of the X display DISPLAY.\n\
4629 The optional argument DISPLAY specifies which display to ask about.\n\
4630 DISPLAY should be either a frame or a display name (a string).\n\
4631 If omitted or nil, that stands for the selected frame's display.")
4633 Lisp_Object display
;
4635 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4637 return make_number (dpyinfo
->n_planes
);
4640 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4642 "Returns the number of color cells of the X display DISPLAY.\n\
4643 The optional argument DISPLAY specifies which display to ask about.\n\
4644 DISPLAY should be either a frame or a display name (a string).\n\
4645 If omitted or nil, that stands for the selected frame's display.")
4647 Lisp_Object display
;
4649 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4651 return make_number (DisplayCells (dpyinfo
->display
,
4652 XScreenNumberOfScreen (dpyinfo
->screen
)));
4655 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4656 Sx_server_max_request_size
,
4658 "Returns the maximum request size of the X server of display DISPLAY.\n\
4659 The optional argument DISPLAY specifies which display to ask about.\n\
4660 DISPLAY should be either a frame or a display name (a string).\n\
4661 If omitted or nil, that stands for the selected frame's display.")
4663 Lisp_Object display
;
4665 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4667 return make_number (MAXREQUEST (dpyinfo
->display
));
4670 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4671 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4672 The optional argument DISPLAY specifies which display to ask about.\n\
4673 DISPLAY should be either a frame or a display name (a string).\n\
4674 If omitted or nil, that stands for the selected frame's display.")
4676 Lisp_Object display
;
4678 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4679 char *vendor
= ServerVendor (dpyinfo
->display
);
4681 if (! vendor
) vendor
= "";
4682 return build_string (vendor
);
4685 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4686 "Returns the version numbers of the X server of display DISPLAY.\n\
4687 The value is a list of three integers: the major and minor\n\
4688 version numbers of the X Protocol in use, and the vendor-specific release\n\
4689 number. See also the function `x-server-vendor'.\n\n\
4690 The optional argument DISPLAY specifies which display to ask about.\n\
4691 DISPLAY should be either a frame or a display name (a string).\n\
4692 If omitted or nil, that stands for the selected frame's display.")
4694 Lisp_Object display
;
4696 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4697 Display
*dpy
= dpyinfo
->display
;
4699 return Fcons (make_number (ProtocolVersion (dpy
)),
4700 Fcons (make_number (ProtocolRevision (dpy
)),
4701 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4704 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4705 "Returns the number of screens on the X server of display DISPLAY.\n\
4706 The optional argument DISPLAY specifies which display to ask about.\n\
4707 DISPLAY should be either a frame or a display name (a string).\n\
4708 If omitted or nil, that stands for the selected frame's display.")
4710 Lisp_Object display
;
4712 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4714 return make_number (ScreenCount (dpyinfo
->display
));
4717 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4718 "Returns the height in millimeters of the X display DISPLAY.\n\
4719 The optional argument DISPLAY specifies which display to ask about.\n\
4720 DISPLAY should be either a frame or a display name (a string).\n\
4721 If omitted or nil, that stands for the selected frame's display.")
4723 Lisp_Object display
;
4725 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4727 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4730 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4731 "Returns the width in millimeters of the X display DISPLAY.\n\
4732 The optional argument DISPLAY specifies which display to ask about.\n\
4733 DISPLAY should be either a frame or a display name (a string).\n\
4734 If omitted or nil, that stands for the selected frame's display.")
4736 Lisp_Object display
;
4738 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4740 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4743 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4744 Sx_display_backing_store
, 0, 1, 0,
4745 "Returns an indication of whether X display DISPLAY does backing store.\n\
4746 The value may be `always', `when-mapped', or `not-useful'.\n\
4747 The optional argument DISPLAY specifies which display to ask about.\n\
4748 DISPLAY should be either a frame or a display name (a string).\n\
4749 If omitted or nil, that stands for the selected frame's display.")
4751 Lisp_Object display
;
4753 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4756 switch (DoesBackingStore (dpyinfo
->screen
))
4759 result
= intern ("always");
4763 result
= intern ("when-mapped");
4767 result
= intern ("not-useful");
4771 error ("Strange value for BackingStore parameter of screen");
4778 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4779 Sx_display_visual_class
, 0, 1, 0,
4780 "Returns the visual class of the X display DISPLAY.\n\
4781 The value is one of the symbols `static-gray', `gray-scale',\n\
4782 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4783 The optional argument DISPLAY specifies which display to ask about.\n\
4784 DISPLAY should be either a frame or a display name (a string).\n\
4785 If omitted or nil, that stands for the selected frame's display.")
4787 Lisp_Object display
;
4789 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4792 switch (dpyinfo
->visual
->class)
4795 result
= intern ("static-gray");
4798 result
= intern ("gray-scale");
4801 result
= intern ("static-color");
4804 result
= intern ("pseudo-color");
4807 result
= intern ("true-color");
4810 result
= intern ("direct-color");
4813 error ("Display has an unknown visual class");
4820 DEFUN ("x-display-save-under", Fx_display_save_under
,
4821 Sx_display_save_under
, 0, 1, 0,
4822 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4823 The optional argument DISPLAY specifies which display to ask about.\n\
4824 DISPLAY should be either a frame or a display name (a string).\n\
4825 If omitted or nil, that stands for the selected frame's display.")
4827 Lisp_Object display
;
4829 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4831 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4839 register struct frame
*f
;
4841 return PIXEL_WIDTH (f
);
4846 register struct frame
*f
;
4848 return PIXEL_HEIGHT (f
);
4853 register struct frame
*f
;
4855 return FONT_WIDTH (f
->output_data
.x
->font
);
4860 register struct frame
*f
;
4862 return f
->output_data
.x
->line_height
;
4867 register struct frame
*f
;
4869 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4874 /************************************************************************
4876 ************************************************************************/
4879 /* Mapping visual names to visuals. */
4881 static struct visual_class
4888 {"StaticGray", StaticGray
},
4889 {"GrayScale", GrayScale
},
4890 {"StaticColor", StaticColor
},
4891 {"PseudoColor", PseudoColor
},
4892 {"TrueColor", TrueColor
},
4893 {"DirectColor", DirectColor
},
4898 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4900 /* Value is the screen number of screen SCR. This is a substitute for
4901 the X function with the same name when that doesn't exist. */
4904 XScreenNumberOfScreen (scr
)
4905 register Screen
*scr
;
4907 Display
*dpy
= scr
->display
;
4910 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4911 if (scr
== dpy
->screens
[i
])
4917 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4920 /* Select the visual that should be used on display DPYINFO. Set
4921 members of DPYINFO appropriately. Called from x_term_init. */
4924 select_visual (dpyinfo
)
4925 struct x_display_info
*dpyinfo
;
4927 Display
*dpy
= dpyinfo
->display
;
4928 Screen
*screen
= dpyinfo
->screen
;
4931 /* See if a visual is specified. */
4932 value
= display_x_get_resource (dpyinfo
,
4933 build_string ("visualClass"),
4934 build_string ("VisualClass"),
4936 if (STRINGP (value
))
4938 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4939 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4940 depth, a decimal number. NAME is compared with case ignored. */
4941 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4946 strcpy (s
, XSTRING (value
)->data
);
4947 dash
= index (s
, '-');
4950 dpyinfo
->n_planes
= atoi (dash
+ 1);
4954 /* We won't find a matching visual with depth 0, so that
4955 an error will be printed below. */
4956 dpyinfo
->n_planes
= 0;
4958 /* Determine the visual class. */
4959 for (i
= 0; visual_classes
[i
].name
; ++i
)
4960 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4962 class = visual_classes
[i
].class;
4966 /* Look up a matching visual for the specified class. */
4968 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4969 dpyinfo
->n_planes
, class, &vinfo
))
4970 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4972 dpyinfo
->visual
= vinfo
.visual
;
4977 XVisualInfo
*vinfo
, vinfo_template
;
4979 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
4982 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
4984 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
4986 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4987 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
4988 &vinfo_template
, &n_visuals
);
4990 fatal ("Can't get proper X visual info");
4992 dpyinfo
->n_planes
= vinfo
->depth
;
4993 XFree ((char *) vinfo
);
4998 /* Return the X display structure for the display named NAME.
4999 Open a new connection if necessary. */
5001 struct x_display_info
*
5002 x_display_info_for_name (name
)
5006 struct x_display_info
*dpyinfo
;
5008 CHECK_STRING (name
, 0);
5010 if (! EQ (Vwindow_system
, intern ("x")))
5011 error ("Not using X Windows");
5013 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5015 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5018 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5023 /* Use this general default value to start with. */
5024 Vx_resource_name
= Vinvocation_name
;
5026 validate_x_resource_name ();
5028 dpyinfo
= x_term_init (name
, (char *)0,
5029 (char *) XSTRING (Vx_resource_name
)->data
);
5032 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5035 XSETFASTINT (Vwindow_system_version
, 11);
5041 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5042 1, 3, 0, "Open a connection to an X server.\n\
5043 DISPLAY is the name of the display to connect to.\n\
5044 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5045 If the optional third arg MUST-SUCCEED is non-nil,\n\
5046 terminate Emacs if we can't open the connection.")
5047 (display
, xrm_string
, must_succeed
)
5048 Lisp_Object display
, xrm_string
, must_succeed
;
5050 unsigned char *xrm_option
;
5051 struct x_display_info
*dpyinfo
;
5053 CHECK_STRING (display
, 0);
5054 if (! NILP (xrm_string
))
5055 CHECK_STRING (xrm_string
, 1);
5057 if (! EQ (Vwindow_system
, intern ("x")))
5058 error ("Not using X Windows");
5060 if (! NILP (xrm_string
))
5061 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5063 xrm_option
= (unsigned char *) 0;
5065 validate_x_resource_name ();
5067 /* This is what opens the connection and sets x_current_display.
5068 This also initializes many symbols, such as those used for input. */
5069 dpyinfo
= x_term_init (display
, xrm_option
,
5070 (char *) XSTRING (Vx_resource_name
)->data
);
5074 if (!NILP (must_succeed
))
5075 fatal ("Cannot connect to X server %s.\n\
5076 Check the DISPLAY environment variable or use `-d'.\n\
5077 Also use the `xhost' program to verify that it is set to permit\n\
5078 connections from your machine.\n",
5079 XSTRING (display
)->data
);
5081 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5086 XSETFASTINT (Vwindow_system_version
, 11);
5090 DEFUN ("x-close-connection", Fx_close_connection
,
5091 Sx_close_connection
, 1, 1, 0,
5092 "Close the connection to DISPLAY's X server.\n\
5093 For DISPLAY, specify either a frame or a display name (a string).\n\
5094 If DISPLAY is nil, that stands for the selected frame's display.")
5096 Lisp_Object display
;
5098 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5101 if (dpyinfo
->reference_count
> 0)
5102 error ("Display still has frames on it");
5105 /* Free the fonts in the font table. */
5106 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5107 if (dpyinfo
->font_table
[i
].name
)
5109 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5110 xfree (dpyinfo
->font_table
[i
].full_name
);
5111 xfree (dpyinfo
->font_table
[i
].name
);
5112 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5115 x_destroy_all_bitmaps (dpyinfo
);
5116 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5118 #ifdef USE_X_TOOLKIT
5119 XtCloseDisplay (dpyinfo
->display
);
5121 XCloseDisplay (dpyinfo
->display
);
5124 x_delete_display (dpyinfo
);
5130 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5131 "Return the list of display names that Emacs has connections to.")
5134 Lisp_Object tail
, result
;
5137 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5138 result
= Fcons (XCAR (XCAR (tail
)), result
);
5143 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5144 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5145 If ON is nil, allow buffering of requests.\n\
5146 Turning on synchronization prohibits the Xlib routines from buffering\n\
5147 requests and seriously degrades performance, but makes debugging much\n\
5149 The optional second argument DISPLAY specifies which display to act on.\n\
5150 DISPLAY should be either a frame or a display name (a string).\n\
5151 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5153 Lisp_Object display
, on
;
5155 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5157 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5162 /* Wait for responses to all X commands issued so far for frame F. */
5169 XSync (FRAME_X_DISPLAY (f
), False
);
5174 /***********************************************************************
5176 ***********************************************************************/
5178 /* Value is the number of elements of vector VECTOR. */
5180 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5182 /* List of supported image types. Use define_image_type to add new
5183 types. Use lookup_image_type to find a type for a given symbol. */
5185 static struct image_type
*image_types
;
5187 /* The symbol `image' which is the car of the lists used to represent
5190 extern Lisp_Object Qimage
;
5192 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5198 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5199 extern Lisp_Object QCdata
;
5200 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5201 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5202 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5204 /* Other symbols. */
5206 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5208 /* Time in seconds after which images should be removed from the cache
5209 if not displayed. */
5211 Lisp_Object Vimage_cache_eviction_delay
;
5213 /* Function prototypes. */
5215 static void define_image_type
P_ ((struct image_type
*type
));
5216 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5217 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5218 static void x_laplace
P_ ((struct frame
*, struct image
*));
5219 static void x_emboss
P_ ((struct frame
*, struct image
*));
5220 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5224 /* Define a new image type from TYPE. This adds a copy of TYPE to
5225 image_types and adds the symbol *TYPE->type to Vimage_types. */
5228 define_image_type (type
)
5229 struct image_type
*type
;
5231 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5232 The initialized data segment is read-only. */
5233 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5234 bcopy (type
, p
, sizeof *p
);
5235 p
->next
= image_types
;
5237 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5241 /* Look up image type SYMBOL, and return a pointer to its image_type
5242 structure. Value is null if SYMBOL is not a known image type. */
5244 static INLINE
struct image_type
*
5245 lookup_image_type (symbol
)
5248 struct image_type
*type
;
5250 for (type
= image_types
; type
; type
= type
->next
)
5251 if (EQ (symbol
, *type
->type
))
5258 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5259 valid image specification is a list whose car is the symbol
5260 `image', and whose rest is a property list. The property list must
5261 contain a value for key `:type'. That value must be the name of a
5262 supported image type. The rest of the property list depends on the
5266 valid_image_p (object
)
5271 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5273 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5274 struct image_type
*type
= lookup_image_type (symbol
);
5277 valid_p
= type
->valid_p (object
);
5284 /* Log error message with format string FORMAT and argument ARG.
5285 Signaling an error, e.g. when an image cannot be loaded, is not a
5286 good idea because this would interrupt redisplay, and the error
5287 message display would lead to another redisplay. This function
5288 therefore simply displays a message. */
5291 image_error (format
, arg1
, arg2
)
5293 Lisp_Object arg1
, arg2
;
5295 add_to_log (format
, arg1
, arg2
);
5300 /***********************************************************************
5301 Image specifications
5302 ***********************************************************************/
5304 enum image_value_type
5306 IMAGE_DONT_CHECK_VALUE_TYPE
,
5309 IMAGE_POSITIVE_INTEGER_VALUE
,
5310 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5311 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5313 IMAGE_INTEGER_VALUE
,
5314 IMAGE_FUNCTION_VALUE
,
5319 /* Structure used when parsing image specifications. */
5321 struct image_keyword
5323 /* Name of keyword. */
5326 /* The type of value allowed. */
5327 enum image_value_type type
;
5329 /* Non-zero means key must be present. */
5332 /* Used to recognize duplicate keywords in a property list. */
5335 /* The value that was found. */
5340 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5342 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5345 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5346 has the format (image KEYWORD VALUE ...). One of the keyword/
5347 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5348 image_keywords structures of size NKEYWORDS describing other
5349 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5352 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5354 struct image_keyword
*keywords
;
5361 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5364 plist
= XCDR (spec
);
5365 while (CONSP (plist
))
5367 Lisp_Object key
, value
;
5369 /* First element of a pair must be a symbol. */
5371 plist
= XCDR (plist
);
5375 /* There must follow a value. */
5378 value
= XCAR (plist
);
5379 plist
= XCDR (plist
);
5381 /* Find key in KEYWORDS. Error if not found. */
5382 for (i
= 0; i
< nkeywords
; ++i
)
5383 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5389 /* Record that we recognized the keyword. If a keywords
5390 was found more than once, it's an error. */
5391 keywords
[i
].value
= value
;
5392 ++keywords
[i
].count
;
5394 if (keywords
[i
].count
> 1)
5397 /* Check type of value against allowed type. */
5398 switch (keywords
[i
].type
)
5400 case IMAGE_STRING_VALUE
:
5401 if (!STRINGP (value
))
5405 case IMAGE_SYMBOL_VALUE
:
5406 if (!SYMBOLP (value
))
5410 case IMAGE_POSITIVE_INTEGER_VALUE
:
5411 if (!INTEGERP (value
) || XINT (value
) <= 0)
5415 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5416 if (INTEGERP (value
) && XINT (value
) >= 0)
5419 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5420 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5424 case IMAGE_ASCENT_VALUE
:
5425 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5427 else if (INTEGERP (value
)
5428 && XINT (value
) >= 0
5429 && XINT (value
) <= 100)
5433 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5434 if (!INTEGERP (value
) || XINT (value
) < 0)
5438 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5441 case IMAGE_FUNCTION_VALUE
:
5442 value
= indirect_function (value
);
5444 || COMPILEDP (value
)
5445 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5449 case IMAGE_NUMBER_VALUE
:
5450 if (!INTEGERP (value
) && !FLOATP (value
))
5454 case IMAGE_INTEGER_VALUE
:
5455 if (!INTEGERP (value
))
5459 case IMAGE_BOOL_VALUE
:
5460 if (!NILP (value
) && !EQ (value
, Qt
))
5469 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5473 /* Check that all mandatory fields are present. */
5474 for (i
= 0; i
< nkeywords
; ++i
)
5475 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5478 return NILP (plist
);
5482 /* Return the value of KEY in image specification SPEC. Value is nil
5483 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5484 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5487 image_spec_value (spec
, key
, found
)
5488 Lisp_Object spec
, key
;
5493 xassert (valid_image_p (spec
));
5495 for (tail
= XCDR (spec
);
5496 CONSP (tail
) && CONSP (XCDR (tail
));
5497 tail
= XCDR (XCDR (tail
)))
5499 if (EQ (XCAR (tail
), key
))
5503 return XCAR (XCDR (tail
));
5513 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5514 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5515 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5516 size in canonical character units.\n\
5517 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5518 or omitted means use the selected frame.")
5519 (spec
, pixels
, frame
)
5520 Lisp_Object spec
, pixels
, frame
;
5525 if (valid_image_p (spec
))
5527 struct frame
*f
= check_x_frame (frame
);
5528 int id
= lookup_image (f
, spec
);
5529 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5530 int width
= img
->width
+ 2 * img
->hmargin
;
5531 int height
= img
->height
+ 2 * img
->vmargin
;
5534 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5535 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5537 size
= Fcons (make_number (width
), make_number (height
));
5540 error ("Invalid image specification");
5546 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5547 "Return t if image SPEC has a mask bitmap.\n\
5548 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5549 or omitted means use the selected frame.")
5551 Lisp_Object spec
, frame
;
5556 if (valid_image_p (spec
))
5558 struct frame
*f
= check_x_frame (frame
);
5559 int id
= lookup_image (f
, spec
);
5560 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5565 error ("Invalid image specification");
5572 /***********************************************************************
5573 Image type independent image structures
5574 ***********************************************************************/
5576 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5577 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5580 /* Allocate and return a new image structure for image specification
5581 SPEC. SPEC has a hash value of HASH. */
5583 static struct image
*
5584 make_image (spec
, hash
)
5588 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5590 xassert (valid_image_p (spec
));
5591 bzero (img
, sizeof *img
);
5592 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5593 xassert (img
->type
!= NULL
);
5595 img
->data
.lisp_val
= Qnil
;
5596 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5602 /* Free image IMG which was used on frame F, including its resources. */
5611 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5613 /* Remove IMG from the hash table of its cache. */
5615 img
->prev
->next
= img
->next
;
5617 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5620 img
->next
->prev
= img
->prev
;
5622 c
->images
[img
->id
] = NULL
;
5624 /* Free resources, then free IMG. */
5625 img
->type
->free (f
, img
);
5631 /* Prepare image IMG for display on frame F. Must be called before
5632 drawing an image. */
5635 prepare_image_for_display (f
, img
)
5641 /* We're about to display IMG, so set its timestamp to `now'. */
5643 img
->timestamp
= EMACS_SECS (t
);
5645 /* If IMG doesn't have a pixmap yet, load it now, using the image
5646 type dependent loader function. */
5647 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5648 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5652 /* Value is the number of pixels for the ascent of image IMG when
5653 drawn in face FACE. */
5656 image_ascent (img
, face
)
5660 int height
= img
->height
+ img
->vmargin
;
5663 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5666 /* This expression is arranged so that if the image can't be
5667 exactly centered, it will be moved slightly up. This is
5668 because a typical font is `top-heavy' (due to the presence
5669 uppercase letters), so the image placement should err towards
5670 being top-heavy too. It also just generally looks better. */
5671 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5673 ascent
= height
/ 2;
5676 ascent
= height
* img
->ascent
/ 100.0;
5683 /***********************************************************************
5684 Helper functions for X image types
5685 ***********************************************************************/
5687 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5689 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5690 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5692 Lisp_Object color_name
,
5693 unsigned long dflt
));
5696 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5697 free the pixmap if any. MASK_P non-zero means clear the mask
5698 pixmap if any. COLORS_P non-zero means free colors allocated for
5699 the image, if any. */
5702 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5705 int pixmap_p
, mask_p
, colors_p
;
5707 if (pixmap_p
&& img
->pixmap
)
5709 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5713 if (mask_p
&& img
->mask
)
5715 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5719 if (colors_p
&& img
->ncolors
)
5721 x_free_colors (f
, img
->colors
, img
->ncolors
);
5722 xfree (img
->colors
);
5728 /* Free X resources of image IMG which is used on frame F. */
5731 x_clear_image (f
, img
)
5736 x_clear_image_1 (f
, img
, 1, 1, 1);
5741 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5742 cannot be allocated, use DFLT. Add a newly allocated color to
5743 IMG->colors, so that it can be freed again. Value is the pixel
5746 static unsigned long
5747 x_alloc_image_color (f
, img
, color_name
, dflt
)
5750 Lisp_Object color_name
;
5754 unsigned long result
;
5756 xassert (STRINGP (color_name
));
5758 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5760 /* This isn't called frequently so we get away with simply
5761 reallocating the color vector to the needed size, here. */
5764 (unsigned long *) xrealloc (img
->colors
,
5765 img
->ncolors
* sizeof *img
->colors
);
5766 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5767 result
= color
.pixel
;
5777 /***********************************************************************
5779 ***********************************************************************/
5781 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5784 /* Return a new, initialized image cache that is allocated from the
5785 heap. Call free_image_cache to free an image cache. */
5787 struct image_cache
*
5790 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5793 bzero (c
, sizeof *c
);
5795 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5796 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5797 c
->buckets
= (struct image
**) xmalloc (size
);
5798 bzero (c
->buckets
, size
);
5803 /* Free image cache of frame F. Be aware that X frames share images
5807 free_image_cache (f
)
5810 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5815 /* Cache should not be referenced by any frame when freed. */
5816 xassert (c
->refcount
== 0);
5818 for (i
= 0; i
< c
->used
; ++i
)
5819 free_image (f
, c
->images
[i
]);
5823 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5828 /* Clear image cache of frame F. FORCE_P non-zero means free all
5829 images. FORCE_P zero means clear only images that haven't been
5830 displayed for some time. Should be called from time to time to
5831 reduce the number of loaded images. If image-eviction-seconds is
5832 non-nil, this frees images in the cache which weren't displayed for
5833 at least that many seconds. */
5836 clear_image_cache (f
, force_p
)
5840 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5842 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5849 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5851 /* Block input so that we won't be interrupted by a SIGIO
5852 while being in an inconsistent state. */
5855 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5857 struct image
*img
= c
->images
[i
];
5859 && (force_p
|| img
->timestamp
< old
))
5861 free_image (f
, img
);
5866 /* We may be clearing the image cache because, for example,
5867 Emacs was iconified for a longer period of time. In that
5868 case, current matrices may still contain references to
5869 images freed above. So, clear these matrices. */
5872 Lisp_Object tail
, frame
;
5874 FOR_EACH_FRAME (tail
, frame
)
5876 struct frame
*f
= XFRAME (frame
);
5878 && FRAME_X_IMAGE_CACHE (f
) == c
)
5879 clear_current_matrices (f
);
5882 ++windows_or_buffers_changed
;
5890 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5892 "Clear the image cache of FRAME.\n\
5893 FRAME nil or omitted means use the selected frame.\n\
5894 FRAME t means clear the image caches of all frames.")
5902 FOR_EACH_FRAME (tail
, frame
)
5903 if (FRAME_X_P (XFRAME (frame
)))
5904 clear_image_cache (XFRAME (frame
), 1);
5907 clear_image_cache (check_x_frame (frame
), 1);
5913 /* Return the id of image with Lisp specification SPEC on frame F.
5914 SPEC must be a valid Lisp image specification (see valid_image_p). */
5917 lookup_image (f
, spec
)
5921 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5925 struct gcpro gcpro1
;
5928 /* F must be a window-system frame, and SPEC must be a valid image
5930 xassert (FRAME_WINDOW_P (f
));
5931 xassert (valid_image_p (spec
));
5935 /* Look up SPEC in the hash table of the image cache. */
5936 hash
= sxhash (spec
, 0);
5937 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5939 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
5940 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
5943 /* If not found, create a new image and cache it. */
5947 img
= make_image (spec
, hash
);
5948 cache_image (f
, img
);
5949 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5951 /* If we can't load the image, and we don't have a width and
5952 height, use some arbitrary width and height so that we can
5953 draw a rectangle for it. */
5954 if (img
->load_failed_p
)
5958 value
= image_spec_value (spec
, QCwidth
, NULL
);
5959 img
->width
= (INTEGERP (value
)
5960 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
5961 value
= image_spec_value (spec
, QCheight
, NULL
);
5962 img
->height
= (INTEGERP (value
)
5963 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
5967 /* Handle image type independent image attributes
5968 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
5969 Lisp_Object ascent
, margin
, relief
;
5971 ascent
= image_spec_value (spec
, QCascent
, NULL
);
5972 if (INTEGERP (ascent
))
5973 img
->ascent
= XFASTINT (ascent
);
5974 else if (EQ (ascent
, Qcenter
))
5975 img
->ascent
= CENTERED_IMAGE_ASCENT
;
5977 margin
= image_spec_value (spec
, QCmargin
, NULL
);
5978 if (INTEGERP (margin
) && XINT (margin
) >= 0)
5979 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
5980 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
5981 && INTEGERP (XCDR (margin
)))
5983 if (XINT (XCAR (margin
)) > 0)
5984 img
->hmargin
= XFASTINT (XCAR (margin
));
5985 if (XINT (XCDR (margin
)) > 0)
5986 img
->vmargin
= XFASTINT (XCDR (margin
));
5989 relief
= image_spec_value (spec
, QCrelief
, NULL
);
5990 if (INTEGERP (relief
))
5992 img
->relief
= XINT (relief
);
5993 img
->hmargin
+= abs (img
->relief
);
5994 img
->vmargin
+= abs (img
->relief
);
5997 /* Manipulation of the image's mask. */
6000 /* `:heuristic-mask t'
6002 means build a mask heuristically.
6003 `:heuristic-mask (R G B)'
6004 `:mask (heuristic (R G B))'
6005 means build a mask from color (R G B) in the
6008 means remove a mask, if any. */
6012 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6014 x_build_heuristic_mask (f
, img
, mask
);
6019 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6021 if (EQ (mask
, Qheuristic
))
6022 x_build_heuristic_mask (f
, img
, Qt
);
6023 else if (CONSP (mask
)
6024 && EQ (XCAR (mask
), Qheuristic
))
6026 if (CONSP (XCDR (mask
)))
6027 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6029 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6031 else if (NILP (mask
) && found_p
&& img
->mask
)
6033 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6039 /* Should we apply an image transformation algorithm? */
6042 Lisp_Object conversion
;
6044 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6045 if (EQ (conversion
, Qdisabled
))
6046 x_disable_image (f
, img
);
6047 else if (EQ (conversion
, Qlaplace
))
6049 else if (EQ (conversion
, Qemboss
))
6051 else if (CONSP (conversion
)
6052 && EQ (XCAR (conversion
), Qedge_detection
))
6055 tem
= XCDR (conversion
);
6057 x_edge_detection (f
, img
,
6058 Fplist_get (tem
, QCmatrix
),
6059 Fplist_get (tem
, QCcolor_adjustment
));
6065 xassert (!interrupt_input_blocked
);
6068 /* We're using IMG, so set its timestamp to `now'. */
6069 EMACS_GET_TIME (now
);
6070 img
->timestamp
= EMACS_SECS (now
);
6074 /* Value is the image id. */
6079 /* Cache image IMG in the image cache of frame F. */
6082 cache_image (f
, img
)
6086 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6089 /* Find a free slot in c->images. */
6090 for (i
= 0; i
< c
->used
; ++i
)
6091 if (c
->images
[i
] == NULL
)
6094 /* If no free slot found, maybe enlarge c->images. */
6095 if (i
== c
->used
&& c
->used
== c
->size
)
6098 c
->images
= (struct image
**) xrealloc (c
->images
,
6099 c
->size
* sizeof *c
->images
);
6102 /* Add IMG to c->images, and assign IMG an id. */
6108 /* Add IMG to the cache's hash table. */
6109 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6110 img
->next
= c
->buckets
[i
];
6112 img
->next
->prev
= img
;
6114 c
->buckets
[i
] = img
;
6118 /* Call FN on every image in the image cache of frame F. Used to mark
6119 Lisp Objects in the image cache. */
6122 forall_images_in_image_cache (f
, fn
)
6124 void (*fn
) P_ ((struct image
*img
));
6126 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6128 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6132 for (i
= 0; i
< c
->used
; ++i
)
6141 /***********************************************************************
6143 ***********************************************************************/
6145 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6146 XImage
**, Pixmap
*));
6147 static void x_destroy_x_image
P_ ((XImage
*));
6148 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6151 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6152 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6153 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6154 via xmalloc. Print error messages via image_error if an error
6155 occurs. Value is non-zero if successful. */
6158 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6160 int width
, height
, depth
;
6164 Display
*display
= FRAME_X_DISPLAY (f
);
6165 Screen
*screen
= FRAME_X_SCREEN (f
);
6166 Window window
= FRAME_X_WINDOW (f
);
6168 xassert (interrupt_input_blocked
);
6171 depth
= DefaultDepthOfScreen (screen
);
6172 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6173 depth
, ZPixmap
, 0, NULL
, width
, height
,
6174 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6177 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6181 /* Allocate image raster. */
6182 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6184 /* Allocate a pixmap of the same size. */
6185 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6186 if (*pixmap
== None
)
6188 x_destroy_x_image (*ximg
);
6190 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6198 /* Destroy XImage XIMG. Free XIMG->data. */
6201 x_destroy_x_image (ximg
)
6204 xassert (interrupt_input_blocked
);
6209 XDestroyImage (ximg
);
6214 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6215 are width and height of both the image and pixmap. */
6218 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6225 xassert (interrupt_input_blocked
);
6226 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6227 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6228 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6233 /***********************************************************************
6235 ***********************************************************************/
6237 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6238 static char *slurp_file
P_ ((char *, int *));
6241 /* Find image file FILE. Look in data-directory, then
6242 x-bitmap-file-path. Value is the full name of the file found, or
6243 nil if not found. */
6246 x_find_image_file (file
)
6249 Lisp_Object file_found
, search_path
;
6250 struct gcpro gcpro1
, gcpro2
;
6254 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6255 GCPRO2 (file_found
, search_path
);
6257 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6258 fd
= openp (search_path
, file
, "", &file_found
, 0);
6270 /* Read FILE into memory. Value is a pointer to a buffer allocated
6271 with xmalloc holding FILE's contents. Value is null if an error
6272 occurred. *SIZE is set to the size of the file. */
6275 slurp_file (file
, size
)
6283 if (stat (file
, &st
) == 0
6284 && (fp
= fopen (file
, "r")) != NULL
6285 && (buf
= (char *) xmalloc (st
.st_size
),
6286 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6307 /***********************************************************************
6309 ***********************************************************************/
6311 static int xbm_scan
P_ ((char **, char *, char *, int *));
6312 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6313 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6315 static int xbm_image_p
P_ ((Lisp_Object object
));
6316 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6318 static int xbm_file_p
P_ ((Lisp_Object
));
6321 /* Indices of image specification fields in xbm_format, below. */
6323 enum xbm_keyword_index
6341 /* Vector of image_keyword structures describing the format
6342 of valid XBM image specifications. */
6344 static struct image_keyword xbm_format
[XBM_LAST
] =
6346 {":type", IMAGE_SYMBOL_VALUE
, 1},
6347 {":file", IMAGE_STRING_VALUE
, 0},
6348 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6349 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6350 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6351 {":foreground", IMAGE_STRING_VALUE
, 0},
6352 {":background", IMAGE_STRING_VALUE
, 0},
6353 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6354 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6355 {":relief", IMAGE_INTEGER_VALUE
, 0},
6356 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6357 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6358 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6361 /* Structure describing the image type XBM. */
6363 static struct image_type xbm_type
=
6372 /* Tokens returned from xbm_scan. */
6381 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6382 A valid specification is a list starting with the symbol `image'
6383 The rest of the list is a property list which must contain an
6386 If the specification specifies a file to load, it must contain
6387 an entry `:file FILENAME' where FILENAME is a string.
6389 If the specification is for a bitmap loaded from memory it must
6390 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6391 WIDTH and HEIGHT are integers > 0. DATA may be:
6393 1. a string large enough to hold the bitmap data, i.e. it must
6394 have a size >= (WIDTH + 7) / 8 * HEIGHT
6396 2. a bool-vector of size >= WIDTH * HEIGHT
6398 3. a vector of strings or bool-vectors, one for each line of the
6401 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6402 may not be specified in this case because they are defined in the
6405 Both the file and data forms may contain the additional entries
6406 `:background COLOR' and `:foreground COLOR'. If not present,
6407 foreground and background of the frame on which the image is
6408 displayed is used. */
6411 xbm_image_p (object
)
6414 struct image_keyword kw
[XBM_LAST
];
6416 bcopy (xbm_format
, kw
, sizeof kw
);
6417 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6420 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6422 if (kw
[XBM_FILE
].count
)
6424 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6427 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6429 /* In-memory XBM file. */
6430 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6438 /* Entries for `:width', `:height' and `:data' must be present. */
6439 if (!kw
[XBM_WIDTH
].count
6440 || !kw
[XBM_HEIGHT
].count
6441 || !kw
[XBM_DATA
].count
)
6444 data
= kw
[XBM_DATA
].value
;
6445 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6446 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6448 /* Check type of data, and width and height against contents of
6454 /* Number of elements of the vector must be >= height. */
6455 if (XVECTOR (data
)->size
< height
)
6458 /* Each string or bool-vector in data must be large enough
6459 for one line of the image. */
6460 for (i
= 0; i
< height
; ++i
)
6462 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6466 if (XSTRING (elt
)->size
6467 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6470 else if (BOOL_VECTOR_P (elt
))
6472 if (XBOOL_VECTOR (elt
)->size
< width
)
6479 else if (STRINGP (data
))
6481 if (XSTRING (data
)->size
6482 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6485 else if (BOOL_VECTOR_P (data
))
6487 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6498 /* Scan a bitmap file. FP is the stream to read from. Value is
6499 either an enumerator from enum xbm_token, or a character for a
6500 single-character token, or 0 at end of file. If scanning an
6501 identifier, store the lexeme of the identifier in SVAL. If
6502 scanning a number, store its value in *IVAL. */
6505 xbm_scan (s
, end
, sval
, ival
)
6514 /* Skip white space. */
6515 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6520 else if (isdigit (c
))
6522 int value
= 0, digit
;
6524 if (c
== '0' && *s
< end
)
6527 if (c
== 'x' || c
== 'X')
6534 else if (c
>= 'a' && c
<= 'f')
6535 digit
= c
- 'a' + 10;
6536 else if (c
>= 'A' && c
<= 'F')
6537 digit
= c
- 'A' + 10;
6540 value
= 16 * value
+ digit
;
6543 else if (isdigit (c
))
6547 && (c
= *(*s
)++, isdigit (c
)))
6548 value
= 8 * value
+ c
- '0';
6555 && (c
= *(*s
)++, isdigit (c
)))
6556 value
= 10 * value
+ c
- '0';
6564 else if (isalpha (c
) || c
== '_')
6568 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6575 else if (c
== '/' && **s
== '*')
6577 /* C-style comment. */
6579 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6592 /* Replacement for XReadBitmapFileData which isn't available under old
6593 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6594 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6595 the image. Return in *DATA the bitmap data allocated with xmalloc.
6596 Value is non-zero if successful. DATA null means just test if
6597 CONTENTS looks like an in-memory XBM file. */
6600 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6601 char *contents
, *end
;
6602 int *width
, *height
;
6603 unsigned char **data
;
6606 char buffer
[BUFSIZ
];
6609 int bytes_per_line
, i
, nbytes
;
6615 LA1 = xbm_scan (&s, end, buffer, &value)
6617 #define expect(TOKEN) \
6618 if (LA1 != (TOKEN)) \
6623 #define expect_ident(IDENT) \
6624 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6629 *width
= *height
= -1;
6632 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6634 /* Parse defines for width, height and hot-spots. */
6638 expect_ident ("define");
6639 expect (XBM_TK_IDENT
);
6641 if (LA1
== XBM_TK_NUMBER
);
6643 char *p
= strrchr (buffer
, '_');
6644 p
= p
? p
+ 1 : buffer
;
6645 if (strcmp (p
, "width") == 0)
6647 else if (strcmp (p
, "height") == 0)
6650 expect (XBM_TK_NUMBER
);
6653 if (*width
< 0 || *height
< 0)
6655 else if (data
== NULL
)
6658 /* Parse bits. Must start with `static'. */
6659 expect_ident ("static");
6660 if (LA1
== XBM_TK_IDENT
)
6662 if (strcmp (buffer
, "unsigned") == 0)
6665 expect_ident ("char");
6667 else if (strcmp (buffer
, "short") == 0)
6671 if (*width
% 16 && *width
% 16 < 9)
6674 else if (strcmp (buffer
, "char") == 0)
6682 expect (XBM_TK_IDENT
);
6688 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6689 nbytes
= bytes_per_line
* *height
;
6690 p
= *data
= (char *) xmalloc (nbytes
);
6694 for (i
= 0; i
< nbytes
; i
+= 2)
6697 expect (XBM_TK_NUMBER
);
6700 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6703 if (LA1
== ',' || LA1
== '}')
6711 for (i
= 0; i
< nbytes
; ++i
)
6714 expect (XBM_TK_NUMBER
);
6718 if (LA1
== ',' || LA1
== '}')
6743 /* Load XBM image IMG which will be displayed on frame F from buffer
6744 CONTENTS. END is the end of the buffer. Value is non-zero if
6748 xbm_load_image (f
, img
, contents
, end
)
6751 char *contents
, *end
;
6754 unsigned char *data
;
6757 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6760 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6761 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6762 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6765 xassert (img
->width
> 0 && img
->height
> 0);
6767 /* Get foreground and background colors, maybe allocate colors. */
6768 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6770 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6772 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6774 background
= x_alloc_image_color (f
, img
, value
, background
);
6777 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6780 img
->width
, img
->height
,
6781 foreground
, background
,
6785 if (img
->pixmap
== None
)
6787 x_clear_image (f
, img
);
6788 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6794 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6800 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6807 return (STRINGP (data
)
6808 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6809 (XSTRING (data
)->data
6810 + STRING_BYTES (XSTRING (data
))),
6815 /* Fill image IMG which is used on frame F with pixmap data. Value is
6816 non-zero if successful. */
6824 Lisp_Object file_name
;
6826 xassert (xbm_image_p (img
->spec
));
6828 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6829 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6830 if (STRINGP (file_name
))
6835 struct gcpro gcpro1
;
6837 file
= x_find_image_file (file_name
);
6839 if (!STRINGP (file
))
6841 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6846 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6847 if (contents
== NULL
)
6849 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6854 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6859 struct image_keyword fmt
[XBM_LAST
];
6862 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6863 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6866 int in_memory_file_p
= 0;
6868 /* See if data looks like an in-memory XBM file. */
6869 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6870 in_memory_file_p
= xbm_file_p (data
);
6872 /* Parse the image specification. */
6873 bcopy (xbm_format
, fmt
, sizeof fmt
);
6874 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6877 /* Get specified width, and height. */
6878 if (!in_memory_file_p
)
6880 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6881 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6882 xassert (img
->width
> 0 && img
->height
> 0);
6885 /* Get foreground and background colors, maybe allocate colors. */
6886 if (fmt
[XBM_FOREGROUND
].count
)
6887 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6889 if (fmt
[XBM_BACKGROUND
].count
)
6890 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6893 if (in_memory_file_p
)
6894 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6895 (XSTRING (data
)->data
6896 + STRING_BYTES (XSTRING (data
))));
6903 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6905 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6906 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6908 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6910 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6912 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6915 else if (STRINGP (data
))
6916 bits
= XSTRING (data
)->data
;
6918 bits
= XBOOL_VECTOR (data
)->data
;
6920 /* Create the pixmap. */
6921 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6923 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6926 img
->width
, img
->height
,
6927 foreground
, background
,
6933 image_error ("Unable to create pixmap for XBM image `%s'",
6935 x_clear_image (f
, img
);
6945 /***********************************************************************
6947 ***********************************************************************/
6951 static int xpm_image_p
P_ ((Lisp_Object object
));
6952 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6953 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6955 #include "X11/xpm.h"
6957 /* The symbol `xpm' identifying XPM-format images. */
6961 /* Indices of image specification fields in xpm_format, below. */
6963 enum xpm_keyword_index
6978 /* Vector of image_keyword structures describing the format
6979 of valid XPM image specifications. */
6981 static struct image_keyword xpm_format
[XPM_LAST
] =
6983 {":type", IMAGE_SYMBOL_VALUE
, 1},
6984 {":file", IMAGE_STRING_VALUE
, 0},
6985 {":data", IMAGE_STRING_VALUE
, 0},
6986 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6987 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6988 {":relief", IMAGE_INTEGER_VALUE
, 0},
6989 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6990 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6991 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6992 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6995 /* Structure describing the image type XBM. */
6997 static struct image_type xpm_type
=
7007 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7008 functions for allocating image colors. Our own functions handle
7009 color allocation failures more gracefully than the ones on the XPM
7012 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7013 #define ALLOC_XPM_COLORS
7016 #ifdef ALLOC_XPM_COLORS
7018 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7019 static void xpm_free_color_cache
P_ ((void));
7020 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7021 static int xpm_color_bucket
P_ ((char *));
7022 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7025 /* An entry in a hash table used to cache color definitions of named
7026 colors. This cache is necessary to speed up XPM image loading in
7027 case we do color allocations ourselves. Without it, we would need
7028 a call to XParseColor per pixel in the image. */
7030 struct xpm_cached_color
7032 /* Next in collision chain. */
7033 struct xpm_cached_color
*next
;
7035 /* Color definition (RGB and pixel color). */
7042 /* The hash table used for the color cache, and its bucket vector
7045 #define XPM_COLOR_CACHE_BUCKETS 1001
7046 struct xpm_cached_color
**xpm_color_cache
;
7048 /* Initialize the color cache. */
7051 xpm_init_color_cache (f
, attrs
)
7053 XpmAttributes
*attrs
;
7055 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7056 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7057 memset (xpm_color_cache
, 0, nbytes
);
7058 init_color_table ();
7060 if (attrs
->valuemask
& XpmColorSymbols
)
7065 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7066 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7067 attrs
->colorsymbols
[i
].value
, &color
))
7069 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7071 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7077 /* Free the color cache. */
7080 xpm_free_color_cache ()
7082 struct xpm_cached_color
*p
, *next
;
7085 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7086 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7092 xfree (xpm_color_cache
);
7093 xpm_color_cache
= NULL
;
7094 free_color_table ();
7098 /* Return the bucket index for color named COLOR_NAME in the color
7102 xpm_color_bucket (color_name
)
7108 for (s
= color_name
; *s
; ++s
)
7110 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7114 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7115 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7118 static struct xpm_cached_color
*
7119 xpm_cache_color (f
, color_name
, color
, bucket
)
7126 struct xpm_cached_color
*p
;
7129 bucket
= xpm_color_bucket (color_name
);
7131 nbytes
= sizeof *p
+ strlen (color_name
);
7132 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7133 strcpy (p
->name
, color_name
);
7135 p
->next
= xpm_color_cache
[bucket
];
7136 xpm_color_cache
[bucket
] = p
;
7141 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7142 return the cached definition in *COLOR. Otherwise, make a new
7143 entry in the cache and allocate the color. Value is zero if color
7144 allocation failed. */
7147 xpm_lookup_color (f
, color_name
, color
)
7152 struct xpm_cached_color
*p
;
7153 int h
= xpm_color_bucket (color_name
);
7155 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7156 if (strcmp (p
->name
, color_name
) == 0)
7161 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7164 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7166 p
= xpm_cache_color (f
, color_name
, color
, h
);
7173 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7174 CLOSURE is a pointer to the frame on which we allocate the
7175 color. Return in *COLOR the allocated color. Value is non-zero
7179 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7186 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7190 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7191 is a pointer to the frame on which we allocate the color. Value is
7192 non-zero if successful. */
7195 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7205 #endif /* ALLOC_XPM_COLORS */
7208 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7209 for XPM images. Such a list must consist of conses whose car and
7213 xpm_valid_color_symbols_p (color_symbols
)
7214 Lisp_Object color_symbols
;
7216 while (CONSP (color_symbols
))
7218 Lisp_Object sym
= XCAR (color_symbols
);
7220 || !STRINGP (XCAR (sym
))
7221 || !STRINGP (XCDR (sym
)))
7223 color_symbols
= XCDR (color_symbols
);
7226 return NILP (color_symbols
);
7230 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7233 xpm_image_p (object
)
7236 struct image_keyword fmt
[XPM_LAST
];
7237 bcopy (xpm_format
, fmt
, sizeof fmt
);
7238 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7239 /* Either `:file' or `:data' must be present. */
7240 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7241 /* Either no `:color-symbols' or it's a list of conses
7242 whose car and cdr are strings. */
7243 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7244 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7248 /* Load image IMG which will be displayed on frame F. Value is
7249 non-zero if successful. */
7257 XpmAttributes attrs
;
7258 Lisp_Object specified_file
, color_symbols
;
7260 /* Configure the XPM lib. Use the visual of frame F. Allocate
7261 close colors. Return colors allocated. */
7262 bzero (&attrs
, sizeof attrs
);
7263 attrs
.visual
= FRAME_X_VISUAL (f
);
7264 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7265 attrs
.valuemask
|= XpmVisual
;
7266 attrs
.valuemask
|= XpmColormap
;
7268 #ifdef ALLOC_XPM_COLORS
7269 /* Allocate colors with our own functions which handle
7270 failing color allocation more gracefully. */
7271 attrs
.color_closure
= f
;
7272 attrs
.alloc_color
= xpm_alloc_color
;
7273 attrs
.free_colors
= xpm_free_colors
;
7274 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7275 #else /* not ALLOC_XPM_COLORS */
7276 /* Let the XPM lib allocate colors. */
7277 attrs
.valuemask
|= XpmReturnAllocPixels
;
7278 #ifdef XpmAllocCloseColors
7279 attrs
.alloc_close_colors
= 1;
7280 attrs
.valuemask
|= XpmAllocCloseColors
;
7281 #else /* not XpmAllocCloseColors */
7282 attrs
.closeness
= 600;
7283 attrs
.valuemask
|= XpmCloseness
;
7284 #endif /* not XpmAllocCloseColors */
7285 #endif /* ALLOC_XPM_COLORS */
7287 /* If image specification contains symbolic color definitions, add
7288 these to `attrs'. */
7289 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7290 if (CONSP (color_symbols
))
7293 XpmColorSymbol
*xpm_syms
;
7296 attrs
.valuemask
|= XpmColorSymbols
;
7298 /* Count number of symbols. */
7299 attrs
.numsymbols
= 0;
7300 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7303 /* Allocate an XpmColorSymbol array. */
7304 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7305 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7306 bzero (xpm_syms
, size
);
7307 attrs
.colorsymbols
= xpm_syms
;
7309 /* Fill the color symbol array. */
7310 for (tail
= color_symbols
, i
= 0;
7312 ++i
, tail
= XCDR (tail
))
7314 Lisp_Object name
= XCAR (XCAR (tail
));
7315 Lisp_Object color
= XCDR (XCAR (tail
));
7316 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7317 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7318 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7319 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7323 /* Create a pixmap for the image, either from a file, or from a
7324 string buffer containing data in the same format as an XPM file. */
7325 #ifdef ALLOC_XPM_COLORS
7326 xpm_init_color_cache (f
, &attrs
);
7329 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7330 if (STRINGP (specified_file
))
7332 Lisp_Object file
= x_find_image_file (specified_file
);
7333 if (!STRINGP (file
))
7335 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7339 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7340 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7345 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7346 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7347 XSTRING (buffer
)->data
,
7348 &img
->pixmap
, &img
->mask
,
7352 if (rc
== XpmSuccess
)
7354 #ifdef ALLOC_XPM_COLORS
7355 img
->colors
= colors_in_color_table (&img
->ncolors
);
7356 #else /* not ALLOC_XPM_COLORS */
7359 img
->ncolors
= attrs
.nalloc_pixels
;
7360 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7361 * sizeof *img
->colors
);
7362 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7364 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7365 #ifdef DEBUG_X_COLORS
7366 register_color (img
->colors
[i
]);
7369 #endif /* not ALLOC_XPM_COLORS */
7371 img
->width
= attrs
.width
;
7372 img
->height
= attrs
.height
;
7373 xassert (img
->width
> 0 && img
->height
> 0);
7375 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7376 XpmFreeAttributes (&attrs
);
7383 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7386 case XpmFileInvalid
:
7387 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7391 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7394 case XpmColorFailed
:
7395 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7399 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7404 #ifdef ALLOC_XPM_COLORS
7405 xpm_free_color_cache ();
7407 return rc
== XpmSuccess
;
7410 #endif /* HAVE_XPM != 0 */
7413 /***********************************************************************
7415 ***********************************************************************/
7417 /* An entry in the color table mapping an RGB color to a pixel color. */
7422 unsigned long pixel
;
7424 /* Next in color table collision list. */
7425 struct ct_color
*next
;
7428 /* The bucket vector size to use. Must be prime. */
7432 /* Value is a hash of the RGB color given by R, G, and B. */
7434 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7436 /* The color hash table. */
7438 struct ct_color
**ct_table
;
7440 /* Number of entries in the color table. */
7442 int ct_colors_allocated
;
7444 /* Initialize the color table. */
7449 int size
= CT_SIZE
* sizeof (*ct_table
);
7450 ct_table
= (struct ct_color
**) xmalloc (size
);
7451 bzero (ct_table
, size
);
7452 ct_colors_allocated
= 0;
7456 /* Free memory associated with the color table. */
7462 struct ct_color
*p
, *next
;
7464 for (i
= 0; i
< CT_SIZE
; ++i
)
7465 for (p
= ct_table
[i
]; p
; p
= next
)
7476 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7477 entry for that color already is in the color table, return the
7478 pixel color of that entry. Otherwise, allocate a new color for R,
7479 G, B, and make an entry in the color table. */
7481 static unsigned long
7482 lookup_rgb_color (f
, r
, g
, b
)
7486 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7487 int i
= hash
% CT_SIZE
;
7490 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7491 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7504 cmap
= FRAME_X_COLORMAP (f
);
7505 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7509 ++ct_colors_allocated
;
7511 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7515 p
->pixel
= color
.pixel
;
7516 p
->next
= ct_table
[i
];
7520 return FRAME_FOREGROUND_PIXEL (f
);
7527 /* Look up pixel color PIXEL which is used on frame F in the color
7528 table. If not already present, allocate it. Value is PIXEL. */
7530 static unsigned long
7531 lookup_pixel_color (f
, pixel
)
7533 unsigned long pixel
;
7535 int i
= pixel
% CT_SIZE
;
7538 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7539 if (p
->pixel
== pixel
)
7548 cmap
= FRAME_X_COLORMAP (f
);
7549 color
.pixel
= pixel
;
7550 x_query_color (f
, &color
);
7551 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7555 ++ct_colors_allocated
;
7557 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7562 p
->next
= ct_table
[i
];
7566 return FRAME_FOREGROUND_PIXEL (f
);
7573 /* Value is a vector of all pixel colors contained in the color table,
7574 allocated via xmalloc. Set *N to the number of colors. */
7576 static unsigned long *
7577 colors_in_color_table (n
)
7582 unsigned long *colors
;
7584 if (ct_colors_allocated
== 0)
7591 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7593 *n
= ct_colors_allocated
;
7595 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7596 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7597 colors
[j
++] = p
->pixel
;
7605 /***********************************************************************
7607 ***********************************************************************/
7609 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7610 int, XImage
*, int));
7611 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7612 XColor
*, int, XImage
*, int));
7613 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7614 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7615 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7617 /* Non-zero means draw a cross on images having `:conversion
7620 int cross_disabled_images
;
7622 /* Edge detection matrices for different edge-detection
7625 static int emboss_matrix
[9] = {
7627 2, -1, 0, /* y - 1 */
7629 0, 1, -2 /* y + 1 */
7632 static int laplace_matrix
[9] = {
7634 1, 0, 0, /* y - 1 */
7636 0, 0, -1 /* y + 1 */
7639 /* Value is the intensity of the color whose red/green/blue values
7642 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7645 /* On frame F, return an array of XColor structures describing image
7646 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7647 non-zero means also fill the red/green/blue members of the XColor
7648 structures. Value is a pointer to the array of XColors structures,
7649 allocated with xmalloc; it must be freed by the caller. */
7652 x_to_xcolors (f
, img
, rgb_p
)
7661 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7663 /* Get the X image IMG->pixmap. */
7664 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7665 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7667 /* Fill the `pixel' members of the XColor array. I wished there
7668 were an easy and portable way to circumvent XGetPixel. */
7670 for (y
= 0; y
< img
->height
; ++y
)
7674 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7675 p
->pixel
= XGetPixel (ximg
, x
, y
);
7678 x_query_colors (f
, row
, img
->width
);
7681 XDestroyImage (ximg
);
7686 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7687 RGB members are set. F is the frame on which this all happens.
7688 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7691 x_from_xcolors (f
, img
, colors
)
7701 init_color_table ();
7703 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7706 for (y
= 0; y
< img
->height
; ++y
)
7707 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7709 unsigned long pixel
;
7710 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7711 XPutPixel (oimg
, x
, y
, pixel
);
7715 x_clear_image_1 (f
, img
, 1, 0, 1);
7717 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7718 x_destroy_x_image (oimg
);
7719 img
->pixmap
= pixmap
;
7720 img
->colors
= colors_in_color_table (&img
->ncolors
);
7721 free_color_table ();
7725 /* On frame F, perform edge-detection on image IMG.
7727 MATRIX is a nine-element array specifying the transformation
7728 matrix. See emboss_matrix for an example.
7730 COLOR_ADJUST is a color adjustment added to each pixel of the
7734 x_detect_edges (f
, img
, matrix
, color_adjust
)
7737 int matrix
[9], color_adjust
;
7739 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7743 for (i
= sum
= 0; i
< 9; ++i
)
7744 sum
+= abs (matrix
[i
]);
7746 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7748 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7750 for (y
= 0; y
< img
->height
; ++y
)
7752 p
= COLOR (new, 0, y
);
7753 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7754 p
= COLOR (new, img
->width
- 1, y
);
7755 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7758 for (x
= 1; x
< img
->width
- 1; ++x
)
7760 p
= COLOR (new, x
, 0);
7761 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7762 p
= COLOR (new, x
, img
->height
- 1);
7763 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7766 for (y
= 1; y
< img
->height
- 1; ++y
)
7768 p
= COLOR (new, 1, y
);
7770 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7772 int r
, g
, b
, y1
, x1
;
7775 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7776 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7779 XColor
*t
= COLOR (colors
, x1
, y1
);
7780 r
+= matrix
[i
] * t
->red
;
7781 g
+= matrix
[i
] * t
->green
;
7782 b
+= matrix
[i
] * t
->blue
;
7785 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7786 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7787 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7788 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7793 x_from_xcolors (f
, img
, new);
7799 /* Perform the pre-defined `emboss' edge-detection on image IMG
7807 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7811 /* Perform the pre-defined `laplace' edge-detection on image IMG
7819 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7823 /* Perform edge-detection on image IMG on frame F, with specified
7824 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7826 MATRIX must be either
7828 - a list of at least 9 numbers in row-major form
7829 - a vector of at least 9 numbers
7831 COLOR_ADJUST nil means use a default; otherwise it must be a
7835 x_edge_detection (f
, img
, matrix
, color_adjust
)
7838 Lisp_Object matrix
, color_adjust
;
7846 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7847 ++i
, matrix
= XCDR (matrix
))
7848 trans
[i
] = XFLOATINT (XCAR (matrix
));
7850 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7852 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7853 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7856 if (NILP (color_adjust
))
7857 color_adjust
= make_number (0xffff / 2);
7859 if (i
== 9 && NUMBERP (color_adjust
))
7860 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7864 /* Transform image IMG on frame F so that it looks disabled. */
7867 x_disable_image (f
, img
)
7871 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7873 if (dpyinfo
->n_planes
>= 2)
7875 /* Color (or grayscale). Convert to gray, and equalize. Just
7876 drawing such images with a stipple can look very odd, so
7877 we're using this method instead. */
7878 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7880 const int h
= 15000;
7881 const int l
= 30000;
7883 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7887 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7888 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7889 p
->red
= p
->green
= p
->blue
= i2
;
7892 x_from_xcolors (f
, img
, colors
);
7895 /* Draw a cross over the disabled image, if we must or if we
7897 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
7899 Display
*dpy
= FRAME_X_DISPLAY (f
);
7902 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
7903 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
7904 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
7905 img
->width
- 1, img
->height
- 1);
7906 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
7912 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
7913 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
7914 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
7915 img
->width
- 1, img
->height
- 1);
7916 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
7924 /* Build a mask for image IMG which is used on frame F. FILE is the
7925 name of an image file, for error messages. HOW determines how to
7926 determine the background color of IMG. If it is a list '(R G B)',
7927 with R, G, and B being integers >= 0, take that as the color of the
7928 background. Otherwise, determine the background color of IMG
7929 heuristically. Value is non-zero if successful. */
7932 x_build_heuristic_mask (f
, img
, how
)
7937 Display
*dpy
= FRAME_X_DISPLAY (f
);
7938 XImage
*ximg
, *mask_img
;
7939 int x
, y
, rc
, look_at_corners_p
;
7940 unsigned long bg
= 0;
7944 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
7948 /* Create an image and pixmap serving as mask. */
7949 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7950 &mask_img
, &img
->mask
);
7954 /* Get the X image of IMG->pixmap. */
7955 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7958 /* Determine the background color of ximg. If HOW is `(R G B)'
7959 take that as color. Otherwise, try to determine the color
7961 look_at_corners_p
= 1;
7969 && NATNUMP (XCAR (how
)))
7971 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7975 if (i
== 3 && NILP (how
))
7977 char color_name
[30];
7978 XColor exact
, color
;
7981 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7983 cmap
= FRAME_X_COLORMAP (f
);
7984 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7987 look_at_corners_p
= 0;
7992 if (look_at_corners_p
)
7994 unsigned long corners
[4];
7997 /* Get the colors at the corners of ximg. */
7998 corners
[0] = XGetPixel (ximg
, 0, 0);
7999 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
8000 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
8001 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
8003 /* Choose the most frequently found color as background. */
8004 for (i
= best_count
= 0; i
< 4; ++i
)
8008 for (j
= n
= 0; j
< 4; ++j
)
8009 if (corners
[i
] == corners
[j
])
8013 bg
= corners
[i
], best_count
= n
;
8017 /* Set all bits in mask_img to 1 whose color in ximg is different
8018 from the background color bg. */
8019 for (y
= 0; y
< img
->height
; ++y
)
8020 for (x
= 0; x
< img
->width
; ++x
)
8021 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8023 /* Put mask_img into img->mask. */
8024 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8025 x_destroy_x_image (mask_img
);
8026 XDestroyImage (ximg
);
8033 /***********************************************************************
8034 PBM (mono, gray, color)
8035 ***********************************************************************/
8037 static int pbm_image_p
P_ ((Lisp_Object object
));
8038 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8039 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8041 /* The symbol `pbm' identifying images of this type. */
8045 /* Indices of image specification fields in gs_format, below. */
8047 enum pbm_keyword_index
8063 /* Vector of image_keyword structures describing the format
8064 of valid user-defined image specifications. */
8066 static struct image_keyword pbm_format
[PBM_LAST
] =
8068 {":type", IMAGE_SYMBOL_VALUE
, 1},
8069 {":file", IMAGE_STRING_VALUE
, 0},
8070 {":data", IMAGE_STRING_VALUE
, 0},
8071 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8072 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8073 {":relief", IMAGE_INTEGER_VALUE
, 0},
8074 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8075 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8076 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8077 {":foreground", IMAGE_STRING_VALUE
, 0},
8078 {":background", IMAGE_STRING_VALUE
, 0}
8081 /* Structure describing the image type `pbm'. */
8083 static struct image_type pbm_type
=
8093 /* Return non-zero if OBJECT is a valid PBM image specification. */
8096 pbm_image_p (object
)
8099 struct image_keyword fmt
[PBM_LAST
];
8101 bcopy (pbm_format
, fmt
, sizeof fmt
);
8103 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8106 /* Must specify either :data or :file. */
8107 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8111 /* Scan a decimal number from *S and return it. Advance *S while
8112 reading the number. END is the end of the string. Value is -1 at
8116 pbm_scan_number (s
, end
)
8117 unsigned char **s
, *end
;
8119 int c
= 0, val
= -1;
8123 /* Skip white-space. */
8124 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8129 /* Skip comment to end of line. */
8130 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8133 else if (isdigit (c
))
8135 /* Read decimal number. */
8137 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8138 val
= 10 * val
+ c
- '0';
8149 /* Load PBM image IMG for use on frame F. */
8157 int width
, height
, max_color_idx
= 0;
8159 Lisp_Object file
, specified_file
;
8160 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8161 struct gcpro gcpro1
;
8162 unsigned char *contents
= NULL
;
8163 unsigned char *end
, *p
;
8166 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8170 if (STRINGP (specified_file
))
8172 file
= x_find_image_file (specified_file
);
8173 if (!STRINGP (file
))
8175 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8180 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8181 if (contents
== NULL
)
8183 image_error ("Error reading `%s'", file
, Qnil
);
8189 end
= contents
+ size
;
8194 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8195 p
= XSTRING (data
)->data
;
8196 end
= p
+ STRING_BYTES (XSTRING (data
));
8199 /* Check magic number. */
8200 if (end
- p
< 2 || *p
++ != 'P')
8202 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8212 raw_p
= 0, type
= PBM_MONO
;
8216 raw_p
= 0, type
= PBM_GRAY
;
8220 raw_p
= 0, type
= PBM_COLOR
;
8224 raw_p
= 1, type
= PBM_MONO
;
8228 raw_p
= 1, type
= PBM_GRAY
;
8232 raw_p
= 1, type
= PBM_COLOR
;
8236 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8240 /* Read width, height, maximum color-component. Characters
8241 starting with `#' up to the end of a line are ignored. */
8242 width
= pbm_scan_number (&p
, end
);
8243 height
= pbm_scan_number (&p
, end
);
8245 if (type
!= PBM_MONO
)
8247 max_color_idx
= pbm_scan_number (&p
, end
);
8248 if (raw_p
&& max_color_idx
> 255)
8249 max_color_idx
= 255;
8254 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8257 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8258 &ximg
, &img
->pixmap
))
8261 /* Initialize the color hash table. */
8262 init_color_table ();
8264 if (type
== PBM_MONO
)
8267 struct image_keyword fmt
[PBM_LAST
];
8268 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8269 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8271 /* Parse the image specification. */
8272 bcopy (pbm_format
, fmt
, sizeof fmt
);
8273 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8275 /* Get foreground and background colors, maybe allocate colors. */
8276 if (fmt
[PBM_FOREGROUND
].count
)
8277 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8278 if (fmt
[PBM_BACKGROUND
].count
)
8279 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8281 for (y
= 0; y
< height
; ++y
)
8282 for (x
= 0; x
< width
; ++x
)
8292 g
= pbm_scan_number (&p
, end
);
8294 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8299 for (y
= 0; y
< height
; ++y
)
8300 for (x
= 0; x
< width
; ++x
)
8304 if (type
== PBM_GRAY
)
8305 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8314 r
= pbm_scan_number (&p
, end
);
8315 g
= pbm_scan_number (&p
, end
);
8316 b
= pbm_scan_number (&p
, end
);
8319 if (r
< 0 || g
< 0 || b
< 0)
8323 XDestroyImage (ximg
);
8324 image_error ("Invalid pixel value in image `%s'",
8329 /* RGB values are now in the range 0..max_color_idx.
8330 Scale this to the range 0..0xffff supported by X. */
8331 r
= (double) r
* 65535 / max_color_idx
;
8332 g
= (double) g
* 65535 / max_color_idx
;
8333 b
= (double) b
* 65535 / max_color_idx
;
8334 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8338 /* Store in IMG->colors the colors allocated for the image, and
8339 free the color table. */
8340 img
->colors
= colors_in_color_table (&img
->ncolors
);
8341 free_color_table ();
8343 /* Put the image into a pixmap. */
8344 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8345 x_destroy_x_image (ximg
);
8348 img
->height
= height
;
8357 /***********************************************************************
8359 ***********************************************************************/
8365 /* Function prototypes. */
8367 static int png_image_p
P_ ((Lisp_Object object
));
8368 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8370 /* The symbol `png' identifying images of this type. */
8374 /* Indices of image specification fields in png_format, below. */
8376 enum png_keyword_index
8390 /* Vector of image_keyword structures describing the format
8391 of valid user-defined image specifications. */
8393 static struct image_keyword png_format
[PNG_LAST
] =
8395 {":type", IMAGE_SYMBOL_VALUE
, 1},
8396 {":data", IMAGE_STRING_VALUE
, 0},
8397 {":file", IMAGE_STRING_VALUE
, 0},
8398 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8399 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8400 {":relief", IMAGE_INTEGER_VALUE
, 0},
8401 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8402 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8403 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8406 /* Structure describing the image type `png'. */
8408 static struct image_type png_type
=
8418 /* Return non-zero if OBJECT is a valid PNG image specification. */
8421 png_image_p (object
)
8424 struct image_keyword fmt
[PNG_LAST
];
8425 bcopy (png_format
, fmt
, sizeof fmt
);
8427 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8430 /* Must specify either the :data or :file keyword. */
8431 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8435 /* Error and warning handlers installed when the PNG library
8439 my_png_error (png_ptr
, msg
)
8440 png_struct
*png_ptr
;
8443 xassert (png_ptr
!= NULL
);
8444 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8445 longjmp (png_ptr
->jmpbuf
, 1);
8450 my_png_warning (png_ptr
, msg
)
8451 png_struct
*png_ptr
;
8454 xassert (png_ptr
!= NULL
);
8455 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8458 /* Memory source for PNG decoding. */
8460 struct png_memory_storage
8462 unsigned char *bytes
; /* The data */
8463 size_t len
; /* How big is it? */
8464 int index
; /* Where are we? */
8468 /* Function set as reader function when reading PNG image from memory.
8469 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8470 bytes from the input to DATA. */
8473 png_read_from_memory (png_ptr
, data
, length
)
8474 png_structp png_ptr
;
8478 struct png_memory_storage
*tbr
8479 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8481 if (length
> tbr
->len
- tbr
->index
)
8482 png_error (png_ptr
, "Read error");
8484 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8485 tbr
->index
= tbr
->index
+ length
;
8488 /* Load PNG image IMG for use on frame F. Value is non-zero if
8496 Lisp_Object file
, specified_file
;
8497 Lisp_Object specified_data
;
8499 XImage
*ximg
, *mask_img
= NULL
;
8500 struct gcpro gcpro1
;
8501 png_struct
*png_ptr
= NULL
;
8502 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8503 FILE *volatile fp
= NULL
;
8505 png_byte
* volatile pixels
= NULL
;
8506 png_byte
** volatile rows
= NULL
;
8507 png_uint_32 width
, height
;
8508 int bit_depth
, color_type
, interlace_type
;
8510 png_uint_32 row_bytes
;
8513 double screen_gamma
, image_gamma
;
8515 struct png_memory_storage tbr
; /* Data to be read */
8517 /* Find out what file to load. */
8518 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8519 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8523 if (NILP (specified_data
))
8525 file
= x_find_image_file (specified_file
);
8526 if (!STRINGP (file
))
8528 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8533 /* Open the image file. */
8534 fp
= fopen (XSTRING (file
)->data
, "rb");
8537 image_error ("Cannot open image file `%s'", file
, Qnil
);
8543 /* Check PNG signature. */
8544 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8545 || !png_check_sig (sig
, sizeof sig
))
8547 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8555 /* Read from memory. */
8556 tbr
.bytes
= XSTRING (specified_data
)->data
;
8557 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8560 /* Check PNG signature. */
8561 if (tbr
.len
< sizeof sig
8562 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8564 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8569 /* Need to skip past the signature. */
8570 tbr
.bytes
+= sizeof (sig
);
8573 /* Initialize read and info structs for PNG lib. */
8574 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8575 my_png_error
, my_png_warning
);
8578 if (fp
) fclose (fp
);
8583 info_ptr
= png_create_info_struct (png_ptr
);
8586 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8587 if (fp
) fclose (fp
);
8592 end_info
= png_create_info_struct (png_ptr
);
8595 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8596 if (fp
) fclose (fp
);
8601 /* Set error jump-back. We come back here when the PNG library
8602 detects an error. */
8603 if (setjmp (png_ptr
->jmpbuf
))
8607 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8610 if (fp
) fclose (fp
);
8615 /* Read image info. */
8616 if (!NILP (specified_data
))
8617 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8619 png_init_io (png_ptr
, fp
);
8621 png_set_sig_bytes (png_ptr
, sizeof sig
);
8622 png_read_info (png_ptr
, info_ptr
);
8623 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8624 &interlace_type
, NULL
, NULL
);
8626 /* If image contains simply transparency data, we prefer to
8627 construct a clipping mask. */
8628 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8633 /* This function is easier to write if we only have to handle
8634 one data format: RGB or RGBA with 8 bits per channel. Let's
8635 transform other formats into that format. */
8637 /* Strip more than 8 bits per channel. */
8638 if (bit_depth
== 16)
8639 png_set_strip_16 (png_ptr
);
8641 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8643 png_set_expand (png_ptr
);
8645 /* Convert grayscale images to RGB. */
8646 if (color_type
== PNG_COLOR_TYPE_GRAY
8647 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8648 png_set_gray_to_rgb (png_ptr
);
8650 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8651 gamma_str
= getenv ("SCREEN_GAMMA");
8652 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8654 /* Tell the PNG lib to handle gamma correction for us. */
8656 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8657 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8658 /* There is a special chunk in the image specifying the gamma. */
8659 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8662 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8663 /* Image contains gamma information. */
8664 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8666 /* Use a default of 0.5 for the image gamma. */
8667 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8669 /* Handle alpha channel by combining the image with a background
8670 color. Do this only if a real alpha channel is supplied. For
8671 simple transparency, we prefer a clipping mask. */
8674 png_color_16
*image_background
;
8676 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8677 /* Image contains a background color with which to
8678 combine the image. */
8679 png_set_background (png_ptr
, image_background
,
8680 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8683 /* Image does not contain a background color with which
8684 to combine the image data via an alpha channel. Use
8685 the frame's background instead. */
8688 png_color_16 frame_background
;
8690 cmap
= FRAME_X_COLORMAP (f
);
8691 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8692 x_query_color (f
, &color
);
8694 bzero (&frame_background
, sizeof frame_background
);
8695 frame_background
.red
= color
.red
;
8696 frame_background
.green
= color
.green
;
8697 frame_background
.blue
= color
.blue
;
8699 png_set_background (png_ptr
, &frame_background
,
8700 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8704 /* Update info structure. */
8705 png_read_update_info (png_ptr
, info_ptr
);
8707 /* Get number of channels. Valid values are 1 for grayscale images
8708 and images with a palette, 2 for grayscale images with transparency
8709 information (alpha channel), 3 for RGB images, and 4 for RGB
8710 images with alpha channel, i.e. RGBA. If conversions above were
8711 sufficient we should only have 3 or 4 channels here. */
8712 channels
= png_get_channels (png_ptr
, info_ptr
);
8713 xassert (channels
== 3 || channels
== 4);
8715 /* Number of bytes needed for one row of the image. */
8716 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8718 /* Allocate memory for the image. */
8719 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8720 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8721 for (i
= 0; i
< height
; ++i
)
8722 rows
[i
] = pixels
+ i
* row_bytes
;
8724 /* Read the entire image. */
8725 png_read_image (png_ptr
, rows
);
8726 png_read_end (png_ptr
, info_ptr
);
8733 /* Create the X image and pixmap. */
8734 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8738 /* Create an image and pixmap serving as mask if the PNG image
8739 contains an alpha channel. */
8742 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8743 &mask_img
, &img
->mask
))
8745 x_destroy_x_image (ximg
);
8746 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8751 /* Fill the X image and mask from PNG data. */
8752 init_color_table ();
8754 for (y
= 0; y
< height
; ++y
)
8756 png_byte
*p
= rows
[y
];
8758 for (x
= 0; x
< width
; ++x
)
8765 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8767 /* An alpha channel, aka mask channel, associates variable
8768 transparency with an image. Where other image formats
8769 support binary transparency---fully transparent or fully
8770 opaque---PNG allows up to 254 levels of partial transparency.
8771 The PNG library implements partial transparency by combining
8772 the image with a specified background color.
8774 I'm not sure how to handle this here nicely: because the
8775 background on which the image is displayed may change, for
8776 real alpha channel support, it would be necessary to create
8777 a new image for each possible background.
8779 What I'm doing now is that a mask is created if we have
8780 boolean transparency information. Otherwise I'm using
8781 the frame's background color to combine the image with. */
8786 XPutPixel (mask_img
, x
, y
, *p
> 0);
8792 /* Remember colors allocated for this image. */
8793 img
->colors
= colors_in_color_table (&img
->ncolors
);
8794 free_color_table ();
8797 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8802 img
->height
= height
;
8804 /* Put the image into the pixmap, then free the X image and its buffer. */
8805 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8806 x_destroy_x_image (ximg
);
8808 /* Same for the mask. */
8811 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8812 x_destroy_x_image (mask_img
);
8819 #endif /* HAVE_PNG != 0 */
8823 /***********************************************************************
8825 ***********************************************************************/
8829 /* Work around a warning about HAVE_STDLIB_H being redefined in
8831 #ifdef HAVE_STDLIB_H
8832 #define HAVE_STDLIB_H_1
8833 #undef HAVE_STDLIB_H
8834 #endif /* HAVE_STLIB_H */
8836 #include <jpeglib.h>
8840 #ifdef HAVE_STLIB_H_1
8841 #define HAVE_STDLIB_H 1
8844 static int jpeg_image_p
P_ ((Lisp_Object object
));
8845 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8847 /* The symbol `jpeg' identifying images of this type. */
8851 /* Indices of image specification fields in gs_format, below. */
8853 enum jpeg_keyword_index
8862 JPEG_HEURISTIC_MASK
,
8867 /* Vector of image_keyword structures describing the format
8868 of valid user-defined image specifications. */
8870 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8872 {":type", IMAGE_SYMBOL_VALUE
, 1},
8873 {":data", IMAGE_STRING_VALUE
, 0},
8874 {":file", IMAGE_STRING_VALUE
, 0},
8875 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8876 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8877 {":relief", IMAGE_INTEGER_VALUE
, 0},
8878 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8879 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8880 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8883 /* Structure describing the image type `jpeg'. */
8885 static struct image_type jpeg_type
=
8895 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8898 jpeg_image_p (object
)
8901 struct image_keyword fmt
[JPEG_LAST
];
8903 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8905 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8908 /* Must specify either the :data or :file keyword. */
8909 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8913 struct my_jpeg_error_mgr
8915 struct jpeg_error_mgr pub
;
8916 jmp_buf setjmp_buffer
;
8921 my_error_exit (cinfo
)
8924 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8925 longjmp (mgr
->setjmp_buffer
, 1);
8929 /* Init source method for JPEG data source manager. Called by
8930 jpeg_read_header() before any data is actually read. See
8931 libjpeg.doc from the JPEG lib distribution. */
8934 our_init_source (cinfo
)
8935 j_decompress_ptr cinfo
;
8940 /* Fill input buffer method for JPEG data source manager. Called
8941 whenever more data is needed. We read the whole image in one step,
8942 so this only adds a fake end of input marker at the end. */
8945 our_fill_input_buffer (cinfo
)
8946 j_decompress_ptr cinfo
;
8948 /* Insert a fake EOI marker. */
8949 struct jpeg_source_mgr
*src
= cinfo
->src
;
8950 static JOCTET buffer
[2];
8952 buffer
[0] = (JOCTET
) 0xFF;
8953 buffer
[1] = (JOCTET
) JPEG_EOI
;
8955 src
->next_input_byte
= buffer
;
8956 src
->bytes_in_buffer
= 2;
8961 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8962 is the JPEG data source manager. */
8965 our_skip_input_data (cinfo
, num_bytes
)
8966 j_decompress_ptr cinfo
;
8969 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8973 if (num_bytes
> src
->bytes_in_buffer
)
8974 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8976 src
->bytes_in_buffer
-= num_bytes
;
8977 src
->next_input_byte
+= num_bytes
;
8982 /* Method to terminate data source. Called by
8983 jpeg_finish_decompress() after all data has been processed. */
8986 our_term_source (cinfo
)
8987 j_decompress_ptr cinfo
;
8992 /* Set up the JPEG lib for reading an image from DATA which contains
8993 LEN bytes. CINFO is the decompression info structure created for
8994 reading the image. */
8997 jpeg_memory_src (cinfo
, data
, len
)
8998 j_decompress_ptr cinfo
;
9002 struct jpeg_source_mgr
*src
;
9004 if (cinfo
->src
== NULL
)
9006 /* First time for this JPEG object? */
9007 cinfo
->src
= (struct jpeg_source_mgr
*)
9008 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9009 sizeof (struct jpeg_source_mgr
));
9010 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9011 src
->next_input_byte
= data
;
9014 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9015 src
->init_source
= our_init_source
;
9016 src
->fill_input_buffer
= our_fill_input_buffer
;
9017 src
->skip_input_data
= our_skip_input_data
;
9018 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9019 src
->term_source
= our_term_source
;
9020 src
->bytes_in_buffer
= len
;
9021 src
->next_input_byte
= data
;
9025 /* Load image IMG for use on frame F. Patterned after example.c
9026 from the JPEG lib. */
9033 struct jpeg_decompress_struct cinfo
;
9034 struct my_jpeg_error_mgr mgr
;
9035 Lisp_Object file
, specified_file
;
9036 Lisp_Object specified_data
;
9037 FILE * volatile fp
= NULL
;
9039 int row_stride
, x
, y
;
9040 XImage
*ximg
= NULL
;
9042 unsigned long *colors
;
9044 struct gcpro gcpro1
;
9046 /* Open the JPEG file. */
9047 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9048 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9052 if (NILP (specified_data
))
9054 file
= x_find_image_file (specified_file
);
9055 if (!STRINGP (file
))
9057 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9062 fp
= fopen (XSTRING (file
)->data
, "r");
9065 image_error ("Cannot open `%s'", file
, Qnil
);
9071 /* Customize libjpeg's error handling to call my_error_exit when an
9072 error is detected. This function will perform a longjmp. */
9073 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9074 mgr
.pub
.error_exit
= my_error_exit
;
9076 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9080 /* Called from my_error_exit. Display a JPEG error. */
9081 char buffer
[JMSG_LENGTH_MAX
];
9082 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9083 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9084 build_string (buffer
));
9087 /* Close the input file and destroy the JPEG object. */
9089 fclose ((FILE *) fp
);
9090 jpeg_destroy_decompress (&cinfo
);
9092 /* If we already have an XImage, free that. */
9093 x_destroy_x_image (ximg
);
9095 /* Free pixmap and colors. */
9096 x_clear_image (f
, img
);
9102 /* Create the JPEG decompression object. Let it read from fp.
9103 Read the JPEG image header. */
9104 jpeg_create_decompress (&cinfo
);
9106 if (NILP (specified_data
))
9107 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9109 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9110 STRING_BYTES (XSTRING (specified_data
)));
9112 jpeg_read_header (&cinfo
, TRUE
);
9114 /* Customize decompression so that color quantization will be used.
9115 Start decompression. */
9116 cinfo
.quantize_colors
= TRUE
;
9117 jpeg_start_decompress (&cinfo
);
9118 width
= img
->width
= cinfo
.output_width
;
9119 height
= img
->height
= cinfo
.output_height
;
9121 /* Create X image and pixmap. */
9122 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9123 longjmp (mgr
.setjmp_buffer
, 2);
9125 /* Allocate colors. When color quantization is used,
9126 cinfo.actual_number_of_colors has been set with the number of
9127 colors generated, and cinfo.colormap is a two-dimensional array
9128 of color indices in the range 0..cinfo.actual_number_of_colors.
9129 No more than 255 colors will be generated. */
9133 if (cinfo
.out_color_components
> 2)
9134 ir
= 0, ig
= 1, ib
= 2;
9135 else if (cinfo
.out_color_components
> 1)
9136 ir
= 0, ig
= 1, ib
= 0;
9138 ir
= 0, ig
= 0, ib
= 0;
9140 /* Use the color table mechanism because it handles colors that
9141 cannot be allocated nicely. Such colors will be replaced with
9142 a default color, and we don't have to care about which colors
9143 can be freed safely, and which can't. */
9144 init_color_table ();
9145 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9148 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9150 /* Multiply RGB values with 255 because X expects RGB values
9151 in the range 0..0xffff. */
9152 int r
= cinfo
.colormap
[ir
][i
] << 8;
9153 int g
= cinfo
.colormap
[ig
][i
] << 8;
9154 int b
= cinfo
.colormap
[ib
][i
] << 8;
9155 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9158 /* Remember those colors actually allocated. */
9159 img
->colors
= colors_in_color_table (&img
->ncolors
);
9160 free_color_table ();
9164 row_stride
= width
* cinfo
.output_components
;
9165 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9167 for (y
= 0; y
< height
; ++y
)
9169 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9170 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9171 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9175 jpeg_finish_decompress (&cinfo
);
9176 jpeg_destroy_decompress (&cinfo
);
9178 fclose ((FILE *) fp
);
9180 /* Put the image into the pixmap. */
9181 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9182 x_destroy_x_image (ximg
);
9187 #endif /* HAVE_JPEG */
9191 /***********************************************************************
9193 ***********************************************************************/
9199 static int tiff_image_p
P_ ((Lisp_Object object
));
9200 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9202 /* The symbol `tiff' identifying images of this type. */
9206 /* Indices of image specification fields in tiff_format, below. */
9208 enum tiff_keyword_index
9217 TIFF_HEURISTIC_MASK
,
9222 /* Vector of image_keyword structures describing the format
9223 of valid user-defined image specifications. */
9225 static struct image_keyword tiff_format
[TIFF_LAST
] =
9227 {":type", IMAGE_SYMBOL_VALUE
, 1},
9228 {":data", IMAGE_STRING_VALUE
, 0},
9229 {":file", IMAGE_STRING_VALUE
, 0},
9230 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9231 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9232 {":relief", IMAGE_INTEGER_VALUE
, 0},
9233 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9234 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9235 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9238 /* Structure describing the image type `tiff'. */
9240 static struct image_type tiff_type
=
9250 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9253 tiff_image_p (object
)
9256 struct image_keyword fmt
[TIFF_LAST
];
9257 bcopy (tiff_format
, fmt
, sizeof fmt
);
9259 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9262 /* Must specify either the :data or :file keyword. */
9263 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9267 /* Reading from a memory buffer for TIFF images Based on the PNG
9268 memory source, but we have to provide a lot of extra functions.
9271 We really only need to implement read and seek, but I am not
9272 convinced that the TIFF library is smart enough not to destroy
9273 itself if we only hand it the function pointers we need to
9278 unsigned char *bytes
;
9286 tiff_read_from_memory (data
, buf
, size
)
9291 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9293 if (size
> src
->len
- src
->index
)
9295 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9302 tiff_write_from_memory (data
, buf
, size
)
9312 tiff_seek_in_memory (data
, off
, whence
)
9317 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9322 case SEEK_SET
: /* Go from beginning of source. */
9326 case SEEK_END
: /* Go from end of source. */
9327 idx
= src
->len
+ off
;
9330 case SEEK_CUR
: /* Go from current position. */
9331 idx
= src
->index
+ off
;
9334 default: /* Invalid `whence'. */
9338 if (idx
> src
->len
|| idx
< 0)
9347 tiff_close_memory (data
)
9356 tiff_mmap_memory (data
, pbase
, psize
)
9361 /* It is already _IN_ memory. */
9367 tiff_unmap_memory (data
, base
, size
)
9372 /* We don't need to do this. */
9377 tiff_size_of_memory (data
)
9380 return ((tiff_memory_source
*) data
)->len
;
9384 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9392 Lisp_Object file
, specified_file
;
9393 Lisp_Object specified_data
;
9395 int width
, height
, x
, y
;
9399 struct gcpro gcpro1
;
9400 tiff_memory_source memsrc
;
9402 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9403 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9407 if (NILP (specified_data
))
9409 /* Read from a file */
9410 file
= x_find_image_file (specified_file
);
9411 if (!STRINGP (file
))
9413 image_error ("Cannot find image file `%s'", file
, Qnil
);
9418 /* Try to open the image file. */
9419 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9422 image_error ("Cannot open `%s'", file
, Qnil
);
9429 /* Memory source! */
9430 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9431 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9434 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9435 (TIFFReadWriteProc
) tiff_read_from_memory
,
9436 (TIFFReadWriteProc
) tiff_write_from_memory
,
9437 tiff_seek_in_memory
,
9439 tiff_size_of_memory
,
9445 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9451 /* Get width and height of the image, and allocate a raster buffer
9452 of width x height 32-bit values. */
9453 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9454 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9455 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9457 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9461 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9467 /* Create the X image and pixmap. */
9468 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9475 /* Initialize the color table. */
9476 init_color_table ();
9478 /* Process the pixel raster. Origin is in the lower-left corner. */
9479 for (y
= 0; y
< height
; ++y
)
9481 uint32
*row
= buf
+ y
* width
;
9483 for (x
= 0; x
< width
; ++x
)
9485 uint32 abgr
= row
[x
];
9486 int r
= TIFFGetR (abgr
) << 8;
9487 int g
= TIFFGetG (abgr
) << 8;
9488 int b
= TIFFGetB (abgr
) << 8;
9489 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9493 /* Remember the colors allocated for the image. Free the color table. */
9494 img
->colors
= colors_in_color_table (&img
->ncolors
);
9495 free_color_table ();
9497 /* Put the image into the pixmap, then free the X image and its buffer. */
9498 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9499 x_destroy_x_image (ximg
);
9503 img
->height
= height
;
9509 #endif /* HAVE_TIFF != 0 */
9513 /***********************************************************************
9515 ***********************************************************************/
9519 #include <gif_lib.h>
9521 static int gif_image_p
P_ ((Lisp_Object object
));
9522 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9524 /* The symbol `gif' identifying images of this type. */
9528 /* Indices of image specification fields in gif_format, below. */
9530 enum gif_keyword_index
9545 /* Vector of image_keyword structures describing the format
9546 of valid user-defined image specifications. */
9548 static struct image_keyword gif_format
[GIF_LAST
] =
9550 {":type", IMAGE_SYMBOL_VALUE
, 1},
9551 {":data", IMAGE_STRING_VALUE
, 0},
9552 {":file", IMAGE_STRING_VALUE
, 0},
9553 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9554 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9555 {":relief", IMAGE_INTEGER_VALUE
, 0},
9556 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9557 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9558 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9559 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9562 /* Structure describing the image type `gif'. */
9564 static struct image_type gif_type
=
9574 /* Return non-zero if OBJECT is a valid GIF image specification. */
9577 gif_image_p (object
)
9580 struct image_keyword fmt
[GIF_LAST
];
9581 bcopy (gif_format
, fmt
, sizeof fmt
);
9583 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9586 /* Must specify either the :data or :file keyword. */
9587 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9591 /* Reading a GIF image from memory
9592 Based on the PNG memory stuff to a certain extent. */
9596 unsigned char *bytes
;
9603 /* Make the current memory source available to gif_read_from_memory.
9604 It's done this way because not all versions of libungif support
9605 a UserData field in the GifFileType structure. */
9606 static gif_memory_source
*current_gif_memory_src
;
9609 gif_read_from_memory (file
, buf
, len
)
9614 gif_memory_source
*src
= current_gif_memory_src
;
9616 if (len
> src
->len
- src
->index
)
9619 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9625 /* Load GIF image IMG for use on frame F. Value is non-zero if
9633 Lisp_Object file
, specified_file
;
9634 Lisp_Object specified_data
;
9635 int rc
, width
, height
, x
, y
, i
;
9637 ColorMapObject
*gif_color_map
;
9638 unsigned long pixel_colors
[256];
9640 struct gcpro gcpro1
;
9642 int ino
, image_left
, image_top
, image_width
, image_height
;
9643 gif_memory_source memsrc
;
9644 unsigned char *raster
;
9646 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9647 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9651 if (NILP (specified_data
))
9653 file
= x_find_image_file (specified_file
);
9654 if (!STRINGP (file
))
9656 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9661 /* Open the GIF file. */
9662 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9665 image_error ("Cannot open `%s'", file
, Qnil
);
9672 /* Read from memory! */
9673 current_gif_memory_src
= &memsrc
;
9674 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9675 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9678 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9681 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9687 /* Read entire contents. */
9688 rc
= DGifSlurp (gif
);
9689 if (rc
== GIF_ERROR
)
9691 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9692 DGifCloseFile (gif
);
9697 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9698 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9699 if (ino
>= gif
->ImageCount
)
9701 image_error ("Invalid image number `%s' in image `%s'",
9703 DGifCloseFile (gif
);
9708 width
= img
->width
= gif
->SWidth
;
9709 height
= img
->height
= gif
->SHeight
;
9711 /* Create the X image and pixmap. */
9712 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9714 DGifCloseFile (gif
);
9719 /* Allocate colors. */
9720 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9722 gif_color_map
= gif
->SColorMap
;
9723 init_color_table ();
9724 bzero (pixel_colors
, sizeof pixel_colors
);
9726 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9728 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9729 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9730 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9731 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9734 img
->colors
= colors_in_color_table (&img
->ncolors
);
9735 free_color_table ();
9737 /* Clear the part of the screen image that are not covered by
9738 the image from the GIF file. Full animated GIF support
9739 requires more than can be done here (see the gif89 spec,
9740 disposal methods). Let's simply assume that the part
9741 not covered by a sub-image is in the frame's background color. */
9742 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9743 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9744 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9745 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9747 for (y
= 0; y
< image_top
; ++y
)
9748 for (x
= 0; x
< width
; ++x
)
9749 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9751 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9752 for (x
= 0; x
< width
; ++x
)
9753 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9755 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9757 for (x
= 0; x
< image_left
; ++x
)
9758 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9759 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9760 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9763 /* Read the GIF image into the X image. We use a local variable
9764 `raster' here because RasterBits below is a char *, and invites
9765 problems with bytes >= 0x80. */
9766 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9768 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9770 static int interlace_start
[] = {0, 4, 2, 1};
9771 static int interlace_increment
[] = {8, 8, 4, 2};
9773 int row
= interlace_start
[0];
9777 for (y
= 0; y
< image_height
; y
++)
9779 if (row
>= image_height
)
9781 row
= interlace_start
[++pass
];
9782 while (row
>= image_height
)
9783 row
= interlace_start
[++pass
];
9786 for (x
= 0; x
< image_width
; x
++)
9788 int i
= raster
[(y
* image_width
) + x
];
9789 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9793 row
+= interlace_increment
[pass
];
9798 for (y
= 0; y
< image_height
; ++y
)
9799 for (x
= 0; x
< image_width
; ++x
)
9801 int i
= raster
[y
* image_width
+ x
];
9802 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9806 DGifCloseFile (gif
);
9808 /* Put the image into the pixmap, then free the X image and its buffer. */
9809 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9810 x_destroy_x_image (ximg
);
9816 #endif /* HAVE_GIF != 0 */
9820 /***********************************************************************
9822 ***********************************************************************/
9824 static int gs_image_p
P_ ((Lisp_Object object
));
9825 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9826 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9828 /* The symbol `postscript' identifying images of this type. */
9830 Lisp_Object Qpostscript
;
9832 /* Keyword symbols. */
9834 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9836 /* Indices of image specification fields in gs_format, below. */
9838 enum gs_keyword_index
9855 /* Vector of image_keyword structures describing the format
9856 of valid user-defined image specifications. */
9858 static struct image_keyword gs_format
[GS_LAST
] =
9860 {":type", IMAGE_SYMBOL_VALUE
, 1},
9861 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9862 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9863 {":file", IMAGE_STRING_VALUE
, 1},
9864 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9865 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9866 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9867 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9868 {":relief", IMAGE_INTEGER_VALUE
, 0},
9869 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9870 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9871 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9874 /* Structure describing the image type `ghostscript'. */
9876 static struct image_type gs_type
=
9886 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9889 gs_clear_image (f
, img
)
9893 /* IMG->data.ptr_val may contain a recorded colormap. */
9894 xfree (img
->data
.ptr_val
);
9895 x_clear_image (f
, img
);
9899 /* Return non-zero if OBJECT is a valid Ghostscript image
9906 struct image_keyword fmt
[GS_LAST
];
9910 bcopy (gs_format
, fmt
, sizeof fmt
);
9912 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
9915 /* Bounding box must be a list or vector containing 4 integers. */
9916 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9919 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9920 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9925 else if (VECTORP (tem
))
9927 if (XVECTOR (tem
)->size
!= 4)
9929 for (i
= 0; i
< 4; ++i
)
9930 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9940 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9949 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9950 struct gcpro gcpro1
, gcpro2
;
9952 double in_width
, in_height
;
9953 Lisp_Object pixel_colors
= Qnil
;
9955 /* Compute pixel size of pixmap needed from the given size in the
9956 image specification. Sizes in the specification are in pt. 1 pt
9957 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9959 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9960 in_width
= XFASTINT (pt_width
) / 72.0;
9961 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9962 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9963 in_height
= XFASTINT (pt_height
) / 72.0;
9964 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9966 /* Create the pixmap. */
9967 xassert (img
->pixmap
== None
);
9968 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9969 img
->width
, img
->height
,
9970 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9974 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9978 /* Call the loader to fill the pixmap. It returns a process object
9979 if successful. We do not record_unwind_protect here because
9980 other places in redisplay like calling window scroll functions
9981 don't either. Let the Lisp loader use `unwind-protect' instead. */
9982 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9984 sprintf (buffer
, "%lu %lu",
9985 (unsigned long) FRAME_X_WINDOW (f
),
9986 (unsigned long) img
->pixmap
);
9987 window_and_pixmap_id
= build_string (buffer
);
9989 sprintf (buffer
, "%lu %lu",
9990 FRAME_FOREGROUND_PIXEL (f
),
9991 FRAME_BACKGROUND_PIXEL (f
));
9992 pixel_colors
= build_string (buffer
);
9994 XSETFRAME (frame
, f
);
9995 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9997 loader
= intern ("gs-load-image");
9999 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10000 make_number (img
->width
),
10001 make_number (img
->height
),
10002 window_and_pixmap_id
,
10005 return PROCESSP (img
->data
.lisp_val
);
10009 /* Kill the Ghostscript process that was started to fill PIXMAP on
10010 frame F. Called from XTread_socket when receiving an event
10011 telling Emacs that Ghostscript has finished drawing. */
10014 x_kill_gs_process (pixmap
, f
)
10018 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10022 /* Find the image containing PIXMAP. */
10023 for (i
= 0; i
< c
->used
; ++i
)
10024 if (c
->images
[i
]->pixmap
== pixmap
)
10027 /* Kill the GS process. We should have found PIXMAP in the image
10028 cache and its image should contain a process object. */
10029 xassert (i
< c
->used
);
10030 img
= c
->images
[i
];
10031 xassert (PROCESSP (img
->data
.lisp_val
));
10032 Fkill_process (img
->data
.lisp_val
, Qnil
);
10033 img
->data
.lisp_val
= Qnil
;
10035 /* On displays with a mutable colormap, figure out the colors
10036 allocated for the image by looking at the pixels of an XImage for
10038 class = FRAME_X_VISUAL (f
)->class;
10039 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10045 /* Try to get an XImage for img->pixmep. */
10046 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10047 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10052 /* Initialize the color table. */
10053 init_color_table ();
10055 /* For each pixel of the image, look its color up in the
10056 color table. After having done so, the color table will
10057 contain an entry for each color used by the image. */
10058 for (y
= 0; y
< img
->height
; ++y
)
10059 for (x
= 0; x
< img
->width
; ++x
)
10061 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10062 lookup_pixel_color (f
, pixel
);
10065 /* Record colors in the image. Free color table and XImage. */
10066 img
->colors
= colors_in_color_table (&img
->ncolors
);
10067 free_color_table ();
10068 XDestroyImage (ximg
);
10070 #if 0 /* This doesn't seem to be the case. If we free the colors
10071 here, we get a BadAccess later in x_clear_image when
10072 freeing the colors. */
10073 /* We have allocated colors once, but Ghostscript has also
10074 allocated colors on behalf of us. So, to get the
10075 reference counts right, free them once. */
10077 x_free_colors (f
, img
->colors
, img
->ncolors
);
10081 image_error ("Cannot get X image of `%s'; colors will not be freed",
10090 /***********************************************************************
10092 ***********************************************************************/
10094 DEFUN ("x-change-window-property", Fx_change_window_property
,
10095 Sx_change_window_property
, 2, 3, 0,
10096 "Change window property PROP to VALUE on the X window of FRAME.\n\
10097 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
10098 selected frame. Value is VALUE.")
10099 (prop
, value
, frame
)
10100 Lisp_Object frame
, prop
, value
;
10102 struct frame
*f
= check_x_frame (frame
);
10105 CHECK_STRING (prop
, 1);
10106 CHECK_STRING (value
, 2);
10109 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10110 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10111 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10112 XSTRING (value
)->data
, XSTRING (value
)->size
);
10114 /* Make sure the property is set when we return. */
10115 XFlush (FRAME_X_DISPLAY (f
));
10122 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10123 Sx_delete_window_property
, 1, 2, 0,
10124 "Remove window property PROP from X window of FRAME.\n\
10125 FRAME nil or omitted means use the selected frame. Value is PROP.")
10127 Lisp_Object prop
, frame
;
10129 struct frame
*f
= check_x_frame (frame
);
10132 CHECK_STRING (prop
, 1);
10134 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10135 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10137 /* Make sure the property is removed when we return. */
10138 XFlush (FRAME_X_DISPLAY (f
));
10145 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10147 "Value is the value of window property PROP on FRAME.\n\
10148 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10149 if FRAME hasn't a property with name PROP or if PROP has no string\n\
10152 Lisp_Object prop
, frame
;
10154 struct frame
*f
= check_x_frame (frame
);
10157 Lisp_Object prop_value
= Qnil
;
10158 char *tmp_data
= NULL
;
10161 unsigned long actual_size
, bytes_remaining
;
10163 CHECK_STRING (prop
, 1);
10165 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10166 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10167 prop_atom
, 0, 0, False
, XA_STRING
,
10168 &actual_type
, &actual_format
, &actual_size
,
10169 &bytes_remaining
, (unsigned char **) &tmp_data
);
10172 int size
= bytes_remaining
;
10177 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10178 prop_atom
, 0, bytes_remaining
,
10180 &actual_type
, &actual_format
,
10181 &actual_size
, &bytes_remaining
,
10182 (unsigned char **) &tmp_data
);
10184 prop_value
= make_string (tmp_data
, size
);
10195 /***********************************************************************
10197 ***********************************************************************/
10199 /* If non-null, an asynchronous timer that, when it expires, displays
10200 an hourglass cursor on all frames. */
10202 static struct atimer
*hourglass_atimer
;
10204 /* Non-zero means an hourglass cursor is currently shown. */
10206 static int hourglass_shown_p
;
10208 /* Number of seconds to wait before displaying an hourglass cursor. */
10210 static Lisp_Object Vhourglass_delay
;
10212 /* Default number of seconds to wait before displaying an hourglass
10215 #define DEFAULT_HOURGLASS_DELAY 1
10217 /* Function prototypes. */
10219 static void show_hourglass
P_ ((struct atimer
*));
10220 static void hide_hourglass
P_ ((void));
10223 /* Cancel a currently active hourglass timer, and start a new one. */
10229 int secs
, usecs
= 0;
10231 cancel_hourglass ();
10233 if (INTEGERP (Vhourglass_delay
)
10234 && XINT (Vhourglass_delay
) > 0)
10235 secs
= XFASTINT (Vhourglass_delay
);
10236 else if (FLOATP (Vhourglass_delay
)
10237 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10240 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10241 secs
= XFASTINT (tem
);
10242 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10245 secs
= DEFAULT_HOURGLASS_DELAY
;
10247 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10248 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10249 show_hourglass
, NULL
);
10253 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10257 cancel_hourglass ()
10259 if (hourglass_atimer
)
10261 cancel_atimer (hourglass_atimer
);
10262 hourglass_atimer
= NULL
;
10265 if (hourglass_shown_p
)
10270 /* Timer function of hourglass_atimer. TIMER is equal to
10273 Display an hourglass pointer on all frames by mapping the frames'
10274 hourglass_window. Set the hourglass_p flag in the frames'
10275 output_data.x structure to indicate that an hourglass cursor is
10276 shown on the frames. */
10279 show_hourglass (timer
)
10280 struct atimer
*timer
;
10282 /* The timer implementation will cancel this timer automatically
10283 after this function has run. Set hourglass_atimer to null
10284 so that we know the timer doesn't have to be canceled. */
10285 hourglass_atimer
= NULL
;
10287 if (!hourglass_shown_p
)
10289 Lisp_Object rest
, frame
;
10293 FOR_EACH_FRAME (rest
, frame
)
10295 struct frame
*f
= XFRAME (frame
);
10297 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10299 Display
*dpy
= FRAME_X_DISPLAY (f
);
10301 #ifdef USE_X_TOOLKIT
10302 if (f
->output_data
.x
->widget
)
10304 if (FRAME_OUTER_WINDOW (f
))
10307 f
->output_data
.x
->hourglass_p
= 1;
10309 if (!f
->output_data
.x
->hourglass_window
)
10311 unsigned long mask
= CWCursor
;
10312 XSetWindowAttributes attrs
;
10314 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10316 f
->output_data
.x
->hourglass_window
10317 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10318 0, 0, 32000, 32000, 0, 0,
10324 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10330 hourglass_shown_p
= 1;
10336 /* Hide the hourglass pointer on all frames, if it is currently
10342 if (hourglass_shown_p
)
10344 Lisp_Object rest
, frame
;
10347 FOR_EACH_FRAME (rest
, frame
)
10349 struct frame
*f
= XFRAME (frame
);
10352 /* Watch out for newly created frames. */
10353 && f
->output_data
.x
->hourglass_window
)
10355 XUnmapWindow (FRAME_X_DISPLAY (f
),
10356 f
->output_data
.x
->hourglass_window
);
10357 /* Sync here because XTread_socket looks at the
10358 hourglass_p flag that is reset to zero below. */
10359 XSync (FRAME_X_DISPLAY (f
), False
);
10360 f
->output_data
.x
->hourglass_p
= 0;
10364 hourglass_shown_p
= 0;
10371 /***********************************************************************
10373 ***********************************************************************/
10375 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10377 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10378 Lisp_Object
, int *, int *));
10380 /* The frame of a currently visible tooltip. */
10382 Lisp_Object tip_frame
;
10384 /* If non-nil, a timer started that hides the last tooltip when it
10387 Lisp_Object tip_timer
;
10390 /* If non-nil, a vector of 3 elements containing the last args
10391 with which x-show-tip was called. See there. */
10393 Lisp_Object last_show_tip_args
;
10397 unwind_create_tip_frame (frame
)
10400 Lisp_Object deleted
;
10402 deleted
= unwind_create_frame (frame
);
10403 if (EQ (deleted
, Qt
))
10413 /* Create a frame for a tooltip on the display described by DPYINFO.
10414 PARMS is a list of frame parameters. Value is the frame.
10416 Note that functions called here, esp. x_default_parameter can
10417 signal errors, for instance when a specified color name is
10418 undefined. We have to make sure that we're in a consistent state
10419 when this happens. */
10422 x_create_tip_frame (dpyinfo
, parms
)
10423 struct x_display_info
*dpyinfo
;
10427 Lisp_Object frame
, tem
;
10429 long window_prompting
= 0;
10431 int count
= BINDING_STACK_SIZE ();
10432 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10434 int face_change_count_before
= face_change_count
;
10438 /* Use this general default value to start with until we know if
10439 this frame has a specified name. */
10440 Vx_resource_name
= Vinvocation_name
;
10442 #ifdef MULTI_KBOARD
10443 kb
= dpyinfo
->kboard
;
10445 kb
= &the_only_kboard
;
10448 /* Get the name of the frame to use for resource lookup. */
10449 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10450 if (!STRINGP (name
)
10451 && !EQ (name
, Qunbound
)
10453 error ("Invalid frame name--not a string or nil");
10454 Vx_resource_name
= name
;
10457 GCPRO3 (parms
, name
, frame
);
10458 f
= make_frame (1);
10459 XSETFRAME (frame
, f
);
10460 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10461 record_unwind_protect (unwind_create_tip_frame
, frame
);
10463 /* By setting the output method, we're essentially saying that
10464 the frame is live, as per FRAME_LIVE_P. If we get a signal
10465 from this point on, x_destroy_window might screw up reference
10467 f
->output_method
= output_x_window
;
10468 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10469 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10470 f
->output_data
.x
->icon_bitmap
= -1;
10471 f
->output_data
.x
->fontset
= -1;
10472 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10473 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10474 f
->icon_name
= Qnil
;
10475 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10477 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10478 dpyinfo_refcount
= dpyinfo
->reference_count
;
10479 #endif /* GLYPH_DEBUG */
10480 #ifdef MULTI_KBOARD
10481 FRAME_KBOARD (f
) = kb
;
10483 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10484 f
->output_data
.x
->explicit_parent
= 0;
10486 /* These colors will be set anyway later, but it's important
10487 to get the color reference counts right, so initialize them! */
10490 struct gcpro gcpro1
;
10492 black
= build_string ("black");
10494 f
->output_data
.x
->foreground_pixel
10495 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10496 f
->output_data
.x
->background_pixel
10497 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10498 f
->output_data
.x
->cursor_pixel
10499 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10500 f
->output_data
.x
->cursor_foreground_pixel
10501 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10502 f
->output_data
.x
->border_pixel
10503 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10504 f
->output_data
.x
->mouse_pixel
10505 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10509 /* Set the name; the functions to which we pass f expect the name to
10511 if (EQ (name
, Qunbound
) || NILP (name
))
10513 f
->name
= build_string (dpyinfo
->x_id_name
);
10514 f
->explicit_name
= 0;
10519 f
->explicit_name
= 1;
10520 /* use the frame's title when getting resources for this frame. */
10521 specbind (Qx_resource_name
, name
);
10524 /* Extract the window parameters from the supplied values that are
10525 needed to determine window geometry. */
10529 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10532 /* First, try whatever font the caller has specified. */
10533 if (STRINGP (font
))
10535 tem
= Fquery_fontset (font
, Qnil
);
10537 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10539 font
= x_new_font (f
, XSTRING (font
)->data
);
10542 /* Try out a font which we hope has bold and italic variations. */
10543 if (!STRINGP (font
))
10544 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10545 if (!STRINGP (font
))
10546 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10547 if (! STRINGP (font
))
10548 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10549 if (! STRINGP (font
))
10550 /* This was formerly the first thing tried, but it finds too many fonts
10551 and takes too long. */
10552 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10553 /* If those didn't work, look for something which will at least work. */
10554 if (! STRINGP (font
))
10555 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10557 if (! STRINGP (font
))
10558 font
= build_string ("fixed");
10560 x_default_parameter (f
, parms
, Qfont
, font
,
10561 "font", "Font", RES_TYPE_STRING
);
10564 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10565 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10567 /* This defaults to 2 in order to match xterm. We recognize either
10568 internalBorderWidth or internalBorder (which is what xterm calls
10570 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10574 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10575 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10576 if (! EQ (value
, Qunbound
))
10577 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10581 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10582 "internalBorderWidth", "internalBorderWidth",
10585 /* Also do the stuff which must be set before the window exists. */
10586 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10587 "foreground", "Foreground", RES_TYPE_STRING
);
10588 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10589 "background", "Background", RES_TYPE_STRING
);
10590 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10591 "pointerColor", "Foreground", RES_TYPE_STRING
);
10592 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10593 "cursorColor", "Foreground", RES_TYPE_STRING
);
10594 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10595 "borderColor", "BorderColor", RES_TYPE_STRING
);
10597 /* Init faces before x_default_parameter is called for scroll-bar
10598 parameters because that function calls x_set_scroll_bar_width,
10599 which calls change_frame_size, which calls Fset_window_buffer,
10600 which runs hooks, which call Fvertical_motion. At the end, we
10601 end up in init_iterator with a null face cache, which should not
10603 init_frame_faces (f
);
10605 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10606 window_prompting
= x_figure_window_size (f
, parms
);
10608 if (window_prompting
& XNegative
)
10610 if (window_prompting
& YNegative
)
10611 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10613 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10617 if (window_prompting
& YNegative
)
10618 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10620 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10623 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10625 XSetWindowAttributes attrs
;
10626 unsigned long mask
;
10629 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10630 if (DoesSaveUnders (dpyinfo
->screen
))
10631 mask
|= CWSaveUnder
;
10633 /* Window managers look at the override-redirect flag to determine
10634 whether or net to give windows a decoration (Xlib spec, chapter
10636 attrs
.override_redirect
= True
;
10637 attrs
.save_under
= True
;
10638 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10639 /* Arrange for getting MapNotify and UnmapNotify events. */
10640 attrs
.event_mask
= StructureNotifyMask
;
10642 = FRAME_X_WINDOW (f
)
10643 = XCreateWindow (FRAME_X_DISPLAY (f
),
10644 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10645 /* x, y, width, height */
10649 CopyFromParent
, InputOutput
, CopyFromParent
,
10656 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10657 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10658 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10659 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10660 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10661 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10663 /* Dimensions, especially f->height, must be done via change_frame_size.
10664 Change will not be effected unless different from the current
10667 height
= f
->height
;
10669 SET_FRAME_WIDTH (f
, 0);
10670 change_frame_size (f
, height
, width
, 1, 0, 0);
10672 /* Set up faces after all frame parameters are known. This call
10673 also merges in face attributes specified for new frames.
10675 Frame parameters may be changed if .Xdefaults contains
10676 specifications for the default font. For example, if there is an
10677 `Emacs.default.attributeBackground: pink', the `background-color'
10678 attribute of the frame get's set, which let's the internal border
10679 of the tooltip frame appear in pink. Prevent this. */
10681 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
10683 /* Set tip_frame here, so that */
10685 call1 (Qface_set_after_frame_default
, frame
);
10687 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
10688 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
10696 /* It is now ok to make the frame official even if we get an error
10697 below. And the frame needs to be on Vframe_list or making it
10698 visible won't work. */
10699 Vframe_list
= Fcons (frame
, Vframe_list
);
10701 /* Now that the frame is official, it counts as a reference to
10703 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10705 /* Setting attributes of faces of the tooltip frame from resources
10706 and similar will increment face_change_count, which leads to the
10707 clearing of all current matrices. Since this isn't necessary
10708 here, avoid it by resetting face_change_count to the value it
10709 had before we created the tip frame. */
10710 face_change_count
= face_change_count_before
;
10712 /* Discard the unwind_protect. */
10713 return unbind_to (count
, frame
);
10717 /* Compute where to display tip frame F. PARMS is the list of frame
10718 parameters for F. DX and DY are specified offsets from the current
10719 location of the mouse. Return coordinates relative to the root
10720 window of the display in *ROOT_X, and *ROOT_Y. */
10723 compute_tip_xy (f
, parms
, dx
, dy
, root_x
, root_y
)
10725 Lisp_Object parms
, dx
, dy
;
10726 int *root_x
, *root_y
;
10728 Lisp_Object left
, top
;
10730 Window root
, child
;
10733 /* User-specified position? */
10734 left
= Fcdr (Fassq (Qleft
, parms
));
10735 top
= Fcdr (Fassq (Qtop
, parms
));
10737 /* Move the tooltip window where the mouse pointer is. Resize and
10740 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10741 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
10744 *root_x
+= XINT (dx
);
10745 *root_y
+= XINT (dy
);
10747 if (INTEGERP (left
))
10748 *root_x
= XINT (left
);
10749 if (INTEGERP (top
))
10750 *root_y
= XINT (top
);
10754 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10755 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10756 A tooltip window is a small X window displaying a string.\n\
10758 FRAME nil or omitted means use the selected frame.\n\
10760 PARMS is an optional list of frame parameters which can be\n\
10761 used to change the tooltip's appearance.\n\
10763 Automatically hide the tooltip after TIMEOUT seconds.\n\
10764 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10766 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10767 the tooltip is displayed at that x-position. Otherwise it is\n\
10768 displayed at the mouse position, with offset DX added (default is 5 if\n\
10769 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10770 parameter is specified, it determines the y-position of the tooltip\n\
10771 window, otherwise it is displayed at the mouse position, with offset\n\
10772 DY added (default is -10).")
10773 (string
, frame
, parms
, timeout
, dx
, dy
)
10774 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10778 Lisp_Object buffer
, top
, left
;
10779 int root_x
, root_y
;
10780 struct buffer
*old_buffer
;
10781 struct text_pos pos
;
10782 int i
, width
, height
;
10783 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10784 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10785 int count
= BINDING_STACK_SIZE ();
10787 specbind (Qinhibit_redisplay
, Qt
);
10789 GCPRO4 (string
, parms
, frame
, timeout
);
10791 CHECK_STRING (string
, 0);
10792 f
= check_x_frame (frame
);
10793 if (NILP (timeout
))
10794 timeout
= make_number (5);
10796 CHECK_NATNUM (timeout
, 2);
10799 dx
= make_number (5);
10801 CHECK_NUMBER (dx
, 5);
10804 dy
= make_number (-10);
10806 CHECK_NUMBER (dy
, 6);
10808 if (NILP (last_show_tip_args
))
10809 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
10811 if (!NILP (tip_frame
))
10813 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
10814 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
10815 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
10817 if (EQ (frame
, last_frame
)
10818 && !NILP (Fequal (last_string
, string
))
10819 && !NILP (Fequal (last_parms
, parms
)))
10821 struct frame
*f
= XFRAME (tip_frame
);
10823 /* Only DX and DY have changed. */
10824 if (!NILP (tip_timer
))
10826 Lisp_Object timer
= tip_timer
;
10828 call1 (Qcancel_timer
, timer
);
10832 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
10833 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10834 root_x
, root_y
- PIXEL_HEIGHT (f
));
10840 /* Hide a previous tip, if any. */
10843 ASET (last_show_tip_args
, 0, string
);
10844 ASET (last_show_tip_args
, 1, frame
);
10845 ASET (last_show_tip_args
, 2, parms
);
10847 /* Add default values to frame parameters. */
10848 if (NILP (Fassq (Qname
, parms
)))
10849 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10850 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10851 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10852 if (NILP (Fassq (Qborder_width
, parms
)))
10853 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10854 if (NILP (Fassq (Qborder_color
, parms
)))
10855 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10856 if (NILP (Fassq (Qbackground_color
, parms
)))
10857 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10860 /* Create a frame for the tooltip, and record it in the global
10861 variable tip_frame. */
10862 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
10863 f
= XFRAME (frame
);
10865 /* Set up the frame's root window. Currently we use a size of 80
10866 columns x 40 lines. If someone wants to show a larger tip, he
10867 will loose. I don't think this is a realistic case. */
10868 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10869 w
->left
= w
->top
= make_number (0);
10870 w
->width
= make_number (80);
10871 w
->height
= make_number (40);
10873 w
->pseudo_window_p
= 1;
10875 /* Display the tooltip text in a temporary buffer. */
10876 buffer
= Fget_buffer_create (build_string (" *tip*"));
10877 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10878 old_buffer
= current_buffer
;
10879 set_buffer_internal_1 (XBUFFER (buffer
));
10881 Finsert (1, &string
);
10882 clear_glyph_matrix (w
->desired_matrix
);
10883 clear_glyph_matrix (w
->current_matrix
);
10884 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10885 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10887 /* Compute width and height of the tooltip. */
10888 width
= height
= 0;
10889 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10891 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10892 struct glyph
*last
;
10895 /* Stop at the first empty row at the end. */
10896 if (!row
->enabled_p
|| !row
->displays_text_p
)
10899 /* Let the row go over the full width of the frame. */
10900 row
->full_width_p
= 1;
10902 /* There's a glyph at the end of rows that is used to place
10903 the cursor there. Don't include the width of this glyph. */
10904 if (row
->used
[TEXT_AREA
])
10906 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10907 row_width
= row
->pixel_width
- last
->pixel_width
;
10910 row_width
= row
->pixel_width
;
10912 height
+= row
->height
;
10913 width
= max (width
, row_width
);
10916 /* Add the frame's internal border to the width and height the X
10917 window should have. */
10918 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10919 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10921 /* Move the tooltip window where the mouse pointer is. Resize and
10923 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
10926 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10927 root_x
, root_y
- height
, width
, height
);
10928 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10931 /* Draw into the window. */
10932 w
->must_be_updated_p
= 1;
10933 update_single_window (w
, 1);
10935 /* Restore original current buffer. */
10936 set_buffer_internal_1 (old_buffer
);
10937 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
10940 /* Let the tip disappear after timeout seconds. */
10941 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
10942 intern ("x-hide-tip"));
10945 return unbind_to (count
, Qnil
);
10949 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
10950 "Hide the current tooltip window, if there is any.\n\
10951 Value is t is tooltip was open, nil otherwise.")
10955 Lisp_Object deleted
, frame
, timer
;
10956 struct gcpro gcpro1
, gcpro2
;
10958 /* Return quickly if nothing to do. */
10959 if (NILP (tip_timer
) && NILP (tip_frame
))
10964 GCPRO2 (frame
, timer
);
10965 tip_frame
= tip_timer
= deleted
= Qnil
;
10967 count
= BINDING_STACK_SIZE ();
10968 specbind (Qinhibit_redisplay
, Qt
);
10969 specbind (Qinhibit_quit
, Qt
);
10972 call1 (Qcancel_timer
, timer
);
10974 if (FRAMEP (frame
))
10976 Fdelete_frame (frame
, Qnil
);
10980 /* Bloodcurdling hack alert: The Lucid menu bar widget's
10981 redisplay procedure is not called when a tip frame over menu
10982 items is unmapped. Redisplay the menu manually... */
10984 struct frame
*f
= SELECTED_FRAME ();
10985 Widget w
= f
->output_data
.x
->menubar_widget
;
10986 extern void xlwmenu_redisplay
P_ ((Widget
));
10988 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
10992 xlwmenu_redisplay (w
);
10996 #endif /* USE_LUCID */
11000 return unbind_to (count
, deleted
);
11005 /***********************************************************************
11006 File selection dialog
11007 ***********************************************************************/
11011 /* Callback for "OK" and "Cancel" on file selection dialog. */
11014 file_dialog_cb (widget
, client_data
, call_data
)
11016 XtPointer call_data
, client_data
;
11018 int *result
= (int *) client_data
;
11019 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11020 *result
= cb
->reason
;
11024 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11025 "Read file name, prompting with PROMPT in directory DIR.\n\
11026 Use a file selection dialog.\n\
11027 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
11028 specified. Don't let the user enter a file name in the file\n\
11029 selection dialog's entry field, if MUSTMATCH is non-nil.")
11030 (prompt
, dir
, default_filename
, mustmatch
)
11031 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11034 struct frame
*f
= SELECTED_FRAME ();
11035 Lisp_Object file
= Qnil
;
11036 Widget dialog
, text
, list
, help
;
11039 extern XtAppContext Xt_app_con
;
11041 XmString dir_xmstring
, pattern_xmstring
;
11042 int popup_activated_flag
;
11043 int count
= specpdl_ptr
- specpdl
;
11044 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11046 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11047 CHECK_STRING (prompt
, 0);
11048 CHECK_STRING (dir
, 1);
11050 /* Prevent redisplay. */
11051 specbind (Qinhibit_redisplay
, Qt
);
11055 /* Create the dialog with PROMPT as title, using DIR as initial
11056 directory and using "*" as pattern. */
11057 dir
= Fexpand_file_name (dir
, Qnil
);
11058 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11059 pattern_xmstring
= XmStringCreateLocalized ("*");
11061 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11062 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11063 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11064 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11065 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11066 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11068 XmStringFree (dir_xmstring
);
11069 XmStringFree (pattern_xmstring
);
11071 /* Add callbacks for OK and Cancel. */
11072 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11073 (XtPointer
) &result
);
11074 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11075 (XtPointer
) &result
);
11077 /* Disable the help button since we can't display help. */
11078 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11079 XtSetSensitive (help
, False
);
11081 /* Mark OK button as default. */
11082 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11083 XmNshowAsDefault
, True
, NULL
);
11085 /* If MUSTMATCH is non-nil, disable the file entry field of the
11086 dialog, so that the user must select a file from the files list
11087 box. We can't remove it because we wouldn't have a way to get at
11088 the result file name, then. */
11089 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11090 if (!NILP (mustmatch
))
11093 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11094 XtSetSensitive (text
, False
);
11095 XtSetSensitive (label
, False
);
11098 /* Manage the dialog, so that list boxes get filled. */
11099 XtManageChild (dialog
);
11101 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11102 must include the path for this to work. */
11103 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11104 if (STRINGP (default_filename
))
11106 XmString default_xmstring
;
11110 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11112 if (!XmListItemExists (list
, default_xmstring
))
11114 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11115 XmListAddItem (list
, default_xmstring
, 0);
11119 item_pos
= XmListItemPos (list
, default_xmstring
);
11120 XmStringFree (default_xmstring
);
11122 /* Select the item and scroll it into view. */
11123 XmListSelectPos (list
, item_pos
, True
);
11124 XmListSetPos (list
, item_pos
);
11127 /* Process events until the user presses Cancel or OK. */
11129 while (result
== 0 || XtAppPending (Xt_app_con
))
11130 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11132 /* Get the result. */
11133 if (result
== XmCR_OK
)
11138 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11139 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11140 XmStringFree (text
);
11141 file
= build_string (data
);
11148 XtUnmanageChild (dialog
);
11149 XtDestroyWidget (dialog
);
11153 /* Make "Cancel" equivalent to C-g. */
11155 Fsignal (Qquit
, Qnil
);
11157 return unbind_to (count
, file
);
11160 #endif /* USE_MOTIF */
11164 /***********************************************************************
11166 ***********************************************************************/
11168 #ifdef HAVE_XKBGETKEYBOARD
11169 #include <X11/XKBlib.h>
11170 #include <X11/keysym.h>
11173 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11174 Sx_backspace_delete_keys_p
, 0, 1, 0,
11175 "Check if both Backspace and Delete keys are on the keyboard of FRAME.\n\
11176 FRAME nil means use the selected frame.\n\
11177 Value is t if we know that both keys are present, and are mapped to the\n\
11182 #ifdef HAVE_XKBGETKEYBOARD
11184 struct frame
*f
= check_x_frame (frame
);
11185 Display
*dpy
= FRAME_X_DISPLAY (f
);
11186 Lisp_Object have_keys
;
11187 int major
, minor
, op
, event
, error
;
11191 /* Check library version in case we're dynamically linked. */
11192 major
= XkbMajorVersion
;
11193 minor
= XkbMinorVersion
;
11194 if (!XkbLibraryVersion (&major
, &minor
))
11200 /* Check that the server supports XKB. */
11201 major
= XkbMajorVersion
;
11202 minor
= XkbMinorVersion
;
11203 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11210 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11213 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11215 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11217 for (i
= kb
->min_key_code
;
11218 (i
< kb
->max_key_code
11219 && (delete_keycode
== 0 || backspace_keycode
== 0));
11222 /* The XKB symbolic key names can be seen most easily
11223 in the PS file generated by `xkbprint -label name $DISPLAY'. */
11224 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11225 delete_keycode
= i
;
11226 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11227 backspace_keycode
= i
;
11230 XkbFreeNames (kb
, 0, True
);
11233 XkbFreeClientMap (kb
, 0, True
);
11236 && backspace_keycode
11237 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11238 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11243 #else /* not HAVE_XKBGETKEYBOARD */
11245 #endif /* not HAVE_XKBGETKEYBOARD */
11250 /***********************************************************************
11252 ***********************************************************************/
11257 /* This is zero if not using X windows. */
11260 /* The section below is built by the lisp expression at the top of the file,
11261 just above where these variables are declared. */
11262 /*&&& init symbols here &&&*/
11263 Qauto_raise
= intern ("auto-raise");
11264 staticpro (&Qauto_raise
);
11265 Qauto_lower
= intern ("auto-lower");
11266 staticpro (&Qauto_lower
);
11267 Qbar
= intern ("bar");
11269 Qborder_color
= intern ("border-color");
11270 staticpro (&Qborder_color
);
11271 Qborder_width
= intern ("border-width");
11272 staticpro (&Qborder_width
);
11273 Qbox
= intern ("box");
11275 Qcursor_color
= intern ("cursor-color");
11276 staticpro (&Qcursor_color
);
11277 Qcursor_type
= intern ("cursor-type");
11278 staticpro (&Qcursor_type
);
11279 Qgeometry
= intern ("geometry");
11280 staticpro (&Qgeometry
);
11281 Qicon_left
= intern ("icon-left");
11282 staticpro (&Qicon_left
);
11283 Qicon_top
= intern ("icon-top");
11284 staticpro (&Qicon_top
);
11285 Qicon_type
= intern ("icon-type");
11286 staticpro (&Qicon_type
);
11287 Qicon_name
= intern ("icon-name");
11288 staticpro (&Qicon_name
);
11289 Qinternal_border_width
= intern ("internal-border-width");
11290 staticpro (&Qinternal_border_width
);
11291 Qleft
= intern ("left");
11292 staticpro (&Qleft
);
11293 Qright
= intern ("right");
11294 staticpro (&Qright
);
11295 Qmouse_color
= intern ("mouse-color");
11296 staticpro (&Qmouse_color
);
11297 Qnone
= intern ("none");
11298 staticpro (&Qnone
);
11299 Qparent_id
= intern ("parent-id");
11300 staticpro (&Qparent_id
);
11301 Qscroll_bar_width
= intern ("scroll-bar-width");
11302 staticpro (&Qscroll_bar_width
);
11303 Qsuppress_icon
= intern ("suppress-icon");
11304 staticpro (&Qsuppress_icon
);
11305 Qundefined_color
= intern ("undefined-color");
11306 staticpro (&Qundefined_color
);
11307 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11308 staticpro (&Qvertical_scroll_bars
);
11309 Qvisibility
= intern ("visibility");
11310 staticpro (&Qvisibility
);
11311 Qwindow_id
= intern ("window-id");
11312 staticpro (&Qwindow_id
);
11313 Qouter_window_id
= intern ("outer-window-id");
11314 staticpro (&Qouter_window_id
);
11315 Qx_frame_parameter
= intern ("x-frame-parameter");
11316 staticpro (&Qx_frame_parameter
);
11317 Qx_resource_name
= intern ("x-resource-name");
11318 staticpro (&Qx_resource_name
);
11319 Quser_position
= intern ("user-position");
11320 staticpro (&Quser_position
);
11321 Quser_size
= intern ("user-size");
11322 staticpro (&Quser_size
);
11323 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11324 staticpro (&Qscroll_bar_foreground
);
11325 Qscroll_bar_background
= intern ("scroll-bar-background");
11326 staticpro (&Qscroll_bar_background
);
11327 Qscreen_gamma
= intern ("screen-gamma");
11328 staticpro (&Qscreen_gamma
);
11329 Qline_spacing
= intern ("line-spacing");
11330 staticpro (&Qline_spacing
);
11331 Qcenter
= intern ("center");
11332 staticpro (&Qcenter
);
11333 Qcompound_text
= intern ("compound-text");
11334 staticpro (&Qcompound_text
);
11335 Qcancel_timer
= intern ("cancel-timer");
11336 staticpro (&Qcancel_timer
);
11337 /* This is the end of symbol initialization. */
11339 /* Text property `display' should be nonsticky by default. */
11340 Vtext_property_default_nonsticky
11341 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11344 Qlaplace
= intern ("laplace");
11345 staticpro (&Qlaplace
);
11346 Qemboss
= intern ("emboss");
11347 staticpro (&Qemboss
);
11348 Qedge_detection
= intern ("edge-detection");
11349 staticpro (&Qedge_detection
);
11350 Qheuristic
= intern ("heuristic");
11351 staticpro (&Qheuristic
);
11352 QCmatrix
= intern (":matrix");
11353 staticpro (&QCmatrix
);
11354 QCcolor_adjustment
= intern (":color-adjustment");
11355 staticpro (&QCcolor_adjustment
);
11356 QCmask
= intern (":mask");
11357 staticpro (&QCmask
);
11359 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11360 staticpro (&Qface_set_after_frame_default
);
11362 Fput (Qundefined_color
, Qerror_conditions
,
11363 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11364 Fput (Qundefined_color
, Qerror_message
,
11365 build_string ("Undefined color"));
11367 init_x_parm_symbols ();
11369 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11370 "Non-nil means always draw a cross over disabled images.\n\
11371 Disabled images are those having an `:conversion disabled' property.\n\
11372 A cross is always drawn on black & white displays.");
11373 cross_disabled_images
= 0;
11375 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11376 "List of directories to search for bitmap files for X.");
11377 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11379 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11380 "The shape of the pointer when over text.\n\
11381 Changing the value does not affect existing frames\n\
11382 unless you set the mouse color.");
11383 Vx_pointer_shape
= Qnil
;
11385 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11386 "The name Emacs uses to look up X resources.\n\
11387 `x-get-resource' uses this as the first component of the instance name\n\
11388 when requesting resource values.\n\
11389 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
11390 was invoked, or to the value specified with the `-name' or `-rn'\n\
11391 switches, if present.\n\
11393 It may be useful to bind this variable locally around a call\n\
11394 to `x-get-resource'. See also the variable `x-resource-class'.");
11395 Vx_resource_name
= Qnil
;
11397 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11398 "The class Emacs uses to look up X resources.\n\
11399 `x-get-resource' uses this as the first component of the instance class\n\
11400 when requesting resource values.\n\
11401 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
11403 Setting this variable permanently is not a reasonable thing to do,\n\
11404 but binding this variable locally around a call to `x-get-resource'\n\
11405 is a reasonable practice. See also the variable `x-resource-name'.");
11406 Vx_resource_class
= build_string (EMACS_CLASS
);
11408 #if 0 /* This doesn't really do anything. */
11409 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11410 "The shape of the pointer when not over text.\n\
11411 This variable takes effect when you create a new frame\n\
11412 or when you set the mouse color.");
11414 Vx_nontext_pointer_shape
= Qnil
;
11416 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
11417 "The shape of the pointer when Emacs is busy.\n\
11418 This variable takes effect when you create a new frame\n\
11419 or when you set the mouse color.");
11420 Vx_hourglass_pointer_shape
= Qnil
;
11422 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
11423 "Non-zero means Emacs displays an hourglass pointer on window systems.");
11424 display_hourglass_p
= 1;
11426 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
11427 "*Seconds to wait before displaying an hourglass pointer.\n\
11428 Value must be an integer or float.");
11429 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
11431 #if 0 /* This doesn't really do anything. */
11432 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11433 "The shape of the pointer when over the mode line.\n\
11434 This variable takes effect when you create a new frame\n\
11435 or when you set the mouse color.");
11437 Vx_mode_pointer_shape
= Qnil
;
11439 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11440 &Vx_sensitive_text_pointer_shape
,
11441 "The shape of the pointer when over mouse-sensitive text.\n\
11442 This variable takes effect when you create a new frame\n\
11443 or when you set the mouse color.");
11444 Vx_sensitive_text_pointer_shape
= Qnil
;
11446 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11447 &Vx_window_horizontal_drag_shape
,
11448 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
11449 This variable takes effect when you create a new frame\n\
11450 or when you set the mouse color.");
11451 Vx_window_horizontal_drag_shape
= Qnil
;
11453 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11454 "A string indicating the foreground color of the cursor box.");
11455 Vx_cursor_fore_pixel
= Qnil
;
11457 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11458 "Non-nil if no X window manager is in use.\n\
11459 Emacs doesn't try to figure this out; this is always nil\n\
11460 unless you set it to something else.");
11461 /* We don't have any way to find this out, so set it to nil
11462 and maybe the user would like to set it to t. */
11463 Vx_no_window_manager
= Qnil
;
11465 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11466 &Vx_pixel_size_width_font_regexp
,
11467 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11469 Since Emacs gets width of a font matching with this regexp from\n\
11470 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11471 such a font. This is especially effective for such large fonts as\n\
11472 Chinese, Japanese, and Korean.");
11473 Vx_pixel_size_width_font_regexp
= Qnil
;
11475 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11476 "Time after which cached images are removed from the cache.\n\
11477 When an image has not been displayed this many seconds, remove it\n\
11478 from the image cache. Value must be an integer or nil with nil\n\
11479 meaning don't clear the cache.");
11480 Vimage_cache_eviction_delay
= make_number (30 * 60);
11482 #ifdef USE_X_TOOLKIT
11483 Fprovide (intern ("x-toolkit"));
11486 Fprovide (intern ("motif"));
11489 defsubr (&Sx_get_resource
);
11491 /* X window properties. */
11492 defsubr (&Sx_change_window_property
);
11493 defsubr (&Sx_delete_window_property
);
11494 defsubr (&Sx_window_property
);
11496 defsubr (&Sxw_display_color_p
);
11497 defsubr (&Sx_display_grayscale_p
);
11498 defsubr (&Sxw_color_defined_p
);
11499 defsubr (&Sxw_color_values
);
11500 defsubr (&Sx_server_max_request_size
);
11501 defsubr (&Sx_server_vendor
);
11502 defsubr (&Sx_server_version
);
11503 defsubr (&Sx_display_pixel_width
);
11504 defsubr (&Sx_display_pixel_height
);
11505 defsubr (&Sx_display_mm_width
);
11506 defsubr (&Sx_display_mm_height
);
11507 defsubr (&Sx_display_screens
);
11508 defsubr (&Sx_display_planes
);
11509 defsubr (&Sx_display_color_cells
);
11510 defsubr (&Sx_display_visual_class
);
11511 defsubr (&Sx_display_backing_store
);
11512 defsubr (&Sx_display_save_under
);
11513 defsubr (&Sx_parse_geometry
);
11514 defsubr (&Sx_create_frame
);
11515 defsubr (&Sx_open_connection
);
11516 defsubr (&Sx_close_connection
);
11517 defsubr (&Sx_display_list
);
11518 defsubr (&Sx_synchronize
);
11519 defsubr (&Sx_focus_frame
);
11520 defsubr (&Sx_backspace_delete_keys_p
);
11522 /* Setting callback functions for fontset handler. */
11523 get_font_info_func
= x_get_font_info
;
11525 #if 0 /* This function pointer doesn't seem to be used anywhere.
11526 And the pointer assigned has the wrong type, anyway. */
11527 list_fonts_func
= x_list_fonts
;
11530 load_font_func
= x_load_font
;
11531 find_ccl_program_func
= x_find_ccl_program
;
11532 query_font_func
= x_query_font
;
11533 set_frame_fontset_func
= x_set_font
;
11534 check_window_system_func
= check_x
;
11537 Qxbm
= intern ("xbm");
11539 QCtype
= intern (":type");
11540 staticpro (&QCtype
);
11541 QCconversion
= intern (":conversion");
11542 staticpro (&QCconversion
);
11543 QCheuristic_mask
= intern (":heuristic-mask");
11544 staticpro (&QCheuristic_mask
);
11545 QCcolor_symbols
= intern (":color-symbols");
11546 staticpro (&QCcolor_symbols
);
11547 QCascent
= intern (":ascent");
11548 staticpro (&QCascent
);
11549 QCmargin
= intern (":margin");
11550 staticpro (&QCmargin
);
11551 QCrelief
= intern (":relief");
11552 staticpro (&QCrelief
);
11553 Qpostscript
= intern ("postscript");
11554 staticpro (&Qpostscript
);
11555 QCloader
= intern (":loader");
11556 staticpro (&QCloader
);
11557 QCbounding_box
= intern (":bounding-box");
11558 staticpro (&QCbounding_box
);
11559 QCpt_width
= intern (":pt-width");
11560 staticpro (&QCpt_width
);
11561 QCpt_height
= intern (":pt-height");
11562 staticpro (&QCpt_height
);
11563 QCindex
= intern (":index");
11564 staticpro (&QCindex
);
11565 Qpbm
= intern ("pbm");
11569 Qxpm
= intern ("xpm");
11574 Qjpeg
= intern ("jpeg");
11575 staticpro (&Qjpeg
);
11579 Qtiff
= intern ("tiff");
11580 staticpro (&Qtiff
);
11584 Qgif
= intern ("gif");
11589 Qpng
= intern ("png");
11593 defsubr (&Sclear_image_cache
);
11594 defsubr (&Simage_size
);
11595 defsubr (&Simage_mask_p
);
11597 hourglass_atimer
= NULL
;
11598 hourglass_shown_p
= 0;
11600 defsubr (&Sx_show_tip
);
11601 defsubr (&Sx_hide_tip
);
11603 staticpro (&tip_timer
);
11605 staticpro (&tip_frame
);
11607 last_show_tip_args
= Qnil
;
11608 staticpro (&last_show_tip_args
);
11611 defsubr (&Sx_file_dialog
);
11619 image_types
= NULL
;
11620 Vimage_types
= Qnil
;
11622 define_image_type (&xbm_type
);
11623 define_image_type (&gs_type
);
11624 define_image_type (&pbm_type
);
11627 define_image_type (&xpm_type
);
11631 define_image_type (&jpeg_type
);
11635 define_image_type (&tiff_type
);
11639 define_image_type (&gif_type
);
11643 define_image_type (&png_type
);
11647 #endif /* HAVE_X_WINDOWS */