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 a busy cursor. */
140 int display_busy_cursor_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_busy_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
->busy_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
->busy_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
->busy_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 busy_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_busy_pointer_shape
))
1447 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1448 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1449 XINT (Vx_busy_pointer_shape
));
1452 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1453 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy 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
), busy_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 (busy_cursor
!= f
->output_data
.x
->busy_cursor
1527 && f
->output_data
.x
->busy_cursor
!= 0)
1528 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1529 f
->output_data
.x
->busy_cursor
= busy_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
;
1818 CHECK_STRING (arg
, 1);
1820 fontset_name
= Fquery_fontset (arg
, Qnil
);
1823 result
= (STRINGP (fontset_name
)
1824 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1825 : x_new_font (f
, XSTRING (arg
)->data
));
1828 if (EQ (result
, Qnil
))
1829 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1830 else if (EQ (result
, Qt
))
1831 error ("The characters of the given font have varying widths");
1832 else if (STRINGP (result
))
1834 store_frame_param (f
, Qfont
, result
);
1835 recompute_basic_faces (f
);
1840 do_pending_window_change (0);
1842 /* Don't call `face-set-after-frame-default' when faces haven't been
1843 initialized yet. This is the case when called from
1844 Fx_create_frame. In that case, the X widget or window doesn't
1845 exist either, and we can end up in x_report_frame_params with a
1846 null widget which gives a segfault. */
1847 if (FRAME_FACE_CACHE (f
))
1849 XSETFRAME (frame
, f
);
1850 call1 (Qface_set_after_frame_default
, frame
);
1855 x_set_border_width (f
, arg
, oldval
)
1857 Lisp_Object arg
, oldval
;
1859 CHECK_NUMBER (arg
, 0);
1861 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1864 if (FRAME_X_WINDOW (f
) != 0)
1865 error ("Cannot change the border width of a window");
1867 f
->output_data
.x
->border_width
= XINT (arg
);
1871 x_set_internal_border_width (f
, arg
, oldval
)
1873 Lisp_Object arg
, oldval
;
1875 int old
= f
->output_data
.x
->internal_border_width
;
1877 CHECK_NUMBER (arg
, 0);
1878 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1879 if (f
->output_data
.x
->internal_border_width
< 0)
1880 f
->output_data
.x
->internal_border_width
= 0;
1882 #ifdef USE_X_TOOLKIT
1883 if (f
->output_data
.x
->edit_widget
)
1884 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1887 if (f
->output_data
.x
->internal_border_width
== old
)
1890 if (FRAME_X_WINDOW (f
) != 0)
1892 x_set_window_size (f
, 0, f
->width
, f
->height
);
1893 SET_FRAME_GARBAGED (f
);
1894 do_pending_window_change (0);
1899 x_set_visibility (f
, value
, oldval
)
1901 Lisp_Object value
, oldval
;
1904 XSETFRAME (frame
, f
);
1907 Fmake_frame_invisible (frame
, Qt
);
1908 else if (EQ (value
, Qicon
))
1909 Ficonify_frame (frame
);
1911 Fmake_frame_visible (frame
);
1915 /* Change window heights in windows rooted in WINDOW by N lines. */
1918 x_change_window_heights (window
, n
)
1922 struct window
*w
= XWINDOW (window
);
1924 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1925 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1927 if (INTEGERP (w
->orig_top
))
1928 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1929 if (INTEGERP (w
->orig_height
))
1930 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1932 /* Handle just the top child in a vertical split. */
1933 if (!NILP (w
->vchild
))
1934 x_change_window_heights (w
->vchild
, n
);
1936 /* Adjust all children in a horizontal split. */
1937 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1939 w
= XWINDOW (window
);
1940 x_change_window_heights (window
, n
);
1945 x_set_menu_bar_lines (f
, value
, oldval
)
1947 Lisp_Object value
, oldval
;
1950 #ifndef USE_X_TOOLKIT
1951 int olines
= FRAME_MENU_BAR_LINES (f
);
1954 /* Right now, menu bars don't work properly in minibuf-only frames;
1955 most of the commands try to apply themselves to the minibuffer
1956 frame itself, and get an error because you can't switch buffers
1957 in or split the minibuffer window. */
1958 if (FRAME_MINIBUF_ONLY_P (f
))
1961 if (INTEGERP (value
))
1962 nlines
= XINT (value
);
1966 /* Make sure we redisplay all windows in this frame. */
1967 windows_or_buffers_changed
++;
1969 #ifdef USE_X_TOOLKIT
1970 FRAME_MENU_BAR_LINES (f
) = 0;
1973 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1974 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1975 /* Make sure next redisplay shows the menu bar. */
1976 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1980 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1981 free_frame_menubar (f
);
1982 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1984 f
->output_data
.x
->menubar_widget
= 0;
1986 #else /* not USE_X_TOOLKIT */
1987 FRAME_MENU_BAR_LINES (f
) = nlines
;
1988 x_change_window_heights (f
->root_window
, nlines
- olines
);
1989 #endif /* not USE_X_TOOLKIT */
1994 /* Set the number of lines used for the tool bar of frame F to VALUE.
1995 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1996 is the old number of tool bar lines. This function changes the
1997 height of all windows on frame F to match the new tool bar height.
1998 The frame's height doesn't change. */
2001 x_set_tool_bar_lines (f
, value
, oldval
)
2003 Lisp_Object value
, oldval
;
2005 int delta
, nlines
, root_height
;
2006 Lisp_Object root_window
;
2008 /* Use VALUE only if an integer >= 0. */
2009 if (INTEGERP (value
) && XINT (value
) >= 0)
2010 nlines
= XFASTINT (value
);
2014 /* Make sure we redisplay all windows in this frame. */
2015 ++windows_or_buffers_changed
;
2017 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2019 /* Don't resize the tool-bar to more than we have room for. */
2020 root_window
= FRAME_ROOT_WINDOW (f
);
2021 root_height
= XINT (XWINDOW (root_window
)->height
);
2022 if (root_height
- delta
< 1)
2024 delta
= root_height
- 1;
2025 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2028 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2029 x_change_window_heights (root_window
, delta
);
2032 /* We also have to make sure that the internal border at the top of
2033 the frame, below the menu bar or tool bar, is redrawn when the
2034 tool bar disappears. This is so because the internal border is
2035 below the tool bar if one is displayed, but is below the menu bar
2036 if there isn't a tool bar. The tool bar draws into the area
2037 below the menu bar. */
2038 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2042 clear_current_matrices (f
);
2043 updating_frame
= NULL
;
2046 /* If the tool bar gets smaller, the internal border below it
2047 has to be cleared. It was formerly part of the display
2048 of the larger tool bar, and updating windows won't clear it. */
2051 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2052 int width
= PIXEL_WIDTH (f
);
2053 int y
= nlines
* CANON_Y_UNIT (f
);
2056 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2057 0, y
, width
, height
, False
);
2063 /* Set the foreground color for scroll bars on frame F to VALUE.
2064 VALUE should be a string, a color name. If it isn't a string or
2065 isn't a valid color name, do nothing. OLDVAL is the old value of
2066 the frame parameter. */
2069 x_set_scroll_bar_foreground (f
, value
, oldval
)
2071 Lisp_Object value
, oldval
;
2073 unsigned long pixel
;
2075 if (STRINGP (value
))
2076 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2080 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2081 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2083 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2084 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2086 /* Remove all scroll bars because they have wrong colors. */
2087 if (condemn_scroll_bars_hook
)
2088 (*condemn_scroll_bars_hook
) (f
);
2089 if (judge_scroll_bars_hook
)
2090 (*judge_scroll_bars_hook
) (f
);
2092 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2098 /* Set the background color for scroll bars on frame F to VALUE VALUE
2099 should be a string, a color name. If it isn't a string or isn't a
2100 valid color name, do nothing. OLDVAL is the old value of the frame
2104 x_set_scroll_bar_background (f
, value
, oldval
)
2106 Lisp_Object value
, oldval
;
2108 unsigned long pixel
;
2110 if (STRINGP (value
))
2111 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2115 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2116 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2118 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2119 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2121 /* Remove all scroll bars because they have wrong colors. */
2122 if (condemn_scroll_bars_hook
)
2123 (*condemn_scroll_bars_hook
) (f
);
2124 if (judge_scroll_bars_hook
)
2125 (*judge_scroll_bars_hook
) (f
);
2127 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2133 /* Encode Lisp string STRING as a text in a format appropriate for
2134 XICCC (X Inter Client Communication Conventions).
2136 If STRING contains only ASCII characters, do no conversion and
2137 return the string data of STRING. Otherwise, encode the text by
2138 CODING_SYSTEM, and return a newly allocated memory area which
2139 should be freed by `xfree' by a caller.
2141 Store the byte length of resulting text in *TEXT_BYTES.
2143 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2144 which means that the `encoding' of the result can be `STRING'.
2145 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2146 the result should be `COMPOUND_TEXT'. */
2149 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2150 Lisp_Object string
, coding_system
;
2151 int *text_bytes
, *stringp
;
2153 unsigned char *str
= XSTRING (string
)->data
;
2154 int chars
= XSTRING (string
)->size
;
2155 int bytes
= STRING_BYTES (XSTRING (string
));
2159 struct coding_system coding
;
2161 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2162 if (charset_info
== 0)
2164 /* No multibyte character in OBJ. We need not encode it. */
2165 *text_bytes
= bytes
;
2170 setup_coding_system (coding_system
, &coding
);
2171 coding
.src_multibyte
= 1;
2172 coding
.dst_multibyte
= 0;
2173 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2174 if (coding
.type
== coding_type_iso2022
)
2175 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2176 /* We suppress producing escape sequences for composition. */
2177 coding
.composing
= COMPOSITION_DISABLED
;
2178 bufsize
= encoding_buffer_size (&coding
, bytes
);
2179 buf
= (unsigned char *) xmalloc (bufsize
);
2180 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2181 *text_bytes
= coding
.produced
;
2182 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2187 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2190 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2191 name; if NAME is a string, set F's name to NAME and set
2192 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2194 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2195 suggesting a new name, which lisp code should override; if
2196 F->explicit_name is set, ignore the new name; otherwise, set it. */
2199 x_set_name (f
, name
, explicit)
2204 /* Make sure that requests from lisp code override requests from
2205 Emacs redisplay code. */
2208 /* If we're switching from explicit to implicit, we had better
2209 update the mode lines and thereby update the title. */
2210 if (f
->explicit_name
&& NILP (name
))
2211 update_mode_lines
= 1;
2213 f
->explicit_name
= ! NILP (name
);
2215 else if (f
->explicit_name
)
2218 /* If NAME is nil, set the name to the x_id_name. */
2221 /* Check for no change needed in this very common case
2222 before we do any consing. */
2223 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2224 XSTRING (f
->name
)->data
))
2226 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2229 CHECK_STRING (name
, 0);
2231 /* Don't change the name if it's already NAME. */
2232 if (! NILP (Fstring_equal (name
, f
->name
)))
2237 /* For setting the frame title, the title parameter should override
2238 the name parameter. */
2239 if (! NILP (f
->title
))
2242 if (FRAME_X_WINDOW (f
))
2247 XTextProperty text
, icon
;
2249 Lisp_Object coding_system
;
2251 coding_system
= Vlocale_coding_system
;
2252 if (NILP (coding_system
))
2253 coding_system
= Qcompound_text
;
2254 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2255 text
.encoding
= (stringp
? XA_STRING
2256 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2258 text
.nitems
= bytes
;
2260 if (NILP (f
->icon_name
))
2266 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2268 icon
.encoding
= (stringp
? XA_STRING
2269 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2271 icon
.nitems
= bytes
;
2273 #ifdef USE_X_TOOLKIT
2274 XSetWMName (FRAME_X_DISPLAY (f
),
2275 XtWindow (f
->output_data
.x
->widget
), &text
);
2276 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2278 #else /* not USE_X_TOOLKIT */
2279 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2280 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2281 #endif /* not USE_X_TOOLKIT */
2282 if (!NILP (f
->icon_name
)
2283 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2285 if (text
.value
!= XSTRING (name
)->data
)
2288 #else /* not HAVE_X11R4 */
2289 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2290 XSTRING (name
)->data
);
2291 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2292 XSTRING (name
)->data
);
2293 #endif /* not HAVE_X11R4 */
2298 /* This function should be called when the user's lisp code has
2299 specified a name for the frame; the name will override any set by the
2302 x_explicitly_set_name (f
, arg
, oldval
)
2304 Lisp_Object arg
, oldval
;
2306 x_set_name (f
, arg
, 1);
2309 /* This function should be called by Emacs redisplay code to set the
2310 name; names set this way will never override names set by the user's
2313 x_implicitly_set_name (f
, arg
, oldval
)
2315 Lisp_Object arg
, oldval
;
2317 x_set_name (f
, arg
, 0);
2320 /* Change the title of frame F to NAME.
2321 If NAME is nil, use the frame name as the title.
2323 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2324 name; if NAME is a string, set F's name to NAME and set
2325 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2327 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2328 suggesting a new name, which lisp code should override; if
2329 F->explicit_name is set, ignore the new name; otherwise, set it. */
2332 x_set_title (f
, name
, old_name
)
2334 Lisp_Object name
, old_name
;
2336 /* Don't change the title if it's already NAME. */
2337 if (EQ (name
, f
->title
))
2340 update_mode_lines
= 1;
2347 CHECK_STRING (name
, 0);
2349 if (FRAME_X_WINDOW (f
))
2354 XTextProperty text
, icon
;
2356 Lisp_Object coding_system
;
2358 coding_system
= Vlocale_coding_system
;
2359 if (NILP (coding_system
))
2360 coding_system
= Qcompound_text
;
2361 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2362 text
.encoding
= (stringp
? XA_STRING
2363 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2365 text
.nitems
= bytes
;
2367 if (NILP (f
->icon_name
))
2373 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2375 icon
.encoding
= (stringp
? XA_STRING
2376 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2378 icon
.nitems
= bytes
;
2380 #ifdef USE_X_TOOLKIT
2381 XSetWMName (FRAME_X_DISPLAY (f
),
2382 XtWindow (f
->output_data
.x
->widget
), &text
);
2383 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2385 #else /* not USE_X_TOOLKIT */
2386 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2387 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2388 #endif /* not USE_X_TOOLKIT */
2389 if (!NILP (f
->icon_name
)
2390 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2392 if (text
.value
!= XSTRING (name
)->data
)
2395 #else /* not HAVE_X11R4 */
2396 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2397 XSTRING (name
)->data
);
2398 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2399 XSTRING (name
)->data
);
2400 #endif /* not HAVE_X11R4 */
2406 x_set_autoraise (f
, arg
, oldval
)
2408 Lisp_Object arg
, oldval
;
2410 f
->auto_raise
= !EQ (Qnil
, arg
);
2414 x_set_autolower (f
, arg
, oldval
)
2416 Lisp_Object arg
, oldval
;
2418 f
->auto_lower
= !EQ (Qnil
, arg
);
2422 x_set_unsplittable (f
, arg
, oldval
)
2424 Lisp_Object arg
, oldval
;
2426 f
->no_split
= !NILP (arg
);
2430 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2432 Lisp_Object arg
, oldval
;
2434 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2435 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2436 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2437 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2439 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2441 ? vertical_scroll_bar_none
2443 ? vertical_scroll_bar_right
2444 : vertical_scroll_bar_left
);
2446 /* We set this parameter before creating the X window for the
2447 frame, so we can get the geometry right from the start.
2448 However, if the window hasn't been created yet, we shouldn't
2449 call x_set_window_size. */
2450 if (FRAME_X_WINDOW (f
))
2451 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2452 do_pending_window_change (0);
2457 x_set_scroll_bar_width (f
, arg
, oldval
)
2459 Lisp_Object arg
, oldval
;
2461 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2465 #ifdef USE_TOOLKIT_SCROLL_BARS
2466 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2467 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2468 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2469 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2471 /* Make the actual width at least 14 pixels and a multiple of a
2473 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2475 /* Use all of that space (aside from required margins) for the
2477 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2480 if (FRAME_X_WINDOW (f
))
2481 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2482 do_pending_window_change (0);
2484 else if (INTEGERP (arg
) && XINT (arg
) > 0
2485 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2487 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2488 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2490 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2491 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2492 if (FRAME_X_WINDOW (f
))
2493 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2496 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2497 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2498 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2503 /* Subroutines of creating an X frame. */
2505 /* Make sure that Vx_resource_name is set to a reasonable value.
2506 Fix it up, or set it to `emacs' if it is too hopeless. */
2509 validate_x_resource_name ()
2512 /* Number of valid characters in the resource name. */
2514 /* Number of invalid characters in the resource name. */
2519 if (!STRINGP (Vx_resource_class
))
2520 Vx_resource_class
= build_string (EMACS_CLASS
);
2522 if (STRINGP (Vx_resource_name
))
2524 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2527 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2529 /* Only letters, digits, - and _ are valid in resource names.
2530 Count the valid characters and count the invalid ones. */
2531 for (i
= 0; i
< len
; i
++)
2534 if (! ((c
>= 'a' && c
<= 'z')
2535 || (c
>= 'A' && c
<= 'Z')
2536 || (c
>= '0' && c
<= '9')
2537 || c
== '-' || c
== '_'))
2544 /* Not a string => completely invalid. */
2545 bad_count
= 5, good_count
= 0;
2547 /* If name is valid already, return. */
2551 /* If name is entirely invalid, or nearly so, use `emacs'. */
2553 || (good_count
== 1 && bad_count
> 0))
2555 Vx_resource_name
= build_string ("emacs");
2559 /* Name is partly valid. Copy it and replace the invalid characters
2560 with underscores. */
2562 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2564 for (i
= 0; i
< len
; i
++)
2566 int c
= XSTRING (new)->data
[i
];
2567 if (! ((c
>= 'a' && c
<= 'z')
2568 || (c
>= 'A' && c
<= 'Z')
2569 || (c
>= '0' && c
<= '9')
2570 || c
== '-' || c
== '_'))
2571 XSTRING (new)->data
[i
] = '_';
2576 extern char *x_get_string_resource ();
2578 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2579 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2580 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2581 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2582 the name specified by the `-name' or `-rn' command-line arguments.\n\
2584 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2585 class, respectively. You must specify both of them or neither.\n\
2586 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2587 and the class is `Emacs.CLASS.SUBCLASS'.")
2588 (attribute
, class, component
, subclass
)
2589 Lisp_Object attribute
, class, component
, subclass
;
2591 register char *value
;
2597 CHECK_STRING (attribute
, 0);
2598 CHECK_STRING (class, 0);
2600 if (!NILP (component
))
2601 CHECK_STRING (component
, 1);
2602 if (!NILP (subclass
))
2603 CHECK_STRING (subclass
, 2);
2604 if (NILP (component
) != NILP (subclass
))
2605 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2607 validate_x_resource_name ();
2609 /* Allocate space for the components, the dots which separate them,
2610 and the final '\0'. Make them big enough for the worst case. */
2611 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2612 + (STRINGP (component
)
2613 ? STRING_BYTES (XSTRING (component
)) : 0)
2614 + STRING_BYTES (XSTRING (attribute
))
2617 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2618 + STRING_BYTES (XSTRING (class))
2619 + (STRINGP (subclass
)
2620 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2623 /* Start with emacs.FRAMENAME for the name (the specific one)
2624 and with `Emacs' for the class key (the general one). */
2625 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2626 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2628 strcat (class_key
, ".");
2629 strcat (class_key
, XSTRING (class)->data
);
2631 if (!NILP (component
))
2633 strcat (class_key
, ".");
2634 strcat (class_key
, XSTRING (subclass
)->data
);
2636 strcat (name_key
, ".");
2637 strcat (name_key
, XSTRING (component
)->data
);
2640 strcat (name_key
, ".");
2641 strcat (name_key
, XSTRING (attribute
)->data
);
2643 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2644 name_key
, class_key
);
2646 if (value
!= (char *) 0)
2647 return build_string (value
);
2652 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2655 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2656 struct x_display_info
*dpyinfo
;
2657 Lisp_Object attribute
, class, component
, subclass
;
2659 register char *value
;
2663 CHECK_STRING (attribute
, 0);
2664 CHECK_STRING (class, 0);
2666 if (!NILP (component
))
2667 CHECK_STRING (component
, 1);
2668 if (!NILP (subclass
))
2669 CHECK_STRING (subclass
, 2);
2670 if (NILP (component
) != NILP (subclass
))
2671 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2673 validate_x_resource_name ();
2675 /* Allocate space for the components, the dots which separate them,
2676 and the final '\0'. Make them big enough for the worst case. */
2677 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2678 + (STRINGP (component
)
2679 ? STRING_BYTES (XSTRING (component
)) : 0)
2680 + STRING_BYTES (XSTRING (attribute
))
2683 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2684 + STRING_BYTES (XSTRING (class))
2685 + (STRINGP (subclass
)
2686 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2689 /* Start with emacs.FRAMENAME for the name (the specific one)
2690 and with `Emacs' for the class key (the general one). */
2691 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2692 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2694 strcat (class_key
, ".");
2695 strcat (class_key
, XSTRING (class)->data
);
2697 if (!NILP (component
))
2699 strcat (class_key
, ".");
2700 strcat (class_key
, XSTRING (subclass
)->data
);
2702 strcat (name_key
, ".");
2703 strcat (name_key
, XSTRING (component
)->data
);
2706 strcat (name_key
, ".");
2707 strcat (name_key
, XSTRING (attribute
)->data
);
2709 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2711 if (value
!= (char *) 0)
2712 return build_string (value
);
2717 /* Used when C code wants a resource value. */
2720 x_get_resource_string (attribute
, class)
2721 char *attribute
, *class;
2725 struct frame
*sf
= SELECTED_FRAME ();
2727 /* Allocate space for the components, the dots which separate them,
2728 and the final '\0'. */
2729 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2730 + strlen (attribute
) + 2);
2731 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2732 + strlen (class) + 2);
2734 sprintf (name_key
, "%s.%s",
2735 XSTRING (Vinvocation_name
)->data
,
2737 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2739 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2740 name_key
, class_key
);
2743 /* Types we might convert a resource string into. */
2753 /* Return the value of parameter PARAM.
2755 First search ALIST, then Vdefault_frame_alist, then the X defaults
2756 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2758 Convert the resource to the type specified by desired_type.
2760 If no default is specified, return Qunbound. If you call
2761 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2762 and don't let it get stored in any Lisp-visible variables! */
2765 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2766 struct x_display_info
*dpyinfo
;
2767 Lisp_Object alist
, param
;
2770 enum resource_types type
;
2772 register Lisp_Object tem
;
2774 tem
= Fassq (param
, alist
);
2776 tem
= Fassq (param
, Vdefault_frame_alist
);
2782 tem
= display_x_get_resource (dpyinfo
,
2783 build_string (attribute
),
2784 build_string (class),
2792 case RES_TYPE_NUMBER
:
2793 return make_number (atoi (XSTRING (tem
)->data
));
2795 case RES_TYPE_FLOAT
:
2796 return make_float (atof (XSTRING (tem
)->data
));
2798 case RES_TYPE_BOOLEAN
:
2799 tem
= Fdowncase (tem
);
2800 if (!strcmp (XSTRING (tem
)->data
, "on")
2801 || !strcmp (XSTRING (tem
)->data
, "true"))
2806 case RES_TYPE_STRING
:
2809 case RES_TYPE_SYMBOL
:
2810 /* As a special case, we map the values `true' and `on'
2811 to Qt, and `false' and `off' to Qnil. */
2814 lower
= Fdowncase (tem
);
2815 if (!strcmp (XSTRING (lower
)->data
, "on")
2816 || !strcmp (XSTRING (lower
)->data
, "true"))
2818 else if (!strcmp (XSTRING (lower
)->data
, "off")
2819 || !strcmp (XSTRING (lower
)->data
, "false"))
2822 return Fintern (tem
, Qnil
);
2835 /* Like x_get_arg, but also record the value in f->param_alist. */
2838 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2840 Lisp_Object alist
, param
;
2843 enum resource_types type
;
2847 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2848 attribute
, class, type
);
2850 store_frame_param (f
, param
, value
);
2855 /* Record in frame F the specified or default value according to ALIST
2856 of the parameter named PROP (a Lisp symbol).
2857 If no value is specified for PROP, look for an X default for XPROP
2858 on the frame named NAME.
2859 If that is not found either, use the value DEFLT. */
2862 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2869 enum resource_types type
;
2873 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2874 if (EQ (tem
, Qunbound
))
2876 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2881 /* Record in frame F the specified or default value according to ALIST
2882 of the parameter named PROP (a Lisp symbol). If no value is
2883 specified for PROP, look for an X default for XPROP on the frame
2884 named NAME. If that is not found either, use the value DEFLT. */
2887 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2896 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2899 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2900 if (EQ (tem
, Qunbound
))
2902 #ifdef USE_TOOLKIT_SCROLL_BARS
2904 /* See if an X resource for the scroll bar color has been
2906 tem
= display_x_get_resource (dpyinfo
,
2907 build_string (foreground_p
2911 build_string ("verticalScrollBar"),
2915 /* If nothing has been specified, scroll bars will use a
2916 toolkit-dependent default. Because these defaults are
2917 difficult to get at without actually creating a scroll
2918 bar, use nil to indicate that no color has been
2923 #else /* not USE_TOOLKIT_SCROLL_BARS */
2927 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2930 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2936 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2937 "Parse an X-style geometry string STRING.\n\
2938 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2939 The properties returned may include `top', `left', `height', and `width'.\n\
2940 The value of `left' or `top' may be an integer,\n\
2941 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2942 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2947 unsigned int width
, height
;
2950 CHECK_STRING (string
, 0);
2952 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2953 &x
, &y
, &width
, &height
);
2956 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2957 error ("Must specify both x and y position, or neither");
2961 if (geometry
& XValue
)
2963 Lisp_Object element
;
2965 if (x
>= 0 && (geometry
& XNegative
))
2966 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2967 else if (x
< 0 && ! (geometry
& XNegative
))
2968 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2970 element
= Fcons (Qleft
, make_number (x
));
2971 result
= Fcons (element
, result
);
2974 if (geometry
& YValue
)
2976 Lisp_Object element
;
2978 if (y
>= 0 && (geometry
& YNegative
))
2979 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2980 else if (y
< 0 && ! (geometry
& YNegative
))
2981 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2983 element
= Fcons (Qtop
, make_number (y
));
2984 result
= Fcons (element
, result
);
2987 if (geometry
& WidthValue
)
2988 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2989 if (geometry
& HeightValue
)
2990 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2995 /* Calculate the desired size and position of this window,
2996 and return the flags saying which aspects were specified.
2998 This function does not make the coordinates positive. */
3000 #define DEFAULT_ROWS 40
3001 #define DEFAULT_COLS 80
3004 x_figure_window_size (f
, parms
)
3008 register Lisp_Object tem0
, tem1
, tem2
;
3009 long window_prompting
= 0;
3010 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3012 /* Default values if we fall through.
3013 Actually, if that happens we should get
3014 window manager prompting. */
3015 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3016 f
->height
= DEFAULT_ROWS
;
3017 /* Window managers expect that if program-specified
3018 positions are not (0,0), they're intentional, not defaults. */
3019 f
->output_data
.x
->top_pos
= 0;
3020 f
->output_data
.x
->left_pos
= 0;
3022 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3023 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3024 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3025 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3027 if (!EQ (tem0
, Qunbound
))
3029 CHECK_NUMBER (tem0
, 0);
3030 f
->height
= XINT (tem0
);
3032 if (!EQ (tem1
, Qunbound
))
3034 CHECK_NUMBER (tem1
, 0);
3035 SET_FRAME_WIDTH (f
, XINT (tem1
));
3037 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3038 window_prompting
|= USSize
;
3040 window_prompting
|= PSize
;
3043 f
->output_data
.x
->vertical_scroll_bar_extra
3044 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3046 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3047 f
->output_data
.x
->flags_areas_extra
3048 = FRAME_FLAGS_AREA_WIDTH (f
);
3049 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3050 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3052 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3053 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3054 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3055 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3057 if (EQ (tem0
, Qminus
))
3059 f
->output_data
.x
->top_pos
= 0;
3060 window_prompting
|= YNegative
;
3062 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3063 && CONSP (XCDR (tem0
))
3064 && INTEGERP (XCAR (XCDR (tem0
))))
3066 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3067 window_prompting
|= YNegative
;
3069 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3070 && CONSP (XCDR (tem0
))
3071 && INTEGERP (XCAR (XCDR (tem0
))))
3073 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3075 else if (EQ (tem0
, Qunbound
))
3076 f
->output_data
.x
->top_pos
= 0;
3079 CHECK_NUMBER (tem0
, 0);
3080 f
->output_data
.x
->top_pos
= XINT (tem0
);
3081 if (f
->output_data
.x
->top_pos
< 0)
3082 window_prompting
|= YNegative
;
3085 if (EQ (tem1
, Qminus
))
3087 f
->output_data
.x
->left_pos
= 0;
3088 window_prompting
|= XNegative
;
3090 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3091 && CONSP (XCDR (tem1
))
3092 && INTEGERP (XCAR (XCDR (tem1
))))
3094 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3095 window_prompting
|= XNegative
;
3097 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3098 && CONSP (XCDR (tem1
))
3099 && INTEGERP (XCAR (XCDR (tem1
))))
3101 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3103 else if (EQ (tem1
, Qunbound
))
3104 f
->output_data
.x
->left_pos
= 0;
3107 CHECK_NUMBER (tem1
, 0);
3108 f
->output_data
.x
->left_pos
= XINT (tem1
);
3109 if (f
->output_data
.x
->left_pos
< 0)
3110 window_prompting
|= XNegative
;
3113 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3114 window_prompting
|= USPosition
;
3116 window_prompting
|= PPosition
;
3119 return window_prompting
;
3122 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3125 XSetWMProtocols (dpy
, w
, protocols
, count
)
3132 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3133 if (prop
== None
) return False
;
3134 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3135 (unsigned char *) protocols
, count
);
3138 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3140 #ifdef USE_X_TOOLKIT
3142 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3143 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3144 already be present because of the toolkit (Motif adds some of them,
3145 for example, but Xt doesn't). */
3148 hack_wm_protocols (f
, widget
)
3152 Display
*dpy
= XtDisplay (widget
);
3153 Window w
= XtWindow (widget
);
3154 int need_delete
= 1;
3160 Atom type
, *atoms
= 0;
3162 unsigned long nitems
= 0;
3163 unsigned long bytes_after
;
3165 if ((XGetWindowProperty (dpy
, w
,
3166 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3167 (long)0, (long)100, False
, XA_ATOM
,
3168 &type
, &format
, &nitems
, &bytes_after
,
3169 (unsigned char **) &atoms
)
3171 && format
== 32 && type
== XA_ATOM
)
3175 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3177 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3179 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3182 if (atoms
) XFree ((char *) atoms
);
3188 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3190 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3192 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3194 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3195 XA_ATOM
, 32, PropModeAppend
,
3196 (unsigned char *) props
, count
);
3204 /* Support routines for XIC (X Input Context). */
3208 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3209 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3212 /* Supported XIM styles, ordered by preferenc. */
3214 static XIMStyle supported_xim_styles
[] =
3216 XIMPreeditPosition
| XIMStatusArea
,
3217 XIMPreeditPosition
| XIMStatusNothing
,
3218 XIMPreeditPosition
| XIMStatusNone
,
3219 XIMPreeditNothing
| XIMStatusArea
,
3220 XIMPreeditNothing
| XIMStatusNothing
,
3221 XIMPreeditNothing
| XIMStatusNone
,
3222 XIMPreeditNone
| XIMStatusArea
,
3223 XIMPreeditNone
| XIMStatusNothing
,
3224 XIMPreeditNone
| XIMStatusNone
,
3229 /* Create an X fontset on frame F with base font name
3233 xic_create_xfontset (f
, base_fontname
)
3235 char *base_fontname
;
3238 char **missing_list
;
3242 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3243 base_fontname
, &missing_list
,
3244 &missing_count
, &def_string
);
3246 XFreeStringList (missing_list
);
3248 /* No need to free def_string. */
3253 /* Value is the best input style, given user preferences USER (already
3254 checked to be supported by Emacs), and styles supported by the
3255 input method XIM. */
3258 best_xim_style (user
, xim
)
3264 for (i
= 0; i
< user
->count_styles
; ++i
)
3265 for (j
= 0; j
< xim
->count_styles
; ++j
)
3266 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3267 return user
->supported_styles
[i
];
3269 /* Return the default style. */
3270 return XIMPreeditNothing
| XIMStatusNothing
;
3273 /* Create XIC for frame F. */
3275 static XIMStyle xic_style
;
3278 create_frame_xic (f
)
3283 XFontSet xfs
= NULL
;
3288 xim
= FRAME_X_XIM (f
);
3293 XVaNestedList preedit_attr
;
3294 XVaNestedList status_attr
;
3295 char *base_fontname
;
3298 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3299 spot
.x
= 0; spot
.y
= 1;
3300 /* Create X fontset. */
3301 fontset
= FRAME_FONTSET (f
);
3303 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3306 /* Determine the base fontname from the ASCII font name of
3308 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3309 char *p
= ascii_font
;
3312 for (i
= 0; *p
; p
++)
3315 /* As the font name doesn't conform to XLFD, we can't
3316 modify it to get a suitable base fontname for the
3318 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3321 int len
= strlen (ascii_font
) + 1;
3324 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3333 base_fontname
= (char *) alloca (len
);
3334 bzero (base_fontname
, len
);
3335 strcpy (base_fontname
, "-*-*-");
3336 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3337 strcat (base_fontname
, "*-*-*-*-*-*-*");
3340 xfs
= xic_create_xfontset (f
, base_fontname
);
3342 /* Determine XIC style. */
3345 XIMStyles supported_list
;
3346 supported_list
.count_styles
= (sizeof supported_xim_styles
3347 / sizeof supported_xim_styles
[0]);
3348 supported_list
.supported_styles
= supported_xim_styles
;
3349 xic_style
= best_xim_style (&supported_list
,
3350 FRAME_X_XIM_STYLES (f
));
3353 preedit_attr
= XVaCreateNestedList (0,
3356 FRAME_FOREGROUND_PIXEL (f
),
3358 FRAME_BACKGROUND_PIXEL (f
),
3359 (xic_style
& XIMPreeditPosition
3364 status_attr
= XVaCreateNestedList (0,
3370 FRAME_FOREGROUND_PIXEL (f
),
3372 FRAME_BACKGROUND_PIXEL (f
),
3375 xic
= XCreateIC (xim
,
3376 XNInputStyle
, xic_style
,
3377 XNClientWindow
, FRAME_X_WINDOW(f
),
3378 XNFocusWindow
, FRAME_X_WINDOW(f
),
3379 XNStatusAttributes
, status_attr
,
3380 XNPreeditAttributes
, preedit_attr
,
3382 XFree (preedit_attr
);
3383 XFree (status_attr
);
3386 FRAME_XIC (f
) = xic
;
3387 FRAME_XIC_STYLE (f
) = xic_style
;
3388 FRAME_XIC_FONTSET (f
) = xfs
;
3392 /* Destroy XIC and free XIC fontset of frame F, if any. */
3398 if (FRAME_XIC (f
) == NULL
)
3401 XDestroyIC (FRAME_XIC (f
));
3402 if (FRAME_XIC_FONTSET (f
))
3403 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3405 FRAME_XIC (f
) = NULL
;
3406 FRAME_XIC_FONTSET (f
) = NULL
;
3410 /* Place preedit area for XIC of window W's frame to specified
3411 pixel position X/Y. X and Y are relative to window W. */
3414 xic_set_preeditarea (w
, x
, y
)
3418 struct frame
*f
= XFRAME (w
->frame
);
3422 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3423 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3424 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3425 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3430 /* Place status area for XIC in bottom right corner of frame F.. */
3433 xic_set_statusarea (f
)
3436 XIC xic
= FRAME_XIC (f
);
3441 /* Negotiate geometry of status area. If input method has existing
3442 status area, use its current size. */
3443 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3444 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3445 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3448 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3449 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3452 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3454 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3455 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3459 area
.width
= needed
->width
;
3460 area
.height
= needed
->height
;
3461 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3462 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3463 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3466 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3467 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3472 /* Set X fontset for XIC of frame F, using base font name
3473 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3476 xic_set_xfontset (f
, base_fontname
)
3478 char *base_fontname
;
3483 xfs
= xic_create_xfontset (f
, base_fontname
);
3485 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3486 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3487 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3488 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3489 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3492 if (FRAME_XIC_FONTSET (f
))
3493 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3494 FRAME_XIC_FONTSET (f
) = xfs
;
3497 #endif /* HAVE_X_I18N */
3501 #ifdef USE_X_TOOLKIT
3503 /* Create and set up the X widget for frame F. */
3506 x_window (f
, window_prompting
, minibuffer_only
)
3508 long window_prompting
;
3509 int minibuffer_only
;
3511 XClassHint class_hints
;
3512 XSetWindowAttributes attributes
;
3513 unsigned long attribute_mask
;
3514 Widget shell_widget
;
3516 Widget frame_widget
;
3522 /* Use the resource name as the top-level widget name
3523 for looking up resources. Make a non-Lisp copy
3524 for the window manager, so GC relocation won't bother it.
3526 Elsewhere we specify the window name for the window manager. */
3529 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3530 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3531 strcpy (f
->namebuf
, str
);
3535 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3536 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3537 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3538 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3539 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3540 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3541 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3542 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3543 applicationShellWidgetClass
,
3544 FRAME_X_DISPLAY (f
), al
, ac
);
3546 f
->output_data
.x
->widget
= shell_widget
;
3547 /* maybe_set_screen_title_format (shell_widget); */
3549 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3550 (widget_value
*) NULL
,
3551 shell_widget
, False
,
3555 (lw_callback
) NULL
);
3558 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3559 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3560 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3561 XtSetValues (pane_widget
, al
, ac
);
3562 f
->output_data
.x
->column_widget
= pane_widget
;
3564 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3565 the emacs screen when changing menubar. This reduces flickering. */
3568 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3569 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3570 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3571 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3572 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
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 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3579 f
->output_data
.x
->edit_widget
= frame_widget
;
3581 XtManageChild (frame_widget
);
3583 /* Do some needed geometry management. */
3586 char *tem
, shell_position
[32];
3589 int extra_borders
= 0;
3591 = (f
->output_data
.x
->menubar_widget
3592 ? (f
->output_data
.x
->menubar_widget
->core
.height
3593 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3596 #if 0 /* Experimentally, we now get the right results
3597 for -geometry -0-0 without this. 24 Aug 96, rms. */
3598 if (FRAME_EXTERNAL_MENU_BAR (f
))
3601 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3602 menubar_size
+= ibw
;
3606 f
->output_data
.x
->menubar_height
= menubar_size
;
3609 /* Motif seems to need this amount added to the sizes
3610 specified for the shell widget. The Athena/Lucid widgets don't.
3611 Both conclusions reached experimentally. -- rms. */
3612 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3613 &extra_borders
, NULL
);
3617 /* Convert our geometry parameters into a geometry string
3619 Note that we do not specify here whether the position
3620 is a user-specified or program-specified one.
3621 We pass that information later, in x_wm_set_size_hints. */
3623 int left
= f
->output_data
.x
->left_pos
;
3624 int xneg
= window_prompting
& XNegative
;
3625 int top
= f
->output_data
.x
->top_pos
;
3626 int yneg
= window_prompting
& YNegative
;
3632 if (window_prompting
& USPosition
)
3633 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3634 PIXEL_WIDTH (f
) + extra_borders
,
3635 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3636 (xneg
? '-' : '+'), left
,
3637 (yneg
? '-' : '+'), top
);
3639 sprintf (shell_position
, "=%dx%d",
3640 PIXEL_WIDTH (f
) + extra_borders
,
3641 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3644 len
= strlen (shell_position
) + 1;
3645 /* We don't free this because we don't know whether
3646 it is safe to free it while the frame exists.
3647 It isn't worth the trouble of arranging to free it
3648 when the frame is deleted. */
3649 tem
= (char *) xmalloc (len
);
3650 strncpy (tem
, shell_position
, len
);
3651 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3652 XtSetValues (shell_widget
, al
, ac
);
3655 XtManageChild (pane_widget
);
3656 XtRealizeWidget (shell_widget
);
3658 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3660 validate_x_resource_name ();
3662 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3663 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3664 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3667 FRAME_XIC (f
) = NULL
;
3669 create_frame_xic (f
);
3673 f
->output_data
.x
->wm_hints
.input
= True
;
3674 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3675 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3676 &f
->output_data
.x
->wm_hints
);
3678 hack_wm_protocols (f
, shell_widget
);
3681 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3684 /* Do a stupid property change to force the server to generate a
3685 PropertyNotify event so that the event_stream server timestamp will
3686 be initialized to something relevant to the time we created the window.
3688 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3689 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3690 XA_ATOM
, 32, PropModeAppend
,
3691 (unsigned char*) NULL
, 0);
3693 /* Make all the standard events reach the Emacs frame. */
3694 attributes
.event_mask
= STANDARD_EVENT_SET
;
3699 /* XIM server might require some X events. */
3700 unsigned long fevent
= NoEventMask
;
3701 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3702 attributes
.event_mask
|= fevent
;
3704 #endif /* HAVE_X_I18N */
3706 attribute_mask
= CWEventMask
;
3707 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3708 attribute_mask
, &attributes
);
3710 XtMapWidget (frame_widget
);
3712 /* x_set_name normally ignores requests to set the name if the
3713 requested name is the same as the current name. This is the one
3714 place where that assumption isn't correct; f->name is set, but
3715 the X server hasn't been told. */
3718 int explicit = f
->explicit_name
;
3720 f
->explicit_name
= 0;
3723 x_set_name (f
, name
, explicit);
3726 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3727 f
->output_data
.x
->text_cursor
);
3731 /* This is a no-op, except under Motif. Make sure main areas are
3732 set to something reasonable, in case we get an error later. */
3733 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3736 #else /* not USE_X_TOOLKIT */
3738 /* Create and set up the X window for frame F. */
3745 XClassHint class_hints
;
3746 XSetWindowAttributes attributes
;
3747 unsigned long attribute_mask
;
3749 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3750 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3751 attributes
.bit_gravity
= StaticGravity
;
3752 attributes
.backing_store
= NotUseful
;
3753 attributes
.save_under
= True
;
3754 attributes
.event_mask
= STANDARD_EVENT_SET
;
3755 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3756 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3761 = XCreateWindow (FRAME_X_DISPLAY (f
),
3762 f
->output_data
.x
->parent_desc
,
3763 f
->output_data
.x
->left_pos
,
3764 f
->output_data
.x
->top_pos
,
3765 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3766 f
->output_data
.x
->border_width
,
3767 CopyFromParent
, /* depth */
3768 InputOutput
, /* class */
3770 attribute_mask
, &attributes
);
3774 create_frame_xic (f
);
3777 /* XIM server might require some X events. */
3778 unsigned long fevent
= NoEventMask
;
3779 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3780 attributes
.event_mask
|= fevent
;
3781 attribute_mask
= CWEventMask
;
3782 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3783 attribute_mask
, &attributes
);
3786 #endif /* HAVE_X_I18N */
3788 validate_x_resource_name ();
3790 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3791 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3792 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3794 /* The menubar is part of the ordinary display;
3795 it does not count in addition to the height of the window. */
3796 f
->output_data
.x
->menubar_height
= 0;
3798 /* This indicates that we use the "Passive Input" input model.
3799 Unless we do this, we don't get the Focus{In,Out} events that we
3800 need to draw the cursor correctly. Accursed bureaucrats.
3801 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3803 f
->output_data
.x
->wm_hints
.input
= True
;
3804 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3805 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3806 &f
->output_data
.x
->wm_hints
);
3807 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3809 /* Request "save yourself" and "delete window" commands from wm. */
3812 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3813 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3814 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3817 /* x_set_name normally ignores requests to set the name if the
3818 requested name is the same as the current name. This is the one
3819 place where that assumption isn't correct; f->name is set, but
3820 the X server hasn't been told. */
3823 int explicit = f
->explicit_name
;
3825 f
->explicit_name
= 0;
3828 x_set_name (f
, name
, explicit);
3831 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3832 f
->output_data
.x
->text_cursor
);
3836 if (FRAME_X_WINDOW (f
) == 0)
3837 error ("Unable to create window");
3840 #endif /* not USE_X_TOOLKIT */
3842 /* Handle the icon stuff for this window. Perhaps later we might
3843 want an x_set_icon_position which can be called interactively as
3851 Lisp_Object icon_x
, icon_y
;
3852 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3854 /* Set the position of the icon. Note that twm groups all
3855 icons in an icon window. */
3856 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3857 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3858 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3860 CHECK_NUMBER (icon_x
, 0);
3861 CHECK_NUMBER (icon_y
, 0);
3863 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3864 error ("Both left and top icon corners of icon must be specified");
3868 if (! EQ (icon_x
, Qunbound
))
3869 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3871 /* Start up iconic or window? */
3872 x_wm_set_window_state
3873 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3878 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3885 /* Make the GCs needed for this window, setting the
3886 background, border and mouse colors; also create the
3887 mouse cursor and the gray border tile. */
3889 static char cursor_bits
[] =
3891 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3892 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3893 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3894 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3901 XGCValues gc_values
;
3905 /* Create the GCs of this frame.
3906 Note that many default values are used. */
3909 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3910 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3911 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3912 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3913 f
->output_data
.x
->normal_gc
3914 = XCreateGC (FRAME_X_DISPLAY (f
),
3916 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
3919 /* Reverse video style. */
3920 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3921 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3922 f
->output_data
.x
->reverse_gc
3923 = XCreateGC (FRAME_X_DISPLAY (f
),
3925 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
3928 /* Cursor has cursor-color background, background-color foreground. */
3929 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3930 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3931 gc_values
.fill_style
= FillOpaqueStippled
;
3933 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3934 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3935 cursor_bits
, 16, 16);
3936 f
->output_data
.x
->cursor_gc
3937 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3938 (GCFont
| GCForeground
| GCBackground
3939 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3943 f
->output_data
.x
->white_relief
.gc
= 0;
3944 f
->output_data
.x
->black_relief
.gc
= 0;
3946 /* Create the gray border tile used when the pointer is not in
3947 the frame. Since this depends on the frame's pixel values,
3948 this must be done on a per-frame basis. */
3949 f
->output_data
.x
->border_tile
3950 = (XCreatePixmapFromBitmapData
3951 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3952 gray_bits
, gray_width
, gray_height
,
3953 f
->output_data
.x
->foreground_pixel
,
3954 f
->output_data
.x
->background_pixel
,
3955 DefaultDepth (FRAME_X_DISPLAY (f
),
3956 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3962 /* Free what was was allocated in x_make_gc. */
3968 Display
*dpy
= FRAME_X_DISPLAY (f
);
3972 if (f
->output_data
.x
->normal_gc
)
3974 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
3975 f
->output_data
.x
->normal_gc
= 0;
3978 if (f
->output_data
.x
->reverse_gc
)
3980 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
3981 f
->output_data
.x
->reverse_gc
= 0;
3984 if (f
->output_data
.x
->cursor_gc
)
3986 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
3987 f
->output_data
.x
->cursor_gc
= 0;
3990 if (f
->output_data
.x
->border_tile
)
3992 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
3993 f
->output_data
.x
->border_tile
= 0;
4000 /* Handler for signals raised during x_create_frame and
4001 x_create_top_frame. FRAME is the frame which is partially
4005 unwind_create_frame (frame
)
4008 struct frame
*f
= XFRAME (frame
);
4010 /* If frame is ``official'', nothing to do. */
4011 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4014 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4017 x_free_frame_resources (f
);
4019 /* Check that reference counts are indeed correct. */
4020 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4021 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4029 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4031 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
4032 Returns an Emacs frame object.\n\
4033 ALIST is an alist of frame parameters.\n\
4034 If the parameters specify that the frame should not have a minibuffer,\n\
4035 and do not specify a specific minibuffer window to use,\n\
4036 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4037 be shared by the new frame.\n\
4039 This function is an internal primitive--use `make-frame' instead.")
4044 Lisp_Object frame
, tem
;
4046 int minibuffer_only
= 0;
4047 long window_prompting
= 0;
4049 int count
= BINDING_STACK_SIZE ();
4050 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4051 Lisp_Object display
;
4052 struct x_display_info
*dpyinfo
= NULL
;
4058 /* Use this general default value to start with
4059 until we know if this frame has a specified name. */
4060 Vx_resource_name
= Vinvocation_name
;
4062 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4063 if (EQ (display
, Qunbound
))
4065 dpyinfo
= check_x_display_info (display
);
4067 kb
= dpyinfo
->kboard
;
4069 kb
= &the_only_kboard
;
4072 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4074 && ! EQ (name
, Qunbound
)
4076 error ("Invalid frame name--not a string or nil");
4079 Vx_resource_name
= name
;
4081 /* See if parent window is specified. */
4082 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4083 if (EQ (parent
, Qunbound
))
4085 if (! NILP (parent
))
4086 CHECK_NUMBER (parent
, 0);
4088 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4089 /* No need to protect DISPLAY because that's not used after passing
4090 it to make_frame_without_minibuffer. */
4092 GCPRO4 (parms
, parent
, name
, frame
);
4093 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4095 if (EQ (tem
, Qnone
) || NILP (tem
))
4096 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4097 else if (EQ (tem
, Qonly
))
4099 f
= make_minibuffer_frame ();
4100 minibuffer_only
= 1;
4102 else if (WINDOWP (tem
))
4103 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4107 XSETFRAME (frame
, f
);
4109 /* Note that X Windows does support scroll bars. */
4110 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4112 f
->output_method
= output_x_window
;
4113 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4114 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4115 f
->output_data
.x
->icon_bitmap
= -1;
4116 f
->output_data
.x
->fontset
= -1;
4117 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4118 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4119 record_unwind_protect (unwind_create_frame
, frame
);
4122 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4124 if (! STRINGP (f
->icon_name
))
4125 f
->icon_name
= Qnil
;
4127 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4129 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4130 dpyinfo_refcount
= dpyinfo
->reference_count
;
4131 #endif /* GLYPH_DEBUG */
4133 FRAME_KBOARD (f
) = kb
;
4136 /* These colors will be set anyway later, but it's important
4137 to get the color reference counts right, so initialize them! */
4140 struct gcpro gcpro1
;
4142 black
= build_string ("black");
4144 f
->output_data
.x
->foreground_pixel
4145 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4146 f
->output_data
.x
->background_pixel
4147 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4148 f
->output_data
.x
->cursor_pixel
4149 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4150 f
->output_data
.x
->cursor_foreground_pixel
4151 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4152 f
->output_data
.x
->border_pixel
4153 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4154 f
->output_data
.x
->mouse_pixel
4155 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4159 /* Specify the parent under which to make this X window. */
4163 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4164 f
->output_data
.x
->explicit_parent
= 1;
4168 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4169 f
->output_data
.x
->explicit_parent
= 0;
4172 /* Set the name; the functions to which we pass f expect the name to
4174 if (EQ (name
, Qunbound
) || NILP (name
))
4176 f
->name
= build_string (dpyinfo
->x_id_name
);
4177 f
->explicit_name
= 0;
4182 f
->explicit_name
= 1;
4183 /* use the frame's title when getting resources for this frame. */
4184 specbind (Qx_resource_name
, name
);
4187 /* Extract the window parameters from the supplied values
4188 that are needed to determine window geometry. */
4192 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4195 /* First, try whatever font the caller has specified. */
4198 tem
= Fquery_fontset (font
, Qnil
);
4200 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4202 font
= x_new_font (f
, XSTRING (font
)->data
);
4205 /* Try out a font which we hope has bold and italic variations. */
4206 if (!STRINGP (font
))
4207 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4208 if (!STRINGP (font
))
4209 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4210 if (! STRINGP (font
))
4211 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4212 if (! STRINGP (font
))
4213 /* This was formerly the first thing tried, but it finds too many fonts
4214 and takes too long. */
4215 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4216 /* If those didn't work, look for something which will at least work. */
4217 if (! STRINGP (font
))
4218 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4220 if (! STRINGP (font
))
4221 font
= build_string ("fixed");
4223 x_default_parameter (f
, parms
, Qfont
, font
,
4224 "font", "Font", RES_TYPE_STRING
);
4228 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4229 whereby it fails to get any font. */
4230 xlwmenu_default_font
= f
->output_data
.x
->font
;
4233 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4234 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4236 /* This defaults to 2 in order to match xterm. We recognize either
4237 internalBorderWidth or internalBorder (which is what xterm calls
4239 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4243 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4244 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4245 if (! EQ (value
, Qunbound
))
4246 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4249 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4250 "internalBorderWidth", "internalBorderWidth",
4252 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4253 "verticalScrollBars", "ScrollBars",
4256 /* Also do the stuff which must be set before the window exists. */
4257 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4258 "foreground", "Foreground", RES_TYPE_STRING
);
4259 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4260 "background", "Background", RES_TYPE_STRING
);
4261 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4262 "pointerColor", "Foreground", RES_TYPE_STRING
);
4263 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4264 "cursorColor", "Foreground", RES_TYPE_STRING
);
4265 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4266 "borderColor", "BorderColor", RES_TYPE_STRING
);
4267 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4268 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4269 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4270 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4272 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4273 "scrollBarForeground",
4274 "ScrollBarForeground", 1);
4275 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4276 "scrollBarBackground",
4277 "ScrollBarBackground", 0);
4279 /* Init faces before x_default_parameter is called for scroll-bar
4280 parameters because that function calls x_set_scroll_bar_width,
4281 which calls change_frame_size, which calls Fset_window_buffer,
4282 which runs hooks, which call Fvertical_motion. At the end, we
4283 end up in init_iterator with a null face cache, which should not
4285 init_frame_faces (f
);
4287 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4288 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4289 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4290 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4291 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4292 "bufferPredicate", "BufferPredicate",
4294 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4295 "title", "Title", RES_TYPE_STRING
);
4297 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4298 window_prompting
= x_figure_window_size (f
, parms
);
4300 if (window_prompting
& XNegative
)
4302 if (window_prompting
& YNegative
)
4303 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4305 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4309 if (window_prompting
& YNegative
)
4310 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4312 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4315 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4317 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4318 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4320 /* Create the X widget or window. */
4321 #ifdef USE_X_TOOLKIT
4322 x_window (f
, window_prompting
, minibuffer_only
);
4330 /* Now consider the frame official. */
4331 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4332 Vframe_list
= Fcons (frame
, Vframe_list
);
4334 /* We need to do this after creating the X window, so that the
4335 icon-creation functions can say whose icon they're describing. */
4336 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4337 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4339 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4340 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4341 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4342 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4343 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4344 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4345 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4346 "scrollBarWidth", "ScrollBarWidth",
4349 /* Dimensions, especially f->height, must be done via change_frame_size.
4350 Change will not be effected unless different from the current
4355 /* Add the tool-bar height to the initial frame height so that the
4356 user gets a text display area of the size he specified with -g or
4357 via .Xdefaults. Later changes of the tool-bar height don't
4358 change the frame size. This is done so that users can create
4359 tall Emacs frames without having to guess how tall the tool-bar
4361 if (FRAME_TOOL_BAR_LINES (f
))
4363 int margin
, relief
, bar_height
;
4365 relief
= (tool_bar_button_relief
> 0
4366 ? tool_bar_button_relief
4367 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4369 if (INTEGERP (Vtool_bar_button_margin
)
4370 && XINT (Vtool_bar_button_margin
) > 0)
4371 margin
= XFASTINT (Vtool_bar_button_margin
);
4372 else if (CONSP (Vtool_bar_button_margin
)
4373 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4374 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4375 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4379 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4380 height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4384 SET_FRAME_WIDTH (f
, 0);
4385 change_frame_size (f
, height
, width
, 1, 0, 0);
4387 /* Set up faces after all frame parameters are known. This call
4388 also merges in face attributes specified for new frames. If we
4389 don't do this, the `menu' face for instance won't have the right
4390 colors, and the menu bar won't appear in the specified colors for
4392 call1 (Qface_set_after_frame_default
, frame
);
4394 #ifdef USE_X_TOOLKIT
4395 /* Create the menu bar. */
4396 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4398 /* If this signals an error, we haven't set size hints for the
4399 frame and we didn't make it visible. */
4400 initialize_frame_menubar (f
);
4402 /* This is a no-op, except under Motif where it arranges the
4403 main window for the widgets on it. */
4404 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4405 f
->output_data
.x
->menubar_widget
,
4406 f
->output_data
.x
->edit_widget
);
4408 #endif /* USE_X_TOOLKIT */
4410 /* Tell the server what size and position, etc, we want, and how
4411 badly we want them. This should be done after we have the menu
4412 bar so that its size can be taken into account. */
4414 x_wm_set_size_hint (f
, window_prompting
, 0);
4417 /* Make the window appear on the frame and enable display, unless
4418 the caller says not to. However, with explicit parent, Emacs
4419 cannot control visibility, so don't try. */
4420 if (! f
->output_data
.x
->explicit_parent
)
4422 Lisp_Object visibility
;
4424 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4426 if (EQ (visibility
, Qunbound
))
4429 if (EQ (visibility
, Qicon
))
4430 x_iconify_frame (f
);
4431 else if (! NILP (visibility
))
4432 x_make_frame_visible (f
);
4434 /* Must have been Qnil. */
4439 return unbind_to (count
, frame
);
4443 /* FRAME is used only to get a handle on the X display. We don't pass the
4444 display info directly because we're called from frame.c, which doesn't
4445 know about that structure. */
4448 x_get_focus_frame (frame
)
4449 struct frame
*frame
;
4451 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4453 if (! dpyinfo
->x_focus_frame
)
4456 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4461 /* In certain situations, when the window manager follows a
4462 click-to-focus policy, there seems to be no way around calling
4463 XSetInputFocus to give another frame the input focus .
4465 In an ideal world, XSetInputFocus should generally be avoided so
4466 that applications don't interfere with the window manager's focus
4467 policy. But I think it's okay to use when it's clearly done
4468 following a user-command. */
4470 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4471 "Set the input focus to FRAME.\n\
4472 FRAME nil means use the selected frame.")
4476 struct frame
*f
= check_x_frame (frame
);
4477 Display
*dpy
= FRAME_X_DISPLAY (f
);
4481 count
= x_catch_errors (dpy
);
4482 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4483 RevertToParent
, CurrentTime
);
4484 x_uncatch_errors (dpy
, count
);
4491 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4492 "Internal function called by `color-defined-p', which see.")
4494 Lisp_Object color
, frame
;
4497 FRAME_PTR f
= check_x_frame (frame
);
4499 CHECK_STRING (color
, 1);
4501 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4507 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4508 "Internal function called by `color-values', which see.")
4510 Lisp_Object color
, frame
;
4513 FRAME_PTR f
= check_x_frame (frame
);
4515 CHECK_STRING (color
, 1);
4517 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4521 rgb
[0] = make_number (foo
.red
);
4522 rgb
[1] = make_number (foo
.green
);
4523 rgb
[2] = make_number (foo
.blue
);
4524 return Flist (3, rgb
);
4530 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4531 "Internal function called by `display-color-p', which see.")
4533 Lisp_Object display
;
4535 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4537 if (dpyinfo
->n_planes
<= 2)
4540 switch (dpyinfo
->visual
->class)
4553 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4555 "Return t if the X display supports shades of gray.\n\
4556 Note that color displays do support shades of gray.\n\
4557 The optional argument DISPLAY specifies which display to ask about.\n\
4558 DISPLAY should be either a frame or a display name (a string).\n\
4559 If omitted or nil, that stands for the selected frame's display.")
4561 Lisp_Object display
;
4563 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4565 if (dpyinfo
->n_planes
<= 1)
4568 switch (dpyinfo
->visual
->class)
4583 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4585 "Returns the width in pixels of the X display DISPLAY.\n\
4586 The optional argument DISPLAY specifies which display to ask about.\n\
4587 DISPLAY should be either a frame or a display name (a string).\n\
4588 If omitted or nil, that stands for the selected frame's display.")
4590 Lisp_Object display
;
4592 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4594 return make_number (dpyinfo
->width
);
4597 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4598 Sx_display_pixel_height
, 0, 1, 0,
4599 "Returns the height in pixels of the X display DISPLAY.\n\
4600 The optional argument DISPLAY specifies which display to ask about.\n\
4601 DISPLAY should be either a frame or a display name (a string).\n\
4602 If omitted or nil, that stands for the selected frame's display.")
4604 Lisp_Object display
;
4606 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4608 return make_number (dpyinfo
->height
);
4611 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4613 "Returns the number of bitplanes of the X display DISPLAY.\n\
4614 The optional argument DISPLAY specifies which display to ask about.\n\
4615 DISPLAY should be either a frame or a display name (a string).\n\
4616 If omitted or nil, that stands for the selected frame's display.")
4618 Lisp_Object display
;
4620 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4622 return make_number (dpyinfo
->n_planes
);
4625 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4627 "Returns the number of color cells of the X display DISPLAY.\n\
4628 The optional argument DISPLAY specifies which display to ask about.\n\
4629 DISPLAY should be either a frame or a display name (a string).\n\
4630 If omitted or nil, that stands for the selected frame's display.")
4632 Lisp_Object display
;
4634 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4636 return make_number (DisplayCells (dpyinfo
->display
,
4637 XScreenNumberOfScreen (dpyinfo
->screen
)));
4640 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4641 Sx_server_max_request_size
,
4643 "Returns the maximum request size of the X server of display DISPLAY.\n\
4644 The optional argument DISPLAY specifies which display to ask about.\n\
4645 DISPLAY should be either a frame or a display name (a string).\n\
4646 If omitted or nil, that stands for the selected frame's display.")
4648 Lisp_Object display
;
4650 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4652 return make_number (MAXREQUEST (dpyinfo
->display
));
4655 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4656 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4657 The optional argument DISPLAY specifies which display to ask about.\n\
4658 DISPLAY should be either a frame or a display name (a string).\n\
4659 If omitted or nil, that stands for the selected frame's display.")
4661 Lisp_Object display
;
4663 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4664 char *vendor
= ServerVendor (dpyinfo
->display
);
4666 if (! vendor
) vendor
= "";
4667 return build_string (vendor
);
4670 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4671 "Returns the version numbers of the X server of display DISPLAY.\n\
4672 The value is a list of three integers: the major and minor\n\
4673 version numbers of the X Protocol in use, and the vendor-specific release\n\
4674 number. See also the function `x-server-vendor'.\n\n\
4675 The optional argument DISPLAY specifies which display to ask about.\n\
4676 DISPLAY should be either a frame or a display name (a string).\n\
4677 If omitted or nil, that stands for the selected frame's display.")
4679 Lisp_Object display
;
4681 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4682 Display
*dpy
= dpyinfo
->display
;
4684 return Fcons (make_number (ProtocolVersion (dpy
)),
4685 Fcons (make_number (ProtocolRevision (dpy
)),
4686 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4689 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4690 "Returns the number of screens on the X server of display DISPLAY.\n\
4691 The optional argument DISPLAY specifies which display to ask about.\n\
4692 DISPLAY should be either a frame or a display name (a string).\n\
4693 If omitted or nil, that stands for the selected frame's display.")
4695 Lisp_Object display
;
4697 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4699 return make_number (ScreenCount (dpyinfo
->display
));
4702 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4703 "Returns the height in millimeters of the X display DISPLAY.\n\
4704 The optional argument DISPLAY specifies which display to ask about.\n\
4705 DISPLAY should be either a frame or a display name (a string).\n\
4706 If omitted or nil, that stands for the selected frame's display.")
4708 Lisp_Object display
;
4710 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4712 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4715 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4716 "Returns the width in millimeters of the X display DISPLAY.\n\
4717 The optional argument DISPLAY specifies which display to ask about.\n\
4718 DISPLAY should be either a frame or a display name (a string).\n\
4719 If omitted or nil, that stands for the selected frame's display.")
4721 Lisp_Object display
;
4723 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4725 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4728 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4729 Sx_display_backing_store
, 0, 1, 0,
4730 "Returns an indication of whether X display DISPLAY does backing store.\n\
4731 The value may be `always', `when-mapped', or `not-useful'.\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
);
4741 switch (DoesBackingStore (dpyinfo
->screen
))
4744 result
= intern ("always");
4748 result
= intern ("when-mapped");
4752 result
= intern ("not-useful");
4756 error ("Strange value for BackingStore parameter of screen");
4763 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4764 Sx_display_visual_class
, 0, 1, 0,
4765 "Returns the visual class of the X display DISPLAY.\n\
4766 The value is one of the symbols `static-gray', `gray-scale',\n\
4767 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4768 The optional argument DISPLAY specifies which display to ask about.\n\
4769 DISPLAY should be either a frame or a display name (a string).\n\
4770 If omitted or nil, that stands for the selected frame's display.")
4772 Lisp_Object display
;
4774 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4777 switch (dpyinfo
->visual
->class)
4780 result
= intern ("static-gray");
4783 result
= intern ("gray-scale");
4786 result
= intern ("static-color");
4789 result
= intern ("pseudo-color");
4792 result
= intern ("true-color");
4795 result
= intern ("direct-color");
4798 error ("Display has an unknown visual class");
4805 DEFUN ("x-display-save-under", Fx_display_save_under
,
4806 Sx_display_save_under
, 0, 1, 0,
4807 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4808 The optional argument DISPLAY specifies which display to ask about.\n\
4809 DISPLAY should be either a frame or a display name (a string).\n\
4810 If omitted or nil, that stands for the selected frame's display.")
4812 Lisp_Object display
;
4814 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4816 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4824 register struct frame
*f
;
4826 return PIXEL_WIDTH (f
);
4831 register struct frame
*f
;
4833 return PIXEL_HEIGHT (f
);
4838 register struct frame
*f
;
4840 return FONT_WIDTH (f
->output_data
.x
->font
);
4845 register struct frame
*f
;
4847 return f
->output_data
.x
->line_height
;
4852 register struct frame
*f
;
4854 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4859 /************************************************************************
4861 ************************************************************************/
4864 /* Mapping visual names to visuals. */
4866 static struct visual_class
4873 {"StaticGray", StaticGray
},
4874 {"GrayScale", GrayScale
},
4875 {"StaticColor", StaticColor
},
4876 {"PseudoColor", PseudoColor
},
4877 {"TrueColor", TrueColor
},
4878 {"DirectColor", DirectColor
},
4883 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4885 /* Value is the screen number of screen SCR. This is a substitute for
4886 the X function with the same name when that doesn't exist. */
4889 XScreenNumberOfScreen (scr
)
4890 register Screen
*scr
;
4892 Display
*dpy
= scr
->display
;
4895 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4896 if (scr
== dpy
->screens
[i
])
4902 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4905 /* Select the visual that should be used on display DPYINFO. Set
4906 members of DPYINFO appropriately. Called from x_term_init. */
4909 select_visual (dpyinfo
)
4910 struct x_display_info
*dpyinfo
;
4912 Display
*dpy
= dpyinfo
->display
;
4913 Screen
*screen
= dpyinfo
->screen
;
4916 /* See if a visual is specified. */
4917 value
= display_x_get_resource (dpyinfo
,
4918 build_string ("visualClass"),
4919 build_string ("VisualClass"),
4921 if (STRINGP (value
))
4923 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4924 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4925 depth, a decimal number. NAME is compared with case ignored. */
4926 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4931 strcpy (s
, XSTRING (value
)->data
);
4932 dash
= index (s
, '-');
4935 dpyinfo
->n_planes
= atoi (dash
+ 1);
4939 /* We won't find a matching visual with depth 0, so that
4940 an error will be printed below. */
4941 dpyinfo
->n_planes
= 0;
4943 /* Determine the visual class. */
4944 for (i
= 0; visual_classes
[i
].name
; ++i
)
4945 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4947 class = visual_classes
[i
].class;
4951 /* Look up a matching visual for the specified class. */
4953 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4954 dpyinfo
->n_planes
, class, &vinfo
))
4955 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4957 dpyinfo
->visual
= vinfo
.visual
;
4962 XVisualInfo
*vinfo
, vinfo_template
;
4964 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
4967 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
4969 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
4971 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4972 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
4973 &vinfo_template
, &n_visuals
);
4975 fatal ("Can't get proper X visual info");
4977 dpyinfo
->n_planes
= vinfo
->depth
;
4978 XFree ((char *) vinfo
);
4983 /* Return the X display structure for the display named NAME.
4984 Open a new connection if necessary. */
4986 struct x_display_info
*
4987 x_display_info_for_name (name
)
4991 struct x_display_info
*dpyinfo
;
4993 CHECK_STRING (name
, 0);
4995 if (! EQ (Vwindow_system
, intern ("x")))
4996 error ("Not using X Windows");
4998 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5000 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5003 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5008 /* Use this general default value to start with. */
5009 Vx_resource_name
= Vinvocation_name
;
5011 validate_x_resource_name ();
5013 dpyinfo
= x_term_init (name
, (char *)0,
5014 (char *) XSTRING (Vx_resource_name
)->data
);
5017 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5020 XSETFASTINT (Vwindow_system_version
, 11);
5026 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5027 1, 3, 0, "Open a connection to an X server.\n\
5028 DISPLAY is the name of the display to connect to.\n\
5029 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5030 If the optional third arg MUST-SUCCEED is non-nil,\n\
5031 terminate Emacs if we can't open the connection.")
5032 (display
, xrm_string
, must_succeed
)
5033 Lisp_Object display
, xrm_string
, must_succeed
;
5035 unsigned char *xrm_option
;
5036 struct x_display_info
*dpyinfo
;
5038 CHECK_STRING (display
, 0);
5039 if (! NILP (xrm_string
))
5040 CHECK_STRING (xrm_string
, 1);
5042 if (! EQ (Vwindow_system
, intern ("x")))
5043 error ("Not using X Windows");
5045 if (! NILP (xrm_string
))
5046 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5048 xrm_option
= (unsigned char *) 0;
5050 validate_x_resource_name ();
5052 /* This is what opens the connection and sets x_current_display.
5053 This also initializes many symbols, such as those used for input. */
5054 dpyinfo
= x_term_init (display
, xrm_option
,
5055 (char *) XSTRING (Vx_resource_name
)->data
);
5059 if (!NILP (must_succeed
))
5060 fatal ("Cannot connect to X server %s.\n\
5061 Check the DISPLAY environment variable or use `-d'.\n\
5062 Also use the `xhost' program to verify that it is set to permit\n\
5063 connections from your machine.\n",
5064 XSTRING (display
)->data
);
5066 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5071 XSETFASTINT (Vwindow_system_version
, 11);
5075 DEFUN ("x-close-connection", Fx_close_connection
,
5076 Sx_close_connection
, 1, 1, 0,
5077 "Close the connection to DISPLAY's X server.\n\
5078 For DISPLAY, specify either a frame or a display name (a string).\n\
5079 If DISPLAY is nil, that stands for the selected frame's display.")
5081 Lisp_Object display
;
5083 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5086 if (dpyinfo
->reference_count
> 0)
5087 error ("Display still has frames on it");
5090 /* Free the fonts in the font table. */
5091 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5092 if (dpyinfo
->font_table
[i
].name
)
5094 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5095 xfree (dpyinfo
->font_table
[i
].full_name
);
5096 xfree (dpyinfo
->font_table
[i
].name
);
5097 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5100 x_destroy_all_bitmaps (dpyinfo
);
5101 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5103 #ifdef USE_X_TOOLKIT
5104 XtCloseDisplay (dpyinfo
->display
);
5106 XCloseDisplay (dpyinfo
->display
);
5109 x_delete_display (dpyinfo
);
5115 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5116 "Return the list of display names that Emacs has connections to.")
5119 Lisp_Object tail
, result
;
5122 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5123 result
= Fcons (XCAR (XCAR (tail
)), result
);
5128 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5129 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5130 If ON is nil, allow buffering of requests.\n\
5131 Turning on synchronization prohibits the Xlib routines from buffering\n\
5132 requests and seriously degrades performance, but makes debugging much\n\
5134 The optional second argument DISPLAY specifies which display to act on.\n\
5135 DISPLAY should be either a frame or a display name (a string).\n\
5136 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5138 Lisp_Object display
, on
;
5140 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5142 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5147 /* Wait for responses to all X commands issued so far for frame F. */
5154 XSync (FRAME_X_DISPLAY (f
), False
);
5159 /***********************************************************************
5161 ***********************************************************************/
5163 /* Value is the number of elements of vector VECTOR. */
5165 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5167 /* List of supported image types. Use define_image_type to add new
5168 types. Use lookup_image_type to find a type for a given symbol. */
5170 static struct image_type
*image_types
;
5172 /* The symbol `image' which is the car of the lists used to represent
5175 extern Lisp_Object Qimage
;
5177 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5183 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5184 extern Lisp_Object QCdata
;
5185 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5186 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5187 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5189 /* Other symbols. */
5191 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5193 /* Time in seconds after which images should be removed from the cache
5194 if not displayed. */
5196 Lisp_Object Vimage_cache_eviction_delay
;
5198 /* Function prototypes. */
5200 static void define_image_type
P_ ((struct image_type
*type
));
5201 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5202 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5203 static void x_laplace
P_ ((struct frame
*, struct image
*));
5204 static void x_emboss
P_ ((struct frame
*, struct image
*));
5205 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5209 /* Define a new image type from TYPE. This adds a copy of TYPE to
5210 image_types and adds the symbol *TYPE->type to Vimage_types. */
5213 define_image_type (type
)
5214 struct image_type
*type
;
5216 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5217 The initialized data segment is read-only. */
5218 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5219 bcopy (type
, p
, sizeof *p
);
5220 p
->next
= image_types
;
5222 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5226 /* Look up image type SYMBOL, and return a pointer to its image_type
5227 structure. Value is null if SYMBOL is not a known image type. */
5229 static INLINE
struct image_type
*
5230 lookup_image_type (symbol
)
5233 struct image_type
*type
;
5235 for (type
= image_types
; type
; type
= type
->next
)
5236 if (EQ (symbol
, *type
->type
))
5243 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5244 valid image specification is a list whose car is the symbol
5245 `image', and whose rest is a property list. The property list must
5246 contain a value for key `:type'. That value must be the name of a
5247 supported image type. The rest of the property list depends on the
5251 valid_image_p (object
)
5256 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5258 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5259 struct image_type
*type
= lookup_image_type (symbol
);
5262 valid_p
= type
->valid_p (object
);
5269 /* Log error message with format string FORMAT and argument ARG.
5270 Signaling an error, e.g. when an image cannot be loaded, is not a
5271 good idea because this would interrupt redisplay, and the error
5272 message display would lead to another redisplay. This function
5273 therefore simply displays a message. */
5276 image_error (format
, arg1
, arg2
)
5278 Lisp_Object arg1
, arg2
;
5280 add_to_log (format
, arg1
, arg2
);
5285 /***********************************************************************
5286 Image specifications
5287 ***********************************************************************/
5289 enum image_value_type
5291 IMAGE_DONT_CHECK_VALUE_TYPE
,
5294 IMAGE_POSITIVE_INTEGER_VALUE
,
5295 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5296 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5298 IMAGE_INTEGER_VALUE
,
5299 IMAGE_FUNCTION_VALUE
,
5304 /* Structure used when parsing image specifications. */
5306 struct image_keyword
5308 /* Name of keyword. */
5311 /* The type of value allowed. */
5312 enum image_value_type type
;
5314 /* Non-zero means key must be present. */
5317 /* Used to recognize duplicate keywords in a property list. */
5320 /* The value that was found. */
5325 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5327 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5330 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5331 has the format (image KEYWORD VALUE ...). One of the keyword/
5332 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5333 image_keywords structures of size NKEYWORDS describing other
5334 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5337 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5339 struct image_keyword
*keywords
;
5346 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5349 plist
= XCDR (spec
);
5350 while (CONSP (plist
))
5352 Lisp_Object key
, value
;
5354 /* First element of a pair must be a symbol. */
5356 plist
= XCDR (plist
);
5360 /* There must follow a value. */
5363 value
= XCAR (plist
);
5364 plist
= XCDR (plist
);
5366 /* Find key in KEYWORDS. Error if not found. */
5367 for (i
= 0; i
< nkeywords
; ++i
)
5368 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5374 /* Record that we recognized the keyword. If a keywords
5375 was found more than once, it's an error. */
5376 keywords
[i
].value
= value
;
5377 ++keywords
[i
].count
;
5379 if (keywords
[i
].count
> 1)
5382 /* Check type of value against allowed type. */
5383 switch (keywords
[i
].type
)
5385 case IMAGE_STRING_VALUE
:
5386 if (!STRINGP (value
))
5390 case IMAGE_SYMBOL_VALUE
:
5391 if (!SYMBOLP (value
))
5395 case IMAGE_POSITIVE_INTEGER_VALUE
:
5396 if (!INTEGERP (value
) || XINT (value
) <= 0)
5400 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5401 if (INTEGERP (value
) && XINT (value
) >= 0)
5404 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5405 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5409 case IMAGE_ASCENT_VALUE
:
5410 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5412 else if (INTEGERP (value
)
5413 && XINT (value
) >= 0
5414 && XINT (value
) <= 100)
5418 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5419 if (!INTEGERP (value
) || XINT (value
) < 0)
5423 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5426 case IMAGE_FUNCTION_VALUE
:
5427 value
= indirect_function (value
);
5429 || COMPILEDP (value
)
5430 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5434 case IMAGE_NUMBER_VALUE
:
5435 if (!INTEGERP (value
) && !FLOATP (value
))
5439 case IMAGE_INTEGER_VALUE
:
5440 if (!INTEGERP (value
))
5444 case IMAGE_BOOL_VALUE
:
5445 if (!NILP (value
) && !EQ (value
, Qt
))
5454 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5458 /* Check that all mandatory fields are present. */
5459 for (i
= 0; i
< nkeywords
; ++i
)
5460 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5463 return NILP (plist
);
5467 /* Return the value of KEY in image specification SPEC. Value is nil
5468 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5469 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5472 image_spec_value (spec
, key
, found
)
5473 Lisp_Object spec
, key
;
5478 xassert (valid_image_p (spec
));
5480 for (tail
= XCDR (spec
);
5481 CONSP (tail
) && CONSP (XCDR (tail
));
5482 tail
= XCDR (XCDR (tail
)))
5484 if (EQ (XCAR (tail
), key
))
5488 return XCAR (XCDR (tail
));
5498 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5499 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5500 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5501 size in canonical character units.\n\
5502 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5503 or omitted means use the selected frame.")
5504 (spec
, pixels
, frame
)
5505 Lisp_Object spec
, pixels
, frame
;
5510 if (valid_image_p (spec
))
5512 struct frame
*f
= check_x_frame (frame
);
5513 int id
= lookup_image (f
, spec
);
5514 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5515 int width
= img
->width
+ 2 * img
->hmargin
;
5516 int height
= img
->height
+ 2 * img
->vmargin
;
5519 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5520 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5522 size
= Fcons (make_number (width
), make_number (height
));
5525 error ("Invalid image specification");
5531 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5532 "Return t if image SPEC has a mask bitmap.\n\
5533 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5534 or omitted means use the selected frame.")
5536 Lisp_Object spec
, frame
;
5541 if (valid_image_p (spec
))
5543 struct frame
*f
= check_x_frame (frame
);
5544 int id
= lookup_image (f
, spec
);
5545 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5550 error ("Invalid image specification");
5557 /***********************************************************************
5558 Image type independent image structures
5559 ***********************************************************************/
5561 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5562 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5565 /* Allocate and return a new image structure for image specification
5566 SPEC. SPEC has a hash value of HASH. */
5568 static struct image
*
5569 make_image (spec
, hash
)
5573 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5575 xassert (valid_image_p (spec
));
5576 bzero (img
, sizeof *img
);
5577 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5578 xassert (img
->type
!= NULL
);
5580 img
->data
.lisp_val
= Qnil
;
5581 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5587 /* Free image IMG which was used on frame F, including its resources. */
5596 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5598 /* Remove IMG from the hash table of its cache. */
5600 img
->prev
->next
= img
->next
;
5602 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5605 img
->next
->prev
= img
->prev
;
5607 c
->images
[img
->id
] = NULL
;
5609 /* Free resources, then free IMG. */
5610 img
->type
->free (f
, img
);
5616 /* Prepare image IMG for display on frame F. Must be called before
5617 drawing an image. */
5620 prepare_image_for_display (f
, img
)
5626 /* We're about to display IMG, so set its timestamp to `now'. */
5628 img
->timestamp
= EMACS_SECS (t
);
5630 /* If IMG doesn't have a pixmap yet, load it now, using the image
5631 type dependent loader function. */
5632 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5633 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5637 /* Value is the number of pixels for the ascent of image IMG when
5638 drawn in face FACE. */
5641 image_ascent (img
, face
)
5645 int height
= img
->height
+ img
->vmargin
;
5648 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5651 /* This expression is arranged so that if the image can't be
5652 exactly centered, it will be moved slightly up. This is
5653 because a typical font is `top-heavy' (due to the presence
5654 uppercase letters), so the image placement should err towards
5655 being top-heavy too. It also just generally looks better. */
5656 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5658 ascent
= height
/ 2;
5661 ascent
= height
* img
->ascent
/ 100.0;
5668 /***********************************************************************
5669 Helper functions for X image types
5670 ***********************************************************************/
5672 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5674 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5675 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5677 Lisp_Object color_name
,
5678 unsigned long dflt
));
5681 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5682 free the pixmap if any. MASK_P non-zero means clear the mask
5683 pixmap if any. COLORS_P non-zero means free colors allocated for
5684 the image, if any. */
5687 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5690 int pixmap_p
, mask_p
, colors_p
;
5692 if (pixmap_p
&& img
->pixmap
)
5694 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5698 if (mask_p
&& img
->mask
)
5700 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5704 if (colors_p
&& img
->ncolors
)
5706 x_free_colors (f
, img
->colors
, img
->ncolors
);
5707 xfree (img
->colors
);
5713 /* Free X resources of image IMG which is used on frame F. */
5716 x_clear_image (f
, img
)
5721 x_clear_image_1 (f
, img
, 1, 1, 1);
5726 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5727 cannot be allocated, use DFLT. Add a newly allocated color to
5728 IMG->colors, so that it can be freed again. Value is the pixel
5731 static unsigned long
5732 x_alloc_image_color (f
, img
, color_name
, dflt
)
5735 Lisp_Object color_name
;
5739 unsigned long result
;
5741 xassert (STRINGP (color_name
));
5743 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5745 /* This isn't called frequently so we get away with simply
5746 reallocating the color vector to the needed size, here. */
5749 (unsigned long *) xrealloc (img
->colors
,
5750 img
->ncolors
* sizeof *img
->colors
);
5751 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5752 result
= color
.pixel
;
5762 /***********************************************************************
5764 ***********************************************************************/
5766 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5769 /* Return a new, initialized image cache that is allocated from the
5770 heap. Call free_image_cache to free an image cache. */
5772 struct image_cache
*
5775 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5778 bzero (c
, sizeof *c
);
5780 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5781 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5782 c
->buckets
= (struct image
**) xmalloc (size
);
5783 bzero (c
->buckets
, size
);
5788 /* Free image cache of frame F. Be aware that X frames share images
5792 free_image_cache (f
)
5795 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5800 /* Cache should not be referenced by any frame when freed. */
5801 xassert (c
->refcount
== 0);
5803 for (i
= 0; i
< c
->used
; ++i
)
5804 free_image (f
, c
->images
[i
]);
5808 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5813 /* Clear image cache of frame F. FORCE_P non-zero means free all
5814 images. FORCE_P zero means clear only images that haven't been
5815 displayed for some time. Should be called from time to time to
5816 reduce the number of loaded images. If image-eviction-seconds is
5817 non-nil, this frees images in the cache which weren't displayed for
5818 at least that many seconds. */
5821 clear_image_cache (f
, force_p
)
5825 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5827 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5834 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5836 /* Block input so that we won't be interrupted by a SIGIO
5837 while being in an inconsistent state. */
5840 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5842 struct image
*img
= c
->images
[i
];
5844 && (force_p
|| img
->timestamp
< old
))
5846 free_image (f
, img
);
5851 /* We may be clearing the image cache because, for example,
5852 Emacs was iconified for a longer period of time. In that
5853 case, current matrices may still contain references to
5854 images freed above. So, clear these matrices. */
5857 Lisp_Object tail
, frame
;
5859 FOR_EACH_FRAME (tail
, frame
)
5861 struct frame
*f
= XFRAME (frame
);
5863 && FRAME_X_IMAGE_CACHE (f
) == c
)
5864 clear_current_matrices (f
);
5867 ++windows_or_buffers_changed
;
5875 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5877 "Clear the image cache of FRAME.\n\
5878 FRAME nil or omitted means use the selected frame.\n\
5879 FRAME t means clear the image caches of all frames.")
5887 FOR_EACH_FRAME (tail
, frame
)
5888 if (FRAME_X_P (XFRAME (frame
)))
5889 clear_image_cache (XFRAME (frame
), 1);
5892 clear_image_cache (check_x_frame (frame
), 1);
5898 /* Return the id of image with Lisp specification SPEC on frame F.
5899 SPEC must be a valid Lisp image specification (see valid_image_p). */
5902 lookup_image (f
, spec
)
5906 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5910 struct gcpro gcpro1
;
5913 /* F must be a window-system frame, and SPEC must be a valid image
5915 xassert (FRAME_WINDOW_P (f
));
5916 xassert (valid_image_p (spec
));
5920 /* Look up SPEC in the hash table of the image cache. */
5921 hash
= sxhash (spec
, 0);
5922 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5924 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
5925 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
5928 /* If not found, create a new image and cache it. */
5932 img
= make_image (spec
, hash
);
5933 cache_image (f
, img
);
5934 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5936 /* If we can't load the image, and we don't have a width and
5937 height, use some arbitrary width and height so that we can
5938 draw a rectangle for it. */
5939 if (img
->load_failed_p
)
5943 value
= image_spec_value (spec
, QCwidth
, NULL
);
5944 img
->width
= (INTEGERP (value
)
5945 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
5946 value
= image_spec_value (spec
, QCheight
, NULL
);
5947 img
->height
= (INTEGERP (value
)
5948 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
5952 /* Handle image type independent image attributes
5953 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
5954 Lisp_Object ascent
, margin
, relief
;
5956 ascent
= image_spec_value (spec
, QCascent
, NULL
);
5957 if (INTEGERP (ascent
))
5958 img
->ascent
= XFASTINT (ascent
);
5959 else if (EQ (ascent
, Qcenter
))
5960 img
->ascent
= CENTERED_IMAGE_ASCENT
;
5962 margin
= image_spec_value (spec
, QCmargin
, NULL
);
5963 if (INTEGERP (margin
) && XINT (margin
) >= 0)
5964 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
5965 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
5966 && INTEGERP (XCDR (margin
)))
5968 if (XINT (XCAR (margin
)) > 0)
5969 img
->hmargin
= XFASTINT (XCAR (margin
));
5970 if (XINT (XCDR (margin
)) > 0)
5971 img
->vmargin
= XFASTINT (XCDR (margin
));
5974 relief
= image_spec_value (spec
, QCrelief
, NULL
);
5975 if (INTEGERP (relief
))
5977 img
->relief
= XINT (relief
);
5978 img
->hmargin
+= abs (img
->relief
);
5979 img
->vmargin
+= abs (img
->relief
);
5982 /* Manipulation of the image's mask. */
5985 /* `:heuristic-mask t'
5987 means build a mask heuristically.
5988 `:heuristic-mask (R G B)'
5989 `:mask (heuristic (R G B))'
5990 means build a mask from color (R G B) in the
5993 means remove a mask, if any. */
5997 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
5999 x_build_heuristic_mask (f
, img
, mask
);
6004 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6006 if (EQ (mask
, Qheuristic
))
6007 x_build_heuristic_mask (f
, img
, Qt
);
6008 else if (CONSP (mask
)
6009 && EQ (XCAR (mask
), Qheuristic
))
6011 if (CONSP (XCDR (mask
)))
6012 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6014 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6016 else if (NILP (mask
) && found_p
&& img
->mask
)
6018 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6024 /* Should we apply an image transformation algorithm? */
6027 Lisp_Object conversion
;
6029 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6030 if (EQ (conversion
, Qdisabled
))
6031 x_disable_image (f
, img
);
6032 else if (EQ (conversion
, Qlaplace
))
6034 else if (EQ (conversion
, Qemboss
))
6036 else if (CONSP (conversion
)
6037 && EQ (XCAR (conversion
), Qedge_detection
))
6040 tem
= XCDR (conversion
);
6042 x_edge_detection (f
, img
,
6043 Fplist_get (tem
, QCmatrix
),
6044 Fplist_get (tem
, QCcolor_adjustment
));
6050 xassert (!interrupt_input_blocked
);
6053 /* We're using IMG, so set its timestamp to `now'. */
6054 EMACS_GET_TIME (now
);
6055 img
->timestamp
= EMACS_SECS (now
);
6059 /* Value is the image id. */
6064 /* Cache image IMG in the image cache of frame F. */
6067 cache_image (f
, img
)
6071 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6074 /* Find a free slot in c->images. */
6075 for (i
= 0; i
< c
->used
; ++i
)
6076 if (c
->images
[i
] == NULL
)
6079 /* If no free slot found, maybe enlarge c->images. */
6080 if (i
== c
->used
&& c
->used
== c
->size
)
6083 c
->images
= (struct image
**) xrealloc (c
->images
,
6084 c
->size
* sizeof *c
->images
);
6087 /* Add IMG to c->images, and assign IMG an id. */
6093 /* Add IMG to the cache's hash table. */
6094 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6095 img
->next
= c
->buckets
[i
];
6097 img
->next
->prev
= img
;
6099 c
->buckets
[i
] = img
;
6103 /* Call FN on every image in the image cache of frame F. Used to mark
6104 Lisp Objects in the image cache. */
6107 forall_images_in_image_cache (f
, fn
)
6109 void (*fn
) P_ ((struct image
*img
));
6111 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6113 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6117 for (i
= 0; i
< c
->used
; ++i
)
6126 /***********************************************************************
6128 ***********************************************************************/
6130 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6131 XImage
**, Pixmap
*));
6132 static void x_destroy_x_image
P_ ((XImage
*));
6133 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6136 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6137 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6138 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6139 via xmalloc. Print error messages via image_error if an error
6140 occurs. Value is non-zero if successful. */
6143 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6145 int width
, height
, depth
;
6149 Display
*display
= FRAME_X_DISPLAY (f
);
6150 Screen
*screen
= FRAME_X_SCREEN (f
);
6151 Window window
= FRAME_X_WINDOW (f
);
6153 xassert (interrupt_input_blocked
);
6156 depth
= DefaultDepthOfScreen (screen
);
6157 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6158 depth
, ZPixmap
, 0, NULL
, width
, height
,
6159 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6162 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6166 /* Allocate image raster. */
6167 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6169 /* Allocate a pixmap of the same size. */
6170 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6171 if (*pixmap
== None
)
6173 x_destroy_x_image (*ximg
);
6175 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6183 /* Destroy XImage XIMG. Free XIMG->data. */
6186 x_destroy_x_image (ximg
)
6189 xassert (interrupt_input_blocked
);
6194 XDestroyImage (ximg
);
6199 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6200 are width and height of both the image and pixmap. */
6203 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6210 xassert (interrupt_input_blocked
);
6211 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6212 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6213 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6218 /***********************************************************************
6220 ***********************************************************************/
6222 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6223 static char *slurp_file
P_ ((char *, int *));
6226 /* Find image file FILE. Look in data-directory, then
6227 x-bitmap-file-path. Value is the full name of the file found, or
6228 nil if not found. */
6231 x_find_image_file (file
)
6234 Lisp_Object file_found
, search_path
;
6235 struct gcpro gcpro1
, gcpro2
;
6239 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6240 GCPRO2 (file_found
, search_path
);
6242 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6243 fd
= openp (search_path
, file
, "", &file_found
, 0);
6255 /* Read FILE into memory. Value is a pointer to a buffer allocated
6256 with xmalloc holding FILE's contents. Value is null if an error
6257 occurred. *SIZE is set to the size of the file. */
6260 slurp_file (file
, size
)
6268 if (stat (file
, &st
) == 0
6269 && (fp
= fopen (file
, "r")) != NULL
6270 && (buf
= (char *) xmalloc (st
.st_size
),
6271 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6292 /***********************************************************************
6294 ***********************************************************************/
6296 static int xbm_scan
P_ ((char **, char *, char *, int *));
6297 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6298 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6300 static int xbm_image_p
P_ ((Lisp_Object object
));
6301 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6303 static int xbm_file_p
P_ ((Lisp_Object
));
6306 /* Indices of image specification fields in xbm_format, below. */
6308 enum xbm_keyword_index
6326 /* Vector of image_keyword structures describing the format
6327 of valid XBM image specifications. */
6329 static struct image_keyword xbm_format
[XBM_LAST
] =
6331 {":type", IMAGE_SYMBOL_VALUE
, 1},
6332 {":file", IMAGE_STRING_VALUE
, 0},
6333 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6334 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6335 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6336 {":foreground", IMAGE_STRING_VALUE
, 0},
6337 {":background", IMAGE_STRING_VALUE
, 0},
6338 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6339 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6340 {":relief", IMAGE_INTEGER_VALUE
, 0},
6341 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6342 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6343 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6346 /* Structure describing the image type XBM. */
6348 static struct image_type xbm_type
=
6357 /* Tokens returned from xbm_scan. */
6366 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6367 A valid specification is a list starting with the symbol `image'
6368 The rest of the list is a property list which must contain an
6371 If the specification specifies a file to load, it must contain
6372 an entry `:file FILENAME' where FILENAME is a string.
6374 If the specification is for a bitmap loaded from memory it must
6375 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6376 WIDTH and HEIGHT are integers > 0. DATA may be:
6378 1. a string large enough to hold the bitmap data, i.e. it must
6379 have a size >= (WIDTH + 7) / 8 * HEIGHT
6381 2. a bool-vector of size >= WIDTH * HEIGHT
6383 3. a vector of strings or bool-vectors, one for each line of the
6386 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6387 may not be specified in this case because they are defined in the
6390 Both the file and data forms may contain the additional entries
6391 `:background COLOR' and `:foreground COLOR'. If not present,
6392 foreground and background of the frame on which the image is
6393 displayed is used. */
6396 xbm_image_p (object
)
6399 struct image_keyword kw
[XBM_LAST
];
6401 bcopy (xbm_format
, kw
, sizeof kw
);
6402 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6405 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6407 if (kw
[XBM_FILE
].count
)
6409 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6412 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6414 /* In-memory XBM file. */
6415 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6423 /* Entries for `:width', `:height' and `:data' must be present. */
6424 if (!kw
[XBM_WIDTH
].count
6425 || !kw
[XBM_HEIGHT
].count
6426 || !kw
[XBM_DATA
].count
)
6429 data
= kw
[XBM_DATA
].value
;
6430 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6431 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6433 /* Check type of data, and width and height against contents of
6439 /* Number of elements of the vector must be >= height. */
6440 if (XVECTOR (data
)->size
< height
)
6443 /* Each string or bool-vector in data must be large enough
6444 for one line of the image. */
6445 for (i
= 0; i
< height
; ++i
)
6447 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6451 if (XSTRING (elt
)->size
6452 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6455 else if (BOOL_VECTOR_P (elt
))
6457 if (XBOOL_VECTOR (elt
)->size
< width
)
6464 else if (STRINGP (data
))
6466 if (XSTRING (data
)->size
6467 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6470 else if (BOOL_VECTOR_P (data
))
6472 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6483 /* Scan a bitmap file. FP is the stream to read from. Value is
6484 either an enumerator from enum xbm_token, or a character for a
6485 single-character token, or 0 at end of file. If scanning an
6486 identifier, store the lexeme of the identifier in SVAL. If
6487 scanning a number, store its value in *IVAL. */
6490 xbm_scan (s
, end
, sval
, ival
)
6499 /* Skip white space. */
6500 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6505 else if (isdigit (c
))
6507 int value
= 0, digit
;
6509 if (c
== '0' && *s
< end
)
6512 if (c
== 'x' || c
== 'X')
6519 else if (c
>= 'a' && c
<= 'f')
6520 digit
= c
- 'a' + 10;
6521 else if (c
>= 'A' && c
<= 'F')
6522 digit
= c
- 'A' + 10;
6525 value
= 16 * value
+ digit
;
6528 else if (isdigit (c
))
6532 && (c
= *(*s
)++, isdigit (c
)))
6533 value
= 8 * value
+ c
- '0';
6540 && (c
= *(*s
)++, isdigit (c
)))
6541 value
= 10 * value
+ c
- '0';
6549 else if (isalpha (c
) || c
== '_')
6553 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6560 else if (c
== '/' && **s
== '*')
6562 /* C-style comment. */
6564 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6577 /* Replacement for XReadBitmapFileData which isn't available under old
6578 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6579 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6580 the image. Return in *DATA the bitmap data allocated with xmalloc.
6581 Value is non-zero if successful. DATA null means just test if
6582 CONTENTS looks like an in-memory XBM file. */
6585 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6586 char *contents
, *end
;
6587 int *width
, *height
;
6588 unsigned char **data
;
6591 char buffer
[BUFSIZ
];
6594 int bytes_per_line
, i
, nbytes
;
6600 LA1 = xbm_scan (&s, end, buffer, &value)
6602 #define expect(TOKEN) \
6603 if (LA1 != (TOKEN)) \
6608 #define expect_ident(IDENT) \
6609 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6614 *width
= *height
= -1;
6617 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6619 /* Parse defines for width, height and hot-spots. */
6623 expect_ident ("define");
6624 expect (XBM_TK_IDENT
);
6626 if (LA1
== XBM_TK_NUMBER
);
6628 char *p
= strrchr (buffer
, '_');
6629 p
= p
? p
+ 1 : buffer
;
6630 if (strcmp (p
, "width") == 0)
6632 else if (strcmp (p
, "height") == 0)
6635 expect (XBM_TK_NUMBER
);
6638 if (*width
< 0 || *height
< 0)
6640 else if (data
== NULL
)
6643 /* Parse bits. Must start with `static'. */
6644 expect_ident ("static");
6645 if (LA1
== XBM_TK_IDENT
)
6647 if (strcmp (buffer
, "unsigned") == 0)
6650 expect_ident ("char");
6652 else if (strcmp (buffer
, "short") == 0)
6656 if (*width
% 16 && *width
% 16 < 9)
6659 else if (strcmp (buffer
, "char") == 0)
6667 expect (XBM_TK_IDENT
);
6673 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6674 nbytes
= bytes_per_line
* *height
;
6675 p
= *data
= (char *) xmalloc (nbytes
);
6679 for (i
= 0; i
< nbytes
; i
+= 2)
6682 expect (XBM_TK_NUMBER
);
6685 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6688 if (LA1
== ',' || LA1
== '}')
6696 for (i
= 0; i
< nbytes
; ++i
)
6699 expect (XBM_TK_NUMBER
);
6703 if (LA1
== ',' || LA1
== '}')
6728 /* Load XBM image IMG which will be displayed on frame F from buffer
6729 CONTENTS. END is the end of the buffer. Value is non-zero if
6733 xbm_load_image (f
, img
, contents
, end
)
6736 char *contents
, *end
;
6739 unsigned char *data
;
6742 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6745 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6746 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6747 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6750 xassert (img
->width
> 0 && img
->height
> 0);
6752 /* Get foreground and background colors, maybe allocate colors. */
6753 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6755 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6757 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6759 background
= x_alloc_image_color (f
, img
, value
, background
);
6762 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6765 img
->width
, img
->height
,
6766 foreground
, background
,
6770 if (img
->pixmap
== None
)
6772 x_clear_image (f
, img
);
6773 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6779 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6785 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6792 return (STRINGP (data
)
6793 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6794 (XSTRING (data
)->data
6795 + STRING_BYTES (XSTRING (data
))),
6800 /* Fill image IMG which is used on frame F with pixmap data. Value is
6801 non-zero if successful. */
6809 Lisp_Object file_name
;
6811 xassert (xbm_image_p (img
->spec
));
6813 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6814 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6815 if (STRINGP (file_name
))
6820 struct gcpro gcpro1
;
6822 file
= x_find_image_file (file_name
);
6824 if (!STRINGP (file
))
6826 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6831 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6832 if (contents
== NULL
)
6834 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6839 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6844 struct image_keyword fmt
[XBM_LAST
];
6847 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6848 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6851 int in_memory_file_p
= 0;
6853 /* See if data looks like an in-memory XBM file. */
6854 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6855 in_memory_file_p
= xbm_file_p (data
);
6857 /* Parse the image specification. */
6858 bcopy (xbm_format
, fmt
, sizeof fmt
);
6859 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6862 /* Get specified width, and height. */
6863 if (!in_memory_file_p
)
6865 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6866 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6867 xassert (img
->width
> 0 && img
->height
> 0);
6870 /* Get foreground and background colors, maybe allocate colors. */
6871 if (fmt
[XBM_FOREGROUND
].count
)
6872 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6874 if (fmt
[XBM_BACKGROUND
].count
)
6875 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6878 if (in_memory_file_p
)
6879 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6880 (XSTRING (data
)->data
6881 + STRING_BYTES (XSTRING (data
))));
6888 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6890 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6891 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6893 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6895 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6897 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6900 else if (STRINGP (data
))
6901 bits
= XSTRING (data
)->data
;
6903 bits
= XBOOL_VECTOR (data
)->data
;
6905 /* Create the pixmap. */
6906 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6908 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6911 img
->width
, img
->height
,
6912 foreground
, background
,
6918 image_error ("Unable to create pixmap for XBM image `%s'",
6920 x_clear_image (f
, img
);
6930 /***********************************************************************
6932 ***********************************************************************/
6936 static int xpm_image_p
P_ ((Lisp_Object object
));
6937 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6938 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6940 #include "X11/xpm.h"
6942 /* The symbol `xpm' identifying XPM-format images. */
6946 /* Indices of image specification fields in xpm_format, below. */
6948 enum xpm_keyword_index
6963 /* Vector of image_keyword structures describing the format
6964 of valid XPM image specifications. */
6966 static struct image_keyword xpm_format
[XPM_LAST
] =
6968 {":type", IMAGE_SYMBOL_VALUE
, 1},
6969 {":file", IMAGE_STRING_VALUE
, 0},
6970 {":data", IMAGE_STRING_VALUE
, 0},
6971 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6972 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6973 {":relief", IMAGE_INTEGER_VALUE
, 0},
6974 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6975 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6976 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6977 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6980 /* Structure describing the image type XBM. */
6982 static struct image_type xpm_type
=
6992 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
6993 functions for allocating image colors. Our own functions handle
6994 color allocation failures more gracefully than the ones on the XPM
6997 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
6998 #define ALLOC_XPM_COLORS
7001 #ifdef ALLOC_XPM_COLORS
7003 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7004 static void xpm_free_color_cache
P_ ((void));
7005 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7006 static int xpm_color_bucket
P_ ((char *));
7007 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7010 /* An entry in a hash table used to cache color definitions of named
7011 colors. This cache is necessary to speed up XPM image loading in
7012 case we do color allocations ourselves. Without it, we would need
7013 a call to XParseColor per pixel in the image. */
7015 struct xpm_cached_color
7017 /* Next in collision chain. */
7018 struct xpm_cached_color
*next
;
7020 /* Color definition (RGB and pixel color). */
7027 /* The hash table used for the color cache, and its bucket vector
7030 #define XPM_COLOR_CACHE_BUCKETS 1001
7031 struct xpm_cached_color
**xpm_color_cache
;
7033 /* Initialize the color cache. */
7036 xpm_init_color_cache (f
, attrs
)
7038 XpmAttributes
*attrs
;
7040 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7041 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7042 memset (xpm_color_cache
, 0, nbytes
);
7043 init_color_table ();
7045 if (attrs
->valuemask
& XpmColorSymbols
)
7050 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7051 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7052 attrs
->colorsymbols
[i
].value
, &color
))
7054 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7056 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7062 /* Free the color cache. */
7065 xpm_free_color_cache ()
7067 struct xpm_cached_color
*p
, *next
;
7070 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7071 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7077 xfree (xpm_color_cache
);
7078 xpm_color_cache
= NULL
;
7079 free_color_table ();
7083 /* Return the bucket index for color named COLOR_NAME in the color
7087 xpm_color_bucket (color_name
)
7093 for (s
= color_name
; *s
; ++s
)
7095 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7099 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7100 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7103 static struct xpm_cached_color
*
7104 xpm_cache_color (f
, color_name
, color
, bucket
)
7111 struct xpm_cached_color
*p
;
7114 bucket
= xpm_color_bucket (color_name
);
7116 nbytes
= sizeof *p
+ strlen (color_name
);
7117 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7118 strcpy (p
->name
, color_name
);
7120 p
->next
= xpm_color_cache
[bucket
];
7121 xpm_color_cache
[bucket
] = p
;
7126 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7127 return the cached definition in *COLOR. Otherwise, make a new
7128 entry in the cache and allocate the color. Value is zero if color
7129 allocation failed. */
7132 xpm_lookup_color (f
, color_name
, color
)
7137 struct xpm_cached_color
*p
;
7138 int h
= xpm_color_bucket (color_name
);
7140 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7141 if (strcmp (p
->name
, color_name
) == 0)
7146 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7149 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7151 p
= xpm_cache_color (f
, color_name
, color
, h
);
7158 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7159 CLOSURE is a pointer to the frame on which we allocate the
7160 color. Return in *COLOR the allocated color. Value is non-zero
7164 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7171 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7175 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7176 is a pointer to the frame on which we allocate the color. Value is
7177 non-zero if successful. */
7180 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7190 #endif /* ALLOC_XPM_COLORS */
7193 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7194 for XPM images. Such a list must consist of conses whose car and
7198 xpm_valid_color_symbols_p (color_symbols
)
7199 Lisp_Object color_symbols
;
7201 while (CONSP (color_symbols
))
7203 Lisp_Object sym
= XCAR (color_symbols
);
7205 || !STRINGP (XCAR (sym
))
7206 || !STRINGP (XCDR (sym
)))
7208 color_symbols
= XCDR (color_symbols
);
7211 return NILP (color_symbols
);
7215 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7218 xpm_image_p (object
)
7221 struct image_keyword fmt
[XPM_LAST
];
7222 bcopy (xpm_format
, fmt
, sizeof fmt
);
7223 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7224 /* Either `:file' or `:data' must be present. */
7225 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7226 /* Either no `:color-symbols' or it's a list of conses
7227 whose car and cdr are strings. */
7228 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7229 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7233 /* Load image IMG which will be displayed on frame F. Value is
7234 non-zero if successful. */
7242 XpmAttributes attrs
;
7243 Lisp_Object specified_file
, color_symbols
;
7245 /* Configure the XPM lib. Use the visual of frame F. Allocate
7246 close colors. Return colors allocated. */
7247 bzero (&attrs
, sizeof attrs
);
7248 attrs
.visual
= FRAME_X_VISUAL (f
);
7249 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7250 attrs
.valuemask
|= XpmVisual
;
7251 attrs
.valuemask
|= XpmColormap
;
7253 #ifdef ALLOC_XPM_COLORS
7254 /* Allocate colors with our own functions which handle
7255 failing color allocation more gracefully. */
7256 attrs
.color_closure
= f
;
7257 attrs
.alloc_color
= xpm_alloc_color
;
7258 attrs
.free_colors
= xpm_free_colors
;
7259 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7260 #else /* not ALLOC_XPM_COLORS */
7261 /* Let the XPM lib allocate colors. */
7262 attrs
.valuemask
|= XpmReturnAllocPixels
;
7263 #ifdef XpmAllocCloseColors
7264 attrs
.alloc_close_colors
= 1;
7265 attrs
.valuemask
|= XpmAllocCloseColors
;
7266 #else /* not XpmAllocCloseColors */
7267 attrs
.closeness
= 600;
7268 attrs
.valuemask
|= XpmCloseness
;
7269 #endif /* not XpmAllocCloseColors */
7270 #endif /* ALLOC_XPM_COLORS */
7272 /* If image specification contains symbolic color definitions, add
7273 these to `attrs'. */
7274 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7275 if (CONSP (color_symbols
))
7278 XpmColorSymbol
*xpm_syms
;
7281 attrs
.valuemask
|= XpmColorSymbols
;
7283 /* Count number of symbols. */
7284 attrs
.numsymbols
= 0;
7285 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7288 /* Allocate an XpmColorSymbol array. */
7289 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7290 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7291 bzero (xpm_syms
, size
);
7292 attrs
.colorsymbols
= xpm_syms
;
7294 /* Fill the color symbol array. */
7295 for (tail
= color_symbols
, i
= 0;
7297 ++i
, tail
= XCDR (tail
))
7299 Lisp_Object name
= XCAR (XCAR (tail
));
7300 Lisp_Object color
= XCDR (XCAR (tail
));
7301 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7302 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7303 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7304 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7308 /* Create a pixmap for the image, either from a file, or from a
7309 string buffer containing data in the same format as an XPM file. */
7310 #ifdef ALLOC_XPM_COLORS
7311 xpm_init_color_cache (f
, &attrs
);
7314 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7315 if (STRINGP (specified_file
))
7317 Lisp_Object file
= x_find_image_file (specified_file
);
7318 if (!STRINGP (file
))
7320 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7324 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7325 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7330 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7331 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7332 XSTRING (buffer
)->data
,
7333 &img
->pixmap
, &img
->mask
,
7337 if (rc
== XpmSuccess
)
7339 #ifdef ALLOC_XPM_COLORS
7340 img
->colors
= colors_in_color_table (&img
->ncolors
);
7341 #else /* not ALLOC_XPM_COLORS */
7344 img
->ncolors
= attrs
.nalloc_pixels
;
7345 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7346 * sizeof *img
->colors
);
7347 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7349 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7350 #ifdef DEBUG_X_COLORS
7351 register_color (img
->colors
[i
]);
7354 #endif /* not ALLOC_XPM_COLORS */
7356 img
->width
= attrs
.width
;
7357 img
->height
= attrs
.height
;
7358 xassert (img
->width
> 0 && img
->height
> 0);
7360 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7361 XpmFreeAttributes (&attrs
);
7368 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7371 case XpmFileInvalid
:
7372 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7376 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7379 case XpmColorFailed
:
7380 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7384 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7389 #ifdef ALLOC_XPM_COLORS
7390 xpm_free_color_cache ();
7392 return rc
== XpmSuccess
;
7395 #endif /* HAVE_XPM != 0 */
7398 /***********************************************************************
7400 ***********************************************************************/
7402 /* An entry in the color table mapping an RGB color to a pixel color. */
7407 unsigned long pixel
;
7409 /* Next in color table collision list. */
7410 struct ct_color
*next
;
7413 /* The bucket vector size to use. Must be prime. */
7417 /* Value is a hash of the RGB color given by R, G, and B. */
7419 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7421 /* The color hash table. */
7423 struct ct_color
**ct_table
;
7425 /* Number of entries in the color table. */
7427 int ct_colors_allocated
;
7429 /* Initialize the color table. */
7434 int size
= CT_SIZE
* sizeof (*ct_table
);
7435 ct_table
= (struct ct_color
**) xmalloc (size
);
7436 bzero (ct_table
, size
);
7437 ct_colors_allocated
= 0;
7441 /* Free memory associated with the color table. */
7447 struct ct_color
*p
, *next
;
7449 for (i
= 0; i
< CT_SIZE
; ++i
)
7450 for (p
= ct_table
[i
]; p
; p
= next
)
7461 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7462 entry for that color already is in the color table, return the
7463 pixel color of that entry. Otherwise, allocate a new color for R,
7464 G, B, and make an entry in the color table. */
7466 static unsigned long
7467 lookup_rgb_color (f
, r
, g
, b
)
7471 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7472 int i
= hash
% CT_SIZE
;
7475 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7476 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7489 cmap
= FRAME_X_COLORMAP (f
);
7490 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7494 ++ct_colors_allocated
;
7496 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7500 p
->pixel
= color
.pixel
;
7501 p
->next
= ct_table
[i
];
7505 return FRAME_FOREGROUND_PIXEL (f
);
7512 /* Look up pixel color PIXEL which is used on frame F in the color
7513 table. If not already present, allocate it. Value is PIXEL. */
7515 static unsigned long
7516 lookup_pixel_color (f
, pixel
)
7518 unsigned long pixel
;
7520 int i
= pixel
% CT_SIZE
;
7523 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7524 if (p
->pixel
== pixel
)
7533 cmap
= FRAME_X_COLORMAP (f
);
7534 color
.pixel
= pixel
;
7535 x_query_color (f
, &color
);
7536 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7540 ++ct_colors_allocated
;
7542 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7547 p
->next
= ct_table
[i
];
7551 return FRAME_FOREGROUND_PIXEL (f
);
7558 /* Value is a vector of all pixel colors contained in the color table,
7559 allocated via xmalloc. Set *N to the number of colors. */
7561 static unsigned long *
7562 colors_in_color_table (n
)
7567 unsigned long *colors
;
7569 if (ct_colors_allocated
== 0)
7576 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7578 *n
= ct_colors_allocated
;
7580 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7581 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7582 colors
[j
++] = p
->pixel
;
7590 /***********************************************************************
7592 ***********************************************************************/
7594 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7595 int, XImage
*, int));
7596 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7597 XColor
*, int, XImage
*, int));
7598 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7599 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7600 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7602 /* Non-zero means draw a cross on images having `:conversion
7605 int cross_disabled_images
;
7607 /* Edge detection matrices for different edge-detection
7610 static int emboss_matrix
[9] = {
7612 2, -1, 0, /* y - 1 */
7614 0, 1, -2 /* y + 1 */
7617 static int laplace_matrix
[9] = {
7619 1, 0, 0, /* y - 1 */
7621 0, 0, -1 /* y + 1 */
7624 /* Value is the intensity of the color whose red/green/blue values
7627 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7630 /* On frame F, return an array of XColor structures describing image
7631 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7632 non-zero means also fill the red/green/blue members of the XColor
7633 structures. Value is a pointer to the array of XColors structures,
7634 allocated with xmalloc; it must be freed by the caller. */
7637 x_to_xcolors (f
, img
, rgb_p
)
7646 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7648 /* Get the X image IMG->pixmap. */
7649 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7650 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7652 /* Fill the `pixel' members of the XColor array. I wished there
7653 were an easy and portable way to circumvent XGetPixel. */
7655 for (y
= 0; y
< img
->height
; ++y
)
7659 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7660 p
->pixel
= XGetPixel (ximg
, x
, y
);
7663 x_query_colors (f
, row
, img
->width
);
7666 XDestroyImage (ximg
);
7671 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7672 RGB members are set. F is the frame on which this all happens.
7673 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7676 x_from_xcolors (f
, img
, colors
)
7686 init_color_table ();
7688 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7691 for (y
= 0; y
< img
->height
; ++y
)
7692 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7694 unsigned long pixel
;
7695 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7696 XPutPixel (oimg
, x
, y
, pixel
);
7700 x_clear_image_1 (f
, img
, 1, 0, 1);
7702 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7703 x_destroy_x_image (oimg
);
7704 img
->pixmap
= pixmap
;
7705 img
->colors
= colors_in_color_table (&img
->ncolors
);
7706 free_color_table ();
7710 /* On frame F, perform edge-detection on image IMG.
7712 MATRIX is a nine-element array specifying the transformation
7713 matrix. See emboss_matrix for an example.
7715 COLOR_ADJUST is a color adjustment added to each pixel of the
7719 x_detect_edges (f
, img
, matrix
, color_adjust
)
7722 int matrix
[9], color_adjust
;
7724 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7728 for (i
= sum
= 0; i
< 9; ++i
)
7729 sum
+= abs (matrix
[i
]);
7731 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7733 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7735 for (y
= 0; y
< img
->height
; ++y
)
7737 p
= COLOR (new, 0, y
);
7738 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7739 p
= COLOR (new, img
->width
- 1, y
);
7740 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7743 for (x
= 1; x
< img
->width
- 1; ++x
)
7745 p
= COLOR (new, x
, 0);
7746 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7747 p
= COLOR (new, x
, img
->height
- 1);
7748 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7751 for (y
= 1; y
< img
->height
- 1; ++y
)
7753 p
= COLOR (new, 1, y
);
7755 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7757 int r
, g
, b
, y1
, x1
;
7760 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7761 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7764 XColor
*t
= COLOR (colors
, x1
, y1
);
7765 r
+= matrix
[i
] * t
->red
;
7766 g
+= matrix
[i
] * t
->green
;
7767 b
+= matrix
[i
] * t
->blue
;
7770 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7771 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7772 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7773 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7778 x_from_xcolors (f
, img
, new);
7784 /* Perform the pre-defined `emboss' edge-detection on image IMG
7792 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7796 /* Perform the pre-defined `laplace' edge-detection on image IMG
7804 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7808 /* Perform edge-detection on image IMG on frame F, with specified
7809 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7811 MATRIX must be either
7813 - a list of at least 9 numbers in row-major form
7814 - a vector of at least 9 numbers
7816 COLOR_ADJUST nil means use a default; otherwise it must be a
7820 x_edge_detection (f
, img
, matrix
, color_adjust
)
7823 Lisp_Object matrix
, color_adjust
;
7831 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7832 ++i
, matrix
= XCDR (matrix
))
7833 trans
[i
] = XFLOATINT (XCAR (matrix
));
7835 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7837 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7838 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7841 if (NILP (color_adjust
))
7842 color_adjust
= make_number (0xffff / 2);
7844 if (i
== 9 && NUMBERP (color_adjust
))
7845 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7849 /* Transform image IMG on frame F so that it looks disabled. */
7852 x_disable_image (f
, img
)
7856 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7858 if (dpyinfo
->n_planes
>= 2)
7860 /* Color (or grayscale). Convert to gray, and equalize. Just
7861 drawing such images with a stipple can look very odd, so
7862 we're using this method instead. */
7863 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7865 const int h
= 15000;
7866 const int l
= 30000;
7868 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7872 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7873 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7874 p
->red
= p
->green
= p
->blue
= i2
;
7877 x_from_xcolors (f
, img
, colors
);
7880 /* Draw a cross over the disabled image, if we must or if we
7882 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
7884 Display
*dpy
= FRAME_X_DISPLAY (f
);
7887 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
7888 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
7889 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
7890 img
->width
- 1, img
->height
- 1);
7891 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
7897 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
7898 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
7899 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
7900 img
->width
- 1, img
->height
- 1);
7901 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
7909 /* Build a mask for image IMG which is used on frame F. FILE is the
7910 name of an image file, for error messages. HOW determines how to
7911 determine the background color of IMG. If it is a list '(R G B)',
7912 with R, G, and B being integers >= 0, take that as the color of the
7913 background. Otherwise, determine the background color of IMG
7914 heuristically. Value is non-zero if successful. */
7917 x_build_heuristic_mask (f
, img
, how
)
7922 Display
*dpy
= FRAME_X_DISPLAY (f
);
7923 XImage
*ximg
, *mask_img
;
7924 int x
, y
, rc
, look_at_corners_p
;
7925 unsigned long bg
= 0;
7929 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
7933 /* Create an image and pixmap serving as mask. */
7934 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7935 &mask_img
, &img
->mask
);
7939 /* Get the X image of IMG->pixmap. */
7940 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7943 /* Determine the background color of ximg. If HOW is `(R G B)'
7944 take that as color. Otherwise, try to determine the color
7946 look_at_corners_p
= 1;
7954 && NATNUMP (XCAR (how
)))
7956 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7960 if (i
== 3 && NILP (how
))
7962 char color_name
[30];
7963 XColor exact
, color
;
7966 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7968 cmap
= FRAME_X_COLORMAP (f
);
7969 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7972 look_at_corners_p
= 0;
7977 if (look_at_corners_p
)
7979 unsigned long corners
[4];
7982 /* Get the colors at the corners of ximg. */
7983 corners
[0] = XGetPixel (ximg
, 0, 0);
7984 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7985 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7986 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7988 /* Choose the most frequently found color as background. */
7989 for (i
= best_count
= 0; i
< 4; ++i
)
7993 for (j
= n
= 0; j
< 4; ++j
)
7994 if (corners
[i
] == corners
[j
])
7998 bg
= corners
[i
], best_count
= n
;
8002 /* Set all bits in mask_img to 1 whose color in ximg is different
8003 from the background color bg. */
8004 for (y
= 0; y
< img
->height
; ++y
)
8005 for (x
= 0; x
< img
->width
; ++x
)
8006 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8008 /* Put mask_img into img->mask. */
8009 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8010 x_destroy_x_image (mask_img
);
8011 XDestroyImage (ximg
);
8018 /***********************************************************************
8019 PBM (mono, gray, color)
8020 ***********************************************************************/
8022 static int pbm_image_p
P_ ((Lisp_Object object
));
8023 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8024 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8026 /* The symbol `pbm' identifying images of this type. */
8030 /* Indices of image specification fields in gs_format, below. */
8032 enum pbm_keyword_index
8048 /* Vector of image_keyword structures describing the format
8049 of valid user-defined image specifications. */
8051 static struct image_keyword pbm_format
[PBM_LAST
] =
8053 {":type", IMAGE_SYMBOL_VALUE
, 1},
8054 {":file", IMAGE_STRING_VALUE
, 0},
8055 {":data", IMAGE_STRING_VALUE
, 0},
8056 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8057 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8058 {":relief", IMAGE_INTEGER_VALUE
, 0},
8059 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8060 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8061 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8062 {":foreground", IMAGE_STRING_VALUE
, 0},
8063 {":background", IMAGE_STRING_VALUE
, 0}
8066 /* Structure describing the image type `pbm'. */
8068 static struct image_type pbm_type
=
8078 /* Return non-zero if OBJECT is a valid PBM image specification. */
8081 pbm_image_p (object
)
8084 struct image_keyword fmt
[PBM_LAST
];
8086 bcopy (pbm_format
, fmt
, sizeof fmt
);
8088 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8091 /* Must specify either :data or :file. */
8092 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8096 /* Scan a decimal number from *S and return it. Advance *S while
8097 reading the number. END is the end of the string. Value is -1 at
8101 pbm_scan_number (s
, end
)
8102 unsigned char **s
, *end
;
8104 int c
= 0, val
= -1;
8108 /* Skip white-space. */
8109 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8114 /* Skip comment to end of line. */
8115 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8118 else if (isdigit (c
))
8120 /* Read decimal number. */
8122 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8123 val
= 10 * val
+ c
- '0';
8134 /* Load PBM image IMG for use on frame F. */
8142 int width
, height
, max_color_idx
= 0;
8144 Lisp_Object file
, specified_file
;
8145 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8146 struct gcpro gcpro1
;
8147 unsigned char *contents
= NULL
;
8148 unsigned char *end
, *p
;
8151 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8155 if (STRINGP (specified_file
))
8157 file
= x_find_image_file (specified_file
);
8158 if (!STRINGP (file
))
8160 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8165 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8166 if (contents
== NULL
)
8168 image_error ("Error reading `%s'", file
, Qnil
);
8174 end
= contents
+ size
;
8179 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8180 p
= XSTRING (data
)->data
;
8181 end
= p
+ STRING_BYTES (XSTRING (data
));
8184 /* Check magic number. */
8185 if (end
- p
< 2 || *p
++ != 'P')
8187 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8197 raw_p
= 0, type
= PBM_MONO
;
8201 raw_p
= 0, type
= PBM_GRAY
;
8205 raw_p
= 0, type
= PBM_COLOR
;
8209 raw_p
= 1, type
= PBM_MONO
;
8213 raw_p
= 1, type
= PBM_GRAY
;
8217 raw_p
= 1, type
= PBM_COLOR
;
8221 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8225 /* Read width, height, maximum color-component. Characters
8226 starting with `#' up to the end of a line are ignored. */
8227 width
= pbm_scan_number (&p
, end
);
8228 height
= pbm_scan_number (&p
, end
);
8230 if (type
!= PBM_MONO
)
8232 max_color_idx
= pbm_scan_number (&p
, end
);
8233 if (raw_p
&& max_color_idx
> 255)
8234 max_color_idx
= 255;
8239 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8242 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8243 &ximg
, &img
->pixmap
))
8246 /* Initialize the color hash table. */
8247 init_color_table ();
8249 if (type
== PBM_MONO
)
8252 struct image_keyword fmt
[PBM_LAST
];
8253 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8254 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8256 /* Parse the image specification. */
8257 bcopy (pbm_format
, fmt
, sizeof fmt
);
8258 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8260 /* Get foreground and background colors, maybe allocate colors. */
8261 if (fmt
[PBM_FOREGROUND
].count
)
8262 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8263 if (fmt
[PBM_BACKGROUND
].count
)
8264 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8266 for (y
= 0; y
< height
; ++y
)
8267 for (x
= 0; x
< width
; ++x
)
8277 g
= pbm_scan_number (&p
, end
);
8279 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8284 for (y
= 0; y
< height
; ++y
)
8285 for (x
= 0; x
< width
; ++x
)
8289 if (type
== PBM_GRAY
)
8290 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8299 r
= pbm_scan_number (&p
, end
);
8300 g
= pbm_scan_number (&p
, end
);
8301 b
= pbm_scan_number (&p
, end
);
8304 if (r
< 0 || g
< 0 || b
< 0)
8308 XDestroyImage (ximg
);
8309 image_error ("Invalid pixel value in image `%s'",
8314 /* RGB values are now in the range 0..max_color_idx.
8315 Scale this to the range 0..0xffff supported by X. */
8316 r
= (double) r
* 65535 / max_color_idx
;
8317 g
= (double) g
* 65535 / max_color_idx
;
8318 b
= (double) b
* 65535 / max_color_idx
;
8319 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8323 /* Store in IMG->colors the colors allocated for the image, and
8324 free the color table. */
8325 img
->colors
= colors_in_color_table (&img
->ncolors
);
8326 free_color_table ();
8328 /* Put the image into a pixmap. */
8329 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8330 x_destroy_x_image (ximg
);
8333 img
->height
= height
;
8342 /***********************************************************************
8344 ***********************************************************************/
8350 /* Function prototypes. */
8352 static int png_image_p
P_ ((Lisp_Object object
));
8353 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8355 /* The symbol `png' identifying images of this type. */
8359 /* Indices of image specification fields in png_format, below. */
8361 enum png_keyword_index
8375 /* Vector of image_keyword structures describing the format
8376 of valid user-defined image specifications. */
8378 static struct image_keyword png_format
[PNG_LAST
] =
8380 {":type", IMAGE_SYMBOL_VALUE
, 1},
8381 {":data", IMAGE_STRING_VALUE
, 0},
8382 {":file", IMAGE_STRING_VALUE
, 0},
8383 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8384 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8385 {":relief", IMAGE_INTEGER_VALUE
, 0},
8386 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8387 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8388 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8391 /* Structure describing the image type `png'. */
8393 static struct image_type png_type
=
8403 /* Return non-zero if OBJECT is a valid PNG image specification. */
8406 png_image_p (object
)
8409 struct image_keyword fmt
[PNG_LAST
];
8410 bcopy (png_format
, fmt
, sizeof fmt
);
8412 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8415 /* Must specify either the :data or :file keyword. */
8416 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8420 /* Error and warning handlers installed when the PNG library
8424 my_png_error (png_ptr
, msg
)
8425 png_struct
*png_ptr
;
8428 xassert (png_ptr
!= NULL
);
8429 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8430 longjmp (png_ptr
->jmpbuf
, 1);
8435 my_png_warning (png_ptr
, msg
)
8436 png_struct
*png_ptr
;
8439 xassert (png_ptr
!= NULL
);
8440 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8443 /* Memory source for PNG decoding. */
8445 struct png_memory_storage
8447 unsigned char *bytes
; /* The data */
8448 size_t len
; /* How big is it? */
8449 int index
; /* Where are we? */
8453 /* Function set as reader function when reading PNG image from memory.
8454 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8455 bytes from the input to DATA. */
8458 png_read_from_memory (png_ptr
, data
, length
)
8459 png_structp png_ptr
;
8463 struct png_memory_storage
*tbr
8464 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8466 if (length
> tbr
->len
- tbr
->index
)
8467 png_error (png_ptr
, "Read error");
8469 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8470 tbr
->index
= tbr
->index
+ length
;
8473 /* Load PNG image IMG for use on frame F. Value is non-zero if
8481 Lisp_Object file
, specified_file
;
8482 Lisp_Object specified_data
;
8484 XImage
*ximg
, *mask_img
= NULL
;
8485 struct gcpro gcpro1
;
8486 png_struct
*png_ptr
= NULL
;
8487 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8488 FILE *volatile fp
= NULL
;
8490 png_byte
* volatile pixels
= NULL
;
8491 png_byte
** volatile rows
= NULL
;
8492 png_uint_32 width
, height
;
8493 int bit_depth
, color_type
, interlace_type
;
8495 png_uint_32 row_bytes
;
8498 double screen_gamma
, image_gamma
;
8500 struct png_memory_storage tbr
; /* Data to be read */
8502 /* Find out what file to load. */
8503 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8504 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8508 if (NILP (specified_data
))
8510 file
= x_find_image_file (specified_file
);
8511 if (!STRINGP (file
))
8513 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8518 /* Open the image file. */
8519 fp
= fopen (XSTRING (file
)->data
, "rb");
8522 image_error ("Cannot open image file `%s'", file
, Qnil
);
8528 /* Check PNG signature. */
8529 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8530 || !png_check_sig (sig
, sizeof sig
))
8532 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8540 /* Read from memory. */
8541 tbr
.bytes
= XSTRING (specified_data
)->data
;
8542 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8545 /* Check PNG signature. */
8546 if (tbr
.len
< sizeof sig
8547 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8549 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8554 /* Need to skip past the signature. */
8555 tbr
.bytes
+= sizeof (sig
);
8558 /* Initialize read and info structs for PNG lib. */
8559 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8560 my_png_error
, my_png_warning
);
8563 if (fp
) fclose (fp
);
8568 info_ptr
= png_create_info_struct (png_ptr
);
8571 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8572 if (fp
) fclose (fp
);
8577 end_info
= png_create_info_struct (png_ptr
);
8580 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8581 if (fp
) fclose (fp
);
8586 /* Set error jump-back. We come back here when the PNG library
8587 detects an error. */
8588 if (setjmp (png_ptr
->jmpbuf
))
8592 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8595 if (fp
) fclose (fp
);
8600 /* Read image info. */
8601 if (!NILP (specified_data
))
8602 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8604 png_init_io (png_ptr
, fp
);
8606 png_set_sig_bytes (png_ptr
, sizeof sig
);
8607 png_read_info (png_ptr
, info_ptr
);
8608 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8609 &interlace_type
, NULL
, NULL
);
8611 /* If image contains simply transparency data, we prefer to
8612 construct a clipping mask. */
8613 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8618 /* This function is easier to write if we only have to handle
8619 one data format: RGB or RGBA with 8 bits per channel. Let's
8620 transform other formats into that format. */
8622 /* Strip more than 8 bits per channel. */
8623 if (bit_depth
== 16)
8624 png_set_strip_16 (png_ptr
);
8626 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8628 png_set_expand (png_ptr
);
8630 /* Convert grayscale images to RGB. */
8631 if (color_type
== PNG_COLOR_TYPE_GRAY
8632 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8633 png_set_gray_to_rgb (png_ptr
);
8635 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8636 gamma_str
= getenv ("SCREEN_GAMMA");
8637 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8639 /* Tell the PNG lib to handle gamma correction for us. */
8641 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8642 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8643 /* There is a special chunk in the image specifying the gamma. */
8644 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8647 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8648 /* Image contains gamma information. */
8649 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8651 /* Use a default of 0.5 for the image gamma. */
8652 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8654 /* Handle alpha channel by combining the image with a background
8655 color. Do this only if a real alpha channel is supplied. For
8656 simple transparency, we prefer a clipping mask. */
8659 png_color_16
*image_background
;
8661 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8662 /* Image contains a background color with which to
8663 combine the image. */
8664 png_set_background (png_ptr
, image_background
,
8665 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8668 /* Image does not contain a background color with which
8669 to combine the image data via an alpha channel. Use
8670 the frame's background instead. */
8673 png_color_16 frame_background
;
8675 cmap
= FRAME_X_COLORMAP (f
);
8676 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8677 x_query_color (f
, &color
);
8679 bzero (&frame_background
, sizeof frame_background
);
8680 frame_background
.red
= color
.red
;
8681 frame_background
.green
= color
.green
;
8682 frame_background
.blue
= color
.blue
;
8684 png_set_background (png_ptr
, &frame_background
,
8685 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8689 /* Update info structure. */
8690 png_read_update_info (png_ptr
, info_ptr
);
8692 /* Get number of channels. Valid values are 1 for grayscale images
8693 and images with a palette, 2 for grayscale images with transparency
8694 information (alpha channel), 3 for RGB images, and 4 for RGB
8695 images with alpha channel, i.e. RGBA. If conversions above were
8696 sufficient we should only have 3 or 4 channels here. */
8697 channels
= png_get_channels (png_ptr
, info_ptr
);
8698 xassert (channels
== 3 || channels
== 4);
8700 /* Number of bytes needed for one row of the image. */
8701 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8703 /* Allocate memory for the image. */
8704 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8705 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8706 for (i
= 0; i
< height
; ++i
)
8707 rows
[i
] = pixels
+ i
* row_bytes
;
8709 /* Read the entire image. */
8710 png_read_image (png_ptr
, rows
);
8711 png_read_end (png_ptr
, info_ptr
);
8718 /* Create the X image and pixmap. */
8719 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8723 /* Create an image and pixmap serving as mask if the PNG image
8724 contains an alpha channel. */
8727 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8728 &mask_img
, &img
->mask
))
8730 x_destroy_x_image (ximg
);
8731 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8736 /* Fill the X image and mask from PNG data. */
8737 init_color_table ();
8739 for (y
= 0; y
< height
; ++y
)
8741 png_byte
*p
= rows
[y
];
8743 for (x
= 0; x
< width
; ++x
)
8750 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8752 /* An alpha channel, aka mask channel, associates variable
8753 transparency with an image. Where other image formats
8754 support binary transparency---fully transparent or fully
8755 opaque---PNG allows up to 254 levels of partial transparency.
8756 The PNG library implements partial transparency by combining
8757 the image with a specified background color.
8759 I'm not sure how to handle this here nicely: because the
8760 background on which the image is displayed may change, for
8761 real alpha channel support, it would be necessary to create
8762 a new image for each possible background.
8764 What I'm doing now is that a mask is created if we have
8765 boolean transparency information. Otherwise I'm using
8766 the frame's background color to combine the image with. */
8771 XPutPixel (mask_img
, x
, y
, *p
> 0);
8777 /* Remember colors allocated for this image. */
8778 img
->colors
= colors_in_color_table (&img
->ncolors
);
8779 free_color_table ();
8782 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8787 img
->height
= height
;
8789 /* Put the image into the pixmap, then free the X image and its buffer. */
8790 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8791 x_destroy_x_image (ximg
);
8793 /* Same for the mask. */
8796 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8797 x_destroy_x_image (mask_img
);
8804 #endif /* HAVE_PNG != 0 */
8808 /***********************************************************************
8810 ***********************************************************************/
8814 /* Work around a warning about HAVE_STDLIB_H being redefined in
8816 #ifdef HAVE_STDLIB_H
8817 #define HAVE_STDLIB_H_1
8818 #undef HAVE_STDLIB_H
8819 #endif /* HAVE_STLIB_H */
8821 #include <jpeglib.h>
8825 #ifdef HAVE_STLIB_H_1
8826 #define HAVE_STDLIB_H 1
8829 static int jpeg_image_p
P_ ((Lisp_Object object
));
8830 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8832 /* The symbol `jpeg' identifying images of this type. */
8836 /* Indices of image specification fields in gs_format, below. */
8838 enum jpeg_keyword_index
8847 JPEG_HEURISTIC_MASK
,
8852 /* Vector of image_keyword structures describing the format
8853 of valid user-defined image specifications. */
8855 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8857 {":type", IMAGE_SYMBOL_VALUE
, 1},
8858 {":data", IMAGE_STRING_VALUE
, 0},
8859 {":file", IMAGE_STRING_VALUE
, 0},
8860 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8861 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8862 {":relief", IMAGE_INTEGER_VALUE
, 0},
8863 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8864 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8865 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8868 /* Structure describing the image type `jpeg'. */
8870 static struct image_type jpeg_type
=
8880 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8883 jpeg_image_p (object
)
8886 struct image_keyword fmt
[JPEG_LAST
];
8888 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8890 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8893 /* Must specify either the :data or :file keyword. */
8894 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8898 struct my_jpeg_error_mgr
8900 struct jpeg_error_mgr pub
;
8901 jmp_buf setjmp_buffer
;
8906 my_error_exit (cinfo
)
8909 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8910 longjmp (mgr
->setjmp_buffer
, 1);
8914 /* Init source method for JPEG data source manager. Called by
8915 jpeg_read_header() before any data is actually read. See
8916 libjpeg.doc from the JPEG lib distribution. */
8919 our_init_source (cinfo
)
8920 j_decompress_ptr cinfo
;
8925 /* Fill input buffer method for JPEG data source manager. Called
8926 whenever more data is needed. We read the whole image in one step,
8927 so this only adds a fake end of input marker at the end. */
8930 our_fill_input_buffer (cinfo
)
8931 j_decompress_ptr cinfo
;
8933 /* Insert a fake EOI marker. */
8934 struct jpeg_source_mgr
*src
= cinfo
->src
;
8935 static JOCTET buffer
[2];
8937 buffer
[0] = (JOCTET
) 0xFF;
8938 buffer
[1] = (JOCTET
) JPEG_EOI
;
8940 src
->next_input_byte
= buffer
;
8941 src
->bytes_in_buffer
= 2;
8946 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8947 is the JPEG data source manager. */
8950 our_skip_input_data (cinfo
, num_bytes
)
8951 j_decompress_ptr cinfo
;
8954 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8958 if (num_bytes
> src
->bytes_in_buffer
)
8959 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8961 src
->bytes_in_buffer
-= num_bytes
;
8962 src
->next_input_byte
+= num_bytes
;
8967 /* Method to terminate data source. Called by
8968 jpeg_finish_decompress() after all data has been processed. */
8971 our_term_source (cinfo
)
8972 j_decompress_ptr cinfo
;
8977 /* Set up the JPEG lib for reading an image from DATA which contains
8978 LEN bytes. CINFO is the decompression info structure created for
8979 reading the image. */
8982 jpeg_memory_src (cinfo
, data
, len
)
8983 j_decompress_ptr cinfo
;
8987 struct jpeg_source_mgr
*src
;
8989 if (cinfo
->src
== NULL
)
8991 /* First time for this JPEG object? */
8992 cinfo
->src
= (struct jpeg_source_mgr
*)
8993 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8994 sizeof (struct jpeg_source_mgr
));
8995 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8996 src
->next_input_byte
= data
;
8999 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9000 src
->init_source
= our_init_source
;
9001 src
->fill_input_buffer
= our_fill_input_buffer
;
9002 src
->skip_input_data
= our_skip_input_data
;
9003 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9004 src
->term_source
= our_term_source
;
9005 src
->bytes_in_buffer
= len
;
9006 src
->next_input_byte
= data
;
9010 /* Load image IMG for use on frame F. Patterned after example.c
9011 from the JPEG lib. */
9018 struct jpeg_decompress_struct cinfo
;
9019 struct my_jpeg_error_mgr mgr
;
9020 Lisp_Object file
, specified_file
;
9021 Lisp_Object specified_data
;
9022 FILE * volatile fp
= NULL
;
9024 int row_stride
, x
, y
;
9025 XImage
*ximg
= NULL
;
9027 unsigned long *colors
;
9029 struct gcpro gcpro1
;
9031 /* Open the JPEG file. */
9032 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9033 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9037 if (NILP (specified_data
))
9039 file
= x_find_image_file (specified_file
);
9040 if (!STRINGP (file
))
9042 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9047 fp
= fopen (XSTRING (file
)->data
, "r");
9050 image_error ("Cannot open `%s'", file
, Qnil
);
9056 /* Customize libjpeg's error handling to call my_error_exit when an
9057 error is detected. This function will perform a longjmp. */
9058 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9059 mgr
.pub
.error_exit
= my_error_exit
;
9061 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9065 /* Called from my_error_exit. Display a JPEG error. */
9066 char buffer
[JMSG_LENGTH_MAX
];
9067 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9068 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9069 build_string (buffer
));
9072 /* Close the input file and destroy the JPEG object. */
9074 fclose ((FILE *) fp
);
9075 jpeg_destroy_decompress (&cinfo
);
9077 /* If we already have an XImage, free that. */
9078 x_destroy_x_image (ximg
);
9080 /* Free pixmap and colors. */
9081 x_clear_image (f
, img
);
9087 /* Create the JPEG decompression object. Let it read from fp.
9088 Read the JPEG image header. */
9089 jpeg_create_decompress (&cinfo
);
9091 if (NILP (specified_data
))
9092 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9094 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9095 STRING_BYTES (XSTRING (specified_data
)));
9097 jpeg_read_header (&cinfo
, TRUE
);
9099 /* Customize decompression so that color quantization will be used.
9100 Start decompression. */
9101 cinfo
.quantize_colors
= TRUE
;
9102 jpeg_start_decompress (&cinfo
);
9103 width
= img
->width
= cinfo
.output_width
;
9104 height
= img
->height
= cinfo
.output_height
;
9106 /* Create X image and pixmap. */
9107 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9108 longjmp (mgr
.setjmp_buffer
, 2);
9110 /* Allocate colors. When color quantization is used,
9111 cinfo.actual_number_of_colors has been set with the number of
9112 colors generated, and cinfo.colormap is a two-dimensional array
9113 of color indices in the range 0..cinfo.actual_number_of_colors.
9114 No more than 255 colors will be generated. */
9118 if (cinfo
.out_color_components
> 2)
9119 ir
= 0, ig
= 1, ib
= 2;
9120 else if (cinfo
.out_color_components
> 1)
9121 ir
= 0, ig
= 1, ib
= 0;
9123 ir
= 0, ig
= 0, ib
= 0;
9125 /* Use the color table mechanism because it handles colors that
9126 cannot be allocated nicely. Such colors will be replaced with
9127 a default color, and we don't have to care about which colors
9128 can be freed safely, and which can't. */
9129 init_color_table ();
9130 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9133 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9135 /* Multiply RGB values with 255 because X expects RGB values
9136 in the range 0..0xffff. */
9137 int r
= cinfo
.colormap
[ir
][i
] << 8;
9138 int g
= cinfo
.colormap
[ig
][i
] << 8;
9139 int b
= cinfo
.colormap
[ib
][i
] << 8;
9140 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9143 /* Remember those colors actually allocated. */
9144 img
->colors
= colors_in_color_table (&img
->ncolors
);
9145 free_color_table ();
9149 row_stride
= width
* cinfo
.output_components
;
9150 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9152 for (y
= 0; y
< height
; ++y
)
9154 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9155 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9156 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9160 jpeg_finish_decompress (&cinfo
);
9161 jpeg_destroy_decompress (&cinfo
);
9163 fclose ((FILE *) fp
);
9165 /* Put the image into the pixmap. */
9166 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9167 x_destroy_x_image (ximg
);
9172 #endif /* HAVE_JPEG */
9176 /***********************************************************************
9178 ***********************************************************************/
9184 static int tiff_image_p
P_ ((Lisp_Object object
));
9185 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9187 /* The symbol `tiff' identifying images of this type. */
9191 /* Indices of image specification fields in tiff_format, below. */
9193 enum tiff_keyword_index
9202 TIFF_HEURISTIC_MASK
,
9207 /* Vector of image_keyword structures describing the format
9208 of valid user-defined image specifications. */
9210 static struct image_keyword tiff_format
[TIFF_LAST
] =
9212 {":type", IMAGE_SYMBOL_VALUE
, 1},
9213 {":data", IMAGE_STRING_VALUE
, 0},
9214 {":file", IMAGE_STRING_VALUE
, 0},
9215 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9216 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9217 {":relief", IMAGE_INTEGER_VALUE
, 0},
9218 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9219 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9220 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9223 /* Structure describing the image type `tiff'. */
9225 static struct image_type tiff_type
=
9235 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9238 tiff_image_p (object
)
9241 struct image_keyword fmt
[TIFF_LAST
];
9242 bcopy (tiff_format
, fmt
, sizeof fmt
);
9244 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9247 /* Must specify either the :data or :file keyword. */
9248 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9252 /* Reading from a memory buffer for TIFF images Based on the PNG
9253 memory source, but we have to provide a lot of extra functions.
9256 We really only need to implement read and seek, but I am not
9257 convinced that the TIFF library is smart enough not to destroy
9258 itself if we only hand it the function pointers we need to
9263 unsigned char *bytes
;
9271 tiff_read_from_memory (data
, buf
, size
)
9276 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9278 if (size
> src
->len
- src
->index
)
9280 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9287 tiff_write_from_memory (data
, buf
, size
)
9297 tiff_seek_in_memory (data
, off
, whence
)
9302 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9307 case SEEK_SET
: /* Go from beginning of source. */
9311 case SEEK_END
: /* Go from end of source. */
9312 idx
= src
->len
+ off
;
9315 case SEEK_CUR
: /* Go from current position. */
9316 idx
= src
->index
+ off
;
9319 default: /* Invalid `whence'. */
9323 if (idx
> src
->len
|| idx
< 0)
9332 tiff_close_memory (data
)
9341 tiff_mmap_memory (data
, pbase
, psize
)
9346 /* It is already _IN_ memory. */
9352 tiff_unmap_memory (data
, base
, size
)
9357 /* We don't need to do this. */
9362 tiff_size_of_memory (data
)
9365 return ((tiff_memory_source
*) data
)->len
;
9369 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9377 Lisp_Object file
, specified_file
;
9378 Lisp_Object specified_data
;
9380 int width
, height
, x
, y
;
9384 struct gcpro gcpro1
;
9385 tiff_memory_source memsrc
;
9387 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9388 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9392 if (NILP (specified_data
))
9394 /* Read from a file */
9395 file
= x_find_image_file (specified_file
);
9396 if (!STRINGP (file
))
9398 image_error ("Cannot find image file `%s'", file
, Qnil
);
9403 /* Try to open the image file. */
9404 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9407 image_error ("Cannot open `%s'", file
, Qnil
);
9414 /* Memory source! */
9415 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9416 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9419 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9420 (TIFFReadWriteProc
) tiff_read_from_memory
,
9421 (TIFFReadWriteProc
) tiff_write_from_memory
,
9422 tiff_seek_in_memory
,
9424 tiff_size_of_memory
,
9430 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9436 /* Get width and height of the image, and allocate a raster buffer
9437 of width x height 32-bit values. */
9438 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9439 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9440 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9442 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9446 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9452 /* Create the X image and pixmap. */
9453 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9460 /* Initialize the color table. */
9461 init_color_table ();
9463 /* Process the pixel raster. Origin is in the lower-left corner. */
9464 for (y
= 0; y
< height
; ++y
)
9466 uint32
*row
= buf
+ y
* width
;
9468 for (x
= 0; x
< width
; ++x
)
9470 uint32 abgr
= row
[x
];
9471 int r
= TIFFGetR (abgr
) << 8;
9472 int g
= TIFFGetG (abgr
) << 8;
9473 int b
= TIFFGetB (abgr
) << 8;
9474 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9478 /* Remember the colors allocated for the image. Free the color table. */
9479 img
->colors
= colors_in_color_table (&img
->ncolors
);
9480 free_color_table ();
9482 /* Put the image into the pixmap, then free the X image and its buffer. */
9483 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9484 x_destroy_x_image (ximg
);
9488 img
->height
= height
;
9494 #endif /* HAVE_TIFF != 0 */
9498 /***********************************************************************
9500 ***********************************************************************/
9504 #include <gif_lib.h>
9506 static int gif_image_p
P_ ((Lisp_Object object
));
9507 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9509 /* The symbol `gif' identifying images of this type. */
9513 /* Indices of image specification fields in gif_format, below. */
9515 enum gif_keyword_index
9530 /* Vector of image_keyword structures describing the format
9531 of valid user-defined image specifications. */
9533 static struct image_keyword gif_format
[GIF_LAST
] =
9535 {":type", IMAGE_SYMBOL_VALUE
, 1},
9536 {":data", IMAGE_STRING_VALUE
, 0},
9537 {":file", IMAGE_STRING_VALUE
, 0},
9538 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9539 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9540 {":relief", IMAGE_INTEGER_VALUE
, 0},
9541 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9542 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9543 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9544 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9547 /* Structure describing the image type `gif'. */
9549 static struct image_type gif_type
=
9559 /* Return non-zero if OBJECT is a valid GIF image specification. */
9562 gif_image_p (object
)
9565 struct image_keyword fmt
[GIF_LAST
];
9566 bcopy (gif_format
, fmt
, sizeof fmt
);
9568 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9571 /* Must specify either the :data or :file keyword. */
9572 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9576 /* Reading a GIF image from memory
9577 Based on the PNG memory stuff to a certain extent. */
9581 unsigned char *bytes
;
9588 /* Make the current memory source available to gif_read_from_memory.
9589 It's done this way because not all versions of libungif support
9590 a UserData field in the GifFileType structure. */
9591 static gif_memory_source
*current_gif_memory_src
;
9594 gif_read_from_memory (file
, buf
, len
)
9599 gif_memory_source
*src
= current_gif_memory_src
;
9601 if (len
> src
->len
- src
->index
)
9604 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9610 /* Load GIF image IMG for use on frame F. Value is non-zero if
9618 Lisp_Object file
, specified_file
;
9619 Lisp_Object specified_data
;
9620 int rc
, width
, height
, x
, y
, i
;
9622 ColorMapObject
*gif_color_map
;
9623 unsigned long pixel_colors
[256];
9625 struct gcpro gcpro1
;
9627 int ino
, image_left
, image_top
, image_width
, image_height
;
9628 gif_memory_source memsrc
;
9629 unsigned char *raster
;
9631 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9632 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9636 if (NILP (specified_data
))
9638 file
= x_find_image_file (specified_file
);
9639 if (!STRINGP (file
))
9641 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9646 /* Open the GIF file. */
9647 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9650 image_error ("Cannot open `%s'", file
, Qnil
);
9657 /* Read from memory! */
9658 current_gif_memory_src
= &memsrc
;
9659 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9660 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9663 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9666 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9672 /* Read entire contents. */
9673 rc
= DGifSlurp (gif
);
9674 if (rc
== GIF_ERROR
)
9676 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9677 DGifCloseFile (gif
);
9682 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9683 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9684 if (ino
>= gif
->ImageCount
)
9686 image_error ("Invalid image number `%s' in image `%s'",
9688 DGifCloseFile (gif
);
9693 width
= img
->width
= gif
->SWidth
;
9694 height
= img
->height
= gif
->SHeight
;
9696 /* Create the X image and pixmap. */
9697 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9699 DGifCloseFile (gif
);
9704 /* Allocate colors. */
9705 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9707 gif_color_map
= gif
->SColorMap
;
9708 init_color_table ();
9709 bzero (pixel_colors
, sizeof pixel_colors
);
9711 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9713 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9714 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9715 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9716 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9719 img
->colors
= colors_in_color_table (&img
->ncolors
);
9720 free_color_table ();
9722 /* Clear the part of the screen image that are not covered by
9723 the image from the GIF file. Full animated GIF support
9724 requires more than can be done here (see the gif89 spec,
9725 disposal methods). Let's simply assume that the part
9726 not covered by a sub-image is in the frame's background color. */
9727 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9728 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9729 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9730 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9732 for (y
= 0; y
< image_top
; ++y
)
9733 for (x
= 0; x
< width
; ++x
)
9734 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9736 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9737 for (x
= 0; x
< width
; ++x
)
9738 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9740 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9742 for (x
= 0; x
< image_left
; ++x
)
9743 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9744 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9745 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9748 /* Read the GIF image into the X image. We use a local variable
9749 `raster' here because RasterBits below is a char *, and invites
9750 problems with bytes >= 0x80. */
9751 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9753 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9755 static int interlace_start
[] = {0, 4, 2, 1};
9756 static int interlace_increment
[] = {8, 8, 4, 2};
9758 int row
= interlace_start
[0];
9762 for (y
= 0; y
< image_height
; y
++)
9764 if (row
>= image_height
)
9766 row
= interlace_start
[++pass
];
9767 while (row
>= image_height
)
9768 row
= interlace_start
[++pass
];
9771 for (x
= 0; x
< image_width
; x
++)
9773 int i
= raster
[(y
* image_width
) + x
];
9774 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9778 row
+= interlace_increment
[pass
];
9783 for (y
= 0; y
< image_height
; ++y
)
9784 for (x
= 0; x
< image_width
; ++x
)
9786 int i
= raster
[y
* image_width
+ x
];
9787 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9791 DGifCloseFile (gif
);
9793 /* Put the image into the pixmap, then free the X image and its buffer. */
9794 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9795 x_destroy_x_image (ximg
);
9801 #endif /* HAVE_GIF != 0 */
9805 /***********************************************************************
9807 ***********************************************************************/
9809 static int gs_image_p
P_ ((Lisp_Object object
));
9810 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9811 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9813 /* The symbol `postscript' identifying images of this type. */
9815 Lisp_Object Qpostscript
;
9817 /* Keyword symbols. */
9819 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9821 /* Indices of image specification fields in gs_format, below. */
9823 enum gs_keyword_index
9840 /* Vector of image_keyword structures describing the format
9841 of valid user-defined image specifications. */
9843 static struct image_keyword gs_format
[GS_LAST
] =
9845 {":type", IMAGE_SYMBOL_VALUE
, 1},
9846 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9847 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9848 {":file", IMAGE_STRING_VALUE
, 1},
9849 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9850 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9851 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9852 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9853 {":relief", IMAGE_INTEGER_VALUE
, 0},
9854 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9855 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9856 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9859 /* Structure describing the image type `ghostscript'. */
9861 static struct image_type gs_type
=
9871 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9874 gs_clear_image (f
, img
)
9878 /* IMG->data.ptr_val may contain a recorded colormap. */
9879 xfree (img
->data
.ptr_val
);
9880 x_clear_image (f
, img
);
9884 /* Return non-zero if OBJECT is a valid Ghostscript image
9891 struct image_keyword fmt
[GS_LAST
];
9895 bcopy (gs_format
, fmt
, sizeof fmt
);
9897 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
9900 /* Bounding box must be a list or vector containing 4 integers. */
9901 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9904 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9905 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9910 else if (VECTORP (tem
))
9912 if (XVECTOR (tem
)->size
!= 4)
9914 for (i
= 0; i
< 4; ++i
)
9915 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9925 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9934 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9935 struct gcpro gcpro1
, gcpro2
;
9937 double in_width
, in_height
;
9938 Lisp_Object pixel_colors
= Qnil
;
9940 /* Compute pixel size of pixmap needed from the given size in the
9941 image specification. Sizes in the specification are in pt. 1 pt
9942 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9944 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9945 in_width
= XFASTINT (pt_width
) / 72.0;
9946 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9947 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9948 in_height
= XFASTINT (pt_height
) / 72.0;
9949 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9951 /* Create the pixmap. */
9952 xassert (img
->pixmap
== None
);
9953 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9954 img
->width
, img
->height
,
9955 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9959 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9963 /* Call the loader to fill the pixmap. It returns a process object
9964 if successful. We do not record_unwind_protect here because
9965 other places in redisplay like calling window scroll functions
9966 don't either. Let the Lisp loader use `unwind-protect' instead. */
9967 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9969 sprintf (buffer
, "%lu %lu",
9970 (unsigned long) FRAME_X_WINDOW (f
),
9971 (unsigned long) img
->pixmap
);
9972 window_and_pixmap_id
= build_string (buffer
);
9974 sprintf (buffer
, "%lu %lu",
9975 FRAME_FOREGROUND_PIXEL (f
),
9976 FRAME_BACKGROUND_PIXEL (f
));
9977 pixel_colors
= build_string (buffer
);
9979 XSETFRAME (frame
, f
);
9980 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9982 loader
= intern ("gs-load-image");
9984 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9985 make_number (img
->width
),
9986 make_number (img
->height
),
9987 window_and_pixmap_id
,
9990 return PROCESSP (img
->data
.lisp_val
);
9994 /* Kill the Ghostscript process that was started to fill PIXMAP on
9995 frame F. Called from XTread_socket when receiving an event
9996 telling Emacs that Ghostscript has finished drawing. */
9999 x_kill_gs_process (pixmap
, f
)
10003 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10007 /* Find the image containing PIXMAP. */
10008 for (i
= 0; i
< c
->used
; ++i
)
10009 if (c
->images
[i
]->pixmap
== pixmap
)
10012 /* Kill the GS process. We should have found PIXMAP in the image
10013 cache and its image should contain a process object. */
10014 xassert (i
< c
->used
);
10015 img
= c
->images
[i
];
10016 xassert (PROCESSP (img
->data
.lisp_val
));
10017 Fkill_process (img
->data
.lisp_val
, Qnil
);
10018 img
->data
.lisp_val
= Qnil
;
10020 /* On displays with a mutable colormap, figure out the colors
10021 allocated for the image by looking at the pixels of an XImage for
10023 class = FRAME_X_VISUAL (f
)->class;
10024 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10030 /* Try to get an XImage for img->pixmep. */
10031 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10032 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10037 /* Initialize the color table. */
10038 init_color_table ();
10040 /* For each pixel of the image, look its color up in the
10041 color table. After having done so, the color table will
10042 contain an entry for each color used by the image. */
10043 for (y
= 0; y
< img
->height
; ++y
)
10044 for (x
= 0; x
< img
->width
; ++x
)
10046 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10047 lookup_pixel_color (f
, pixel
);
10050 /* Record colors in the image. Free color table and XImage. */
10051 img
->colors
= colors_in_color_table (&img
->ncolors
);
10052 free_color_table ();
10053 XDestroyImage (ximg
);
10055 #if 0 /* This doesn't seem to be the case. If we free the colors
10056 here, we get a BadAccess later in x_clear_image when
10057 freeing the colors. */
10058 /* We have allocated colors once, but Ghostscript has also
10059 allocated colors on behalf of us. So, to get the
10060 reference counts right, free them once. */
10062 x_free_colors (f
, img
->colors
, img
->ncolors
);
10066 image_error ("Cannot get X image of `%s'; colors will not be freed",
10075 /***********************************************************************
10077 ***********************************************************************/
10079 DEFUN ("x-change-window-property", Fx_change_window_property
,
10080 Sx_change_window_property
, 2, 3, 0,
10081 "Change window property PROP to VALUE on the X window of FRAME.\n\
10082 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
10083 selected frame. Value is VALUE.")
10084 (prop
, value
, frame
)
10085 Lisp_Object frame
, prop
, value
;
10087 struct frame
*f
= check_x_frame (frame
);
10090 CHECK_STRING (prop
, 1);
10091 CHECK_STRING (value
, 2);
10094 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10095 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10096 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10097 XSTRING (value
)->data
, XSTRING (value
)->size
);
10099 /* Make sure the property is set when we return. */
10100 XFlush (FRAME_X_DISPLAY (f
));
10107 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10108 Sx_delete_window_property
, 1, 2, 0,
10109 "Remove window property PROP from X window of FRAME.\n\
10110 FRAME nil or omitted means use the selected frame. Value is PROP.")
10112 Lisp_Object prop
, frame
;
10114 struct frame
*f
= check_x_frame (frame
);
10117 CHECK_STRING (prop
, 1);
10119 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10120 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10122 /* Make sure the property is removed when we return. */
10123 XFlush (FRAME_X_DISPLAY (f
));
10130 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10132 "Value is the value of window property PROP on FRAME.\n\
10133 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10134 if FRAME hasn't a property with name PROP or if PROP has no string\n\
10137 Lisp_Object prop
, frame
;
10139 struct frame
*f
= check_x_frame (frame
);
10142 Lisp_Object prop_value
= Qnil
;
10143 char *tmp_data
= NULL
;
10146 unsigned long actual_size
, bytes_remaining
;
10148 CHECK_STRING (prop
, 1);
10150 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10151 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10152 prop_atom
, 0, 0, False
, XA_STRING
,
10153 &actual_type
, &actual_format
, &actual_size
,
10154 &bytes_remaining
, (unsigned char **) &tmp_data
);
10157 int size
= bytes_remaining
;
10162 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10163 prop_atom
, 0, bytes_remaining
,
10165 &actual_type
, &actual_format
,
10166 &actual_size
, &bytes_remaining
,
10167 (unsigned char **) &tmp_data
);
10169 prop_value
= make_string (tmp_data
, size
);
10180 /***********************************************************************
10182 ***********************************************************************/
10184 /* If non-null, an asynchronous timer that, when it expires, displays
10185 a busy cursor on all frames. */
10187 static struct atimer
*busy_cursor_atimer
;
10189 /* Non-zero means a busy cursor is currently shown. */
10191 static int busy_cursor_shown_p
;
10193 /* Number of seconds to wait before displaying a busy cursor. */
10195 static Lisp_Object Vbusy_cursor_delay
;
10197 /* Default number of seconds to wait before displaying a busy
10200 #define DEFAULT_BUSY_CURSOR_DELAY 1
10202 /* Function prototypes. */
10204 static void show_busy_cursor
P_ ((struct atimer
*));
10205 static void hide_busy_cursor
P_ ((void));
10208 /* Cancel a currently active busy-cursor timer, and start a new one. */
10211 start_busy_cursor ()
10214 int secs
, usecs
= 0;
10216 cancel_busy_cursor ();
10218 if (INTEGERP (Vbusy_cursor_delay
)
10219 && XINT (Vbusy_cursor_delay
) > 0)
10220 secs
= XFASTINT (Vbusy_cursor_delay
);
10221 else if (FLOATP (Vbusy_cursor_delay
)
10222 && XFLOAT_DATA (Vbusy_cursor_delay
) > 0)
10225 tem
= Ftruncate (Vbusy_cursor_delay
, Qnil
);
10226 secs
= XFASTINT (tem
);
10227 usecs
= (XFLOAT_DATA (Vbusy_cursor_delay
) - secs
) * 1000000;
10230 secs
= DEFAULT_BUSY_CURSOR_DELAY
;
10232 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10233 busy_cursor_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10234 show_busy_cursor
, NULL
);
10238 /* Cancel the busy cursor timer if active, hide a busy cursor if
10242 cancel_busy_cursor ()
10244 if (busy_cursor_atimer
)
10246 cancel_atimer (busy_cursor_atimer
);
10247 busy_cursor_atimer
= NULL
;
10250 if (busy_cursor_shown_p
)
10251 hide_busy_cursor ();
10255 /* Timer function of busy_cursor_atimer. TIMER is equal to
10256 busy_cursor_atimer.
10258 Display a busy cursor on all frames by mapping the frames'
10259 busy_window. Set the busy_p flag in the frames' output_data.x
10260 structure to indicate that a busy cursor is shown on the
10264 show_busy_cursor (timer
)
10265 struct atimer
*timer
;
10267 /* The timer implementation will cancel this timer automatically
10268 after this function has run. Set busy_cursor_atimer to null
10269 so that we know the timer doesn't have to be canceled. */
10270 busy_cursor_atimer
= NULL
;
10272 if (!busy_cursor_shown_p
)
10274 Lisp_Object rest
, frame
;
10278 FOR_EACH_FRAME (rest
, frame
)
10280 struct frame
*f
= XFRAME (frame
);
10282 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10284 Display
*dpy
= FRAME_X_DISPLAY (f
);
10286 #ifdef USE_X_TOOLKIT
10287 if (f
->output_data
.x
->widget
)
10289 if (FRAME_OUTER_WINDOW (f
))
10292 f
->output_data
.x
->busy_p
= 1;
10294 if (!f
->output_data
.x
->busy_window
)
10296 unsigned long mask
= CWCursor
;
10297 XSetWindowAttributes attrs
;
10299 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
10301 f
->output_data
.x
->busy_window
10302 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10303 0, 0, 32000, 32000, 0, 0,
10309 XMapRaised (dpy
, f
->output_data
.x
->busy_window
);
10315 busy_cursor_shown_p
= 1;
10321 /* Hide the busy cursor on all frames, if it is currently shown. */
10324 hide_busy_cursor ()
10326 if (busy_cursor_shown_p
)
10328 Lisp_Object rest
, frame
;
10331 FOR_EACH_FRAME (rest
, frame
)
10333 struct frame
*f
= XFRAME (frame
);
10336 /* Watch out for newly created frames. */
10337 && f
->output_data
.x
->busy_window
)
10339 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10340 /* Sync here because XTread_socket looks at the busy_p flag
10341 that is reset to zero below. */
10342 XSync (FRAME_X_DISPLAY (f
), False
);
10343 f
->output_data
.x
->busy_p
= 0;
10347 busy_cursor_shown_p
= 0;
10354 /***********************************************************************
10356 ***********************************************************************/
10358 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10360 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10361 Lisp_Object
, int *, int *));
10363 /* The frame of a currently visible tooltip. */
10365 Lisp_Object tip_frame
;
10367 /* If non-nil, a timer started that hides the last tooltip when it
10370 Lisp_Object tip_timer
;
10373 /* If non-nil, a vector of 3 elements containing the last args
10374 with which x-show-tip was called. See there. */
10376 Lisp_Object last_show_tip_args
;
10380 unwind_create_tip_frame (frame
)
10383 Lisp_Object deleted
;
10385 deleted
= unwind_create_frame (frame
);
10386 if (EQ (deleted
, Qt
))
10396 /* Create a frame for a tooltip on the display described by DPYINFO.
10397 PARMS is a list of frame parameters. Value is the frame.
10399 Note that functions called here, esp. x_default_parameter can
10400 signal errors, for instance when a specified color name is
10401 undefined. We have to make sure that we're in a consistent state
10402 when this happens. */
10405 x_create_tip_frame (dpyinfo
, parms
)
10406 struct x_display_info
*dpyinfo
;
10410 Lisp_Object frame
, tem
;
10412 long window_prompting
= 0;
10414 int count
= BINDING_STACK_SIZE ();
10415 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10417 int face_change_count_before
= face_change_count
;
10421 /* Use this general default value to start with until we know if
10422 this frame has a specified name. */
10423 Vx_resource_name
= Vinvocation_name
;
10425 #ifdef MULTI_KBOARD
10426 kb
= dpyinfo
->kboard
;
10428 kb
= &the_only_kboard
;
10431 /* Get the name of the frame to use for resource lookup. */
10432 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10433 if (!STRINGP (name
)
10434 && !EQ (name
, Qunbound
)
10436 error ("Invalid frame name--not a string or nil");
10437 Vx_resource_name
= name
;
10440 GCPRO3 (parms
, name
, frame
);
10441 f
= make_frame (1);
10442 XSETFRAME (frame
, f
);
10443 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10444 record_unwind_protect (unwind_create_tip_frame
, frame
);
10446 /* By setting the output method, we're essentially saying that
10447 the frame is live, as per FRAME_LIVE_P. If we get a signal
10448 from this point on, x_destroy_window might screw up reference
10450 f
->output_method
= output_x_window
;
10451 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10452 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10453 f
->output_data
.x
->icon_bitmap
= -1;
10454 f
->output_data
.x
->fontset
= -1;
10455 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10456 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10457 f
->icon_name
= Qnil
;
10458 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10460 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10461 dpyinfo_refcount
= dpyinfo
->reference_count
;
10462 #endif /* GLYPH_DEBUG */
10463 #ifdef MULTI_KBOARD
10464 FRAME_KBOARD (f
) = kb
;
10466 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10467 f
->output_data
.x
->explicit_parent
= 0;
10469 /* These colors will be set anyway later, but it's important
10470 to get the color reference counts right, so initialize them! */
10473 struct gcpro gcpro1
;
10475 black
= build_string ("black");
10477 f
->output_data
.x
->foreground_pixel
10478 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10479 f
->output_data
.x
->background_pixel
10480 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10481 f
->output_data
.x
->cursor_pixel
10482 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10483 f
->output_data
.x
->cursor_foreground_pixel
10484 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10485 f
->output_data
.x
->border_pixel
10486 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10487 f
->output_data
.x
->mouse_pixel
10488 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10492 /* Set the name; the functions to which we pass f expect the name to
10494 if (EQ (name
, Qunbound
) || NILP (name
))
10496 f
->name
= build_string (dpyinfo
->x_id_name
);
10497 f
->explicit_name
= 0;
10502 f
->explicit_name
= 1;
10503 /* use the frame's title when getting resources for this frame. */
10504 specbind (Qx_resource_name
, name
);
10507 /* Extract the window parameters from the supplied values that are
10508 needed to determine window geometry. */
10512 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10515 /* First, try whatever font the caller has specified. */
10516 if (STRINGP (font
))
10518 tem
= Fquery_fontset (font
, Qnil
);
10520 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10522 font
= x_new_font (f
, XSTRING (font
)->data
);
10525 /* Try out a font which we hope has bold and italic variations. */
10526 if (!STRINGP (font
))
10527 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10528 if (!STRINGP (font
))
10529 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10530 if (! STRINGP (font
))
10531 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10532 if (! STRINGP (font
))
10533 /* This was formerly the first thing tried, but it finds too many fonts
10534 and takes too long. */
10535 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10536 /* If those didn't work, look for something which will at least work. */
10537 if (! STRINGP (font
))
10538 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10540 if (! STRINGP (font
))
10541 font
= build_string ("fixed");
10543 x_default_parameter (f
, parms
, Qfont
, font
,
10544 "font", "Font", RES_TYPE_STRING
);
10547 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10548 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10550 /* This defaults to 2 in order to match xterm. We recognize either
10551 internalBorderWidth or internalBorder (which is what xterm calls
10553 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10557 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10558 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10559 if (! EQ (value
, Qunbound
))
10560 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10564 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10565 "internalBorderWidth", "internalBorderWidth",
10568 /* Also do the stuff which must be set before the window exists. */
10569 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10570 "foreground", "Foreground", RES_TYPE_STRING
);
10571 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10572 "background", "Background", RES_TYPE_STRING
);
10573 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10574 "pointerColor", "Foreground", RES_TYPE_STRING
);
10575 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10576 "cursorColor", "Foreground", RES_TYPE_STRING
);
10577 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10578 "borderColor", "BorderColor", RES_TYPE_STRING
);
10580 /* Init faces before x_default_parameter is called for scroll-bar
10581 parameters because that function calls x_set_scroll_bar_width,
10582 which calls change_frame_size, which calls Fset_window_buffer,
10583 which runs hooks, which call Fvertical_motion. At the end, we
10584 end up in init_iterator with a null face cache, which should not
10586 init_frame_faces (f
);
10588 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10589 window_prompting
= x_figure_window_size (f
, parms
);
10591 if (window_prompting
& XNegative
)
10593 if (window_prompting
& YNegative
)
10594 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10596 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10600 if (window_prompting
& YNegative
)
10601 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10603 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10606 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10608 XSetWindowAttributes attrs
;
10609 unsigned long mask
;
10612 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10613 if (DoesSaveUnders (dpyinfo
->screen
))
10614 mask
|= CWSaveUnder
;
10616 /* Window managers look at the override-redirect flag to determine
10617 whether or net to give windows a decoration (Xlib spec, chapter
10619 attrs
.override_redirect
= True
;
10620 attrs
.save_under
= True
;
10621 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10622 /* Arrange for getting MapNotify and UnmapNotify events. */
10623 attrs
.event_mask
= StructureNotifyMask
;
10625 = FRAME_X_WINDOW (f
)
10626 = XCreateWindow (FRAME_X_DISPLAY (f
),
10627 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10628 /* x, y, width, height */
10632 CopyFromParent
, InputOutput
, CopyFromParent
,
10639 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10640 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10641 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10642 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10643 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10644 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10646 /* Dimensions, especially f->height, must be done via change_frame_size.
10647 Change will not be effected unless different from the current
10650 height
= f
->height
;
10652 SET_FRAME_WIDTH (f
, 0);
10653 change_frame_size (f
, height
, width
, 1, 0, 0);
10655 /* Set up faces after all frame parameters are known. This call
10656 also merges in face attributes specified for new frames.
10658 Frame parameters may be changed if .Xdefaults contains
10659 specifications for the default font. For example, if there is an
10660 `Emacs.default.attributeBackground: pink', the `background-color'
10661 attribute of the frame get's set, which let's the internal border
10662 of the tooltip frame appear in pink. Prevent this. */
10664 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
10666 /* Set tip_frame here, so that */
10668 call1 (Qface_set_after_frame_default
, frame
);
10670 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
10671 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
10679 /* It is now ok to make the frame official even if we get an error
10680 below. And the frame needs to be on Vframe_list or making it
10681 visible won't work. */
10682 Vframe_list
= Fcons (frame
, Vframe_list
);
10684 /* Now that the frame is official, it counts as a reference to
10686 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10688 /* Setting attributes of faces of the tooltip frame from resources
10689 and similar will increment face_change_count, which leads to the
10690 clearing of all current matrices. Since this isn't necessary
10691 here, avoid it by resetting face_change_count to the value it
10692 had before we created the tip frame. */
10693 face_change_count
= face_change_count_before
;
10695 /* Discard the unwind_protect. */
10696 return unbind_to (count
, frame
);
10700 /* Compute where to display tip frame F. PARMS is the list of frame
10701 parameters for F. DX and DY are specified offsets from the current
10702 location of the mouse. Return coordinates relative to the root
10703 window of the display in *ROOT_X, and *ROOT_Y. */
10706 compute_tip_xy (f
, parms
, dx
, dy
, root_x
, root_y
)
10708 Lisp_Object parms
, dx
, dy
;
10709 int *root_x
, *root_y
;
10711 Lisp_Object left
, top
;
10713 Window root
, child
;
10716 /* User-specified position? */
10717 left
= Fcdr (Fassq (Qleft
, parms
));
10718 top
= Fcdr (Fassq (Qtop
, parms
));
10720 /* Move the tooltip window where the mouse pointer is. Resize and
10723 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10724 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
10727 *root_x
+= XINT (dx
);
10728 *root_y
+= XINT (dy
);
10730 if (INTEGERP (left
))
10731 *root_x
= XINT (left
);
10732 if (INTEGERP (top
))
10733 *root_y
= XINT (top
);
10737 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10738 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10739 A tooltip window is a small X window displaying a string.\n\
10741 FRAME nil or omitted means use the selected frame.\n\
10743 PARMS is an optional list of frame parameters which can be\n\
10744 used to change the tooltip's appearance.\n\
10746 Automatically hide the tooltip after TIMEOUT seconds.\n\
10747 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10749 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10750 the tooltip is displayed at that x-position. Otherwise it is\n\
10751 displayed at the mouse position, with offset DX added (default is 5 if\n\
10752 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10753 parameter is specified, it determines the y-position of the tooltip\n\
10754 window, otherwise it is displayed at the mouse position, with offset\n\
10755 DY added (default is -10).")
10756 (string
, frame
, parms
, timeout
, dx
, dy
)
10757 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10761 Lisp_Object buffer
, top
, left
;
10762 int root_x
, root_y
;
10763 struct buffer
*old_buffer
;
10764 struct text_pos pos
;
10765 int i
, width
, height
;
10766 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10767 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10768 int count
= BINDING_STACK_SIZE ();
10770 specbind (Qinhibit_redisplay
, Qt
);
10772 GCPRO4 (string
, parms
, frame
, timeout
);
10774 CHECK_STRING (string
, 0);
10775 f
= check_x_frame (frame
);
10776 if (NILP (timeout
))
10777 timeout
= make_number (5);
10779 CHECK_NATNUM (timeout
, 2);
10782 dx
= make_number (5);
10784 CHECK_NUMBER (dx
, 5);
10787 dy
= make_number (-10);
10789 CHECK_NUMBER (dy
, 6);
10791 if (NILP (last_show_tip_args
))
10792 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
10794 if (!NILP (tip_frame
))
10796 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
10797 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
10798 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
10800 if (EQ (frame
, last_frame
)
10801 && !NILP (Fequal (last_string
, string
))
10802 && !NILP (Fequal (last_parms
, parms
)))
10804 struct frame
*f
= XFRAME (tip_frame
);
10806 /* Only DX and DY have changed. */
10807 if (!NILP (tip_timer
))
10809 Lisp_Object timer
= tip_timer
;
10811 call1 (Qcancel_timer
, timer
);
10815 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
10816 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10817 root_x
, root_y
- PIXEL_HEIGHT (f
));
10823 /* Hide a previous tip, if any. */
10826 ASET (last_show_tip_args
, 0, string
);
10827 ASET (last_show_tip_args
, 1, frame
);
10828 ASET (last_show_tip_args
, 2, parms
);
10830 /* Add default values to frame parameters. */
10831 if (NILP (Fassq (Qname
, parms
)))
10832 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10833 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10834 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10835 if (NILP (Fassq (Qborder_width
, parms
)))
10836 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10837 if (NILP (Fassq (Qborder_color
, parms
)))
10838 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10839 if (NILP (Fassq (Qbackground_color
, parms
)))
10840 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10843 /* Create a frame for the tooltip, and record it in the global
10844 variable tip_frame. */
10845 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
10846 f
= XFRAME (frame
);
10848 /* Set up the frame's root window. Currently we use a size of 80
10849 columns x 40 lines. If someone wants to show a larger tip, he
10850 will loose. I don't think this is a realistic case. */
10851 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10852 w
->left
= w
->top
= make_number (0);
10853 w
->width
= make_number (80);
10854 w
->height
= make_number (40);
10856 w
->pseudo_window_p
= 1;
10858 /* Display the tooltip text in a temporary buffer. */
10859 buffer
= Fget_buffer_create (build_string (" *tip*"));
10860 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10861 old_buffer
= current_buffer
;
10862 set_buffer_internal_1 (XBUFFER (buffer
));
10864 Finsert (1, &string
);
10865 clear_glyph_matrix (w
->desired_matrix
);
10866 clear_glyph_matrix (w
->current_matrix
);
10867 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10868 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10870 /* Compute width and height of the tooltip. */
10871 width
= height
= 0;
10872 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10874 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10875 struct glyph
*last
;
10878 /* Stop at the first empty row at the end. */
10879 if (!row
->enabled_p
|| !row
->displays_text_p
)
10882 /* Let the row go over the full width of the frame. */
10883 row
->full_width_p
= 1;
10885 /* There's a glyph at the end of rows that is used to place
10886 the cursor there. Don't include the width of this glyph. */
10887 if (row
->used
[TEXT_AREA
])
10889 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10890 row_width
= row
->pixel_width
- last
->pixel_width
;
10893 row_width
= row
->pixel_width
;
10895 height
+= row
->height
;
10896 width
= max (width
, row_width
);
10899 /* Add the frame's internal border to the width and height the X
10900 window should have. */
10901 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10902 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10904 /* Move the tooltip window where the mouse pointer is. Resize and
10906 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
10909 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10910 root_x
, root_y
- height
, width
, height
);
10911 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10914 /* Draw into the window. */
10915 w
->must_be_updated_p
= 1;
10916 update_single_window (w
, 1);
10918 /* Restore original current buffer. */
10919 set_buffer_internal_1 (old_buffer
);
10920 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
10923 /* Let the tip disappear after timeout seconds. */
10924 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
10925 intern ("x-hide-tip"));
10928 return unbind_to (count
, Qnil
);
10932 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
10933 "Hide the current tooltip window, if there is any.\n\
10934 Value is t is tooltip was open, nil otherwise.")
10938 Lisp_Object deleted
, frame
, timer
;
10939 struct gcpro gcpro1
, gcpro2
;
10941 /* Return quickly if nothing to do. */
10942 if (NILP (tip_timer
) && NILP (tip_frame
))
10947 GCPRO2 (frame
, timer
);
10948 tip_frame
= tip_timer
= deleted
= Qnil
;
10950 count
= BINDING_STACK_SIZE ();
10951 specbind (Qinhibit_redisplay
, Qt
);
10952 specbind (Qinhibit_quit
, Qt
);
10955 call1 (Qcancel_timer
, timer
);
10957 if (FRAMEP (frame
))
10959 Fdelete_frame (frame
, Qnil
);
10963 /* Bloodcurdling hack alert: The Lucid menu bar widget's
10964 redisplay procedure is not called when a tip frame over menu
10965 items is unmapped. Redisplay the menu manually... */
10967 struct frame
*f
= SELECTED_FRAME ();
10968 Widget w
= f
->output_data
.x
->menubar_widget
;
10969 extern void xlwmenu_redisplay
P_ ((Widget
));
10971 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
10975 xlwmenu_redisplay (w
);
10979 #endif /* USE_LUCID */
10983 return unbind_to (count
, deleted
);
10988 /***********************************************************************
10989 File selection dialog
10990 ***********************************************************************/
10994 /* Callback for "OK" and "Cancel" on file selection dialog. */
10997 file_dialog_cb (widget
, client_data
, call_data
)
10999 XtPointer call_data
, client_data
;
11001 int *result
= (int *) client_data
;
11002 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11003 *result
= cb
->reason
;
11007 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11008 "Read file name, prompting with PROMPT in directory DIR.\n\
11009 Use a file selection dialog.\n\
11010 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
11011 specified. Don't let the user enter a file name in the file\n\
11012 selection dialog's entry field, if MUSTMATCH is non-nil.")
11013 (prompt
, dir
, default_filename
, mustmatch
)
11014 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11017 struct frame
*f
= SELECTED_FRAME ();
11018 Lisp_Object file
= Qnil
;
11019 Widget dialog
, text
, list
, help
;
11022 extern XtAppContext Xt_app_con
;
11024 XmString dir_xmstring
, pattern_xmstring
;
11025 int popup_activated_flag
;
11026 int count
= specpdl_ptr
- specpdl
;
11027 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11029 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11030 CHECK_STRING (prompt
, 0);
11031 CHECK_STRING (dir
, 1);
11033 /* Prevent redisplay. */
11034 specbind (Qinhibit_redisplay
, Qt
);
11038 /* Create the dialog with PROMPT as title, using DIR as initial
11039 directory and using "*" as pattern. */
11040 dir
= Fexpand_file_name (dir
, Qnil
);
11041 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11042 pattern_xmstring
= XmStringCreateLocalized ("*");
11044 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11045 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11046 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11047 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11048 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11049 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11051 XmStringFree (dir_xmstring
);
11052 XmStringFree (pattern_xmstring
);
11054 /* Add callbacks for OK and Cancel. */
11055 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11056 (XtPointer
) &result
);
11057 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11058 (XtPointer
) &result
);
11060 /* Disable the help button since we can't display help. */
11061 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11062 XtSetSensitive (help
, False
);
11064 /* Mark OK button as default. */
11065 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11066 XmNshowAsDefault
, True
, NULL
);
11068 /* If MUSTMATCH is non-nil, disable the file entry field of the
11069 dialog, so that the user must select a file from the files list
11070 box. We can't remove it because we wouldn't have a way to get at
11071 the result file name, then. */
11072 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11073 if (!NILP (mustmatch
))
11076 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11077 XtSetSensitive (text
, False
);
11078 XtSetSensitive (label
, False
);
11081 /* Manage the dialog, so that list boxes get filled. */
11082 XtManageChild (dialog
);
11084 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11085 must include the path for this to work. */
11086 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11087 if (STRINGP (default_filename
))
11089 XmString default_xmstring
;
11093 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11095 if (!XmListItemExists (list
, default_xmstring
))
11097 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11098 XmListAddItem (list
, default_xmstring
, 0);
11102 item_pos
= XmListItemPos (list
, default_xmstring
);
11103 XmStringFree (default_xmstring
);
11105 /* Select the item and scroll it into view. */
11106 XmListSelectPos (list
, item_pos
, True
);
11107 XmListSetPos (list
, item_pos
);
11110 /* Process events until the user presses Cancel or OK. */
11112 while (result
== 0 || XtAppPending (Xt_app_con
))
11113 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11115 /* Get the result. */
11116 if (result
== XmCR_OK
)
11121 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11122 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11123 XmStringFree (text
);
11124 file
= build_string (data
);
11131 XtUnmanageChild (dialog
);
11132 XtDestroyWidget (dialog
);
11136 /* Make "Cancel" equivalent to C-g. */
11138 Fsignal (Qquit
, Qnil
);
11140 return unbind_to (count
, file
);
11143 #endif /* USE_MOTIF */
11147 /***********************************************************************
11149 ***********************************************************************/
11151 #ifdef HAVE_XKBGETKEYBOARD
11152 #include <X11/XKBlib.h>
11153 #include <X11/keysym.h>
11156 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11157 Sx_backspace_delete_keys_p
, 0, 1, 0,
11158 "Check if both Backspace and Delete keys are on the keyboard of FRAME.\n\
11159 FRAME nil means use the selected frame.\n\
11160 Value is t if we know that both keys are present, and are mapped to the\n\
11165 #ifdef HAVE_XKBGETKEYBOARD
11167 struct frame
*f
= check_x_frame (frame
);
11168 Display
*dpy
= FRAME_X_DISPLAY (f
);
11169 Lisp_Object have_keys
;
11170 int major
, minor
, op
, event
, error
;
11174 /* Check library version in case we're dynamically linked. */
11175 major
= XkbMajorVersion
;
11176 minor
= XkbMinorVersion
;
11177 if (!XkbLibraryVersion (&major
, &minor
))
11183 /* Check that the server supports XKB. */
11184 major
= XkbMajorVersion
;
11185 minor
= XkbMinorVersion
;
11186 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11193 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11196 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11198 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11200 for (i
= kb
->min_key_code
;
11201 (i
< kb
->max_key_code
11202 && (delete_keycode
== 0 || backspace_keycode
== 0));
11205 /* The XKB symbolic key names can be seen most easily
11206 in the PS file generated by `xkbprint -label name $DISPLAY'. */
11207 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11208 delete_keycode
= i
;
11209 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11210 backspace_keycode
= i
;
11213 XkbFreeNames (kb
, 0, True
);
11216 XkbFreeClientMap (kb
, 0, True
);
11219 && backspace_keycode
11220 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11221 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11226 #else /* not HAVE_XKBGETKEYBOARD */
11228 #endif /* not HAVE_XKBGETKEYBOARD */
11233 /***********************************************************************
11235 ***********************************************************************/
11240 /* This is zero if not using X windows. */
11243 /* The section below is built by the lisp expression at the top of the file,
11244 just above where these variables are declared. */
11245 /*&&& init symbols here &&&*/
11246 Qauto_raise
= intern ("auto-raise");
11247 staticpro (&Qauto_raise
);
11248 Qauto_lower
= intern ("auto-lower");
11249 staticpro (&Qauto_lower
);
11250 Qbar
= intern ("bar");
11252 Qborder_color
= intern ("border-color");
11253 staticpro (&Qborder_color
);
11254 Qborder_width
= intern ("border-width");
11255 staticpro (&Qborder_width
);
11256 Qbox
= intern ("box");
11258 Qcursor_color
= intern ("cursor-color");
11259 staticpro (&Qcursor_color
);
11260 Qcursor_type
= intern ("cursor-type");
11261 staticpro (&Qcursor_type
);
11262 Qgeometry
= intern ("geometry");
11263 staticpro (&Qgeometry
);
11264 Qicon_left
= intern ("icon-left");
11265 staticpro (&Qicon_left
);
11266 Qicon_top
= intern ("icon-top");
11267 staticpro (&Qicon_top
);
11268 Qicon_type
= intern ("icon-type");
11269 staticpro (&Qicon_type
);
11270 Qicon_name
= intern ("icon-name");
11271 staticpro (&Qicon_name
);
11272 Qinternal_border_width
= intern ("internal-border-width");
11273 staticpro (&Qinternal_border_width
);
11274 Qleft
= intern ("left");
11275 staticpro (&Qleft
);
11276 Qright
= intern ("right");
11277 staticpro (&Qright
);
11278 Qmouse_color
= intern ("mouse-color");
11279 staticpro (&Qmouse_color
);
11280 Qnone
= intern ("none");
11281 staticpro (&Qnone
);
11282 Qparent_id
= intern ("parent-id");
11283 staticpro (&Qparent_id
);
11284 Qscroll_bar_width
= intern ("scroll-bar-width");
11285 staticpro (&Qscroll_bar_width
);
11286 Qsuppress_icon
= intern ("suppress-icon");
11287 staticpro (&Qsuppress_icon
);
11288 Qundefined_color
= intern ("undefined-color");
11289 staticpro (&Qundefined_color
);
11290 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11291 staticpro (&Qvertical_scroll_bars
);
11292 Qvisibility
= intern ("visibility");
11293 staticpro (&Qvisibility
);
11294 Qwindow_id
= intern ("window-id");
11295 staticpro (&Qwindow_id
);
11296 Qouter_window_id
= intern ("outer-window-id");
11297 staticpro (&Qouter_window_id
);
11298 Qx_frame_parameter
= intern ("x-frame-parameter");
11299 staticpro (&Qx_frame_parameter
);
11300 Qx_resource_name
= intern ("x-resource-name");
11301 staticpro (&Qx_resource_name
);
11302 Quser_position
= intern ("user-position");
11303 staticpro (&Quser_position
);
11304 Quser_size
= intern ("user-size");
11305 staticpro (&Quser_size
);
11306 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11307 staticpro (&Qscroll_bar_foreground
);
11308 Qscroll_bar_background
= intern ("scroll-bar-background");
11309 staticpro (&Qscroll_bar_background
);
11310 Qscreen_gamma
= intern ("screen-gamma");
11311 staticpro (&Qscreen_gamma
);
11312 Qline_spacing
= intern ("line-spacing");
11313 staticpro (&Qline_spacing
);
11314 Qcenter
= intern ("center");
11315 staticpro (&Qcenter
);
11316 Qcompound_text
= intern ("compound-text");
11317 staticpro (&Qcompound_text
);
11318 Qcancel_timer
= intern ("cancel-timer");
11319 staticpro (&Qcancel_timer
);
11320 /* This is the end of symbol initialization. */
11322 /* Text property `display' should be nonsticky by default. */
11323 Vtext_property_default_nonsticky
11324 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11327 Qlaplace
= intern ("laplace");
11328 staticpro (&Qlaplace
);
11329 Qemboss
= intern ("emboss");
11330 staticpro (&Qemboss
);
11331 Qedge_detection
= intern ("edge-detection");
11332 staticpro (&Qedge_detection
);
11333 Qheuristic
= intern ("heuristic");
11334 staticpro (&Qheuristic
);
11335 QCmatrix
= intern (":matrix");
11336 staticpro (&QCmatrix
);
11337 QCcolor_adjustment
= intern (":color-adjustment");
11338 staticpro (&QCcolor_adjustment
);
11339 QCmask
= intern (":mask");
11340 staticpro (&QCmask
);
11342 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11343 staticpro (&Qface_set_after_frame_default
);
11345 Fput (Qundefined_color
, Qerror_conditions
,
11346 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11347 Fput (Qundefined_color
, Qerror_message
,
11348 build_string ("Undefined color"));
11350 init_x_parm_symbols ();
11352 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11353 "Non-nil means always draw a cross over disabled images.\n\
11354 Disabled images are those having an `:conversion disabled' property.\n\
11355 A cross is always drawn on black & white displays.");
11356 cross_disabled_images
= 0;
11358 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11359 "List of directories to search for bitmap files for X.");
11360 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11362 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11363 "The shape of the pointer when over text.\n\
11364 Changing the value does not affect existing frames\n\
11365 unless you set the mouse color.");
11366 Vx_pointer_shape
= Qnil
;
11368 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11369 "The name Emacs uses to look up X resources.\n\
11370 `x-get-resource' uses this as the first component of the instance name\n\
11371 when requesting resource values.\n\
11372 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
11373 was invoked, or to the value specified with the `-name' or `-rn'\n\
11374 switches, if present.\n\
11376 It may be useful to bind this variable locally around a call\n\
11377 to `x-get-resource'. See also the variable `x-resource-class'.");
11378 Vx_resource_name
= Qnil
;
11380 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11381 "The class Emacs uses to look up X resources.\n\
11382 `x-get-resource' uses this as the first component of the instance class\n\
11383 when requesting resource values.\n\
11384 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
11386 Setting this variable permanently is not a reasonable thing to do,\n\
11387 but binding this variable locally around a call to `x-get-resource'\n\
11388 is a reasonable practice. See also the variable `x-resource-name'.");
11389 Vx_resource_class
= build_string (EMACS_CLASS
);
11391 #if 0 /* This doesn't really do anything. */
11392 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11393 "The shape of the pointer when not over text.\n\
11394 This variable takes effect when you create a new frame\n\
11395 or when you set the mouse color.");
11397 Vx_nontext_pointer_shape
= Qnil
;
11399 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
11400 "The shape of the pointer when Emacs is busy.\n\
11401 This variable takes effect when you create a new frame\n\
11402 or when you set the mouse color.");
11403 Vx_busy_pointer_shape
= Qnil
;
11405 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
11406 "Non-zero means Emacs displays a busy cursor on window systems.");
11407 display_busy_cursor_p
= 1;
11409 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay
,
11410 "*Seconds to wait before displaying a busy-cursor.\n\
11411 Value must be an integer or float.");
11412 Vbusy_cursor_delay
= make_number (DEFAULT_BUSY_CURSOR_DELAY
);
11414 #if 0 /* This doesn't really do anything. */
11415 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11416 "The shape of the pointer when over the mode line.\n\
11417 This variable takes effect when you create a new frame\n\
11418 or when you set the mouse color.");
11420 Vx_mode_pointer_shape
= Qnil
;
11422 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11423 &Vx_sensitive_text_pointer_shape
,
11424 "The shape of the pointer when over mouse-sensitive text.\n\
11425 This variable takes effect when you create a new frame\n\
11426 or when you set the mouse color.");
11427 Vx_sensitive_text_pointer_shape
= Qnil
;
11429 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11430 &Vx_window_horizontal_drag_shape
,
11431 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
11432 This variable takes effect when you create a new frame\n\
11433 or when you set the mouse color.");
11434 Vx_window_horizontal_drag_shape
= Qnil
;
11436 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11437 "A string indicating the foreground color of the cursor box.");
11438 Vx_cursor_fore_pixel
= Qnil
;
11440 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11441 "Non-nil if no X window manager is in use.\n\
11442 Emacs doesn't try to figure this out; this is always nil\n\
11443 unless you set it to something else.");
11444 /* We don't have any way to find this out, so set it to nil
11445 and maybe the user would like to set it to t. */
11446 Vx_no_window_manager
= Qnil
;
11448 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11449 &Vx_pixel_size_width_font_regexp
,
11450 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11452 Since Emacs gets width of a font matching with this regexp from\n\
11453 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11454 such a font. This is especially effective for such large fonts as\n\
11455 Chinese, Japanese, and Korean.");
11456 Vx_pixel_size_width_font_regexp
= Qnil
;
11458 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11459 "Time after which cached images are removed from the cache.\n\
11460 When an image has not been displayed this many seconds, remove it\n\
11461 from the image cache. Value must be an integer or nil with nil\n\
11462 meaning don't clear the cache.");
11463 Vimage_cache_eviction_delay
= make_number (30 * 60);
11465 #ifdef USE_X_TOOLKIT
11466 Fprovide (intern ("x-toolkit"));
11469 Fprovide (intern ("motif"));
11472 defsubr (&Sx_get_resource
);
11474 /* X window properties. */
11475 defsubr (&Sx_change_window_property
);
11476 defsubr (&Sx_delete_window_property
);
11477 defsubr (&Sx_window_property
);
11479 defsubr (&Sxw_display_color_p
);
11480 defsubr (&Sx_display_grayscale_p
);
11481 defsubr (&Sxw_color_defined_p
);
11482 defsubr (&Sxw_color_values
);
11483 defsubr (&Sx_server_max_request_size
);
11484 defsubr (&Sx_server_vendor
);
11485 defsubr (&Sx_server_version
);
11486 defsubr (&Sx_display_pixel_width
);
11487 defsubr (&Sx_display_pixel_height
);
11488 defsubr (&Sx_display_mm_width
);
11489 defsubr (&Sx_display_mm_height
);
11490 defsubr (&Sx_display_screens
);
11491 defsubr (&Sx_display_planes
);
11492 defsubr (&Sx_display_color_cells
);
11493 defsubr (&Sx_display_visual_class
);
11494 defsubr (&Sx_display_backing_store
);
11495 defsubr (&Sx_display_save_under
);
11496 defsubr (&Sx_parse_geometry
);
11497 defsubr (&Sx_create_frame
);
11498 defsubr (&Sx_open_connection
);
11499 defsubr (&Sx_close_connection
);
11500 defsubr (&Sx_display_list
);
11501 defsubr (&Sx_synchronize
);
11502 defsubr (&Sx_focus_frame
);
11503 defsubr (&Sx_backspace_delete_keys_p
);
11505 /* Setting callback functions for fontset handler. */
11506 get_font_info_func
= x_get_font_info
;
11508 #if 0 /* This function pointer doesn't seem to be used anywhere.
11509 And the pointer assigned has the wrong type, anyway. */
11510 list_fonts_func
= x_list_fonts
;
11513 load_font_func
= x_load_font
;
11514 find_ccl_program_func
= x_find_ccl_program
;
11515 query_font_func
= x_query_font
;
11516 set_frame_fontset_func
= x_set_font
;
11517 check_window_system_func
= check_x
;
11520 Qxbm
= intern ("xbm");
11522 QCtype
= intern (":type");
11523 staticpro (&QCtype
);
11524 QCconversion
= intern (":conversion");
11525 staticpro (&QCconversion
);
11526 QCheuristic_mask
= intern (":heuristic-mask");
11527 staticpro (&QCheuristic_mask
);
11528 QCcolor_symbols
= intern (":color-symbols");
11529 staticpro (&QCcolor_symbols
);
11530 QCascent
= intern (":ascent");
11531 staticpro (&QCascent
);
11532 QCmargin
= intern (":margin");
11533 staticpro (&QCmargin
);
11534 QCrelief
= intern (":relief");
11535 staticpro (&QCrelief
);
11536 Qpostscript
= intern ("postscript");
11537 staticpro (&Qpostscript
);
11538 QCloader
= intern (":loader");
11539 staticpro (&QCloader
);
11540 QCbounding_box
= intern (":bounding-box");
11541 staticpro (&QCbounding_box
);
11542 QCpt_width
= intern (":pt-width");
11543 staticpro (&QCpt_width
);
11544 QCpt_height
= intern (":pt-height");
11545 staticpro (&QCpt_height
);
11546 QCindex
= intern (":index");
11547 staticpro (&QCindex
);
11548 Qpbm
= intern ("pbm");
11552 Qxpm
= intern ("xpm");
11557 Qjpeg
= intern ("jpeg");
11558 staticpro (&Qjpeg
);
11562 Qtiff
= intern ("tiff");
11563 staticpro (&Qtiff
);
11567 Qgif
= intern ("gif");
11572 Qpng
= intern ("png");
11576 defsubr (&Sclear_image_cache
);
11577 defsubr (&Simage_size
);
11578 defsubr (&Simage_mask_p
);
11580 busy_cursor_atimer
= NULL
;
11581 busy_cursor_shown_p
= 0;
11583 defsubr (&Sx_show_tip
);
11584 defsubr (&Sx_hide_tip
);
11586 staticpro (&tip_timer
);
11588 staticpro (&tip_frame
);
11590 last_show_tip_args
= Qnil
;
11591 staticpro (&last_show_tip_args
);
11594 defsubr (&Sx_file_dialog
);
11602 image_types
= NULL
;
11603 Vimage_types
= Qnil
;
11605 define_image_type (&xbm_type
);
11606 define_image_type (&gs_type
);
11607 define_image_type (&pbm_type
);
11610 define_image_type (&xpm_type
);
11614 define_image_type (&jpeg_type
);
11618 define_image_type (&tiff_type
);
11622 define_image_type (&gif_type
);
11626 define_image_type (&png_type
);
11630 #endif /* HAVE_X_WINDOWS */