1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999, 2000, 2001
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
27 /* This makes the fields of a Display accessible, in Xlib header files. */
29 #define XLIB_ILLEGAL_ACCESS
36 #include "intervals.h"
37 #include "dispextern.h"
39 #include "blockinput.h"
45 #include "termhooks.h"
51 #include <sys/types.h>
55 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
56 #include "bitmaps/gray.xbm"
58 #include <X11/bitmaps/gray>
61 #include "[.bitmaps]gray.xbm"
65 #include <X11/Shell.h>
68 #include <X11/Xaw/Paned.h>
69 #include <X11/Xaw/Label.h>
70 #endif /* USE_MOTIF */
73 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
82 #include "../lwlib/lwlib.h"
86 #include <Xm/DialogS.h>
87 #include <Xm/FileSB.h>
90 /* Do the EDITRES protocol if running X11R5
91 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
93 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
95 extern void _XEditResCheckMessages ();
96 #endif /* R5 + Athena */
98 /* Unique id counter for widgets created by the Lucid Widget Library. */
100 extern LWLIB_ID widget_id_tick
;
103 /* This is part of a kludge--see lwlib/xlwmenu.c. */
104 extern XFontStruct
*xlwmenu_default_font
;
107 extern void free_frame_menubar ();
108 extern double atof ();
110 #endif /* USE_X_TOOLKIT */
112 #define min(a,b) ((a) < (b) ? (a) : (b))
113 #define max(a,b) ((a) > (b) ? (a) : (b))
116 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
118 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
121 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
122 it, and including `bitmaps/gray' more than once is a problem when
123 config.h defines `static' as an empty replacement string. */
125 int gray_bitmap_width
= gray_width
;
126 int gray_bitmap_height
= gray_height
;
127 char *gray_bitmap_bits
= gray_bits
;
129 /* The name we're using in resource queries. Most often "emacs". */
131 Lisp_Object Vx_resource_name
;
133 /* The application class we're using in resource queries.
136 Lisp_Object Vx_resource_class
;
138 /* Non-zero means we're allowed to display an hourglass cursor. */
140 int display_hourglass_p
;
142 /* The background and shape of the mouse pointer, and shape when not
143 over text or in the modeline. */
145 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
146 Lisp_Object Vx_hourglass_pointer_shape
;
148 /* The shape when over mouse-sensitive text. */
150 Lisp_Object Vx_sensitive_text_pointer_shape
;
152 /* If non-nil, the pointer shape to indicate that windows can be
153 dragged horizontally. */
155 Lisp_Object Vx_window_horizontal_drag_shape
;
157 /* Color of chars displayed in cursor box. */
159 Lisp_Object Vx_cursor_fore_pixel
;
161 /* Nonzero if using X. */
165 /* Non nil if no window manager is in use. */
167 Lisp_Object Vx_no_window_manager
;
169 /* Search path for bitmap files. */
171 Lisp_Object Vx_bitmap_file_path
;
173 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
175 Lisp_Object Vx_pixel_size_width_font_regexp
;
177 Lisp_Object Qauto_raise
;
178 Lisp_Object Qauto_lower
;
180 Lisp_Object Qborder_color
;
181 Lisp_Object Qborder_width
;
183 Lisp_Object Qcursor_color
;
184 Lisp_Object Qcursor_type
;
185 Lisp_Object Qgeometry
;
186 Lisp_Object Qicon_left
;
187 Lisp_Object Qicon_top
;
188 Lisp_Object Qicon_type
;
189 Lisp_Object Qicon_name
;
190 Lisp_Object Qinternal_border_width
;
193 Lisp_Object Qmouse_color
;
195 Lisp_Object Qouter_window_id
;
196 Lisp_Object Qparent_id
;
197 Lisp_Object Qscroll_bar_width
;
198 Lisp_Object Qsuppress_icon
;
199 extern Lisp_Object Qtop
;
200 Lisp_Object Qundefined_color
;
201 Lisp_Object Qvertical_scroll_bars
;
202 Lisp_Object Qvisibility
;
203 Lisp_Object Qwindow_id
;
204 Lisp_Object Qx_frame_parameter
;
205 Lisp_Object Qx_resource_name
;
206 Lisp_Object Quser_position
;
207 Lisp_Object Quser_size
;
208 extern Lisp_Object Qdisplay
;
209 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
210 Lisp_Object Qscreen_gamma
, Qline_spacing
, Qcenter
;
211 Lisp_Object Qcompound_text
, Qcancel_timer
;
213 /* The below are defined in frame.c. */
215 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
216 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
217 extern Lisp_Object Qtool_bar_lines
;
219 extern Lisp_Object Vwindow_system_version
;
221 Lisp_Object Qface_set_after_frame_default
;
224 int image_cache_refcount
, dpyinfo_refcount
;
229 /* Error if we are not connected to X. */
235 error ("X windows are not in use or not initialized");
238 /* Nonzero if we can use mouse menus.
239 You should not call this unless HAVE_MENUS is defined. */
247 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
248 and checking validity for X. */
251 check_x_frame (frame
)
257 frame
= selected_frame
;
258 CHECK_LIVE_FRAME (frame
, 0);
261 error ("Non-X frame used");
265 /* Let the user specify an X display with a frame.
266 nil stands for the selected frame--or, if that is not an X frame,
267 the first X display on the list. */
269 static struct x_display_info
*
270 check_x_display_info (frame
)
273 struct x_display_info
*dpyinfo
= NULL
;
277 struct frame
*sf
= XFRAME (selected_frame
);
279 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
280 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
281 else if (x_display_list
!= 0)
282 dpyinfo
= x_display_list
;
284 error ("X windows are not in use or not initialized");
286 else if (STRINGP (frame
))
287 dpyinfo
= x_display_info_for_name (frame
);
292 CHECK_LIVE_FRAME (frame
, 0);
295 error ("Non-X frame used");
296 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
303 /* Return the Emacs frame-object corresponding to an X window.
304 It could be the frame's main window or an icon window. */
306 /* This function can be called during GC, so use GC_xxx type test macros. */
309 x_window_to_frame (dpyinfo
, wdesc
)
310 struct x_display_info
*dpyinfo
;
313 Lisp_Object tail
, frame
;
316 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
319 if (!GC_FRAMEP (frame
))
322 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
324 if (f
->output_data
.x
->hourglass_window
== wdesc
)
327 if ((f
->output_data
.x
->edit_widget
328 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
329 /* A tooltip frame? */
330 || (!f
->output_data
.x
->edit_widget
331 && FRAME_X_WINDOW (f
) == wdesc
)
332 || f
->output_data
.x
->icon_desc
== wdesc
)
334 #else /* not USE_X_TOOLKIT */
335 if (FRAME_X_WINDOW (f
) == wdesc
336 || f
->output_data
.x
->icon_desc
== wdesc
)
338 #endif /* not USE_X_TOOLKIT */
344 /* Like x_window_to_frame but also compares the window with the widget's
348 x_any_window_to_frame (dpyinfo
, wdesc
)
349 struct x_display_info
*dpyinfo
;
352 Lisp_Object tail
, frame
;
353 struct frame
*f
, *found
;
357 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
360 if (!GC_FRAMEP (frame
))
364 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
366 /* This frame matches if the window is any of its widgets. */
367 x
= f
->output_data
.x
;
368 if (x
->hourglass_window
== wdesc
)
372 if (wdesc
== XtWindow (x
->widget
)
373 || wdesc
== XtWindow (x
->column_widget
)
374 || wdesc
== XtWindow (x
->edit_widget
))
376 /* Match if the window is this frame's menubar. */
377 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
380 else if (FRAME_X_WINDOW (f
) == wdesc
)
381 /* A tooltip frame. */
389 /* Likewise, but exclude the menu bar widget. */
392 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
393 struct x_display_info
*dpyinfo
;
396 Lisp_Object tail
, frame
;
400 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
403 if (!GC_FRAMEP (frame
))
406 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
408 x
= f
->output_data
.x
;
409 /* This frame matches if the window is any of its widgets. */
410 if (x
->hourglass_window
== wdesc
)
414 if (wdesc
== XtWindow (x
->widget
)
415 || wdesc
== XtWindow (x
->column_widget
)
416 || wdesc
== XtWindow (x
->edit_widget
))
419 else if (FRAME_X_WINDOW (f
) == wdesc
)
420 /* A tooltip frame. */
426 /* Likewise, but consider only the menu bar widget. */
429 x_menubar_window_to_frame (dpyinfo
, wdesc
)
430 struct x_display_info
*dpyinfo
;
433 Lisp_Object tail
, frame
;
437 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
440 if (!GC_FRAMEP (frame
))
443 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
445 x
= f
->output_data
.x
;
446 /* Match if the window is this frame's menubar. */
447 if (x
->menubar_widget
448 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
454 /* Return the frame whose principal (outermost) window is WDESC.
455 If WDESC is some other (smaller) window, we return 0. */
458 x_top_window_to_frame (dpyinfo
, wdesc
)
459 struct x_display_info
*dpyinfo
;
462 Lisp_Object tail
, frame
;
466 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
469 if (!GC_FRAMEP (frame
))
472 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
474 x
= f
->output_data
.x
;
478 /* This frame matches if the window is its topmost widget. */
479 if (wdesc
== XtWindow (x
->widget
))
481 #if 0 /* I don't know why it did this,
482 but it seems logically wrong,
483 and it causes trouble for MapNotify events. */
484 /* Match if the window is this frame's menubar. */
485 if (x
->menubar_widget
486 && wdesc
== XtWindow (x
->menubar_widget
))
490 else if (FRAME_X_WINDOW (f
) == wdesc
)
496 #endif /* USE_X_TOOLKIT */
500 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
501 id, which is just an int that this section returns. Bitmaps are
502 reference counted so they can be shared among frames.
504 Bitmap indices are guaranteed to be > 0, so a negative number can
505 be used to indicate no bitmap.
507 If you use x_create_bitmap_from_data, then you must keep track of
508 the bitmaps yourself. That is, creating a bitmap from the same
509 data more than once will not be caught. */
512 /* Functions to access the contents of a bitmap, given an id. */
515 x_bitmap_height (f
, id
)
519 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
523 x_bitmap_width (f
, id
)
527 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
531 x_bitmap_pixmap (f
, id
)
535 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
539 /* Allocate a new bitmap record. Returns index of new record. */
542 x_allocate_bitmap_record (f
)
545 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
548 if (dpyinfo
->bitmaps
== NULL
)
550 dpyinfo
->bitmaps_size
= 10;
552 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
553 dpyinfo
->bitmaps_last
= 1;
557 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
558 return ++dpyinfo
->bitmaps_last
;
560 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
561 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
564 dpyinfo
->bitmaps_size
*= 2;
566 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
567 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
568 return ++dpyinfo
->bitmaps_last
;
571 /* Add one reference to the reference count of the bitmap with id ID. */
574 x_reference_bitmap (f
, id
)
578 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
581 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
584 x_create_bitmap_from_data (f
, bits
, width
, height
)
587 unsigned int width
, height
;
589 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
593 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
594 bits
, width
, height
);
599 id
= x_allocate_bitmap_record (f
);
600 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
601 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
602 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
603 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
604 dpyinfo
->bitmaps
[id
- 1].height
= height
;
605 dpyinfo
->bitmaps
[id
- 1].width
= width
;
610 /* Create bitmap from file FILE for frame F. */
613 x_create_bitmap_from_file (f
, file
)
617 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
618 unsigned int width
, height
;
620 int xhot
, yhot
, result
, id
;
625 /* Look for an existing bitmap with the same name. */
626 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
628 if (dpyinfo
->bitmaps
[id
].refcount
629 && dpyinfo
->bitmaps
[id
].file
630 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
632 ++dpyinfo
->bitmaps
[id
].refcount
;
637 /* Search bitmap-file-path for the file, if appropriate. */
638 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
643 filename
= (char *) XSTRING (found
)->data
;
645 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
646 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
647 if (result
!= BitmapSuccess
)
650 id
= x_allocate_bitmap_record (f
);
651 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
652 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
653 dpyinfo
->bitmaps
[id
- 1].file
654 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
655 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
656 dpyinfo
->bitmaps
[id
- 1].height
= height
;
657 dpyinfo
->bitmaps
[id
- 1].width
= width
;
658 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
663 /* Remove reference to bitmap with id number ID. */
666 x_destroy_bitmap (f
, id
)
670 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
674 --dpyinfo
->bitmaps
[id
- 1].refcount
;
675 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
678 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
679 if (dpyinfo
->bitmaps
[id
- 1].file
)
681 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
682 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
689 /* Free all the bitmaps for the display specified by DPYINFO. */
692 x_destroy_all_bitmaps (dpyinfo
)
693 struct x_display_info
*dpyinfo
;
696 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
697 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
699 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
700 if (dpyinfo
->bitmaps
[i
].file
)
701 xfree (dpyinfo
->bitmaps
[i
].file
);
703 dpyinfo
->bitmaps_last
= 0;
706 /* Connect the frame-parameter names for X frames
707 to the ways of passing the parameter values to the window system.
709 The name of a parameter, as a Lisp symbol,
710 has an `x-frame-parameter' property which is an integer in Lisp
711 that is an index in this table. */
713 struct x_frame_parm_table
716 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
719 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
720 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
721 static void x_change_window_heights
P_ ((Lisp_Object
, int));
722 static void x_disable_image
P_ ((struct frame
*, struct image
*));
723 static void x_create_im
P_ ((struct frame
*));
724 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
725 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
726 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
727 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
728 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
729 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
730 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
731 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
732 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
733 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
734 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
735 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
737 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
738 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
739 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
740 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
742 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
743 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
744 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
745 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
746 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
750 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
752 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
757 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
760 static void init_color_table
P_ ((void));
761 static void free_color_table
P_ ((void));
762 static unsigned long *colors_in_color_table
P_ ((int *n
));
763 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
764 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
768 static struct x_frame_parm_table x_frame_parms
[] =
770 "auto-raise", x_set_autoraise
,
771 "auto-lower", x_set_autolower
,
772 "background-color", x_set_background_color
,
773 "border-color", x_set_border_color
,
774 "border-width", x_set_border_width
,
775 "cursor-color", x_set_cursor_color
,
776 "cursor-type", x_set_cursor_type
,
778 "foreground-color", x_set_foreground_color
,
779 "icon-name", x_set_icon_name
,
780 "icon-type", x_set_icon_type
,
781 "internal-border-width", x_set_internal_border_width
,
782 "menu-bar-lines", x_set_menu_bar_lines
,
783 "mouse-color", x_set_mouse_color
,
784 "name", x_explicitly_set_name
,
785 "scroll-bar-width", x_set_scroll_bar_width
,
786 "title", x_set_title
,
787 "unsplittable", x_set_unsplittable
,
788 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
789 "visibility", x_set_visibility
,
790 "tool-bar-lines", x_set_tool_bar_lines
,
791 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
792 "scroll-bar-background", x_set_scroll_bar_background
,
793 "screen-gamma", x_set_screen_gamma
,
794 "line-spacing", x_set_line_spacing
797 /* Attach the `x-frame-parameter' properties to
798 the Lisp symbol names of parameters relevant to X. */
801 init_x_parm_symbols ()
805 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
806 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
810 /* Change the parameters of frame F as specified by ALIST.
811 If a parameter is not specially recognized, do nothing special;
812 otherwise call the `x_set_...' function for that parameter.
813 Except for certain geometry properties, always call store_frame_param
814 to store the new value in the parameter alist. */
817 x_set_frame_parameters (f
, alist
)
823 /* If both of these parameters are present, it's more efficient to
824 set them both at once. So we wait until we've looked at the
825 entire list before we set them. */
829 Lisp_Object left
, top
;
831 /* Same with these. */
832 Lisp_Object icon_left
, icon_top
;
834 /* Record in these vectors all the parms specified. */
838 int left_no_change
= 0, top_no_change
= 0;
839 int icon_left_no_change
= 0, icon_top_no_change
= 0;
841 struct gcpro gcpro1
, gcpro2
;
844 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
847 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
848 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
850 /* Extract parm names and values into those vectors. */
853 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
858 parms
[i
] = Fcar (elt
);
859 values
[i
] = Fcdr (elt
);
862 /* TAIL and ALIST are not used again below here. */
865 GCPRO2 (*parms
, *values
);
869 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
870 because their values appear in VALUES and strings are not valid. */
871 top
= left
= Qunbound
;
872 icon_left
= icon_top
= Qunbound
;
874 /* Provide default values for HEIGHT and WIDTH. */
875 if (FRAME_NEW_WIDTH (f
))
876 width
= FRAME_NEW_WIDTH (f
);
878 width
= FRAME_WIDTH (f
);
880 if (FRAME_NEW_HEIGHT (f
))
881 height
= FRAME_NEW_HEIGHT (f
);
883 height
= FRAME_HEIGHT (f
);
885 /* Process foreground_color and background_color before anything else.
886 They are independent of other properties, but other properties (e.g.,
887 cursor_color) are dependent upon them. */
888 for (p
= 0; p
< i
; p
++)
890 Lisp_Object prop
, val
;
894 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
896 register Lisp_Object param_index
, old_value
;
898 param_index
= Fget (prop
, Qx_frame_parameter
);
899 old_value
= get_frame_param (f
, prop
);
900 store_frame_param (f
, prop
, val
);
901 if (NATNUMP (param_index
)
902 && (XFASTINT (param_index
)
903 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
904 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
908 /* Now process them in reverse of specified order. */
909 for (i
--; i
>= 0; i
--)
911 Lisp_Object prop
, val
;
916 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
917 width
= XFASTINT (val
);
918 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
919 height
= XFASTINT (val
);
920 else if (EQ (prop
, Qtop
))
922 else if (EQ (prop
, Qleft
))
924 else if (EQ (prop
, Qicon_top
))
926 else if (EQ (prop
, Qicon_left
))
928 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
929 /* Processed above. */
933 register Lisp_Object param_index
, old_value
;
935 param_index
= Fget (prop
, Qx_frame_parameter
);
936 old_value
= get_frame_param (f
, prop
);
937 store_frame_param (f
, prop
, val
);
938 if (NATNUMP (param_index
)
939 && (XFASTINT (param_index
)
940 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
941 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
945 /* Don't die if just one of these was set. */
946 if (EQ (left
, Qunbound
))
949 if (f
->output_data
.x
->left_pos
< 0)
950 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
952 XSETINT (left
, f
->output_data
.x
->left_pos
);
954 if (EQ (top
, Qunbound
))
957 if (f
->output_data
.x
->top_pos
< 0)
958 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
960 XSETINT (top
, f
->output_data
.x
->top_pos
);
963 /* If one of the icon positions was not set, preserve or default it. */
964 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
966 icon_left_no_change
= 1;
967 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
968 if (NILP (icon_left
))
969 XSETINT (icon_left
, 0);
971 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
973 icon_top_no_change
= 1;
974 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
976 XSETINT (icon_top
, 0);
979 /* Don't set these parameters unless they've been explicitly
980 specified. The window might be mapped or resized while we're in
981 this function, and we don't want to override that unless the lisp
982 code has asked for it.
984 Don't set these parameters unless they actually differ from the
985 window's current parameters; the window may not actually exist
990 check_frame_size (f
, &height
, &width
);
992 XSETFRAME (frame
, f
);
994 if (width
!= FRAME_WIDTH (f
)
995 || height
!= FRAME_HEIGHT (f
)
996 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
997 Fset_frame_size (frame
, make_number (width
), make_number (height
));
999 if ((!NILP (left
) || !NILP (top
))
1000 && ! (left_no_change
&& top_no_change
)
1001 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1002 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1007 /* Record the signs. */
1008 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1009 if (EQ (left
, Qminus
))
1010 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1011 else if (INTEGERP (left
))
1013 leftpos
= XINT (left
);
1015 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1017 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1018 && CONSP (XCDR (left
))
1019 && INTEGERP (XCAR (XCDR (left
))))
1021 leftpos
= - XINT (XCAR (XCDR (left
)));
1022 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1024 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1025 && CONSP (XCDR (left
))
1026 && INTEGERP (XCAR (XCDR (left
))))
1028 leftpos
= XINT (XCAR (XCDR (left
)));
1031 if (EQ (top
, Qminus
))
1032 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1033 else if (INTEGERP (top
))
1035 toppos
= XINT (top
);
1037 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1039 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1040 && CONSP (XCDR (top
))
1041 && INTEGERP (XCAR (XCDR (top
))))
1043 toppos
= - XINT (XCAR (XCDR (top
)));
1044 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1046 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1047 && CONSP (XCDR (top
))
1048 && INTEGERP (XCAR (XCDR (top
))))
1050 toppos
= XINT (XCAR (XCDR (top
)));
1054 /* Store the numeric value of the position. */
1055 f
->output_data
.x
->top_pos
= toppos
;
1056 f
->output_data
.x
->left_pos
= leftpos
;
1058 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1060 /* Actually set that position, and convert to absolute. */
1061 x_set_offset (f
, leftpos
, toppos
, -1);
1064 if ((!NILP (icon_left
) || !NILP (icon_top
))
1065 && ! (icon_left_no_change
&& icon_top_no_change
))
1066 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1072 /* Store the screen positions of frame F into XPTR and YPTR.
1073 These are the positions of the containing window manager window,
1074 not Emacs's own window. */
1077 x_real_positions (f
, xptr
, yptr
)
1084 /* This is pretty gross, but seems to be the easiest way out of
1085 the problem that arises when restarting window-managers. */
1087 #ifdef USE_X_TOOLKIT
1088 Window outer
= (f
->output_data
.x
->widget
1089 ? XtWindow (f
->output_data
.x
->widget
)
1090 : FRAME_X_WINDOW (f
));
1092 Window outer
= f
->output_data
.x
->window_desc
;
1094 Window tmp_root_window
;
1095 Window
*tmp_children
;
1096 unsigned int tmp_nchildren
;
1100 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1101 Window outer_window
;
1103 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1104 &f
->output_data
.x
->parent_desc
,
1105 &tmp_children
, &tmp_nchildren
);
1106 XFree ((char *) tmp_children
);
1110 /* Find the position of the outside upper-left corner of
1111 the inner window, with respect to the outer window. */
1112 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1113 outer_window
= f
->output_data
.x
->parent_desc
;
1115 outer_window
= outer
;
1117 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1119 /* From-window, to-window. */
1121 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1123 /* From-position, to-position. */
1124 0, 0, &win_x
, &win_y
,
1129 /* It is possible for the window returned by the XQueryNotify
1130 to become invalid by the time we call XTranslateCoordinates.
1131 That can happen when you restart some window managers.
1132 If so, we get an error in XTranslateCoordinates.
1133 Detect that and try the whole thing over. */
1134 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1136 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1140 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1147 /* Insert a description of internally-recorded parameters of frame X
1148 into the parameter alist *ALISTPTR that is to be given to the user.
1149 Only parameters that are specific to the X window system
1150 and whose values are not correctly recorded in the frame's
1151 param_alist need to be considered here. */
1154 x_report_frame_params (f
, alistptr
)
1156 Lisp_Object
*alistptr
;
1161 /* Represent negative positions (off the top or left screen edge)
1162 in a way that Fmodify_frame_parameters will understand correctly. */
1163 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1164 if (f
->output_data
.x
->left_pos
>= 0)
1165 store_in_alist (alistptr
, Qleft
, tem
);
1167 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1169 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1170 if (f
->output_data
.x
->top_pos
>= 0)
1171 store_in_alist (alistptr
, Qtop
, tem
);
1173 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1175 store_in_alist (alistptr
, Qborder_width
,
1176 make_number (f
->output_data
.x
->border_width
));
1177 store_in_alist (alistptr
, Qinternal_border_width
,
1178 make_number (f
->output_data
.x
->internal_border_width
));
1179 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1180 store_in_alist (alistptr
, Qwindow_id
,
1181 build_string (buf
));
1182 #ifdef USE_X_TOOLKIT
1183 /* Tooltip frame may not have this widget. */
1184 if (f
->output_data
.x
->widget
)
1186 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1187 store_in_alist (alistptr
, Qouter_window_id
,
1188 build_string (buf
));
1189 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1190 FRAME_SAMPLE_VISIBILITY (f
);
1191 store_in_alist (alistptr
, Qvisibility
,
1192 (FRAME_VISIBLE_P (f
) ? Qt
1193 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1194 store_in_alist (alistptr
, Qdisplay
,
1195 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1197 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1200 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1201 store_in_alist (alistptr
, Qparent_id
, tem
);
1206 /* Gamma-correct COLOR on frame F. */
1209 gamma_correct (f
, color
)
1215 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1216 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1217 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1222 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1223 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1224 allocate the color. Value is zero if COLOR_NAME is invalid, or
1225 no color could be allocated. */
1228 x_defined_color (f
, color_name
, color
, alloc_p
)
1235 Display
*dpy
= FRAME_X_DISPLAY (f
);
1236 Colormap cmap
= FRAME_X_COLORMAP (f
);
1239 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1240 if (success_p
&& alloc_p
)
1241 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1248 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1249 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1250 Signal an error if color can't be allocated. */
1253 x_decode_color (f
, color_name
, mono_color
)
1255 Lisp_Object color_name
;
1260 CHECK_STRING (color_name
, 0);
1262 #if 0 /* Don't do this. It's wrong when we're not using the default
1263 colormap, it makes freeing difficult, and it's probably not
1264 an important optimization. */
1265 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1266 return BLACK_PIX_DEFAULT (f
);
1267 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1268 return WHITE_PIX_DEFAULT (f
);
1271 /* Return MONO_COLOR for monochrome frames. */
1272 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1275 /* x_defined_color is responsible for coping with failures
1276 by looking for a near-miss. */
1277 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1280 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1281 Fcons (color_name
, Qnil
)));
1287 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1288 the previous value of that parameter, NEW_VALUE is the new value. */
1291 x_set_line_spacing (f
, new_value
, old_value
)
1293 Lisp_Object new_value
, old_value
;
1295 if (NILP (new_value
))
1296 f
->extra_line_spacing
= 0;
1297 else if (NATNUMP (new_value
))
1298 f
->extra_line_spacing
= XFASTINT (new_value
);
1300 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1301 Fcons (new_value
, Qnil
)));
1302 if (FRAME_VISIBLE_P (f
))
1307 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1308 the previous value of that parameter, NEW_VALUE is the new value. */
1311 x_set_screen_gamma (f
, new_value
, old_value
)
1313 Lisp_Object new_value
, old_value
;
1315 if (NILP (new_value
))
1317 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1318 /* The value 0.4545 is the normal viewing gamma. */
1319 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1321 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1322 Fcons (new_value
, Qnil
)));
1324 clear_face_cache (0);
1328 /* Functions called only from `x_set_frame_param'
1329 to set individual parameters.
1331 If FRAME_X_WINDOW (f) is 0,
1332 the frame is being created and its X-window does not exist yet.
1333 In that case, just record the parameter's new value
1334 in the standard place; do not attempt to change the window. */
1337 x_set_foreground_color (f
, arg
, oldval
)
1339 Lisp_Object arg
, oldval
;
1341 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1343 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1344 f
->output_data
.x
->foreground_pixel
= pixel
;
1346 if (FRAME_X_WINDOW (f
) != 0)
1349 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1350 f
->output_data
.x
->foreground_pixel
);
1351 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1352 f
->output_data
.x
->foreground_pixel
);
1353 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1354 f
->output_data
.x
->foreground_pixel
);
1356 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1357 if (FRAME_VISIBLE_P (f
))
1363 x_set_background_color (f
, arg
, oldval
)
1365 Lisp_Object arg
, oldval
;
1367 unsigned long pixel
= x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1369 unload_color (f
, f
->output_data
.x
->background_pixel
);
1370 f
->output_data
.x
->background_pixel
= pixel
;
1372 if (FRAME_X_WINDOW (f
) != 0)
1375 /* The main frame area. */
1376 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1377 f
->output_data
.x
->background_pixel
);
1378 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1379 f
->output_data
.x
->background_pixel
);
1380 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1381 f
->output_data
.x
->background_pixel
);
1382 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1383 f
->output_data
.x
->background_pixel
);
1386 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1387 bar
= XSCROLL_BAR (bar
)->next
)
1388 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1389 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1390 f
->output_data
.x
->background_pixel
);
1394 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1396 if (FRAME_VISIBLE_P (f
))
1402 x_set_mouse_color (f
, arg
, oldval
)
1404 Lisp_Object arg
, oldval
;
1406 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1407 Cursor hourglass_cursor
, horizontal_drag_cursor
;
1409 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1410 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1412 /* Don't let pointers be invisible. */
1413 if (mask_color
== pixel
1414 && mask_color
== f
->output_data
.x
->background_pixel
)
1416 x_free_colors (f
, &pixel
, 1);
1417 pixel
= x_copy_color (f
, f
->output_data
.x
->foreground_pixel
);
1420 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1421 f
->output_data
.x
->mouse_pixel
= pixel
;
1425 /* It's not okay to crash if the user selects a screwy cursor. */
1426 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1428 if (!EQ (Qnil
, Vx_pointer_shape
))
1430 CHECK_NUMBER (Vx_pointer_shape
, 0);
1431 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1434 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1435 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1437 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1439 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1440 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1441 XINT (Vx_nontext_pointer_shape
));
1444 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1445 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1447 if (!EQ (Qnil
, Vx_hourglass_pointer_shape
))
1449 CHECK_NUMBER (Vx_hourglass_pointer_shape
, 0);
1450 hourglass_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1451 XINT (Vx_hourglass_pointer_shape
));
1454 hourglass_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1455 x_check_errors (FRAME_X_DISPLAY (f
), "bad hourglass pointer cursor: %s");
1457 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1458 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1460 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1461 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1462 XINT (Vx_mode_pointer_shape
));
1465 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1466 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1468 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1470 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1472 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1473 XINT (Vx_sensitive_text_pointer_shape
));
1476 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1478 if (!NILP (Vx_window_horizontal_drag_shape
))
1480 CHECK_NUMBER (Vx_window_horizontal_drag_shape
, 0);
1481 horizontal_drag_cursor
1482 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1483 XINT (Vx_window_horizontal_drag_shape
));
1486 horizontal_drag_cursor
1487 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
1489 /* Check and report errors with the above calls. */
1490 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1491 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1494 XColor fore_color
, back_color
;
1496 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1497 x_query_color (f
, &fore_color
);
1498 back_color
.pixel
= mask_color
;
1499 x_query_color (f
, &back_color
);
1501 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1502 &fore_color
, &back_color
);
1503 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1504 &fore_color
, &back_color
);
1505 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1506 &fore_color
, &back_color
);
1507 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1508 &fore_color
, &back_color
);
1509 XRecolorCursor (FRAME_X_DISPLAY (f
), hourglass_cursor
,
1510 &fore_color
, &back_color
);
1511 XRecolorCursor (FRAME_X_DISPLAY (f
), horizontal_drag_cursor
,
1512 &fore_color
, &back_color
);
1515 if (FRAME_X_WINDOW (f
) != 0)
1516 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1518 if (cursor
!= f
->output_data
.x
->text_cursor
1519 && f
->output_data
.x
->text_cursor
!= 0)
1520 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1521 f
->output_data
.x
->text_cursor
= cursor
;
1523 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1524 && f
->output_data
.x
->nontext_cursor
!= 0)
1525 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1526 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1528 if (hourglass_cursor
!= f
->output_data
.x
->hourglass_cursor
1529 && f
->output_data
.x
->hourglass_cursor
!= 0)
1530 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->hourglass_cursor
);
1531 f
->output_data
.x
->hourglass_cursor
= hourglass_cursor
;
1533 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1534 && f
->output_data
.x
->modeline_cursor
!= 0)
1535 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1536 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1538 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1539 && f
->output_data
.x
->cross_cursor
!= 0)
1540 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1541 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1543 if (horizontal_drag_cursor
!= f
->output_data
.x
->horizontal_drag_cursor
1544 && f
->output_data
.x
->horizontal_drag_cursor
!= 0)
1545 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->horizontal_drag_cursor
);
1546 f
->output_data
.x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1548 XFlush (FRAME_X_DISPLAY (f
));
1551 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1555 x_set_cursor_color (f
, arg
, oldval
)
1557 Lisp_Object arg
, oldval
;
1559 unsigned long fore_pixel
, pixel
;
1560 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1562 if (!NILP (Vx_cursor_fore_pixel
))
1564 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1565 WHITE_PIX_DEFAULT (f
));
1566 fore_pixel_allocated_p
= 1;
1569 fore_pixel
= f
->output_data
.x
->background_pixel
;
1571 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1572 pixel_allocated_p
= 1;
1574 /* Make sure that the cursor color differs from the background color. */
1575 if (pixel
== f
->output_data
.x
->background_pixel
)
1577 if (pixel_allocated_p
)
1579 x_free_colors (f
, &pixel
, 1);
1580 pixel_allocated_p
= 0;
1583 pixel
= f
->output_data
.x
->mouse_pixel
;
1584 if (pixel
== fore_pixel
)
1586 if (fore_pixel_allocated_p
)
1588 x_free_colors (f
, &fore_pixel
, 1);
1589 fore_pixel_allocated_p
= 0;
1591 fore_pixel
= f
->output_data
.x
->background_pixel
;
1595 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1596 if (!fore_pixel_allocated_p
)
1597 fore_pixel
= x_copy_color (f
, fore_pixel
);
1598 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1600 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1601 if (!pixel_allocated_p
)
1602 pixel
= x_copy_color (f
, pixel
);
1603 f
->output_data
.x
->cursor_pixel
= pixel
;
1605 if (FRAME_X_WINDOW (f
) != 0)
1608 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1609 f
->output_data
.x
->cursor_pixel
);
1610 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1614 if (FRAME_VISIBLE_P (f
))
1616 x_update_cursor (f
, 0);
1617 x_update_cursor (f
, 1);
1621 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1624 /* Set the border-color of frame F to value described by ARG.
1625 ARG can be a string naming a color.
1626 The border-color is used for the border that is drawn by the X server.
1627 Note that this does not fully take effect if done before
1628 F has an x-window; it must be redone when the window is created.
1630 Note: this is done in two routines because of the way X10 works.
1632 Note: under X11, this is normally the province of the window manager,
1633 and so emacs' border colors may be overridden. */
1636 x_set_border_color (f
, arg
, oldval
)
1638 Lisp_Object arg
, oldval
;
1642 CHECK_STRING (arg
, 0);
1643 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1644 x_set_border_pixel (f
, pix
);
1645 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1648 /* Set the border-color of frame F to pixel value PIX.
1649 Note that this does not fully take effect if done before
1650 F has an x-window. */
1653 x_set_border_pixel (f
, pix
)
1657 unload_color (f
, f
->output_data
.x
->border_pixel
);
1658 f
->output_data
.x
->border_pixel
= pix
;
1660 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1663 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1664 (unsigned long)pix
);
1667 if (FRAME_VISIBLE_P (f
))
1673 /* Value is the internal representation of the specified cursor type
1674 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1675 of the bar cursor. */
1677 enum text_cursor_kinds
1678 x_specified_cursor_type (arg
, width
)
1682 enum text_cursor_kinds type
;
1689 else if (CONSP (arg
)
1690 && EQ (XCAR (arg
), Qbar
)
1691 && INTEGERP (XCDR (arg
))
1692 && XINT (XCDR (arg
)) >= 0)
1695 *width
= XINT (XCDR (arg
));
1697 else if (NILP (arg
))
1700 /* Treat anything unknown as "box cursor".
1701 It was bad to signal an error; people have trouble fixing
1702 .Xdefaults with Emacs, when it has something bad in it. */
1703 type
= FILLED_BOX_CURSOR
;
1709 x_set_cursor_type (f
, arg
, oldval
)
1711 Lisp_Object arg
, oldval
;
1715 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1716 f
->output_data
.x
->cursor_width
= width
;
1718 /* Make sure the cursor gets redrawn. This is overkill, but how
1719 often do people change cursor types? */
1720 update_mode_lines
++;
1724 x_set_icon_type (f
, arg
, oldval
)
1726 Lisp_Object arg
, oldval
;
1732 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1735 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1740 result
= x_text_icon (f
,
1741 (char *) XSTRING ((!NILP (f
->icon_name
)
1745 result
= x_bitmap_icon (f
, arg
);
1750 error ("No icon window available");
1753 XFlush (FRAME_X_DISPLAY (f
));
1757 /* Return non-nil if frame F wants a bitmap icon. */
1765 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1773 x_set_icon_name (f
, arg
, oldval
)
1775 Lisp_Object arg
, oldval
;
1781 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1784 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1789 if (f
->output_data
.x
->icon_bitmap
!= 0)
1794 result
= x_text_icon (f
,
1795 (char *) XSTRING ((!NILP (f
->icon_name
)
1804 error ("No icon window available");
1807 XFlush (FRAME_X_DISPLAY (f
));
1812 x_set_font (f
, arg
, oldval
)
1814 Lisp_Object arg
, oldval
;
1817 Lisp_Object fontset_name
;
1819 int old_fontset
= f
->output_data
.x
->fontset
;
1821 CHECK_STRING (arg
, 1);
1823 fontset_name
= Fquery_fontset (arg
, Qnil
);
1826 result
= (STRINGP (fontset_name
)
1827 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1828 : x_new_font (f
, XSTRING (arg
)->data
));
1831 if (EQ (result
, Qnil
))
1832 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1833 else if (EQ (result
, Qt
))
1834 error ("The characters of the given font have varying widths");
1835 else if (STRINGP (result
))
1837 if (STRINGP (fontset_name
))
1839 /* Fontset names are built from ASCII font names, so the
1840 names may be equal despite there was a change. */
1841 if (old_fontset
== f
->output_data
.x
->fontset
)
1844 else if (!NILP (Fequal (result
, oldval
)))
1847 store_frame_param (f
, Qfont
, result
);
1848 recompute_basic_faces (f
);
1853 do_pending_window_change (0);
1855 /* Don't call `face-set-after-frame-default' when faces haven't been
1856 initialized yet. This is the case when called from
1857 Fx_create_frame. In that case, the X widget or window doesn't
1858 exist either, and we can end up in x_report_frame_params with a
1859 null widget which gives a segfault. */
1860 if (FRAME_FACE_CACHE (f
))
1862 XSETFRAME (frame
, f
);
1863 call1 (Qface_set_after_frame_default
, frame
);
1868 x_set_border_width (f
, arg
, oldval
)
1870 Lisp_Object arg
, oldval
;
1872 CHECK_NUMBER (arg
, 0);
1874 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1877 if (FRAME_X_WINDOW (f
) != 0)
1878 error ("Cannot change the border width of a window");
1880 f
->output_data
.x
->border_width
= XINT (arg
);
1884 x_set_internal_border_width (f
, arg
, oldval
)
1886 Lisp_Object arg
, oldval
;
1888 int old
= f
->output_data
.x
->internal_border_width
;
1890 CHECK_NUMBER (arg
, 0);
1891 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1892 if (f
->output_data
.x
->internal_border_width
< 0)
1893 f
->output_data
.x
->internal_border_width
= 0;
1895 #ifdef USE_X_TOOLKIT
1896 if (f
->output_data
.x
->edit_widget
)
1897 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1900 if (f
->output_data
.x
->internal_border_width
== old
)
1903 if (FRAME_X_WINDOW (f
) != 0)
1905 x_set_window_size (f
, 0, f
->width
, f
->height
);
1906 SET_FRAME_GARBAGED (f
);
1907 do_pending_window_change (0);
1912 x_set_visibility (f
, value
, oldval
)
1914 Lisp_Object value
, oldval
;
1917 XSETFRAME (frame
, f
);
1920 Fmake_frame_invisible (frame
, Qt
);
1921 else if (EQ (value
, Qicon
))
1922 Ficonify_frame (frame
);
1924 Fmake_frame_visible (frame
);
1928 /* Change window heights in windows rooted in WINDOW by N lines. */
1931 x_change_window_heights (window
, n
)
1935 struct window
*w
= XWINDOW (window
);
1937 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1938 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1940 if (INTEGERP (w
->orig_top
))
1941 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1942 if (INTEGERP (w
->orig_height
))
1943 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1945 /* Handle just the top child in a vertical split. */
1946 if (!NILP (w
->vchild
))
1947 x_change_window_heights (w
->vchild
, n
);
1949 /* Adjust all children in a horizontal split. */
1950 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1952 w
= XWINDOW (window
);
1953 x_change_window_heights (window
, n
);
1958 x_set_menu_bar_lines (f
, value
, oldval
)
1960 Lisp_Object value
, oldval
;
1963 #ifndef USE_X_TOOLKIT
1964 int olines
= FRAME_MENU_BAR_LINES (f
);
1967 /* Right now, menu bars don't work properly in minibuf-only frames;
1968 most of the commands try to apply themselves to the minibuffer
1969 frame itself, and get an error because you can't switch buffers
1970 in or split the minibuffer window. */
1971 if (FRAME_MINIBUF_ONLY_P (f
))
1974 if (INTEGERP (value
))
1975 nlines
= XINT (value
);
1979 /* Make sure we redisplay all windows in this frame. */
1980 windows_or_buffers_changed
++;
1982 #ifdef USE_X_TOOLKIT
1983 FRAME_MENU_BAR_LINES (f
) = 0;
1986 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1987 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1988 /* Make sure next redisplay shows the menu bar. */
1989 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1993 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1994 free_frame_menubar (f
);
1995 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1997 f
->output_data
.x
->menubar_widget
= 0;
1999 #else /* not USE_X_TOOLKIT */
2000 FRAME_MENU_BAR_LINES (f
) = nlines
;
2001 x_change_window_heights (f
->root_window
, nlines
- olines
);
2002 #endif /* not USE_X_TOOLKIT */
2007 /* Set the number of lines used for the tool bar of frame F to VALUE.
2008 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2009 is the old number of tool bar lines. This function changes the
2010 height of all windows on frame F to match the new tool bar height.
2011 The frame's height doesn't change. */
2014 x_set_tool_bar_lines (f
, value
, oldval
)
2016 Lisp_Object value
, oldval
;
2018 int delta
, nlines
, root_height
;
2019 Lisp_Object root_window
;
2021 /* Treat tool bars like menu bars. */
2022 if (FRAME_MINIBUF_ONLY_P (f
))
2025 /* Use VALUE only if an integer >= 0. */
2026 if (INTEGERP (value
) && XINT (value
) >= 0)
2027 nlines
= XFASTINT (value
);
2031 /* Make sure we redisplay all windows in this frame. */
2032 ++windows_or_buffers_changed
;
2034 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2036 /* Don't resize the tool-bar to more than we have room for. */
2037 root_window
= FRAME_ROOT_WINDOW (f
);
2038 root_height
= XINT (XWINDOW (root_window
)->height
);
2039 if (root_height
- delta
< 1)
2041 delta
= root_height
- 1;
2042 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2045 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2046 x_change_window_heights (root_window
, delta
);
2049 /* We also have to make sure that the internal border at the top of
2050 the frame, below the menu bar or tool bar, is redrawn when the
2051 tool bar disappears. This is so because the internal border is
2052 below the tool bar if one is displayed, but is below the menu bar
2053 if there isn't a tool bar. The tool bar draws into the area
2054 below the menu bar. */
2055 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2059 clear_current_matrices (f
);
2060 updating_frame
= NULL
;
2063 /* If the tool bar gets smaller, the internal border below it
2064 has to be cleared. It was formerly part of the display
2065 of the larger tool bar, and updating windows won't clear it. */
2068 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2069 int width
= PIXEL_WIDTH (f
);
2070 int y
= nlines
* CANON_Y_UNIT (f
);
2073 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2074 0, y
, width
, height
, False
);
2080 /* Set the foreground color for scroll bars on frame F to VALUE.
2081 VALUE should be a string, a color name. If it isn't a string or
2082 isn't a valid color name, do nothing. OLDVAL is the old value of
2083 the frame parameter. */
2086 x_set_scroll_bar_foreground (f
, value
, oldval
)
2088 Lisp_Object value
, oldval
;
2090 unsigned long pixel
;
2092 if (STRINGP (value
))
2093 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2097 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2098 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2100 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2101 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2103 /* Remove all scroll bars because they have wrong colors. */
2104 if (condemn_scroll_bars_hook
)
2105 (*condemn_scroll_bars_hook
) (f
);
2106 if (judge_scroll_bars_hook
)
2107 (*judge_scroll_bars_hook
) (f
);
2109 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2115 /* Set the background color for scroll bars on frame F to VALUE VALUE
2116 should be a string, a color name. If it isn't a string or isn't a
2117 valid color name, do nothing. OLDVAL is the old value of the frame
2121 x_set_scroll_bar_background (f
, value
, oldval
)
2123 Lisp_Object value
, oldval
;
2125 unsigned long pixel
;
2127 if (STRINGP (value
))
2128 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2132 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2133 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2135 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2136 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2138 /* Remove all scroll bars because they have wrong colors. */
2139 if (condemn_scroll_bars_hook
)
2140 (*condemn_scroll_bars_hook
) (f
);
2141 if (judge_scroll_bars_hook
)
2142 (*judge_scroll_bars_hook
) (f
);
2144 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2150 /* Encode Lisp string STRING as a text in a format appropriate for
2151 XICCC (X Inter Client Communication Conventions).
2153 If STRING contains only ASCII characters, do no conversion and
2154 return the string data of STRING. Otherwise, encode the text by
2155 CODING_SYSTEM, and return a newly allocated memory area which
2156 should be freed by `xfree' by a caller.
2158 Store the byte length of resulting text in *TEXT_BYTES.
2160 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2161 which means that the `encoding' of the result can be `STRING'.
2162 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2163 the result should be `COMPOUND_TEXT'. */
2166 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2167 Lisp_Object string
, coding_system
;
2168 int *text_bytes
, *stringp
;
2170 unsigned char *str
= XSTRING (string
)->data
;
2171 int chars
= XSTRING (string
)->size
;
2172 int bytes
= STRING_BYTES (XSTRING (string
));
2176 struct coding_system coding
;
2178 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2179 if (charset_info
== 0)
2181 /* No multibyte character in OBJ. We need not encode it. */
2182 *text_bytes
= bytes
;
2187 setup_coding_system (coding_system
, &coding
);
2188 coding
.src_multibyte
= 1;
2189 coding
.dst_multibyte
= 0;
2190 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2191 if (coding
.type
== coding_type_iso2022
)
2192 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2193 /* We suppress producing escape sequences for composition. */
2194 coding
.composing
= COMPOSITION_DISABLED
;
2195 bufsize
= encoding_buffer_size (&coding
, bytes
);
2196 buf
= (unsigned char *) xmalloc (bufsize
);
2197 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2198 *text_bytes
= coding
.produced
;
2199 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2204 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2207 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2208 name; if NAME is a string, set F's name to NAME and set
2209 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2211 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2212 suggesting a new name, which lisp code should override; if
2213 F->explicit_name is set, ignore the new name; otherwise, set it. */
2216 x_set_name (f
, name
, explicit)
2221 /* Make sure that requests from lisp code override requests from
2222 Emacs redisplay code. */
2225 /* If we're switching from explicit to implicit, we had better
2226 update the mode lines and thereby update the title. */
2227 if (f
->explicit_name
&& NILP (name
))
2228 update_mode_lines
= 1;
2230 f
->explicit_name
= ! NILP (name
);
2232 else if (f
->explicit_name
)
2235 /* If NAME is nil, set the name to the x_id_name. */
2238 /* Check for no change needed in this very common case
2239 before we do any consing. */
2240 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2241 XSTRING (f
->name
)->data
))
2243 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2246 CHECK_STRING (name
, 0);
2248 /* Don't change the name if it's already NAME. */
2249 if (! NILP (Fstring_equal (name
, f
->name
)))
2254 /* For setting the frame title, the title parameter should override
2255 the name parameter. */
2256 if (! NILP (f
->title
))
2259 if (FRAME_X_WINDOW (f
))
2264 XTextProperty text
, icon
;
2266 Lisp_Object coding_system
;
2268 coding_system
= Vlocale_coding_system
;
2269 if (NILP (coding_system
))
2270 coding_system
= Qcompound_text
;
2271 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2272 text
.encoding
= (stringp
? XA_STRING
2273 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2275 text
.nitems
= bytes
;
2277 if (NILP (f
->icon_name
))
2283 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2285 icon
.encoding
= (stringp
? XA_STRING
2286 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2288 icon
.nitems
= bytes
;
2290 #ifdef USE_X_TOOLKIT
2291 XSetWMName (FRAME_X_DISPLAY (f
),
2292 XtWindow (f
->output_data
.x
->widget
), &text
);
2293 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2295 #else /* not USE_X_TOOLKIT */
2296 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2297 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2298 #endif /* not USE_X_TOOLKIT */
2299 if (!NILP (f
->icon_name
)
2300 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2302 if (text
.value
!= XSTRING (name
)->data
)
2305 #else /* not HAVE_X11R4 */
2306 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2307 XSTRING (name
)->data
);
2308 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2309 XSTRING (name
)->data
);
2310 #endif /* not HAVE_X11R4 */
2315 /* This function should be called when the user's lisp code has
2316 specified a name for the frame; the name will override any set by the
2319 x_explicitly_set_name (f
, arg
, oldval
)
2321 Lisp_Object arg
, oldval
;
2323 x_set_name (f
, arg
, 1);
2326 /* This function should be called by Emacs redisplay code to set the
2327 name; names set this way will never override names set by the user's
2330 x_implicitly_set_name (f
, arg
, oldval
)
2332 Lisp_Object arg
, oldval
;
2334 x_set_name (f
, arg
, 0);
2337 /* Change the title of frame F to NAME.
2338 If NAME is nil, use the frame name as the title.
2340 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2341 name; if NAME is a string, set F's name to NAME and set
2342 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2344 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2345 suggesting a new name, which lisp code should override; if
2346 F->explicit_name is set, ignore the new name; otherwise, set it. */
2349 x_set_title (f
, name
, old_name
)
2351 Lisp_Object name
, old_name
;
2353 /* Don't change the title if it's already NAME. */
2354 if (EQ (name
, f
->title
))
2357 update_mode_lines
= 1;
2364 CHECK_STRING (name
, 0);
2366 if (FRAME_X_WINDOW (f
))
2371 XTextProperty text
, icon
;
2373 Lisp_Object coding_system
;
2375 coding_system
= Vlocale_coding_system
;
2376 if (NILP (coding_system
))
2377 coding_system
= Qcompound_text
;
2378 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2379 text
.encoding
= (stringp
? XA_STRING
2380 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2382 text
.nitems
= bytes
;
2384 if (NILP (f
->icon_name
))
2390 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2392 icon
.encoding
= (stringp
? XA_STRING
2393 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2395 icon
.nitems
= bytes
;
2397 #ifdef USE_X_TOOLKIT
2398 XSetWMName (FRAME_X_DISPLAY (f
),
2399 XtWindow (f
->output_data
.x
->widget
), &text
);
2400 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2402 #else /* not USE_X_TOOLKIT */
2403 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2404 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2405 #endif /* not USE_X_TOOLKIT */
2406 if (!NILP (f
->icon_name
)
2407 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2409 if (text
.value
!= XSTRING (name
)->data
)
2412 #else /* not HAVE_X11R4 */
2413 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2414 XSTRING (name
)->data
);
2415 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2416 XSTRING (name
)->data
);
2417 #endif /* not HAVE_X11R4 */
2423 x_set_autoraise (f
, arg
, oldval
)
2425 Lisp_Object arg
, oldval
;
2427 f
->auto_raise
= !EQ (Qnil
, arg
);
2431 x_set_autolower (f
, arg
, oldval
)
2433 Lisp_Object arg
, oldval
;
2435 f
->auto_lower
= !EQ (Qnil
, arg
);
2439 x_set_unsplittable (f
, arg
, oldval
)
2441 Lisp_Object arg
, oldval
;
2443 f
->no_split
= !NILP (arg
);
2447 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2449 Lisp_Object arg
, oldval
;
2451 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2452 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2453 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2454 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2456 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2458 ? vertical_scroll_bar_none
2460 ? vertical_scroll_bar_right
2461 : vertical_scroll_bar_left
);
2463 /* We set this parameter before creating the X window for the
2464 frame, so we can get the geometry right from the start.
2465 However, if the window hasn't been created yet, we shouldn't
2466 call x_set_window_size. */
2467 if (FRAME_X_WINDOW (f
))
2468 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2469 do_pending_window_change (0);
2474 x_set_scroll_bar_width (f
, arg
, oldval
)
2476 Lisp_Object arg
, oldval
;
2478 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2482 #ifdef USE_TOOLKIT_SCROLL_BARS
2483 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2484 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2485 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2486 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2488 /* Make the actual width at least 14 pixels and a multiple of a
2490 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2492 /* Use all of that space (aside from required margins) for the
2494 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2497 if (FRAME_X_WINDOW (f
))
2498 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2499 do_pending_window_change (0);
2501 else if (INTEGERP (arg
) && XINT (arg
) > 0
2502 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2504 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2505 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2507 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2508 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2509 if (FRAME_X_WINDOW (f
))
2510 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2513 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2514 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2515 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2520 /* Subroutines of creating an X frame. */
2522 /* Make sure that Vx_resource_name is set to a reasonable value.
2523 Fix it up, or set it to `emacs' if it is too hopeless. */
2526 validate_x_resource_name ()
2529 /* Number of valid characters in the resource name. */
2531 /* Number of invalid characters in the resource name. */
2536 if (!STRINGP (Vx_resource_class
))
2537 Vx_resource_class
= build_string (EMACS_CLASS
);
2539 if (STRINGP (Vx_resource_name
))
2541 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2544 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2546 /* Only letters, digits, - and _ are valid in resource names.
2547 Count the valid characters and count the invalid ones. */
2548 for (i
= 0; i
< len
; i
++)
2551 if (! ((c
>= 'a' && c
<= 'z')
2552 || (c
>= 'A' && c
<= 'Z')
2553 || (c
>= '0' && c
<= '9')
2554 || c
== '-' || c
== '_'))
2561 /* Not a string => completely invalid. */
2562 bad_count
= 5, good_count
= 0;
2564 /* If name is valid already, return. */
2568 /* If name is entirely invalid, or nearly so, use `emacs'. */
2570 || (good_count
== 1 && bad_count
> 0))
2572 Vx_resource_name
= build_string ("emacs");
2576 /* Name is partly valid. Copy it and replace the invalid characters
2577 with underscores. */
2579 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2581 for (i
= 0; i
< len
; i
++)
2583 int c
= XSTRING (new)->data
[i
];
2584 if (! ((c
>= 'a' && c
<= 'z')
2585 || (c
>= 'A' && c
<= 'Z')
2586 || (c
>= '0' && c
<= '9')
2587 || c
== '-' || c
== '_'))
2588 XSTRING (new)->data
[i
] = '_';
2593 extern char *x_get_string_resource ();
2595 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2596 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2597 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2598 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2599 the name specified by the `-name' or `-rn' command-line arguments.\n\
2601 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2602 class, respectively. You must specify both of them or neither.\n\
2603 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2604 and the class is `Emacs.CLASS.SUBCLASS'.")
2605 (attribute
, class, component
, subclass
)
2606 Lisp_Object attribute
, class, component
, subclass
;
2608 register char *value
;
2614 CHECK_STRING (attribute
, 0);
2615 CHECK_STRING (class, 0);
2617 if (!NILP (component
))
2618 CHECK_STRING (component
, 1);
2619 if (!NILP (subclass
))
2620 CHECK_STRING (subclass
, 2);
2621 if (NILP (component
) != NILP (subclass
))
2622 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2624 validate_x_resource_name ();
2626 /* Allocate space for the components, the dots which separate them,
2627 and the final '\0'. Make them big enough for the worst case. */
2628 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2629 + (STRINGP (component
)
2630 ? STRING_BYTES (XSTRING (component
)) : 0)
2631 + STRING_BYTES (XSTRING (attribute
))
2634 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2635 + STRING_BYTES (XSTRING (class))
2636 + (STRINGP (subclass
)
2637 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2640 /* Start with emacs.FRAMENAME for the name (the specific one)
2641 and with `Emacs' for the class key (the general one). */
2642 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2643 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2645 strcat (class_key
, ".");
2646 strcat (class_key
, XSTRING (class)->data
);
2648 if (!NILP (component
))
2650 strcat (class_key
, ".");
2651 strcat (class_key
, XSTRING (subclass
)->data
);
2653 strcat (name_key
, ".");
2654 strcat (name_key
, XSTRING (component
)->data
);
2657 strcat (name_key
, ".");
2658 strcat (name_key
, XSTRING (attribute
)->data
);
2660 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2661 name_key
, class_key
);
2663 if (value
!= (char *) 0)
2664 return build_string (value
);
2669 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2672 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2673 struct x_display_info
*dpyinfo
;
2674 Lisp_Object attribute
, class, component
, subclass
;
2676 register char *value
;
2680 CHECK_STRING (attribute
, 0);
2681 CHECK_STRING (class, 0);
2683 if (!NILP (component
))
2684 CHECK_STRING (component
, 1);
2685 if (!NILP (subclass
))
2686 CHECK_STRING (subclass
, 2);
2687 if (NILP (component
) != NILP (subclass
))
2688 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2690 validate_x_resource_name ();
2692 /* Allocate space for the components, the dots which separate them,
2693 and the final '\0'. Make them big enough for the worst case. */
2694 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2695 + (STRINGP (component
)
2696 ? STRING_BYTES (XSTRING (component
)) : 0)
2697 + STRING_BYTES (XSTRING (attribute
))
2700 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2701 + STRING_BYTES (XSTRING (class))
2702 + (STRINGP (subclass
)
2703 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2706 /* Start with emacs.FRAMENAME for the name (the specific one)
2707 and with `Emacs' for the class key (the general one). */
2708 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2709 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2711 strcat (class_key
, ".");
2712 strcat (class_key
, XSTRING (class)->data
);
2714 if (!NILP (component
))
2716 strcat (class_key
, ".");
2717 strcat (class_key
, XSTRING (subclass
)->data
);
2719 strcat (name_key
, ".");
2720 strcat (name_key
, XSTRING (component
)->data
);
2723 strcat (name_key
, ".");
2724 strcat (name_key
, XSTRING (attribute
)->data
);
2726 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2728 if (value
!= (char *) 0)
2729 return build_string (value
);
2734 /* Used when C code wants a resource value. */
2737 x_get_resource_string (attribute
, class)
2738 char *attribute
, *class;
2742 struct frame
*sf
= SELECTED_FRAME ();
2744 /* Allocate space for the components, the dots which separate them,
2745 and the final '\0'. */
2746 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2747 + strlen (attribute
) + 2);
2748 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2749 + strlen (class) + 2);
2751 sprintf (name_key
, "%s.%s",
2752 XSTRING (Vinvocation_name
)->data
,
2754 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2756 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2757 name_key
, class_key
);
2760 /* Types we might convert a resource string into. */
2770 /* Return the value of parameter PARAM.
2772 First search ALIST, then Vdefault_frame_alist, then the X defaults
2773 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2775 Convert the resource to the type specified by desired_type.
2777 If no default is specified, return Qunbound. If you call
2778 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2779 and don't let it get stored in any Lisp-visible variables! */
2782 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2783 struct x_display_info
*dpyinfo
;
2784 Lisp_Object alist
, param
;
2787 enum resource_types type
;
2789 register Lisp_Object tem
;
2791 tem
= Fassq (param
, alist
);
2793 tem
= Fassq (param
, Vdefault_frame_alist
);
2799 tem
= display_x_get_resource (dpyinfo
,
2800 build_string (attribute
),
2801 build_string (class),
2809 case RES_TYPE_NUMBER
:
2810 return make_number (atoi (XSTRING (tem
)->data
));
2812 case RES_TYPE_FLOAT
:
2813 return make_float (atof (XSTRING (tem
)->data
));
2815 case RES_TYPE_BOOLEAN
:
2816 tem
= Fdowncase (tem
);
2817 if (!strcmp (XSTRING (tem
)->data
, "on")
2818 || !strcmp (XSTRING (tem
)->data
, "true"))
2823 case RES_TYPE_STRING
:
2826 case RES_TYPE_SYMBOL
:
2827 /* As a special case, we map the values `true' and `on'
2828 to Qt, and `false' and `off' to Qnil. */
2831 lower
= Fdowncase (tem
);
2832 if (!strcmp (XSTRING (lower
)->data
, "on")
2833 || !strcmp (XSTRING (lower
)->data
, "true"))
2835 else if (!strcmp (XSTRING (lower
)->data
, "off")
2836 || !strcmp (XSTRING (lower
)->data
, "false"))
2839 return Fintern (tem
, Qnil
);
2852 /* Like x_get_arg, but also record the value in f->param_alist. */
2855 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2857 Lisp_Object alist
, param
;
2860 enum resource_types type
;
2864 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2865 attribute
, class, type
);
2867 store_frame_param (f
, param
, value
);
2872 /* Record in frame F the specified or default value according to ALIST
2873 of the parameter named PROP (a Lisp symbol).
2874 If no value is specified for PROP, look for an X default for XPROP
2875 on the frame named NAME.
2876 If that is not found either, use the value DEFLT. */
2879 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2886 enum resource_types type
;
2890 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2891 if (EQ (tem
, Qunbound
))
2893 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2898 /* Record in frame F the specified or default value according to ALIST
2899 of the parameter named PROP (a Lisp symbol). If no value is
2900 specified for PROP, look for an X default for XPROP on the frame
2901 named NAME. If that is not found either, use the value DEFLT. */
2904 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2913 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2916 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2917 if (EQ (tem
, Qunbound
))
2919 #ifdef USE_TOOLKIT_SCROLL_BARS
2921 /* See if an X resource for the scroll bar color has been
2923 tem
= display_x_get_resource (dpyinfo
,
2924 build_string (foreground_p
2928 build_string ("verticalScrollBar"),
2932 /* If nothing has been specified, scroll bars will use a
2933 toolkit-dependent default. Because these defaults are
2934 difficult to get at without actually creating a scroll
2935 bar, use nil to indicate that no color has been
2940 #else /* not USE_TOOLKIT_SCROLL_BARS */
2944 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2947 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2953 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2954 "Parse an X-style geometry string STRING.\n\
2955 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2956 The properties returned may include `top', `left', `height', and `width'.\n\
2957 The value of `left' or `top' may be an integer,\n\
2958 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2959 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2964 unsigned int width
, height
;
2967 CHECK_STRING (string
, 0);
2969 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2970 &x
, &y
, &width
, &height
);
2973 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2974 error ("Must specify both x and y position, or neither");
2978 if (geometry
& XValue
)
2980 Lisp_Object element
;
2982 if (x
>= 0 && (geometry
& XNegative
))
2983 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2984 else if (x
< 0 && ! (geometry
& XNegative
))
2985 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2987 element
= Fcons (Qleft
, make_number (x
));
2988 result
= Fcons (element
, result
);
2991 if (geometry
& YValue
)
2993 Lisp_Object element
;
2995 if (y
>= 0 && (geometry
& YNegative
))
2996 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2997 else if (y
< 0 && ! (geometry
& YNegative
))
2998 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3000 element
= Fcons (Qtop
, make_number (y
));
3001 result
= Fcons (element
, result
);
3004 if (geometry
& WidthValue
)
3005 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3006 if (geometry
& HeightValue
)
3007 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3012 /* Calculate the desired size and position of this window,
3013 and return the flags saying which aspects were specified.
3015 This function does not make the coordinates positive. */
3017 #define DEFAULT_ROWS 40
3018 #define DEFAULT_COLS 80
3021 x_figure_window_size (f
, parms
)
3025 register Lisp_Object tem0
, tem1
, tem2
;
3026 long window_prompting
= 0;
3027 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3029 /* Default values if we fall through.
3030 Actually, if that happens we should get
3031 window manager prompting. */
3032 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3033 f
->height
= DEFAULT_ROWS
;
3034 /* Window managers expect that if program-specified
3035 positions are not (0,0), they're intentional, not defaults. */
3036 f
->output_data
.x
->top_pos
= 0;
3037 f
->output_data
.x
->left_pos
= 0;
3039 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3040 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3041 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3042 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3044 if (!EQ (tem0
, Qunbound
))
3046 CHECK_NUMBER (tem0
, 0);
3047 f
->height
= XINT (tem0
);
3049 if (!EQ (tem1
, Qunbound
))
3051 CHECK_NUMBER (tem1
, 0);
3052 SET_FRAME_WIDTH (f
, XINT (tem1
));
3054 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3055 window_prompting
|= USSize
;
3057 window_prompting
|= PSize
;
3060 f
->output_data
.x
->vertical_scroll_bar_extra
3061 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3063 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3064 f
->output_data
.x
->flags_areas_extra
3065 = FRAME_FLAGS_AREA_WIDTH (f
);
3066 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3067 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3069 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3070 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3071 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3072 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3074 if (EQ (tem0
, Qminus
))
3076 f
->output_data
.x
->top_pos
= 0;
3077 window_prompting
|= YNegative
;
3079 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3080 && CONSP (XCDR (tem0
))
3081 && INTEGERP (XCAR (XCDR (tem0
))))
3083 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3084 window_prompting
|= YNegative
;
3086 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3087 && CONSP (XCDR (tem0
))
3088 && INTEGERP (XCAR (XCDR (tem0
))))
3090 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3092 else if (EQ (tem0
, Qunbound
))
3093 f
->output_data
.x
->top_pos
= 0;
3096 CHECK_NUMBER (tem0
, 0);
3097 f
->output_data
.x
->top_pos
= XINT (tem0
);
3098 if (f
->output_data
.x
->top_pos
< 0)
3099 window_prompting
|= YNegative
;
3102 if (EQ (tem1
, Qminus
))
3104 f
->output_data
.x
->left_pos
= 0;
3105 window_prompting
|= XNegative
;
3107 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3108 && CONSP (XCDR (tem1
))
3109 && INTEGERP (XCAR (XCDR (tem1
))))
3111 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3112 window_prompting
|= XNegative
;
3114 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3115 && CONSP (XCDR (tem1
))
3116 && INTEGERP (XCAR (XCDR (tem1
))))
3118 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3120 else if (EQ (tem1
, Qunbound
))
3121 f
->output_data
.x
->left_pos
= 0;
3124 CHECK_NUMBER (tem1
, 0);
3125 f
->output_data
.x
->left_pos
= XINT (tem1
);
3126 if (f
->output_data
.x
->left_pos
< 0)
3127 window_prompting
|= XNegative
;
3130 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3131 window_prompting
|= USPosition
;
3133 window_prompting
|= PPosition
;
3136 return window_prompting
;
3139 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3142 XSetWMProtocols (dpy
, w
, protocols
, count
)
3149 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3150 if (prop
== None
) return False
;
3151 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3152 (unsigned char *) protocols
, count
);
3155 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3157 #ifdef USE_X_TOOLKIT
3159 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3160 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3161 already be present because of the toolkit (Motif adds some of them,
3162 for example, but Xt doesn't). */
3165 hack_wm_protocols (f
, widget
)
3169 Display
*dpy
= XtDisplay (widget
);
3170 Window w
= XtWindow (widget
);
3171 int need_delete
= 1;
3177 Atom type
, *atoms
= 0;
3179 unsigned long nitems
= 0;
3180 unsigned long bytes_after
;
3182 if ((XGetWindowProperty (dpy
, w
,
3183 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3184 (long)0, (long)100, False
, XA_ATOM
,
3185 &type
, &format
, &nitems
, &bytes_after
,
3186 (unsigned char **) &atoms
)
3188 && format
== 32 && type
== XA_ATOM
)
3192 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3194 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3196 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3199 if (atoms
) XFree ((char *) atoms
);
3205 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3207 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3209 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3211 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3212 XA_ATOM
, 32, PropModeAppend
,
3213 (unsigned char *) props
, count
);
3221 /* Support routines for XIC (X Input Context). */
3225 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3226 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3229 /* Supported XIM styles, ordered by preferenc. */
3231 static XIMStyle supported_xim_styles
[] =
3233 XIMPreeditPosition
| XIMStatusArea
,
3234 XIMPreeditPosition
| XIMStatusNothing
,
3235 XIMPreeditPosition
| XIMStatusNone
,
3236 XIMPreeditNothing
| XIMStatusArea
,
3237 XIMPreeditNothing
| XIMStatusNothing
,
3238 XIMPreeditNothing
| XIMStatusNone
,
3239 XIMPreeditNone
| XIMStatusArea
,
3240 XIMPreeditNone
| XIMStatusNothing
,
3241 XIMPreeditNone
| XIMStatusNone
,
3246 /* Create an X fontset on frame F with base font name
3250 xic_create_xfontset (f
, base_fontname
)
3252 char *base_fontname
;
3255 char **missing_list
;
3259 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3260 base_fontname
, &missing_list
,
3261 &missing_count
, &def_string
);
3263 XFreeStringList (missing_list
);
3265 /* No need to free def_string. */
3270 /* Value is the best input style, given user preferences USER (already
3271 checked to be supported by Emacs), and styles supported by the
3272 input method XIM. */
3275 best_xim_style (user
, xim
)
3281 for (i
= 0; i
< user
->count_styles
; ++i
)
3282 for (j
= 0; j
< xim
->count_styles
; ++j
)
3283 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3284 return user
->supported_styles
[i
];
3286 /* Return the default style. */
3287 return XIMPreeditNothing
| XIMStatusNothing
;
3290 /* Create XIC for frame F. */
3292 static XIMStyle xic_style
;
3295 create_frame_xic (f
)
3300 XFontSet xfs
= NULL
;
3305 xim
= FRAME_X_XIM (f
);
3310 XVaNestedList preedit_attr
;
3311 XVaNestedList status_attr
;
3312 char *base_fontname
;
3315 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3316 spot
.x
= 0; spot
.y
= 1;
3317 /* Create X fontset. */
3318 fontset
= FRAME_FONTSET (f
);
3320 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3323 /* Determine the base fontname from the ASCII font name of
3325 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3326 char *p
= ascii_font
;
3329 for (i
= 0; *p
; p
++)
3332 /* As the font name doesn't conform to XLFD, we can't
3333 modify it to get a suitable base fontname for the
3335 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3338 int len
= strlen (ascii_font
) + 1;
3341 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3350 base_fontname
= (char *) alloca (len
);
3351 bzero (base_fontname
, len
);
3352 strcpy (base_fontname
, "-*-*-");
3353 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3354 strcat (base_fontname
, "*-*-*-*-*-*-*");
3357 xfs
= xic_create_xfontset (f
, base_fontname
);
3359 /* Determine XIC style. */
3362 XIMStyles supported_list
;
3363 supported_list
.count_styles
= (sizeof supported_xim_styles
3364 / sizeof supported_xim_styles
[0]);
3365 supported_list
.supported_styles
= supported_xim_styles
;
3366 xic_style
= best_xim_style (&supported_list
,
3367 FRAME_X_XIM_STYLES (f
));
3370 preedit_attr
= XVaCreateNestedList (0,
3373 FRAME_FOREGROUND_PIXEL (f
),
3375 FRAME_BACKGROUND_PIXEL (f
),
3376 (xic_style
& XIMPreeditPosition
3381 status_attr
= XVaCreateNestedList (0,
3387 FRAME_FOREGROUND_PIXEL (f
),
3389 FRAME_BACKGROUND_PIXEL (f
),
3392 xic
= XCreateIC (xim
,
3393 XNInputStyle
, xic_style
,
3394 XNClientWindow
, FRAME_X_WINDOW(f
),
3395 XNFocusWindow
, FRAME_X_WINDOW(f
),
3396 XNStatusAttributes
, status_attr
,
3397 XNPreeditAttributes
, preedit_attr
,
3399 XFree (preedit_attr
);
3400 XFree (status_attr
);
3403 FRAME_XIC (f
) = xic
;
3404 FRAME_XIC_STYLE (f
) = xic_style
;
3405 FRAME_XIC_FONTSET (f
) = xfs
;
3409 /* Destroy XIC and free XIC fontset of frame F, if any. */
3415 if (FRAME_XIC (f
) == NULL
)
3418 XDestroyIC (FRAME_XIC (f
));
3419 if (FRAME_XIC_FONTSET (f
))
3420 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3422 FRAME_XIC (f
) = NULL
;
3423 FRAME_XIC_FONTSET (f
) = NULL
;
3427 /* Place preedit area for XIC of window W's frame to specified
3428 pixel position X/Y. X and Y are relative to window W. */
3431 xic_set_preeditarea (w
, x
, y
)
3435 struct frame
*f
= XFRAME (w
->frame
);
3439 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3440 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3441 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3442 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3447 /* Place status area for XIC in bottom right corner of frame F.. */
3450 xic_set_statusarea (f
)
3453 XIC xic
= FRAME_XIC (f
);
3458 /* Negotiate geometry of status area. If input method has existing
3459 status area, use its current size. */
3460 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3461 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3462 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3465 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3466 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3469 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3471 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3472 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3476 area
.width
= needed
->width
;
3477 area
.height
= needed
->height
;
3478 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3479 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3480 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3483 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3484 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3489 /* Set X fontset for XIC of frame F, using base font name
3490 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3493 xic_set_xfontset (f
, base_fontname
)
3495 char *base_fontname
;
3500 xfs
= xic_create_xfontset (f
, base_fontname
);
3502 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3503 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3504 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3505 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3506 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3509 if (FRAME_XIC_FONTSET (f
))
3510 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3511 FRAME_XIC_FONTSET (f
) = xfs
;
3514 #endif /* HAVE_X_I18N */
3518 #ifdef USE_X_TOOLKIT
3520 /* Create and set up the X widget for frame F. */
3523 x_window (f
, window_prompting
, minibuffer_only
)
3525 long window_prompting
;
3526 int minibuffer_only
;
3528 XClassHint class_hints
;
3529 XSetWindowAttributes attributes
;
3530 unsigned long attribute_mask
;
3531 Widget shell_widget
;
3533 Widget frame_widget
;
3539 /* Use the resource name as the top-level widget name
3540 for looking up resources. Make a non-Lisp copy
3541 for the window manager, so GC relocation won't bother it.
3543 Elsewhere we specify the window name for the window manager. */
3546 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3547 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3548 strcpy (f
->namebuf
, str
);
3552 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3553 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3554 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3555 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3556 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3557 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3558 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3559 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3560 applicationShellWidgetClass
,
3561 FRAME_X_DISPLAY (f
), al
, ac
);
3563 f
->output_data
.x
->widget
= shell_widget
;
3564 /* maybe_set_screen_title_format (shell_widget); */
3566 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3567 (widget_value
*) NULL
,
3568 shell_widget
, False
,
3572 (lw_callback
) NULL
);
3575 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3576 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3577 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3578 XtSetValues (pane_widget
, al
, ac
);
3579 f
->output_data
.x
->column_widget
= pane_widget
;
3581 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3582 the emacs screen when changing menubar. This reduces flickering. */
3585 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3586 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3587 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3588 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3589 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3590 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3591 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3592 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3593 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3596 f
->output_data
.x
->edit_widget
= frame_widget
;
3598 XtManageChild (frame_widget
);
3600 /* Do some needed geometry management. */
3603 char *tem
, shell_position
[32];
3606 int extra_borders
= 0;
3608 = (f
->output_data
.x
->menubar_widget
3609 ? (f
->output_data
.x
->menubar_widget
->core
.height
3610 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3613 #if 0 /* Experimentally, we now get the right results
3614 for -geometry -0-0 without this. 24 Aug 96, rms. */
3615 if (FRAME_EXTERNAL_MENU_BAR (f
))
3618 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3619 menubar_size
+= ibw
;
3623 f
->output_data
.x
->menubar_height
= menubar_size
;
3626 /* Motif seems to need this amount added to the sizes
3627 specified for the shell widget. The Athena/Lucid widgets don't.
3628 Both conclusions reached experimentally. -- rms. */
3629 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3630 &extra_borders
, NULL
);
3634 /* Convert our geometry parameters into a geometry string
3636 Note that we do not specify here whether the position
3637 is a user-specified or program-specified one.
3638 We pass that information later, in x_wm_set_size_hints. */
3640 int left
= f
->output_data
.x
->left_pos
;
3641 int xneg
= window_prompting
& XNegative
;
3642 int top
= f
->output_data
.x
->top_pos
;
3643 int yneg
= window_prompting
& YNegative
;
3649 if (window_prompting
& USPosition
)
3650 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3651 PIXEL_WIDTH (f
) + extra_borders
,
3652 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3653 (xneg
? '-' : '+'), left
,
3654 (yneg
? '-' : '+'), top
);
3656 sprintf (shell_position
, "=%dx%d",
3657 PIXEL_WIDTH (f
) + extra_borders
,
3658 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3661 len
= strlen (shell_position
) + 1;
3662 /* We don't free this because we don't know whether
3663 it is safe to free it while the frame exists.
3664 It isn't worth the trouble of arranging to free it
3665 when the frame is deleted. */
3666 tem
= (char *) xmalloc (len
);
3667 strncpy (tem
, shell_position
, len
);
3668 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3669 XtSetValues (shell_widget
, al
, ac
);
3672 XtManageChild (pane_widget
);
3673 XtRealizeWidget (shell_widget
);
3675 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3677 validate_x_resource_name ();
3679 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3680 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3681 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3684 FRAME_XIC (f
) = NULL
;
3686 create_frame_xic (f
);
3690 f
->output_data
.x
->wm_hints
.input
= True
;
3691 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3692 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3693 &f
->output_data
.x
->wm_hints
);
3695 hack_wm_protocols (f
, shell_widget
);
3698 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3701 /* Do a stupid property change to force the server to generate a
3702 PropertyNotify event so that the event_stream server timestamp will
3703 be initialized to something relevant to the time we created the window.
3705 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3706 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3707 XA_ATOM
, 32, PropModeAppend
,
3708 (unsigned char*) NULL
, 0);
3710 /* Make all the standard events reach the Emacs frame. */
3711 attributes
.event_mask
= STANDARD_EVENT_SET
;
3716 /* XIM server might require some X events. */
3717 unsigned long fevent
= NoEventMask
;
3718 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3719 attributes
.event_mask
|= fevent
;
3721 #endif /* HAVE_X_I18N */
3723 attribute_mask
= CWEventMask
;
3724 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3725 attribute_mask
, &attributes
);
3727 XtMapWidget (frame_widget
);
3729 /* x_set_name normally ignores requests to set the name if the
3730 requested name is the same as the current name. This is the one
3731 place where that assumption isn't correct; f->name is set, but
3732 the X server hasn't been told. */
3735 int explicit = f
->explicit_name
;
3737 f
->explicit_name
= 0;
3740 x_set_name (f
, name
, explicit);
3743 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3744 f
->output_data
.x
->text_cursor
);
3748 /* This is a no-op, except under Motif. Make sure main areas are
3749 set to something reasonable, in case we get an error later. */
3750 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3753 #else /* not USE_X_TOOLKIT */
3755 /* Create and set up the X window for frame F. */
3762 XClassHint class_hints
;
3763 XSetWindowAttributes attributes
;
3764 unsigned long attribute_mask
;
3766 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3767 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3768 attributes
.bit_gravity
= StaticGravity
;
3769 attributes
.backing_store
= NotUseful
;
3770 attributes
.save_under
= True
;
3771 attributes
.event_mask
= STANDARD_EVENT_SET
;
3772 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3773 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3778 = XCreateWindow (FRAME_X_DISPLAY (f
),
3779 f
->output_data
.x
->parent_desc
,
3780 f
->output_data
.x
->left_pos
,
3781 f
->output_data
.x
->top_pos
,
3782 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3783 f
->output_data
.x
->border_width
,
3784 CopyFromParent
, /* depth */
3785 InputOutput
, /* class */
3787 attribute_mask
, &attributes
);
3791 create_frame_xic (f
);
3794 /* XIM server might require some X events. */
3795 unsigned long fevent
= NoEventMask
;
3796 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3797 attributes
.event_mask
|= fevent
;
3798 attribute_mask
= CWEventMask
;
3799 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3800 attribute_mask
, &attributes
);
3803 #endif /* HAVE_X_I18N */
3805 validate_x_resource_name ();
3807 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3808 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3809 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3811 /* The menubar is part of the ordinary display;
3812 it does not count in addition to the height of the window. */
3813 f
->output_data
.x
->menubar_height
= 0;
3815 /* This indicates that we use the "Passive Input" input model.
3816 Unless we do this, we don't get the Focus{In,Out} events that we
3817 need to draw the cursor correctly. Accursed bureaucrats.
3818 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3820 f
->output_data
.x
->wm_hints
.input
= True
;
3821 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3822 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3823 &f
->output_data
.x
->wm_hints
);
3824 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3826 /* Request "save yourself" and "delete window" commands from wm. */
3829 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3830 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3831 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3834 /* x_set_name normally ignores requests to set the name if the
3835 requested name is the same as the current name. This is the one
3836 place where that assumption isn't correct; f->name is set, but
3837 the X server hasn't been told. */
3840 int explicit = f
->explicit_name
;
3842 f
->explicit_name
= 0;
3845 x_set_name (f
, name
, explicit);
3848 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3849 f
->output_data
.x
->text_cursor
);
3853 if (FRAME_X_WINDOW (f
) == 0)
3854 error ("Unable to create window");
3857 #endif /* not USE_X_TOOLKIT */
3859 /* Handle the icon stuff for this window. Perhaps later we might
3860 want an x_set_icon_position which can be called interactively as
3868 Lisp_Object icon_x
, icon_y
;
3869 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3871 /* Set the position of the icon. Note that twm groups all
3872 icons in an icon window. */
3873 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3874 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3875 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3877 CHECK_NUMBER (icon_x
, 0);
3878 CHECK_NUMBER (icon_y
, 0);
3880 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3881 error ("Both left and top icon corners of icon must be specified");
3885 if (! EQ (icon_x
, Qunbound
))
3886 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3888 /* Start up iconic or window? */
3889 x_wm_set_window_state
3890 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3895 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3902 /* Make the GCs needed for this window, setting the
3903 background, border and mouse colors; also create the
3904 mouse cursor and the gray border tile. */
3906 static char cursor_bits
[] =
3908 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3909 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3910 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3911 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3918 XGCValues gc_values
;
3922 /* Create the GCs of this frame.
3923 Note that many default values are used. */
3926 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3927 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3928 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3929 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3930 f
->output_data
.x
->normal_gc
3931 = XCreateGC (FRAME_X_DISPLAY (f
),
3933 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
3936 /* Reverse video style. */
3937 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3938 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3939 f
->output_data
.x
->reverse_gc
3940 = XCreateGC (FRAME_X_DISPLAY (f
),
3942 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
3945 /* Cursor has cursor-color background, background-color foreground. */
3946 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3947 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3948 gc_values
.fill_style
= FillOpaqueStippled
;
3950 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3951 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3952 cursor_bits
, 16, 16);
3953 f
->output_data
.x
->cursor_gc
3954 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3955 (GCFont
| GCForeground
| GCBackground
3956 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3960 f
->output_data
.x
->white_relief
.gc
= 0;
3961 f
->output_data
.x
->black_relief
.gc
= 0;
3963 /* Create the gray border tile used when the pointer is not in
3964 the frame. Since this depends on the frame's pixel values,
3965 this must be done on a per-frame basis. */
3966 f
->output_data
.x
->border_tile
3967 = (XCreatePixmapFromBitmapData
3968 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3969 gray_bits
, gray_width
, gray_height
,
3970 f
->output_data
.x
->foreground_pixel
,
3971 f
->output_data
.x
->background_pixel
,
3972 DefaultDepth (FRAME_X_DISPLAY (f
),
3973 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3979 /* Free what was was allocated in x_make_gc. */
3985 Display
*dpy
= FRAME_X_DISPLAY (f
);
3989 if (f
->output_data
.x
->normal_gc
)
3991 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
3992 f
->output_data
.x
->normal_gc
= 0;
3995 if (f
->output_data
.x
->reverse_gc
)
3997 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
3998 f
->output_data
.x
->reverse_gc
= 0;
4001 if (f
->output_data
.x
->cursor_gc
)
4003 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4004 f
->output_data
.x
->cursor_gc
= 0;
4007 if (f
->output_data
.x
->border_tile
)
4009 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4010 f
->output_data
.x
->border_tile
= 0;
4017 /* Handler for signals raised during x_create_frame and
4018 x_create_top_frame. FRAME is the frame which is partially
4022 unwind_create_frame (frame
)
4025 struct frame
*f
= XFRAME (frame
);
4027 /* If frame is ``official'', nothing to do. */
4028 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4031 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4034 x_free_frame_resources (f
);
4036 /* Check that reference counts are indeed correct. */
4037 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4038 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4046 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4048 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
4049 Returns an Emacs frame object.\n\
4050 ALIST is an alist of frame parameters.\n\
4051 If the parameters specify that the frame should not have a minibuffer,\n\
4052 and do not specify a specific minibuffer window to use,\n\
4053 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4054 be shared by the new frame.\n\
4056 This function is an internal primitive--use `make-frame' instead.")
4061 Lisp_Object frame
, tem
;
4063 int minibuffer_only
= 0;
4064 long window_prompting
= 0;
4066 int count
= BINDING_STACK_SIZE ();
4067 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4068 Lisp_Object display
;
4069 struct x_display_info
*dpyinfo
= NULL
;
4075 /* Use this general default value to start with
4076 until we know if this frame has a specified name. */
4077 Vx_resource_name
= Vinvocation_name
;
4079 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4080 if (EQ (display
, Qunbound
))
4082 dpyinfo
= check_x_display_info (display
);
4084 kb
= dpyinfo
->kboard
;
4086 kb
= &the_only_kboard
;
4089 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4091 && ! EQ (name
, Qunbound
)
4093 error ("Invalid frame name--not a string or nil");
4096 Vx_resource_name
= name
;
4098 /* See if parent window is specified. */
4099 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4100 if (EQ (parent
, Qunbound
))
4102 if (! NILP (parent
))
4103 CHECK_NUMBER (parent
, 0);
4105 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4106 /* No need to protect DISPLAY because that's not used after passing
4107 it to make_frame_without_minibuffer. */
4109 GCPRO4 (parms
, parent
, name
, frame
);
4110 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4112 if (EQ (tem
, Qnone
) || NILP (tem
))
4113 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4114 else if (EQ (tem
, Qonly
))
4116 f
= make_minibuffer_frame ();
4117 minibuffer_only
= 1;
4119 else if (WINDOWP (tem
))
4120 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4124 XSETFRAME (frame
, f
);
4126 /* Note that X Windows does support scroll bars. */
4127 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4129 f
->output_method
= output_x_window
;
4130 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4131 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4132 f
->output_data
.x
->icon_bitmap
= -1;
4133 f
->output_data
.x
->fontset
= -1;
4134 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4135 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4136 record_unwind_protect (unwind_create_frame
, frame
);
4139 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4141 if (! STRINGP (f
->icon_name
))
4142 f
->icon_name
= Qnil
;
4144 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4146 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4147 dpyinfo_refcount
= dpyinfo
->reference_count
;
4148 #endif /* GLYPH_DEBUG */
4150 FRAME_KBOARD (f
) = kb
;
4153 /* These colors will be set anyway later, but it's important
4154 to get the color reference counts right, so initialize them! */
4157 struct gcpro gcpro1
;
4159 black
= build_string ("black");
4161 f
->output_data
.x
->foreground_pixel
4162 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4163 f
->output_data
.x
->background_pixel
4164 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4165 f
->output_data
.x
->cursor_pixel
4166 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4167 f
->output_data
.x
->cursor_foreground_pixel
4168 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4169 f
->output_data
.x
->border_pixel
4170 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4171 f
->output_data
.x
->mouse_pixel
4172 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4176 /* Specify the parent under which to make this X window. */
4180 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4181 f
->output_data
.x
->explicit_parent
= 1;
4185 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4186 f
->output_data
.x
->explicit_parent
= 0;
4189 /* Set the name; the functions to which we pass f expect the name to
4191 if (EQ (name
, Qunbound
) || NILP (name
))
4193 f
->name
= build_string (dpyinfo
->x_id_name
);
4194 f
->explicit_name
= 0;
4199 f
->explicit_name
= 1;
4200 /* use the frame's title when getting resources for this frame. */
4201 specbind (Qx_resource_name
, name
);
4204 /* Extract the window parameters from the supplied values
4205 that are needed to determine window geometry. */
4209 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4212 /* First, try whatever font the caller has specified. */
4215 tem
= Fquery_fontset (font
, Qnil
);
4217 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4219 font
= x_new_font (f
, XSTRING (font
)->data
);
4222 /* Try out a font which we hope has bold and italic variations. */
4223 if (!STRINGP (font
))
4224 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4225 if (!STRINGP (font
))
4226 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4227 if (! STRINGP (font
))
4228 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4229 if (! STRINGP (font
))
4230 /* This was formerly the first thing tried, but it finds too many fonts
4231 and takes too long. */
4232 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4233 /* If those didn't work, look for something which will at least work. */
4234 if (! STRINGP (font
))
4235 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4237 if (! STRINGP (font
))
4238 font
= build_string ("fixed");
4240 x_default_parameter (f
, parms
, Qfont
, font
,
4241 "font", "Font", RES_TYPE_STRING
);
4245 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4246 whereby it fails to get any font. */
4247 xlwmenu_default_font
= f
->output_data
.x
->font
;
4250 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4251 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4253 /* This defaults to 2 in order to match xterm. We recognize either
4254 internalBorderWidth or internalBorder (which is what xterm calls
4256 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4260 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4261 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4262 if (! EQ (value
, Qunbound
))
4263 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4266 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4267 "internalBorderWidth", "internalBorderWidth",
4269 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4270 "verticalScrollBars", "ScrollBars",
4273 /* Also do the stuff which must be set before the window exists. */
4274 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4275 "foreground", "Foreground", RES_TYPE_STRING
);
4276 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4277 "background", "Background", RES_TYPE_STRING
);
4278 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4279 "pointerColor", "Foreground", RES_TYPE_STRING
);
4280 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4281 "cursorColor", "Foreground", RES_TYPE_STRING
);
4282 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4283 "borderColor", "BorderColor", RES_TYPE_STRING
);
4284 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4285 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4286 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4287 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4289 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4290 "scrollBarForeground",
4291 "ScrollBarForeground", 1);
4292 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4293 "scrollBarBackground",
4294 "ScrollBarBackground", 0);
4296 /* Init faces before x_default_parameter is called for scroll-bar
4297 parameters because that function calls x_set_scroll_bar_width,
4298 which calls change_frame_size, which calls Fset_window_buffer,
4299 which runs hooks, which call Fvertical_motion. At the end, we
4300 end up in init_iterator with a null face cache, which should not
4302 init_frame_faces (f
);
4304 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4305 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4306 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4307 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4308 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4309 "bufferPredicate", "BufferPredicate",
4311 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4312 "title", "Title", RES_TYPE_STRING
);
4314 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4315 window_prompting
= x_figure_window_size (f
, parms
);
4317 if (window_prompting
& XNegative
)
4319 if (window_prompting
& YNegative
)
4320 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4322 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4326 if (window_prompting
& YNegative
)
4327 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4329 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4332 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4334 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4335 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4337 /* Create the X widget or window. */
4338 #ifdef USE_X_TOOLKIT
4339 x_window (f
, window_prompting
, minibuffer_only
);
4347 /* Now consider the frame official. */
4348 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4349 Vframe_list
= Fcons (frame
, Vframe_list
);
4351 /* We need to do this after creating the X window, so that the
4352 icon-creation functions can say whose icon they're describing. */
4353 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4354 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4356 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4357 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4358 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4359 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4360 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4361 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4362 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4363 "scrollBarWidth", "ScrollBarWidth",
4366 /* Dimensions, especially f->height, must be done via change_frame_size.
4367 Change will not be effected unless different from the current
4372 /* Add the tool-bar height to the initial frame height so that the
4373 user gets a text display area of the size he specified with -g or
4374 via .Xdefaults. Later changes of the tool-bar height don't
4375 change the frame size. This is done so that users can create
4376 tall Emacs frames without having to guess how tall the tool-bar
4378 if (FRAME_TOOL_BAR_LINES (f
))
4380 int margin
, relief
, bar_height
;
4382 relief
= (tool_bar_button_relief
> 0
4383 ? tool_bar_button_relief
4384 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4386 if (INTEGERP (Vtool_bar_button_margin
)
4387 && XINT (Vtool_bar_button_margin
) > 0)
4388 margin
= XFASTINT (Vtool_bar_button_margin
);
4389 else if (CONSP (Vtool_bar_button_margin
)
4390 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4391 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4392 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4396 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4397 height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4401 SET_FRAME_WIDTH (f
, 0);
4402 change_frame_size (f
, height
, width
, 1, 0, 0);
4404 /* Set up faces after all frame parameters are known. This call
4405 also merges in face attributes specified for new frames. If we
4406 don't do this, the `menu' face for instance won't have the right
4407 colors, and the menu bar won't appear in the specified colors for
4409 call1 (Qface_set_after_frame_default
, frame
);
4411 #ifdef USE_X_TOOLKIT
4412 /* Create the menu bar. */
4413 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4415 /* If this signals an error, we haven't set size hints for the
4416 frame and we didn't make it visible. */
4417 initialize_frame_menubar (f
);
4419 /* This is a no-op, except under Motif where it arranges the
4420 main window for the widgets on it. */
4421 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4422 f
->output_data
.x
->menubar_widget
,
4423 f
->output_data
.x
->edit_widget
);
4425 #endif /* USE_X_TOOLKIT */
4427 /* Tell the server what size and position, etc, we want, and how
4428 badly we want them. This should be done after we have the menu
4429 bar so that its size can be taken into account. */
4431 x_wm_set_size_hint (f
, window_prompting
, 0);
4434 /* Make the window appear on the frame and enable display, unless
4435 the caller says not to. However, with explicit parent, Emacs
4436 cannot control visibility, so don't try. */
4437 if (! f
->output_data
.x
->explicit_parent
)
4439 Lisp_Object visibility
;
4441 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4443 if (EQ (visibility
, Qunbound
))
4446 if (EQ (visibility
, Qicon
))
4447 x_iconify_frame (f
);
4448 else if (! NILP (visibility
))
4449 x_make_frame_visible (f
);
4451 /* Must have been Qnil. */
4456 return unbind_to (count
, frame
);
4460 /* FRAME is used only to get a handle on the X display. We don't pass the
4461 display info directly because we're called from frame.c, which doesn't
4462 know about that structure. */
4465 x_get_focus_frame (frame
)
4466 struct frame
*frame
;
4468 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4470 if (! dpyinfo
->x_focus_frame
)
4473 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4478 /* In certain situations, when the window manager follows a
4479 click-to-focus policy, there seems to be no way around calling
4480 XSetInputFocus to give another frame the input focus .
4482 In an ideal world, XSetInputFocus should generally be avoided so
4483 that applications don't interfere with the window manager's focus
4484 policy. But I think it's okay to use when it's clearly done
4485 following a user-command. */
4487 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4488 "Set the input focus to FRAME.\n\
4489 FRAME nil means use the selected frame.")
4493 struct frame
*f
= check_x_frame (frame
);
4494 Display
*dpy
= FRAME_X_DISPLAY (f
);
4498 count
= x_catch_errors (dpy
);
4499 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4500 RevertToParent
, CurrentTime
);
4501 x_uncatch_errors (dpy
, count
);
4508 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4509 "Internal function called by `color-defined-p', which see.")
4511 Lisp_Object color
, frame
;
4514 FRAME_PTR f
= check_x_frame (frame
);
4516 CHECK_STRING (color
, 1);
4518 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4524 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4525 "Internal function called by `color-values', which see.")
4527 Lisp_Object color
, frame
;
4530 FRAME_PTR f
= check_x_frame (frame
);
4532 CHECK_STRING (color
, 1);
4534 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4538 rgb
[0] = make_number (foo
.red
);
4539 rgb
[1] = make_number (foo
.green
);
4540 rgb
[2] = make_number (foo
.blue
);
4541 return Flist (3, rgb
);
4547 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4548 "Internal function called by `display-color-p', which see.")
4550 Lisp_Object display
;
4552 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4554 if (dpyinfo
->n_planes
<= 2)
4557 switch (dpyinfo
->visual
->class)
4570 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4572 "Return t if the X display supports shades of gray.\n\
4573 Note that color displays do support shades of gray.\n\
4574 The optional argument DISPLAY specifies which display to ask about.\n\
4575 DISPLAY should be either a frame or a display name (a string).\n\
4576 If omitted or nil, that stands for the selected frame's display.")
4578 Lisp_Object display
;
4580 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4582 if (dpyinfo
->n_planes
<= 1)
4585 switch (dpyinfo
->visual
->class)
4600 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4602 "Returns the width in pixels of the X display DISPLAY.\n\
4603 The optional argument DISPLAY specifies which display to ask about.\n\
4604 DISPLAY should be either a frame or a display name (a string).\n\
4605 If omitted or nil, that stands for the selected frame's display.")
4607 Lisp_Object display
;
4609 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4611 return make_number (dpyinfo
->width
);
4614 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4615 Sx_display_pixel_height
, 0, 1, 0,
4616 "Returns the height in pixels of the X display DISPLAY.\n\
4617 The optional argument DISPLAY specifies which display to ask about.\n\
4618 DISPLAY should be either a frame or a display name (a string).\n\
4619 If omitted or nil, that stands for the selected frame's display.")
4621 Lisp_Object display
;
4623 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4625 return make_number (dpyinfo
->height
);
4628 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4630 "Returns the number of bitplanes of the X display DISPLAY.\n\
4631 The optional argument DISPLAY specifies which display to ask about.\n\
4632 DISPLAY should be either a frame or a display name (a string).\n\
4633 If omitted or nil, that stands for the selected frame's display.")
4635 Lisp_Object display
;
4637 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4639 return make_number (dpyinfo
->n_planes
);
4642 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4644 "Returns the number of color cells of the X display DISPLAY.\n\
4645 The optional argument DISPLAY specifies which display to ask about.\n\
4646 DISPLAY should be either a frame or a display name (a string).\n\
4647 If omitted or nil, that stands for the selected frame's display.")
4649 Lisp_Object display
;
4651 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4653 return make_number (DisplayCells (dpyinfo
->display
,
4654 XScreenNumberOfScreen (dpyinfo
->screen
)));
4657 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4658 Sx_server_max_request_size
,
4660 "Returns the maximum request size of the X server of display DISPLAY.\n\
4661 The optional argument DISPLAY specifies which display to ask about.\n\
4662 DISPLAY should be either a frame or a display name (a string).\n\
4663 If omitted or nil, that stands for the selected frame's display.")
4665 Lisp_Object display
;
4667 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4669 return make_number (MAXREQUEST (dpyinfo
->display
));
4672 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4673 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4674 The optional argument DISPLAY specifies which display to ask about.\n\
4675 DISPLAY should be either a frame or a display name (a string).\n\
4676 If omitted or nil, that stands for the selected frame's display.")
4678 Lisp_Object display
;
4680 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4681 char *vendor
= ServerVendor (dpyinfo
->display
);
4683 if (! vendor
) vendor
= "";
4684 return build_string (vendor
);
4687 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4688 "Returns the version numbers of the X server of display DISPLAY.\n\
4689 The value is a list of three integers: the major and minor\n\
4690 version numbers of the X Protocol in use, and the vendor-specific release\n\
4691 number. See also the function `x-server-vendor'.\n\n\
4692 The optional argument DISPLAY specifies which display to ask about.\n\
4693 DISPLAY should be either a frame or a display name (a string).\n\
4694 If omitted or nil, that stands for the selected frame's display.")
4696 Lisp_Object display
;
4698 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4699 Display
*dpy
= dpyinfo
->display
;
4701 return Fcons (make_number (ProtocolVersion (dpy
)),
4702 Fcons (make_number (ProtocolRevision (dpy
)),
4703 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4706 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4707 "Returns the number of screens on the X server of display DISPLAY.\n\
4708 The optional argument DISPLAY specifies which display to ask about.\n\
4709 DISPLAY should be either a frame or a display name (a string).\n\
4710 If omitted or nil, that stands for the selected frame's display.")
4712 Lisp_Object display
;
4714 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4716 return make_number (ScreenCount (dpyinfo
->display
));
4719 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4720 "Returns the height in millimeters of the X display DISPLAY.\n\
4721 The optional argument DISPLAY specifies which display to ask about.\n\
4722 DISPLAY should be either a frame or a display name (a string).\n\
4723 If omitted or nil, that stands for the selected frame's display.")
4725 Lisp_Object display
;
4727 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4729 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4732 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4733 "Returns the width in millimeters of the X display DISPLAY.\n\
4734 The optional argument DISPLAY specifies which display to ask about.\n\
4735 DISPLAY should be either a frame or a display name (a string).\n\
4736 If omitted or nil, that stands for the selected frame's display.")
4738 Lisp_Object display
;
4740 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4742 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4745 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4746 Sx_display_backing_store
, 0, 1, 0,
4747 "Returns an indication of whether X display DISPLAY does backing store.\n\
4748 The value may be `always', `when-mapped', or `not-useful'.\n\
4749 The optional argument DISPLAY specifies which display to ask about.\n\
4750 DISPLAY should be either a frame or a display name (a string).\n\
4751 If omitted or nil, that stands for the selected frame's display.")
4753 Lisp_Object display
;
4755 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4758 switch (DoesBackingStore (dpyinfo
->screen
))
4761 result
= intern ("always");
4765 result
= intern ("when-mapped");
4769 result
= intern ("not-useful");
4773 error ("Strange value for BackingStore parameter of screen");
4780 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4781 Sx_display_visual_class
, 0, 1, 0,
4782 "Returns the visual class of the X display DISPLAY.\n\
4783 The value is one of the symbols `static-gray', `gray-scale',\n\
4784 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4785 The optional argument DISPLAY specifies which display to ask about.\n\
4786 DISPLAY should be either a frame or a display name (a string).\n\
4787 If omitted or nil, that stands for the selected frame's display.")
4789 Lisp_Object display
;
4791 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4794 switch (dpyinfo
->visual
->class)
4797 result
= intern ("static-gray");
4800 result
= intern ("gray-scale");
4803 result
= intern ("static-color");
4806 result
= intern ("pseudo-color");
4809 result
= intern ("true-color");
4812 result
= intern ("direct-color");
4815 error ("Display has an unknown visual class");
4822 DEFUN ("x-display-save-under", Fx_display_save_under
,
4823 Sx_display_save_under
, 0, 1, 0,
4824 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4825 The optional argument DISPLAY specifies which display to ask about.\n\
4826 DISPLAY should be either a frame or a display name (a string).\n\
4827 If omitted or nil, that stands for the selected frame's display.")
4829 Lisp_Object display
;
4831 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4833 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4841 register struct frame
*f
;
4843 return PIXEL_WIDTH (f
);
4848 register struct frame
*f
;
4850 return PIXEL_HEIGHT (f
);
4855 register struct frame
*f
;
4857 return FONT_WIDTH (f
->output_data
.x
->font
);
4862 register struct frame
*f
;
4864 return f
->output_data
.x
->line_height
;
4869 register struct frame
*f
;
4871 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4876 /************************************************************************
4878 ************************************************************************/
4881 /* Mapping visual names to visuals. */
4883 static struct visual_class
4890 {"StaticGray", StaticGray
},
4891 {"GrayScale", GrayScale
},
4892 {"StaticColor", StaticColor
},
4893 {"PseudoColor", PseudoColor
},
4894 {"TrueColor", TrueColor
},
4895 {"DirectColor", DirectColor
},
4900 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4902 /* Value is the screen number of screen SCR. This is a substitute for
4903 the X function with the same name when that doesn't exist. */
4906 XScreenNumberOfScreen (scr
)
4907 register Screen
*scr
;
4909 Display
*dpy
= scr
->display
;
4912 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4913 if (scr
== dpy
->screens
[i
])
4919 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4922 /* Select the visual that should be used on display DPYINFO. Set
4923 members of DPYINFO appropriately. Called from x_term_init. */
4926 select_visual (dpyinfo
)
4927 struct x_display_info
*dpyinfo
;
4929 Display
*dpy
= dpyinfo
->display
;
4930 Screen
*screen
= dpyinfo
->screen
;
4933 /* See if a visual is specified. */
4934 value
= display_x_get_resource (dpyinfo
,
4935 build_string ("visualClass"),
4936 build_string ("VisualClass"),
4938 if (STRINGP (value
))
4940 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4941 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4942 depth, a decimal number. NAME is compared with case ignored. */
4943 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4948 strcpy (s
, XSTRING (value
)->data
);
4949 dash
= index (s
, '-');
4952 dpyinfo
->n_planes
= atoi (dash
+ 1);
4956 /* We won't find a matching visual with depth 0, so that
4957 an error will be printed below. */
4958 dpyinfo
->n_planes
= 0;
4960 /* Determine the visual class. */
4961 for (i
= 0; visual_classes
[i
].name
; ++i
)
4962 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4964 class = visual_classes
[i
].class;
4968 /* Look up a matching visual for the specified class. */
4970 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4971 dpyinfo
->n_planes
, class, &vinfo
))
4972 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4974 dpyinfo
->visual
= vinfo
.visual
;
4979 XVisualInfo
*vinfo
, vinfo_template
;
4981 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
4984 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
4986 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
4988 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4989 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
4990 &vinfo_template
, &n_visuals
);
4992 fatal ("Can't get proper X visual info");
4994 dpyinfo
->n_planes
= vinfo
->depth
;
4995 XFree ((char *) vinfo
);
5000 /* Return the X display structure for the display named NAME.
5001 Open a new connection if necessary. */
5003 struct x_display_info
*
5004 x_display_info_for_name (name
)
5008 struct x_display_info
*dpyinfo
;
5010 CHECK_STRING (name
, 0);
5012 if (! EQ (Vwindow_system
, intern ("x")))
5013 error ("Not using X Windows");
5015 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5017 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5020 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5025 /* Use this general default value to start with. */
5026 Vx_resource_name
= Vinvocation_name
;
5028 validate_x_resource_name ();
5030 dpyinfo
= x_term_init (name
, (char *)0,
5031 (char *) XSTRING (Vx_resource_name
)->data
);
5034 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5037 XSETFASTINT (Vwindow_system_version
, 11);
5043 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5044 1, 3, 0, "Open a connection to an X server.\n\
5045 DISPLAY is the name of the display to connect to.\n\
5046 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5047 If the optional third arg MUST-SUCCEED is non-nil,\n\
5048 terminate Emacs if we can't open the connection.")
5049 (display
, xrm_string
, must_succeed
)
5050 Lisp_Object display
, xrm_string
, must_succeed
;
5052 unsigned char *xrm_option
;
5053 struct x_display_info
*dpyinfo
;
5055 CHECK_STRING (display
, 0);
5056 if (! NILP (xrm_string
))
5057 CHECK_STRING (xrm_string
, 1);
5059 if (! EQ (Vwindow_system
, intern ("x")))
5060 error ("Not using X Windows");
5062 if (! NILP (xrm_string
))
5063 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5065 xrm_option
= (unsigned char *) 0;
5067 validate_x_resource_name ();
5069 /* This is what opens the connection and sets x_current_display.
5070 This also initializes many symbols, such as those used for input. */
5071 dpyinfo
= x_term_init (display
, xrm_option
,
5072 (char *) XSTRING (Vx_resource_name
)->data
);
5076 if (!NILP (must_succeed
))
5077 fatal ("Cannot connect to X server %s.\n\
5078 Check the DISPLAY environment variable or use `-d'.\n\
5079 Also use the `xhost' program to verify that it is set to permit\n\
5080 connections from your machine.\n",
5081 XSTRING (display
)->data
);
5083 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5088 XSETFASTINT (Vwindow_system_version
, 11);
5092 DEFUN ("x-close-connection", Fx_close_connection
,
5093 Sx_close_connection
, 1, 1, 0,
5094 "Close the connection to DISPLAY's X server.\n\
5095 For DISPLAY, specify either a frame or a display name (a string).\n\
5096 If DISPLAY is nil, that stands for the selected frame's display.")
5098 Lisp_Object display
;
5100 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5103 if (dpyinfo
->reference_count
> 0)
5104 error ("Display still has frames on it");
5107 /* Free the fonts in the font table. */
5108 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5109 if (dpyinfo
->font_table
[i
].name
)
5111 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5112 xfree (dpyinfo
->font_table
[i
].full_name
);
5113 xfree (dpyinfo
->font_table
[i
].name
);
5114 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5117 x_destroy_all_bitmaps (dpyinfo
);
5118 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5120 #ifdef USE_X_TOOLKIT
5121 XtCloseDisplay (dpyinfo
->display
);
5123 XCloseDisplay (dpyinfo
->display
);
5126 x_delete_display (dpyinfo
);
5132 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5133 "Return the list of display names that Emacs has connections to.")
5136 Lisp_Object tail
, result
;
5139 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5140 result
= Fcons (XCAR (XCAR (tail
)), result
);
5145 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5146 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5147 If ON is nil, allow buffering of requests.\n\
5148 Turning on synchronization prohibits the Xlib routines from buffering\n\
5149 requests and seriously degrades performance, but makes debugging much\n\
5151 The optional second argument DISPLAY specifies which display to act on.\n\
5152 DISPLAY should be either a frame or a display name (a string).\n\
5153 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5155 Lisp_Object display
, on
;
5157 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5159 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5164 /* Wait for responses to all X commands issued so far for frame F. */
5171 XSync (FRAME_X_DISPLAY (f
), False
);
5176 /***********************************************************************
5178 ***********************************************************************/
5180 /* Value is the number of elements of vector VECTOR. */
5182 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5184 /* List of supported image types. Use define_image_type to add new
5185 types. Use lookup_image_type to find a type for a given symbol. */
5187 static struct image_type
*image_types
;
5189 /* The symbol `image' which is the car of the lists used to represent
5192 extern Lisp_Object Qimage
;
5194 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5200 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5201 extern Lisp_Object QCdata
;
5202 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5203 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5204 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5206 /* Other symbols. */
5208 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5210 /* Time in seconds after which images should be removed from the cache
5211 if not displayed. */
5213 Lisp_Object Vimage_cache_eviction_delay
;
5215 /* Function prototypes. */
5217 static void define_image_type
P_ ((struct image_type
*type
));
5218 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5219 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5220 static void x_laplace
P_ ((struct frame
*, struct image
*));
5221 static void x_emboss
P_ ((struct frame
*, struct image
*));
5222 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5226 /* Define a new image type from TYPE. This adds a copy of TYPE to
5227 image_types and adds the symbol *TYPE->type to Vimage_types. */
5230 define_image_type (type
)
5231 struct image_type
*type
;
5233 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5234 The initialized data segment is read-only. */
5235 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5236 bcopy (type
, p
, sizeof *p
);
5237 p
->next
= image_types
;
5239 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5243 /* Look up image type SYMBOL, and return a pointer to its image_type
5244 structure. Value is null if SYMBOL is not a known image type. */
5246 static INLINE
struct image_type
*
5247 lookup_image_type (symbol
)
5250 struct image_type
*type
;
5252 for (type
= image_types
; type
; type
= type
->next
)
5253 if (EQ (symbol
, *type
->type
))
5260 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5261 valid image specification is a list whose car is the symbol
5262 `image', and whose rest is a property list. The property list must
5263 contain a value for key `:type'. That value must be the name of a
5264 supported image type. The rest of the property list depends on the
5268 valid_image_p (object
)
5273 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5275 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5276 struct image_type
*type
= lookup_image_type (symbol
);
5279 valid_p
= type
->valid_p (object
);
5286 /* Log error message with format string FORMAT and argument ARG.
5287 Signaling an error, e.g. when an image cannot be loaded, is not a
5288 good idea because this would interrupt redisplay, and the error
5289 message display would lead to another redisplay. This function
5290 therefore simply displays a message. */
5293 image_error (format
, arg1
, arg2
)
5295 Lisp_Object arg1
, arg2
;
5297 add_to_log (format
, arg1
, arg2
);
5302 /***********************************************************************
5303 Image specifications
5304 ***********************************************************************/
5306 enum image_value_type
5308 IMAGE_DONT_CHECK_VALUE_TYPE
,
5311 IMAGE_POSITIVE_INTEGER_VALUE
,
5312 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5313 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5315 IMAGE_INTEGER_VALUE
,
5316 IMAGE_FUNCTION_VALUE
,
5321 /* Structure used when parsing image specifications. */
5323 struct image_keyword
5325 /* Name of keyword. */
5328 /* The type of value allowed. */
5329 enum image_value_type type
;
5331 /* Non-zero means key must be present. */
5334 /* Used to recognize duplicate keywords in a property list. */
5337 /* The value that was found. */
5342 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5344 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5347 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5348 has the format (image KEYWORD VALUE ...). One of the keyword/
5349 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5350 image_keywords structures of size NKEYWORDS describing other
5351 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5354 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5356 struct image_keyword
*keywords
;
5363 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5366 plist
= XCDR (spec
);
5367 while (CONSP (plist
))
5369 Lisp_Object key
, value
;
5371 /* First element of a pair must be a symbol. */
5373 plist
= XCDR (plist
);
5377 /* There must follow a value. */
5380 value
= XCAR (plist
);
5381 plist
= XCDR (plist
);
5383 /* Find key in KEYWORDS. Error if not found. */
5384 for (i
= 0; i
< nkeywords
; ++i
)
5385 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5391 /* Record that we recognized the keyword. If a keywords
5392 was found more than once, it's an error. */
5393 keywords
[i
].value
= value
;
5394 ++keywords
[i
].count
;
5396 if (keywords
[i
].count
> 1)
5399 /* Check type of value against allowed type. */
5400 switch (keywords
[i
].type
)
5402 case IMAGE_STRING_VALUE
:
5403 if (!STRINGP (value
))
5407 case IMAGE_SYMBOL_VALUE
:
5408 if (!SYMBOLP (value
))
5412 case IMAGE_POSITIVE_INTEGER_VALUE
:
5413 if (!INTEGERP (value
) || XINT (value
) <= 0)
5417 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5418 if (INTEGERP (value
) && XINT (value
) >= 0)
5421 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5422 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5426 case IMAGE_ASCENT_VALUE
:
5427 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5429 else if (INTEGERP (value
)
5430 && XINT (value
) >= 0
5431 && XINT (value
) <= 100)
5435 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5436 if (!INTEGERP (value
) || XINT (value
) < 0)
5440 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5443 case IMAGE_FUNCTION_VALUE
:
5444 value
= indirect_function (value
);
5446 || COMPILEDP (value
)
5447 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5451 case IMAGE_NUMBER_VALUE
:
5452 if (!INTEGERP (value
) && !FLOATP (value
))
5456 case IMAGE_INTEGER_VALUE
:
5457 if (!INTEGERP (value
))
5461 case IMAGE_BOOL_VALUE
:
5462 if (!NILP (value
) && !EQ (value
, Qt
))
5471 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5475 /* Check that all mandatory fields are present. */
5476 for (i
= 0; i
< nkeywords
; ++i
)
5477 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5480 return NILP (plist
);
5484 /* Return the value of KEY in image specification SPEC. Value is nil
5485 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5486 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5489 image_spec_value (spec
, key
, found
)
5490 Lisp_Object spec
, key
;
5495 xassert (valid_image_p (spec
));
5497 for (tail
= XCDR (spec
);
5498 CONSP (tail
) && CONSP (XCDR (tail
));
5499 tail
= XCDR (XCDR (tail
)))
5501 if (EQ (XCAR (tail
), key
))
5505 return XCAR (XCDR (tail
));
5515 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5516 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5517 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5518 size in canonical character units.\n\
5519 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5520 or omitted means use the selected frame.")
5521 (spec
, pixels
, frame
)
5522 Lisp_Object spec
, pixels
, frame
;
5527 if (valid_image_p (spec
))
5529 struct frame
*f
= check_x_frame (frame
);
5530 int id
= lookup_image (f
, spec
);
5531 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5532 int width
= img
->width
+ 2 * img
->hmargin
;
5533 int height
= img
->height
+ 2 * img
->vmargin
;
5536 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5537 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5539 size
= Fcons (make_number (width
), make_number (height
));
5542 error ("Invalid image specification");
5548 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5549 "Return t if image SPEC has a mask bitmap.\n\
5550 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5551 or omitted means use the selected frame.")
5553 Lisp_Object spec
, frame
;
5558 if (valid_image_p (spec
))
5560 struct frame
*f
= check_x_frame (frame
);
5561 int id
= lookup_image (f
, spec
);
5562 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5567 error ("Invalid image specification");
5574 /***********************************************************************
5575 Image type independent image structures
5576 ***********************************************************************/
5578 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5579 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5582 /* Allocate and return a new image structure for image specification
5583 SPEC. SPEC has a hash value of HASH. */
5585 static struct image
*
5586 make_image (spec
, hash
)
5590 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5592 xassert (valid_image_p (spec
));
5593 bzero (img
, sizeof *img
);
5594 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5595 xassert (img
->type
!= NULL
);
5597 img
->data
.lisp_val
= Qnil
;
5598 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5604 /* Free image IMG which was used on frame F, including its resources. */
5613 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5615 /* Remove IMG from the hash table of its cache. */
5617 img
->prev
->next
= img
->next
;
5619 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5622 img
->next
->prev
= img
->prev
;
5624 c
->images
[img
->id
] = NULL
;
5626 /* Free resources, then free IMG. */
5627 img
->type
->free (f
, img
);
5633 /* Prepare image IMG for display on frame F. Must be called before
5634 drawing an image. */
5637 prepare_image_for_display (f
, img
)
5643 /* We're about to display IMG, so set its timestamp to `now'. */
5645 img
->timestamp
= EMACS_SECS (t
);
5647 /* If IMG doesn't have a pixmap yet, load it now, using the image
5648 type dependent loader function. */
5649 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5650 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5654 /* Value is the number of pixels for the ascent of image IMG when
5655 drawn in face FACE. */
5658 image_ascent (img
, face
)
5662 int height
= img
->height
+ img
->vmargin
;
5665 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5668 /* This expression is arranged so that if the image can't be
5669 exactly centered, it will be moved slightly up. This is
5670 because a typical font is `top-heavy' (due to the presence
5671 uppercase letters), so the image placement should err towards
5672 being top-heavy too. It also just generally looks better. */
5673 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5675 ascent
= height
/ 2;
5678 ascent
= height
* img
->ascent
/ 100.0;
5685 /***********************************************************************
5686 Helper functions for X image types
5687 ***********************************************************************/
5689 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5691 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5692 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5694 Lisp_Object color_name
,
5695 unsigned long dflt
));
5698 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5699 free the pixmap if any. MASK_P non-zero means clear the mask
5700 pixmap if any. COLORS_P non-zero means free colors allocated for
5701 the image, if any. */
5704 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5707 int pixmap_p
, mask_p
, colors_p
;
5709 if (pixmap_p
&& img
->pixmap
)
5711 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5715 if (mask_p
&& img
->mask
)
5717 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5721 if (colors_p
&& img
->ncolors
)
5723 x_free_colors (f
, img
->colors
, img
->ncolors
);
5724 xfree (img
->colors
);
5730 /* Free X resources of image IMG which is used on frame F. */
5733 x_clear_image (f
, img
)
5738 x_clear_image_1 (f
, img
, 1, 1, 1);
5743 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5744 cannot be allocated, use DFLT. Add a newly allocated color to
5745 IMG->colors, so that it can be freed again. Value is the pixel
5748 static unsigned long
5749 x_alloc_image_color (f
, img
, color_name
, dflt
)
5752 Lisp_Object color_name
;
5756 unsigned long result
;
5758 xassert (STRINGP (color_name
));
5760 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5762 /* This isn't called frequently so we get away with simply
5763 reallocating the color vector to the needed size, here. */
5766 (unsigned long *) xrealloc (img
->colors
,
5767 img
->ncolors
* sizeof *img
->colors
);
5768 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5769 result
= color
.pixel
;
5779 /***********************************************************************
5781 ***********************************************************************/
5783 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5786 /* Return a new, initialized image cache that is allocated from the
5787 heap. Call free_image_cache to free an image cache. */
5789 struct image_cache
*
5792 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5795 bzero (c
, sizeof *c
);
5797 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5798 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5799 c
->buckets
= (struct image
**) xmalloc (size
);
5800 bzero (c
->buckets
, size
);
5805 /* Free image cache of frame F. Be aware that X frames share images
5809 free_image_cache (f
)
5812 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5817 /* Cache should not be referenced by any frame when freed. */
5818 xassert (c
->refcount
== 0);
5820 for (i
= 0; i
< c
->used
; ++i
)
5821 free_image (f
, c
->images
[i
]);
5825 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5830 /* Clear image cache of frame F. FORCE_P non-zero means free all
5831 images. FORCE_P zero means clear only images that haven't been
5832 displayed for some time. Should be called from time to time to
5833 reduce the number of loaded images. If image-eviction-seconds is
5834 non-nil, this frees images in the cache which weren't displayed for
5835 at least that many seconds. */
5838 clear_image_cache (f
, force_p
)
5842 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5844 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5851 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5853 /* Block input so that we won't be interrupted by a SIGIO
5854 while being in an inconsistent state. */
5857 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5859 struct image
*img
= c
->images
[i
];
5861 && (force_p
|| img
->timestamp
< old
))
5863 free_image (f
, img
);
5868 /* We may be clearing the image cache because, for example,
5869 Emacs was iconified for a longer period of time. In that
5870 case, current matrices may still contain references to
5871 images freed above. So, clear these matrices. */
5874 Lisp_Object tail
, frame
;
5876 FOR_EACH_FRAME (tail
, frame
)
5878 struct frame
*f
= XFRAME (frame
);
5880 && FRAME_X_IMAGE_CACHE (f
) == c
)
5881 clear_current_matrices (f
);
5884 ++windows_or_buffers_changed
;
5892 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5894 "Clear the image cache of FRAME.\n\
5895 FRAME nil or omitted means use the selected frame.\n\
5896 FRAME t means clear the image caches of all frames.")
5904 FOR_EACH_FRAME (tail
, frame
)
5905 if (FRAME_X_P (XFRAME (frame
)))
5906 clear_image_cache (XFRAME (frame
), 1);
5909 clear_image_cache (check_x_frame (frame
), 1);
5915 /* Return the id of image with Lisp specification SPEC on frame F.
5916 SPEC must be a valid Lisp image specification (see valid_image_p). */
5919 lookup_image (f
, spec
)
5923 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5927 struct gcpro gcpro1
;
5930 /* F must be a window-system frame, and SPEC must be a valid image
5932 xassert (FRAME_WINDOW_P (f
));
5933 xassert (valid_image_p (spec
));
5937 /* Look up SPEC in the hash table of the image cache. */
5938 hash
= sxhash (spec
, 0);
5939 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5941 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
5942 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
5945 /* If not found, create a new image and cache it. */
5949 img
= make_image (spec
, hash
);
5950 cache_image (f
, img
);
5951 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5953 /* If we can't load the image, and we don't have a width and
5954 height, use some arbitrary width and height so that we can
5955 draw a rectangle for it. */
5956 if (img
->load_failed_p
)
5960 value
= image_spec_value (spec
, QCwidth
, NULL
);
5961 img
->width
= (INTEGERP (value
)
5962 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
5963 value
= image_spec_value (spec
, QCheight
, NULL
);
5964 img
->height
= (INTEGERP (value
)
5965 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
5969 /* Handle image type independent image attributes
5970 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
5971 Lisp_Object ascent
, margin
, relief
;
5973 ascent
= image_spec_value (spec
, QCascent
, NULL
);
5974 if (INTEGERP (ascent
))
5975 img
->ascent
= XFASTINT (ascent
);
5976 else if (EQ (ascent
, Qcenter
))
5977 img
->ascent
= CENTERED_IMAGE_ASCENT
;
5979 margin
= image_spec_value (spec
, QCmargin
, NULL
);
5980 if (INTEGERP (margin
) && XINT (margin
) >= 0)
5981 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
5982 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
5983 && INTEGERP (XCDR (margin
)))
5985 if (XINT (XCAR (margin
)) > 0)
5986 img
->hmargin
= XFASTINT (XCAR (margin
));
5987 if (XINT (XCDR (margin
)) > 0)
5988 img
->vmargin
= XFASTINT (XCDR (margin
));
5991 relief
= image_spec_value (spec
, QCrelief
, NULL
);
5992 if (INTEGERP (relief
))
5994 img
->relief
= XINT (relief
);
5995 img
->hmargin
+= abs (img
->relief
);
5996 img
->vmargin
+= abs (img
->relief
);
5999 /* Manipulation of the image's mask. */
6002 /* `:heuristic-mask t'
6004 means build a mask heuristically.
6005 `:heuristic-mask (R G B)'
6006 `:mask (heuristic (R G B))'
6007 means build a mask from color (R G B) in the
6010 means remove a mask, if any. */
6014 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6016 x_build_heuristic_mask (f
, img
, mask
);
6021 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6023 if (EQ (mask
, Qheuristic
))
6024 x_build_heuristic_mask (f
, img
, Qt
);
6025 else if (CONSP (mask
)
6026 && EQ (XCAR (mask
), Qheuristic
))
6028 if (CONSP (XCDR (mask
)))
6029 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6031 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6033 else if (NILP (mask
) && found_p
&& img
->mask
)
6035 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6041 /* Should we apply an image transformation algorithm? */
6044 Lisp_Object conversion
;
6046 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6047 if (EQ (conversion
, Qdisabled
))
6048 x_disable_image (f
, img
);
6049 else if (EQ (conversion
, Qlaplace
))
6051 else if (EQ (conversion
, Qemboss
))
6053 else if (CONSP (conversion
)
6054 && EQ (XCAR (conversion
), Qedge_detection
))
6057 tem
= XCDR (conversion
);
6059 x_edge_detection (f
, img
,
6060 Fplist_get (tem
, QCmatrix
),
6061 Fplist_get (tem
, QCcolor_adjustment
));
6067 xassert (!interrupt_input_blocked
);
6070 /* We're using IMG, so set its timestamp to `now'. */
6071 EMACS_GET_TIME (now
);
6072 img
->timestamp
= EMACS_SECS (now
);
6076 /* Value is the image id. */
6081 /* Cache image IMG in the image cache of frame F. */
6084 cache_image (f
, img
)
6088 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6091 /* Find a free slot in c->images. */
6092 for (i
= 0; i
< c
->used
; ++i
)
6093 if (c
->images
[i
] == NULL
)
6096 /* If no free slot found, maybe enlarge c->images. */
6097 if (i
== c
->used
&& c
->used
== c
->size
)
6100 c
->images
= (struct image
**) xrealloc (c
->images
,
6101 c
->size
* sizeof *c
->images
);
6104 /* Add IMG to c->images, and assign IMG an id. */
6110 /* Add IMG to the cache's hash table. */
6111 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6112 img
->next
= c
->buckets
[i
];
6114 img
->next
->prev
= img
;
6116 c
->buckets
[i
] = img
;
6120 /* Call FN on every image in the image cache of frame F. Used to mark
6121 Lisp Objects in the image cache. */
6124 forall_images_in_image_cache (f
, fn
)
6126 void (*fn
) P_ ((struct image
*img
));
6128 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6130 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6134 for (i
= 0; i
< c
->used
; ++i
)
6143 /***********************************************************************
6145 ***********************************************************************/
6147 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6148 XImage
**, Pixmap
*));
6149 static void x_destroy_x_image
P_ ((XImage
*));
6150 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6153 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6154 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6155 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6156 via xmalloc. Print error messages via image_error if an error
6157 occurs. Value is non-zero if successful. */
6160 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6162 int width
, height
, depth
;
6166 Display
*display
= FRAME_X_DISPLAY (f
);
6167 Screen
*screen
= FRAME_X_SCREEN (f
);
6168 Window window
= FRAME_X_WINDOW (f
);
6170 xassert (interrupt_input_blocked
);
6173 depth
= DefaultDepthOfScreen (screen
);
6174 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6175 depth
, ZPixmap
, 0, NULL
, width
, height
,
6176 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6179 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6183 /* Allocate image raster. */
6184 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6186 /* Allocate a pixmap of the same size. */
6187 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6188 if (*pixmap
== None
)
6190 x_destroy_x_image (*ximg
);
6192 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6200 /* Destroy XImage XIMG. Free XIMG->data. */
6203 x_destroy_x_image (ximg
)
6206 xassert (interrupt_input_blocked
);
6211 XDestroyImage (ximg
);
6216 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6217 are width and height of both the image and pixmap. */
6220 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6227 xassert (interrupt_input_blocked
);
6228 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6229 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6230 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6235 /***********************************************************************
6237 ***********************************************************************/
6239 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6240 static char *slurp_file
P_ ((char *, int *));
6243 /* Find image file FILE. Look in data-directory, then
6244 x-bitmap-file-path. Value is the full name of the file found, or
6245 nil if not found. */
6248 x_find_image_file (file
)
6251 Lisp_Object file_found
, search_path
;
6252 struct gcpro gcpro1
, gcpro2
;
6256 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6257 GCPRO2 (file_found
, search_path
);
6259 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6260 fd
= openp (search_path
, file
, "", &file_found
, 0);
6272 /* Read FILE into memory. Value is a pointer to a buffer allocated
6273 with xmalloc holding FILE's contents. Value is null if an error
6274 occurred. *SIZE is set to the size of the file. */
6277 slurp_file (file
, size
)
6285 if (stat (file
, &st
) == 0
6286 && (fp
= fopen (file
, "r")) != NULL
6287 && (buf
= (char *) xmalloc (st
.st_size
),
6288 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6309 /***********************************************************************
6311 ***********************************************************************/
6313 static int xbm_scan
P_ ((char **, char *, char *, int *));
6314 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6315 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6317 static int xbm_image_p
P_ ((Lisp_Object object
));
6318 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6320 static int xbm_file_p
P_ ((Lisp_Object
));
6323 /* Indices of image specification fields in xbm_format, below. */
6325 enum xbm_keyword_index
6343 /* Vector of image_keyword structures describing the format
6344 of valid XBM image specifications. */
6346 static struct image_keyword xbm_format
[XBM_LAST
] =
6348 {":type", IMAGE_SYMBOL_VALUE
, 1},
6349 {":file", IMAGE_STRING_VALUE
, 0},
6350 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6351 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6352 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6353 {":foreground", IMAGE_STRING_VALUE
, 0},
6354 {":background", IMAGE_STRING_VALUE
, 0},
6355 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6356 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6357 {":relief", IMAGE_INTEGER_VALUE
, 0},
6358 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6359 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6360 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6363 /* Structure describing the image type XBM. */
6365 static struct image_type xbm_type
=
6374 /* Tokens returned from xbm_scan. */
6383 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6384 A valid specification is a list starting with the symbol `image'
6385 The rest of the list is a property list which must contain an
6388 If the specification specifies a file to load, it must contain
6389 an entry `:file FILENAME' where FILENAME is a string.
6391 If the specification is for a bitmap loaded from memory it must
6392 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6393 WIDTH and HEIGHT are integers > 0. DATA may be:
6395 1. a string large enough to hold the bitmap data, i.e. it must
6396 have a size >= (WIDTH + 7) / 8 * HEIGHT
6398 2. a bool-vector of size >= WIDTH * HEIGHT
6400 3. a vector of strings or bool-vectors, one for each line of the
6403 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6404 may not be specified in this case because they are defined in the
6407 Both the file and data forms may contain the additional entries
6408 `:background COLOR' and `:foreground COLOR'. If not present,
6409 foreground and background of the frame on which the image is
6410 displayed is used. */
6413 xbm_image_p (object
)
6416 struct image_keyword kw
[XBM_LAST
];
6418 bcopy (xbm_format
, kw
, sizeof kw
);
6419 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6422 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6424 if (kw
[XBM_FILE
].count
)
6426 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6429 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6431 /* In-memory XBM file. */
6432 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6440 /* Entries for `:width', `:height' and `:data' must be present. */
6441 if (!kw
[XBM_WIDTH
].count
6442 || !kw
[XBM_HEIGHT
].count
6443 || !kw
[XBM_DATA
].count
)
6446 data
= kw
[XBM_DATA
].value
;
6447 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6448 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6450 /* Check type of data, and width and height against contents of
6456 /* Number of elements of the vector must be >= height. */
6457 if (XVECTOR (data
)->size
< height
)
6460 /* Each string or bool-vector in data must be large enough
6461 for one line of the image. */
6462 for (i
= 0; i
< height
; ++i
)
6464 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6468 if (XSTRING (elt
)->size
6469 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6472 else if (BOOL_VECTOR_P (elt
))
6474 if (XBOOL_VECTOR (elt
)->size
< width
)
6481 else if (STRINGP (data
))
6483 if (XSTRING (data
)->size
6484 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6487 else if (BOOL_VECTOR_P (data
))
6489 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6500 /* Scan a bitmap file. FP is the stream to read from. Value is
6501 either an enumerator from enum xbm_token, or a character for a
6502 single-character token, or 0 at end of file. If scanning an
6503 identifier, store the lexeme of the identifier in SVAL. If
6504 scanning a number, store its value in *IVAL. */
6507 xbm_scan (s
, end
, sval
, ival
)
6516 /* Skip white space. */
6517 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6522 else if (isdigit (c
))
6524 int value
= 0, digit
;
6526 if (c
== '0' && *s
< end
)
6529 if (c
== 'x' || c
== 'X')
6536 else if (c
>= 'a' && c
<= 'f')
6537 digit
= c
- 'a' + 10;
6538 else if (c
>= 'A' && c
<= 'F')
6539 digit
= c
- 'A' + 10;
6542 value
= 16 * value
+ digit
;
6545 else if (isdigit (c
))
6549 && (c
= *(*s
)++, isdigit (c
)))
6550 value
= 8 * value
+ c
- '0';
6557 && (c
= *(*s
)++, isdigit (c
)))
6558 value
= 10 * value
+ c
- '0';
6566 else if (isalpha (c
) || c
== '_')
6570 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6577 else if (c
== '/' && **s
== '*')
6579 /* C-style comment. */
6581 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6594 /* Replacement for XReadBitmapFileData which isn't available under old
6595 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6596 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6597 the image. Return in *DATA the bitmap data allocated with xmalloc.
6598 Value is non-zero if successful. DATA null means just test if
6599 CONTENTS looks like an in-memory XBM file. */
6602 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6603 char *contents
, *end
;
6604 int *width
, *height
;
6605 unsigned char **data
;
6608 char buffer
[BUFSIZ
];
6611 int bytes_per_line
, i
, nbytes
;
6617 LA1 = xbm_scan (&s, end, buffer, &value)
6619 #define expect(TOKEN) \
6620 if (LA1 != (TOKEN)) \
6625 #define expect_ident(IDENT) \
6626 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6631 *width
= *height
= -1;
6634 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6636 /* Parse defines for width, height and hot-spots. */
6640 expect_ident ("define");
6641 expect (XBM_TK_IDENT
);
6643 if (LA1
== XBM_TK_NUMBER
);
6645 char *p
= strrchr (buffer
, '_');
6646 p
= p
? p
+ 1 : buffer
;
6647 if (strcmp (p
, "width") == 0)
6649 else if (strcmp (p
, "height") == 0)
6652 expect (XBM_TK_NUMBER
);
6655 if (*width
< 0 || *height
< 0)
6657 else if (data
== NULL
)
6660 /* Parse bits. Must start with `static'. */
6661 expect_ident ("static");
6662 if (LA1
== XBM_TK_IDENT
)
6664 if (strcmp (buffer
, "unsigned") == 0)
6667 expect_ident ("char");
6669 else if (strcmp (buffer
, "short") == 0)
6673 if (*width
% 16 && *width
% 16 < 9)
6676 else if (strcmp (buffer
, "char") == 0)
6684 expect (XBM_TK_IDENT
);
6690 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6691 nbytes
= bytes_per_line
* *height
;
6692 p
= *data
= (char *) xmalloc (nbytes
);
6696 for (i
= 0; i
< nbytes
; i
+= 2)
6699 expect (XBM_TK_NUMBER
);
6702 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6705 if (LA1
== ',' || LA1
== '}')
6713 for (i
= 0; i
< nbytes
; ++i
)
6716 expect (XBM_TK_NUMBER
);
6720 if (LA1
== ',' || LA1
== '}')
6745 /* Load XBM image IMG which will be displayed on frame F from buffer
6746 CONTENTS. END is the end of the buffer. Value is non-zero if
6750 xbm_load_image (f
, img
, contents
, end
)
6753 char *contents
, *end
;
6756 unsigned char *data
;
6759 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6762 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6763 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6764 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6767 xassert (img
->width
> 0 && img
->height
> 0);
6769 /* Get foreground and background colors, maybe allocate colors. */
6770 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6772 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6774 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6776 background
= x_alloc_image_color (f
, img
, value
, background
);
6779 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6782 img
->width
, img
->height
,
6783 foreground
, background
,
6787 if (img
->pixmap
== None
)
6789 x_clear_image (f
, img
);
6790 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6796 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6802 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6809 return (STRINGP (data
)
6810 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6811 (XSTRING (data
)->data
6812 + STRING_BYTES (XSTRING (data
))),
6817 /* Fill image IMG which is used on frame F with pixmap data. Value is
6818 non-zero if successful. */
6826 Lisp_Object file_name
;
6828 xassert (xbm_image_p (img
->spec
));
6830 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6831 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6832 if (STRINGP (file_name
))
6837 struct gcpro gcpro1
;
6839 file
= x_find_image_file (file_name
);
6841 if (!STRINGP (file
))
6843 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6848 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6849 if (contents
== NULL
)
6851 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6856 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6861 struct image_keyword fmt
[XBM_LAST
];
6864 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6865 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6868 int in_memory_file_p
= 0;
6870 /* See if data looks like an in-memory XBM file. */
6871 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6872 in_memory_file_p
= xbm_file_p (data
);
6874 /* Parse the image specification. */
6875 bcopy (xbm_format
, fmt
, sizeof fmt
);
6876 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6879 /* Get specified width, and height. */
6880 if (!in_memory_file_p
)
6882 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6883 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6884 xassert (img
->width
> 0 && img
->height
> 0);
6887 /* Get foreground and background colors, maybe allocate colors. */
6888 if (fmt
[XBM_FOREGROUND
].count
)
6889 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6891 if (fmt
[XBM_BACKGROUND
].count
)
6892 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6895 if (in_memory_file_p
)
6896 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6897 (XSTRING (data
)->data
6898 + STRING_BYTES (XSTRING (data
))));
6905 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6907 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6908 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6910 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6912 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6914 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6917 else if (STRINGP (data
))
6918 bits
= XSTRING (data
)->data
;
6920 bits
= XBOOL_VECTOR (data
)->data
;
6922 /* Create the pixmap. */
6923 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6925 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6928 img
->width
, img
->height
,
6929 foreground
, background
,
6935 image_error ("Unable to create pixmap for XBM image `%s'",
6937 x_clear_image (f
, img
);
6947 /***********************************************************************
6949 ***********************************************************************/
6953 static int xpm_image_p
P_ ((Lisp_Object object
));
6954 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6955 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6957 #include "X11/xpm.h"
6959 /* The symbol `xpm' identifying XPM-format images. */
6963 /* Indices of image specification fields in xpm_format, below. */
6965 enum xpm_keyword_index
6980 /* Vector of image_keyword structures describing the format
6981 of valid XPM image specifications. */
6983 static struct image_keyword xpm_format
[XPM_LAST
] =
6985 {":type", IMAGE_SYMBOL_VALUE
, 1},
6986 {":file", IMAGE_STRING_VALUE
, 0},
6987 {":data", IMAGE_STRING_VALUE
, 0},
6988 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6989 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6990 {":relief", IMAGE_INTEGER_VALUE
, 0},
6991 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6992 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6993 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6994 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6997 /* Structure describing the image type XBM. */
6999 static struct image_type xpm_type
=
7009 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7010 functions for allocating image colors. Our own functions handle
7011 color allocation failures more gracefully than the ones on the XPM
7014 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7015 #define ALLOC_XPM_COLORS
7018 #ifdef ALLOC_XPM_COLORS
7020 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7021 static void xpm_free_color_cache
P_ ((void));
7022 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7023 static int xpm_color_bucket
P_ ((char *));
7024 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7027 /* An entry in a hash table used to cache color definitions of named
7028 colors. This cache is necessary to speed up XPM image loading in
7029 case we do color allocations ourselves. Without it, we would need
7030 a call to XParseColor per pixel in the image. */
7032 struct xpm_cached_color
7034 /* Next in collision chain. */
7035 struct xpm_cached_color
*next
;
7037 /* Color definition (RGB and pixel color). */
7044 /* The hash table used for the color cache, and its bucket vector
7047 #define XPM_COLOR_CACHE_BUCKETS 1001
7048 struct xpm_cached_color
**xpm_color_cache
;
7050 /* Initialize the color cache. */
7053 xpm_init_color_cache (f
, attrs
)
7055 XpmAttributes
*attrs
;
7057 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7058 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7059 memset (xpm_color_cache
, 0, nbytes
);
7060 init_color_table ();
7062 if (attrs
->valuemask
& XpmColorSymbols
)
7067 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7068 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7069 attrs
->colorsymbols
[i
].value
, &color
))
7071 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7073 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7079 /* Free the color cache. */
7082 xpm_free_color_cache ()
7084 struct xpm_cached_color
*p
, *next
;
7087 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7088 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7094 xfree (xpm_color_cache
);
7095 xpm_color_cache
= NULL
;
7096 free_color_table ();
7100 /* Return the bucket index for color named COLOR_NAME in the color
7104 xpm_color_bucket (color_name
)
7110 for (s
= color_name
; *s
; ++s
)
7112 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7116 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7117 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7120 static struct xpm_cached_color
*
7121 xpm_cache_color (f
, color_name
, color
, bucket
)
7128 struct xpm_cached_color
*p
;
7131 bucket
= xpm_color_bucket (color_name
);
7133 nbytes
= sizeof *p
+ strlen (color_name
);
7134 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7135 strcpy (p
->name
, color_name
);
7137 p
->next
= xpm_color_cache
[bucket
];
7138 xpm_color_cache
[bucket
] = p
;
7143 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7144 return the cached definition in *COLOR. Otherwise, make a new
7145 entry in the cache and allocate the color. Value is zero if color
7146 allocation failed. */
7149 xpm_lookup_color (f
, color_name
, color
)
7154 struct xpm_cached_color
*p
;
7155 int h
= xpm_color_bucket (color_name
);
7157 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7158 if (strcmp (p
->name
, color_name
) == 0)
7163 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7166 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7168 p
= xpm_cache_color (f
, color_name
, color
, h
);
7175 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7176 CLOSURE is a pointer to the frame on which we allocate the
7177 color. Return in *COLOR the allocated color. Value is non-zero
7181 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7188 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7192 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7193 is a pointer to the frame on which we allocate the color. Value is
7194 non-zero if successful. */
7197 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7207 #endif /* ALLOC_XPM_COLORS */
7210 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7211 for XPM images. Such a list must consist of conses whose car and
7215 xpm_valid_color_symbols_p (color_symbols
)
7216 Lisp_Object color_symbols
;
7218 while (CONSP (color_symbols
))
7220 Lisp_Object sym
= XCAR (color_symbols
);
7222 || !STRINGP (XCAR (sym
))
7223 || !STRINGP (XCDR (sym
)))
7225 color_symbols
= XCDR (color_symbols
);
7228 return NILP (color_symbols
);
7232 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7235 xpm_image_p (object
)
7238 struct image_keyword fmt
[XPM_LAST
];
7239 bcopy (xpm_format
, fmt
, sizeof fmt
);
7240 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7241 /* Either `:file' or `:data' must be present. */
7242 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7243 /* Either no `:color-symbols' or it's a list of conses
7244 whose car and cdr are strings. */
7245 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7246 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7250 /* Load image IMG which will be displayed on frame F. Value is
7251 non-zero if successful. */
7259 XpmAttributes attrs
;
7260 Lisp_Object specified_file
, color_symbols
;
7262 /* Configure the XPM lib. Use the visual of frame F. Allocate
7263 close colors. Return colors allocated. */
7264 bzero (&attrs
, sizeof attrs
);
7265 attrs
.visual
= FRAME_X_VISUAL (f
);
7266 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7267 attrs
.valuemask
|= XpmVisual
;
7268 attrs
.valuemask
|= XpmColormap
;
7270 #ifdef ALLOC_XPM_COLORS
7271 /* Allocate colors with our own functions which handle
7272 failing color allocation more gracefully. */
7273 attrs
.color_closure
= f
;
7274 attrs
.alloc_color
= xpm_alloc_color
;
7275 attrs
.free_colors
= xpm_free_colors
;
7276 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7277 #else /* not ALLOC_XPM_COLORS */
7278 /* Let the XPM lib allocate colors. */
7279 attrs
.valuemask
|= XpmReturnAllocPixels
;
7280 #ifdef XpmAllocCloseColors
7281 attrs
.alloc_close_colors
= 1;
7282 attrs
.valuemask
|= XpmAllocCloseColors
;
7283 #else /* not XpmAllocCloseColors */
7284 attrs
.closeness
= 600;
7285 attrs
.valuemask
|= XpmCloseness
;
7286 #endif /* not XpmAllocCloseColors */
7287 #endif /* ALLOC_XPM_COLORS */
7289 /* If image specification contains symbolic color definitions, add
7290 these to `attrs'. */
7291 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7292 if (CONSP (color_symbols
))
7295 XpmColorSymbol
*xpm_syms
;
7298 attrs
.valuemask
|= XpmColorSymbols
;
7300 /* Count number of symbols. */
7301 attrs
.numsymbols
= 0;
7302 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7305 /* Allocate an XpmColorSymbol array. */
7306 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7307 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7308 bzero (xpm_syms
, size
);
7309 attrs
.colorsymbols
= xpm_syms
;
7311 /* Fill the color symbol array. */
7312 for (tail
= color_symbols
, i
= 0;
7314 ++i
, tail
= XCDR (tail
))
7316 Lisp_Object name
= XCAR (XCAR (tail
));
7317 Lisp_Object color
= XCDR (XCAR (tail
));
7318 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7319 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7320 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7321 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7325 /* Create a pixmap for the image, either from a file, or from a
7326 string buffer containing data in the same format as an XPM file. */
7327 #ifdef ALLOC_XPM_COLORS
7328 xpm_init_color_cache (f
, &attrs
);
7331 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7332 if (STRINGP (specified_file
))
7334 Lisp_Object file
= x_find_image_file (specified_file
);
7335 if (!STRINGP (file
))
7337 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7341 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7342 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7347 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7348 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7349 XSTRING (buffer
)->data
,
7350 &img
->pixmap
, &img
->mask
,
7354 if (rc
== XpmSuccess
)
7356 #ifdef ALLOC_XPM_COLORS
7357 img
->colors
= colors_in_color_table (&img
->ncolors
);
7358 #else /* not ALLOC_XPM_COLORS */
7361 img
->ncolors
= attrs
.nalloc_pixels
;
7362 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7363 * sizeof *img
->colors
);
7364 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7366 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7367 #ifdef DEBUG_X_COLORS
7368 register_color (img
->colors
[i
]);
7371 #endif /* not ALLOC_XPM_COLORS */
7373 img
->width
= attrs
.width
;
7374 img
->height
= attrs
.height
;
7375 xassert (img
->width
> 0 && img
->height
> 0);
7377 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7378 XpmFreeAttributes (&attrs
);
7385 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7388 case XpmFileInvalid
:
7389 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7393 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7396 case XpmColorFailed
:
7397 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7401 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7406 #ifdef ALLOC_XPM_COLORS
7407 xpm_free_color_cache ();
7409 return rc
== XpmSuccess
;
7412 #endif /* HAVE_XPM != 0 */
7415 /***********************************************************************
7417 ***********************************************************************/
7419 /* An entry in the color table mapping an RGB color to a pixel color. */
7424 unsigned long pixel
;
7426 /* Next in color table collision list. */
7427 struct ct_color
*next
;
7430 /* The bucket vector size to use. Must be prime. */
7434 /* Value is a hash of the RGB color given by R, G, and B. */
7436 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7438 /* The color hash table. */
7440 struct ct_color
**ct_table
;
7442 /* Number of entries in the color table. */
7444 int ct_colors_allocated
;
7446 /* Initialize the color table. */
7451 int size
= CT_SIZE
* sizeof (*ct_table
);
7452 ct_table
= (struct ct_color
**) xmalloc (size
);
7453 bzero (ct_table
, size
);
7454 ct_colors_allocated
= 0;
7458 /* Free memory associated with the color table. */
7464 struct ct_color
*p
, *next
;
7466 for (i
= 0; i
< CT_SIZE
; ++i
)
7467 for (p
= ct_table
[i
]; p
; p
= next
)
7478 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7479 entry for that color already is in the color table, return the
7480 pixel color of that entry. Otherwise, allocate a new color for R,
7481 G, B, and make an entry in the color table. */
7483 static unsigned long
7484 lookup_rgb_color (f
, r
, g
, b
)
7488 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7489 int i
= hash
% CT_SIZE
;
7492 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7493 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7506 cmap
= FRAME_X_COLORMAP (f
);
7507 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7511 ++ct_colors_allocated
;
7513 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7517 p
->pixel
= color
.pixel
;
7518 p
->next
= ct_table
[i
];
7522 return FRAME_FOREGROUND_PIXEL (f
);
7529 /* Look up pixel color PIXEL which is used on frame F in the color
7530 table. If not already present, allocate it. Value is PIXEL. */
7532 static unsigned long
7533 lookup_pixel_color (f
, pixel
)
7535 unsigned long pixel
;
7537 int i
= pixel
% CT_SIZE
;
7540 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7541 if (p
->pixel
== pixel
)
7550 cmap
= FRAME_X_COLORMAP (f
);
7551 color
.pixel
= pixel
;
7552 x_query_color (f
, &color
);
7553 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7557 ++ct_colors_allocated
;
7559 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7564 p
->next
= ct_table
[i
];
7568 return FRAME_FOREGROUND_PIXEL (f
);
7575 /* Value is a vector of all pixel colors contained in the color table,
7576 allocated via xmalloc. Set *N to the number of colors. */
7578 static unsigned long *
7579 colors_in_color_table (n
)
7584 unsigned long *colors
;
7586 if (ct_colors_allocated
== 0)
7593 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7595 *n
= ct_colors_allocated
;
7597 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7598 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7599 colors
[j
++] = p
->pixel
;
7607 /***********************************************************************
7609 ***********************************************************************/
7611 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7612 int, XImage
*, int));
7613 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7614 XColor
*, int, XImage
*, int));
7615 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7616 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7617 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7619 /* Non-zero means draw a cross on images having `:conversion
7622 int cross_disabled_images
;
7624 /* Edge detection matrices for different edge-detection
7627 static int emboss_matrix
[9] = {
7629 2, -1, 0, /* y - 1 */
7631 0, 1, -2 /* y + 1 */
7634 static int laplace_matrix
[9] = {
7636 1, 0, 0, /* y - 1 */
7638 0, 0, -1 /* y + 1 */
7641 /* Value is the intensity of the color whose red/green/blue values
7644 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7647 /* On frame F, return an array of XColor structures describing image
7648 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7649 non-zero means also fill the red/green/blue members of the XColor
7650 structures. Value is a pointer to the array of XColors structures,
7651 allocated with xmalloc; it must be freed by the caller. */
7654 x_to_xcolors (f
, img
, rgb_p
)
7663 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7665 /* Get the X image IMG->pixmap. */
7666 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7667 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7669 /* Fill the `pixel' members of the XColor array. I wished there
7670 were an easy and portable way to circumvent XGetPixel. */
7672 for (y
= 0; y
< img
->height
; ++y
)
7676 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7677 p
->pixel
= XGetPixel (ximg
, x
, y
);
7680 x_query_colors (f
, row
, img
->width
);
7683 XDestroyImage (ximg
);
7688 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7689 RGB members are set. F is the frame on which this all happens.
7690 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7693 x_from_xcolors (f
, img
, colors
)
7703 init_color_table ();
7705 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7708 for (y
= 0; y
< img
->height
; ++y
)
7709 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7711 unsigned long pixel
;
7712 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7713 XPutPixel (oimg
, x
, y
, pixel
);
7717 x_clear_image_1 (f
, img
, 1, 0, 1);
7719 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7720 x_destroy_x_image (oimg
);
7721 img
->pixmap
= pixmap
;
7722 img
->colors
= colors_in_color_table (&img
->ncolors
);
7723 free_color_table ();
7727 /* On frame F, perform edge-detection on image IMG.
7729 MATRIX is a nine-element array specifying the transformation
7730 matrix. See emboss_matrix for an example.
7732 COLOR_ADJUST is a color adjustment added to each pixel of the
7736 x_detect_edges (f
, img
, matrix
, color_adjust
)
7739 int matrix
[9], color_adjust
;
7741 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7745 for (i
= sum
= 0; i
< 9; ++i
)
7746 sum
+= abs (matrix
[i
]);
7748 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7750 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7752 for (y
= 0; y
< img
->height
; ++y
)
7754 p
= COLOR (new, 0, y
);
7755 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7756 p
= COLOR (new, img
->width
- 1, y
);
7757 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7760 for (x
= 1; x
< img
->width
- 1; ++x
)
7762 p
= COLOR (new, x
, 0);
7763 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7764 p
= COLOR (new, x
, img
->height
- 1);
7765 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7768 for (y
= 1; y
< img
->height
- 1; ++y
)
7770 p
= COLOR (new, 1, y
);
7772 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7774 int r
, g
, b
, y1
, x1
;
7777 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7778 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7781 XColor
*t
= COLOR (colors
, x1
, y1
);
7782 r
+= matrix
[i
] * t
->red
;
7783 g
+= matrix
[i
] * t
->green
;
7784 b
+= matrix
[i
] * t
->blue
;
7787 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7788 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7789 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7790 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7795 x_from_xcolors (f
, img
, new);
7801 /* Perform the pre-defined `emboss' edge-detection on image IMG
7809 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7813 /* Perform the pre-defined `laplace' edge-detection on image IMG
7821 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7825 /* Perform edge-detection on image IMG on frame F, with specified
7826 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7828 MATRIX must be either
7830 - a list of at least 9 numbers in row-major form
7831 - a vector of at least 9 numbers
7833 COLOR_ADJUST nil means use a default; otherwise it must be a
7837 x_edge_detection (f
, img
, matrix
, color_adjust
)
7840 Lisp_Object matrix
, color_adjust
;
7848 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7849 ++i
, matrix
= XCDR (matrix
))
7850 trans
[i
] = XFLOATINT (XCAR (matrix
));
7852 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7854 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7855 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7858 if (NILP (color_adjust
))
7859 color_adjust
= make_number (0xffff / 2);
7861 if (i
== 9 && NUMBERP (color_adjust
))
7862 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7866 /* Transform image IMG on frame F so that it looks disabled. */
7869 x_disable_image (f
, img
)
7873 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7875 if (dpyinfo
->n_planes
>= 2)
7877 /* Color (or grayscale). Convert to gray, and equalize. Just
7878 drawing such images with a stipple can look very odd, so
7879 we're using this method instead. */
7880 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7882 const int h
= 15000;
7883 const int l
= 30000;
7885 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7889 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7890 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7891 p
->red
= p
->green
= p
->blue
= i2
;
7894 x_from_xcolors (f
, img
, colors
);
7897 /* Draw a cross over the disabled image, if we must or if we
7899 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
7901 Display
*dpy
= FRAME_X_DISPLAY (f
);
7904 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
7905 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
7906 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
7907 img
->width
- 1, img
->height
- 1);
7908 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
7914 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
7915 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
7916 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
7917 img
->width
- 1, img
->height
- 1);
7918 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
7926 /* Build a mask for image IMG which is used on frame F. FILE is the
7927 name of an image file, for error messages. HOW determines how to
7928 determine the background color of IMG. If it is a list '(R G B)',
7929 with R, G, and B being integers >= 0, take that as the color of the
7930 background. Otherwise, determine the background color of IMG
7931 heuristically. Value is non-zero if successful. */
7934 x_build_heuristic_mask (f
, img
, how
)
7939 Display
*dpy
= FRAME_X_DISPLAY (f
);
7940 XImage
*ximg
, *mask_img
;
7941 int x
, y
, rc
, look_at_corners_p
;
7942 unsigned long bg
= 0;
7946 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
7950 /* Create an image and pixmap serving as mask. */
7951 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7952 &mask_img
, &img
->mask
);
7956 /* Get the X image of IMG->pixmap. */
7957 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7960 /* Determine the background color of ximg. If HOW is `(R G B)'
7961 take that as color. Otherwise, try to determine the color
7963 look_at_corners_p
= 1;
7971 && NATNUMP (XCAR (how
)))
7973 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7977 if (i
== 3 && NILP (how
))
7979 char color_name
[30];
7980 XColor exact
, color
;
7983 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7985 cmap
= FRAME_X_COLORMAP (f
);
7986 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7989 look_at_corners_p
= 0;
7994 if (look_at_corners_p
)
7996 unsigned long corners
[4];
7999 /* Get the colors at the corners of ximg. */
8000 corners
[0] = XGetPixel (ximg
, 0, 0);
8001 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
8002 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
8003 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
8005 /* Choose the most frequently found color as background. */
8006 for (i
= best_count
= 0; i
< 4; ++i
)
8010 for (j
= n
= 0; j
< 4; ++j
)
8011 if (corners
[i
] == corners
[j
])
8015 bg
= corners
[i
], best_count
= n
;
8019 /* Set all bits in mask_img to 1 whose color in ximg is different
8020 from the background color bg. */
8021 for (y
= 0; y
< img
->height
; ++y
)
8022 for (x
= 0; x
< img
->width
; ++x
)
8023 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8025 /* Put mask_img into img->mask. */
8026 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8027 x_destroy_x_image (mask_img
);
8028 XDestroyImage (ximg
);
8035 /***********************************************************************
8036 PBM (mono, gray, color)
8037 ***********************************************************************/
8039 static int pbm_image_p
P_ ((Lisp_Object object
));
8040 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8041 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8043 /* The symbol `pbm' identifying images of this type. */
8047 /* Indices of image specification fields in gs_format, below. */
8049 enum pbm_keyword_index
8065 /* Vector of image_keyword structures describing the format
8066 of valid user-defined image specifications. */
8068 static struct image_keyword pbm_format
[PBM_LAST
] =
8070 {":type", IMAGE_SYMBOL_VALUE
, 1},
8071 {":file", IMAGE_STRING_VALUE
, 0},
8072 {":data", IMAGE_STRING_VALUE
, 0},
8073 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8074 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8075 {":relief", IMAGE_INTEGER_VALUE
, 0},
8076 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8077 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8078 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8079 {":foreground", IMAGE_STRING_VALUE
, 0},
8080 {":background", IMAGE_STRING_VALUE
, 0}
8083 /* Structure describing the image type `pbm'. */
8085 static struct image_type pbm_type
=
8095 /* Return non-zero if OBJECT is a valid PBM image specification. */
8098 pbm_image_p (object
)
8101 struct image_keyword fmt
[PBM_LAST
];
8103 bcopy (pbm_format
, fmt
, sizeof fmt
);
8105 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8108 /* Must specify either :data or :file. */
8109 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8113 /* Scan a decimal number from *S and return it. Advance *S while
8114 reading the number. END is the end of the string. Value is -1 at
8118 pbm_scan_number (s
, end
)
8119 unsigned char **s
, *end
;
8121 int c
= 0, val
= -1;
8125 /* Skip white-space. */
8126 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8131 /* Skip comment to end of line. */
8132 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8135 else if (isdigit (c
))
8137 /* Read decimal number. */
8139 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8140 val
= 10 * val
+ c
- '0';
8151 /* Load PBM image IMG for use on frame F. */
8159 int width
, height
, max_color_idx
= 0;
8161 Lisp_Object file
, specified_file
;
8162 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8163 struct gcpro gcpro1
;
8164 unsigned char *contents
= NULL
;
8165 unsigned char *end
, *p
;
8168 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8172 if (STRINGP (specified_file
))
8174 file
= x_find_image_file (specified_file
);
8175 if (!STRINGP (file
))
8177 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8182 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8183 if (contents
== NULL
)
8185 image_error ("Error reading `%s'", file
, Qnil
);
8191 end
= contents
+ size
;
8196 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8197 p
= XSTRING (data
)->data
;
8198 end
= p
+ STRING_BYTES (XSTRING (data
));
8201 /* Check magic number. */
8202 if (end
- p
< 2 || *p
++ != 'P')
8204 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8214 raw_p
= 0, type
= PBM_MONO
;
8218 raw_p
= 0, type
= PBM_GRAY
;
8222 raw_p
= 0, type
= PBM_COLOR
;
8226 raw_p
= 1, type
= PBM_MONO
;
8230 raw_p
= 1, type
= PBM_GRAY
;
8234 raw_p
= 1, type
= PBM_COLOR
;
8238 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8242 /* Read width, height, maximum color-component. Characters
8243 starting with `#' up to the end of a line are ignored. */
8244 width
= pbm_scan_number (&p
, end
);
8245 height
= pbm_scan_number (&p
, end
);
8247 if (type
!= PBM_MONO
)
8249 max_color_idx
= pbm_scan_number (&p
, end
);
8250 if (raw_p
&& max_color_idx
> 255)
8251 max_color_idx
= 255;
8256 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8259 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8260 &ximg
, &img
->pixmap
))
8263 /* Initialize the color hash table. */
8264 init_color_table ();
8266 if (type
== PBM_MONO
)
8269 struct image_keyword fmt
[PBM_LAST
];
8270 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8271 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8273 /* Parse the image specification. */
8274 bcopy (pbm_format
, fmt
, sizeof fmt
);
8275 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8277 /* Get foreground and background colors, maybe allocate colors. */
8278 if (fmt
[PBM_FOREGROUND
].count
)
8279 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8280 if (fmt
[PBM_BACKGROUND
].count
)
8281 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8283 for (y
= 0; y
< height
; ++y
)
8284 for (x
= 0; x
< width
; ++x
)
8294 g
= pbm_scan_number (&p
, end
);
8296 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8301 for (y
= 0; y
< height
; ++y
)
8302 for (x
= 0; x
< width
; ++x
)
8306 if (type
== PBM_GRAY
)
8307 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8316 r
= pbm_scan_number (&p
, end
);
8317 g
= pbm_scan_number (&p
, end
);
8318 b
= pbm_scan_number (&p
, end
);
8321 if (r
< 0 || g
< 0 || b
< 0)
8325 XDestroyImage (ximg
);
8326 image_error ("Invalid pixel value in image `%s'",
8331 /* RGB values are now in the range 0..max_color_idx.
8332 Scale this to the range 0..0xffff supported by X. */
8333 r
= (double) r
* 65535 / max_color_idx
;
8334 g
= (double) g
* 65535 / max_color_idx
;
8335 b
= (double) b
* 65535 / max_color_idx
;
8336 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8340 /* Store in IMG->colors the colors allocated for the image, and
8341 free the color table. */
8342 img
->colors
= colors_in_color_table (&img
->ncolors
);
8343 free_color_table ();
8345 /* Put the image into a pixmap. */
8346 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8347 x_destroy_x_image (ximg
);
8350 img
->height
= height
;
8359 /***********************************************************************
8361 ***********************************************************************/
8367 /* Function prototypes. */
8369 static int png_image_p
P_ ((Lisp_Object object
));
8370 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8372 /* The symbol `png' identifying images of this type. */
8376 /* Indices of image specification fields in png_format, below. */
8378 enum png_keyword_index
8392 /* Vector of image_keyword structures describing the format
8393 of valid user-defined image specifications. */
8395 static struct image_keyword png_format
[PNG_LAST
] =
8397 {":type", IMAGE_SYMBOL_VALUE
, 1},
8398 {":data", IMAGE_STRING_VALUE
, 0},
8399 {":file", IMAGE_STRING_VALUE
, 0},
8400 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8401 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8402 {":relief", IMAGE_INTEGER_VALUE
, 0},
8403 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8404 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8405 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8408 /* Structure describing the image type `png'. */
8410 static struct image_type png_type
=
8420 /* Return non-zero if OBJECT is a valid PNG image specification. */
8423 png_image_p (object
)
8426 struct image_keyword fmt
[PNG_LAST
];
8427 bcopy (png_format
, fmt
, sizeof fmt
);
8429 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8432 /* Must specify either the :data or :file keyword. */
8433 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8437 /* Error and warning handlers installed when the PNG library
8441 my_png_error (png_ptr
, msg
)
8442 png_struct
*png_ptr
;
8445 xassert (png_ptr
!= NULL
);
8446 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8447 longjmp (png_ptr
->jmpbuf
, 1);
8452 my_png_warning (png_ptr
, msg
)
8453 png_struct
*png_ptr
;
8456 xassert (png_ptr
!= NULL
);
8457 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8460 /* Memory source for PNG decoding. */
8462 struct png_memory_storage
8464 unsigned char *bytes
; /* The data */
8465 size_t len
; /* How big is it? */
8466 int index
; /* Where are we? */
8470 /* Function set as reader function when reading PNG image from memory.
8471 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8472 bytes from the input to DATA. */
8475 png_read_from_memory (png_ptr
, data
, length
)
8476 png_structp png_ptr
;
8480 struct png_memory_storage
*tbr
8481 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8483 if (length
> tbr
->len
- tbr
->index
)
8484 png_error (png_ptr
, "Read error");
8486 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8487 tbr
->index
= tbr
->index
+ length
;
8490 /* Load PNG image IMG for use on frame F. Value is non-zero if
8498 Lisp_Object file
, specified_file
;
8499 Lisp_Object specified_data
;
8501 XImage
*ximg
, *mask_img
= NULL
;
8502 struct gcpro gcpro1
;
8503 png_struct
*png_ptr
= NULL
;
8504 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8505 FILE *volatile fp
= NULL
;
8507 png_byte
* volatile pixels
= NULL
;
8508 png_byte
** volatile rows
= NULL
;
8509 png_uint_32 width
, height
;
8510 int bit_depth
, color_type
, interlace_type
;
8512 png_uint_32 row_bytes
;
8515 double screen_gamma
, image_gamma
;
8517 struct png_memory_storage tbr
; /* Data to be read */
8519 /* Find out what file to load. */
8520 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8521 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8525 if (NILP (specified_data
))
8527 file
= x_find_image_file (specified_file
);
8528 if (!STRINGP (file
))
8530 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8535 /* Open the image file. */
8536 fp
= fopen (XSTRING (file
)->data
, "rb");
8539 image_error ("Cannot open image file `%s'", file
, Qnil
);
8545 /* Check PNG signature. */
8546 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8547 || !png_check_sig (sig
, sizeof sig
))
8549 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8557 /* Read from memory. */
8558 tbr
.bytes
= XSTRING (specified_data
)->data
;
8559 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8562 /* Check PNG signature. */
8563 if (tbr
.len
< sizeof sig
8564 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8566 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8571 /* Need to skip past the signature. */
8572 tbr
.bytes
+= sizeof (sig
);
8575 /* Initialize read and info structs for PNG lib. */
8576 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8577 my_png_error
, my_png_warning
);
8580 if (fp
) fclose (fp
);
8585 info_ptr
= png_create_info_struct (png_ptr
);
8588 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8589 if (fp
) fclose (fp
);
8594 end_info
= png_create_info_struct (png_ptr
);
8597 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8598 if (fp
) fclose (fp
);
8603 /* Set error jump-back. We come back here when the PNG library
8604 detects an error. */
8605 if (setjmp (png_ptr
->jmpbuf
))
8609 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8612 if (fp
) fclose (fp
);
8617 /* Read image info. */
8618 if (!NILP (specified_data
))
8619 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8621 png_init_io (png_ptr
, fp
);
8623 png_set_sig_bytes (png_ptr
, sizeof sig
);
8624 png_read_info (png_ptr
, info_ptr
);
8625 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8626 &interlace_type
, NULL
, NULL
);
8628 /* If image contains simply transparency data, we prefer to
8629 construct a clipping mask. */
8630 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8635 /* This function is easier to write if we only have to handle
8636 one data format: RGB or RGBA with 8 bits per channel. Let's
8637 transform other formats into that format. */
8639 /* Strip more than 8 bits per channel. */
8640 if (bit_depth
== 16)
8641 png_set_strip_16 (png_ptr
);
8643 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8645 png_set_expand (png_ptr
);
8647 /* Convert grayscale images to RGB. */
8648 if (color_type
== PNG_COLOR_TYPE_GRAY
8649 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8650 png_set_gray_to_rgb (png_ptr
);
8652 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8653 gamma_str
= getenv ("SCREEN_GAMMA");
8654 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8656 /* Tell the PNG lib to handle gamma correction for us. */
8658 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8659 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8660 /* There is a special chunk in the image specifying the gamma. */
8661 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8664 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8665 /* Image contains gamma information. */
8666 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8668 /* Use a default of 0.5 for the image gamma. */
8669 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8671 /* Handle alpha channel by combining the image with a background
8672 color. Do this only if a real alpha channel is supplied. For
8673 simple transparency, we prefer a clipping mask. */
8676 png_color_16
*image_background
;
8678 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8679 /* Image contains a background color with which to
8680 combine the image. */
8681 png_set_background (png_ptr
, image_background
,
8682 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8685 /* Image does not contain a background color with which
8686 to combine the image data via an alpha channel. Use
8687 the frame's background instead. */
8690 png_color_16 frame_background
;
8692 cmap
= FRAME_X_COLORMAP (f
);
8693 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8694 x_query_color (f
, &color
);
8696 bzero (&frame_background
, sizeof frame_background
);
8697 frame_background
.red
= color
.red
;
8698 frame_background
.green
= color
.green
;
8699 frame_background
.blue
= color
.blue
;
8701 png_set_background (png_ptr
, &frame_background
,
8702 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8706 /* Update info structure. */
8707 png_read_update_info (png_ptr
, info_ptr
);
8709 /* Get number of channels. Valid values are 1 for grayscale images
8710 and images with a palette, 2 for grayscale images with transparency
8711 information (alpha channel), 3 for RGB images, and 4 for RGB
8712 images with alpha channel, i.e. RGBA. If conversions above were
8713 sufficient we should only have 3 or 4 channels here. */
8714 channels
= png_get_channels (png_ptr
, info_ptr
);
8715 xassert (channels
== 3 || channels
== 4);
8717 /* Number of bytes needed for one row of the image. */
8718 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8720 /* Allocate memory for the image. */
8721 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8722 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8723 for (i
= 0; i
< height
; ++i
)
8724 rows
[i
] = pixels
+ i
* row_bytes
;
8726 /* Read the entire image. */
8727 png_read_image (png_ptr
, rows
);
8728 png_read_end (png_ptr
, info_ptr
);
8735 /* Create the X image and pixmap. */
8736 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8740 /* Create an image and pixmap serving as mask if the PNG image
8741 contains an alpha channel. */
8744 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8745 &mask_img
, &img
->mask
))
8747 x_destroy_x_image (ximg
);
8748 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8753 /* Fill the X image and mask from PNG data. */
8754 init_color_table ();
8756 for (y
= 0; y
< height
; ++y
)
8758 png_byte
*p
= rows
[y
];
8760 for (x
= 0; x
< width
; ++x
)
8767 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8769 /* An alpha channel, aka mask channel, associates variable
8770 transparency with an image. Where other image formats
8771 support binary transparency---fully transparent or fully
8772 opaque---PNG allows up to 254 levels of partial transparency.
8773 The PNG library implements partial transparency by combining
8774 the image with a specified background color.
8776 I'm not sure how to handle this here nicely: because the
8777 background on which the image is displayed may change, for
8778 real alpha channel support, it would be necessary to create
8779 a new image for each possible background.
8781 What I'm doing now is that a mask is created if we have
8782 boolean transparency information. Otherwise I'm using
8783 the frame's background color to combine the image with. */
8788 XPutPixel (mask_img
, x
, y
, *p
> 0);
8794 /* Remember colors allocated for this image. */
8795 img
->colors
= colors_in_color_table (&img
->ncolors
);
8796 free_color_table ();
8799 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8804 img
->height
= height
;
8806 /* Put the image into the pixmap, then free the X image and its buffer. */
8807 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8808 x_destroy_x_image (ximg
);
8810 /* Same for the mask. */
8813 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8814 x_destroy_x_image (mask_img
);
8821 #endif /* HAVE_PNG != 0 */
8825 /***********************************************************************
8827 ***********************************************************************/
8831 /* Work around a warning about HAVE_STDLIB_H being redefined in
8833 #ifdef HAVE_STDLIB_H
8834 #define HAVE_STDLIB_H_1
8835 #undef HAVE_STDLIB_H
8836 #endif /* HAVE_STLIB_H */
8838 #include <jpeglib.h>
8842 #ifdef HAVE_STLIB_H_1
8843 #define HAVE_STDLIB_H 1
8846 static int jpeg_image_p
P_ ((Lisp_Object object
));
8847 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8849 /* The symbol `jpeg' identifying images of this type. */
8853 /* Indices of image specification fields in gs_format, below. */
8855 enum jpeg_keyword_index
8864 JPEG_HEURISTIC_MASK
,
8869 /* Vector of image_keyword structures describing the format
8870 of valid user-defined image specifications. */
8872 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8874 {":type", IMAGE_SYMBOL_VALUE
, 1},
8875 {":data", IMAGE_STRING_VALUE
, 0},
8876 {":file", IMAGE_STRING_VALUE
, 0},
8877 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8878 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8879 {":relief", IMAGE_INTEGER_VALUE
, 0},
8880 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8881 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8882 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8885 /* Structure describing the image type `jpeg'. */
8887 static struct image_type jpeg_type
=
8897 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8900 jpeg_image_p (object
)
8903 struct image_keyword fmt
[JPEG_LAST
];
8905 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8907 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8910 /* Must specify either the :data or :file keyword. */
8911 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8915 struct my_jpeg_error_mgr
8917 struct jpeg_error_mgr pub
;
8918 jmp_buf setjmp_buffer
;
8923 my_error_exit (cinfo
)
8926 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8927 longjmp (mgr
->setjmp_buffer
, 1);
8931 /* Init source method for JPEG data source manager. Called by
8932 jpeg_read_header() before any data is actually read. See
8933 libjpeg.doc from the JPEG lib distribution. */
8936 our_init_source (cinfo
)
8937 j_decompress_ptr cinfo
;
8942 /* Fill input buffer method for JPEG data source manager. Called
8943 whenever more data is needed. We read the whole image in one step,
8944 so this only adds a fake end of input marker at the end. */
8947 our_fill_input_buffer (cinfo
)
8948 j_decompress_ptr cinfo
;
8950 /* Insert a fake EOI marker. */
8951 struct jpeg_source_mgr
*src
= cinfo
->src
;
8952 static JOCTET buffer
[2];
8954 buffer
[0] = (JOCTET
) 0xFF;
8955 buffer
[1] = (JOCTET
) JPEG_EOI
;
8957 src
->next_input_byte
= buffer
;
8958 src
->bytes_in_buffer
= 2;
8963 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8964 is the JPEG data source manager. */
8967 our_skip_input_data (cinfo
, num_bytes
)
8968 j_decompress_ptr cinfo
;
8971 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8975 if (num_bytes
> src
->bytes_in_buffer
)
8976 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8978 src
->bytes_in_buffer
-= num_bytes
;
8979 src
->next_input_byte
+= num_bytes
;
8984 /* Method to terminate data source. Called by
8985 jpeg_finish_decompress() after all data has been processed. */
8988 our_term_source (cinfo
)
8989 j_decompress_ptr cinfo
;
8994 /* Set up the JPEG lib for reading an image from DATA which contains
8995 LEN bytes. CINFO is the decompression info structure created for
8996 reading the image. */
8999 jpeg_memory_src (cinfo
, data
, len
)
9000 j_decompress_ptr cinfo
;
9004 struct jpeg_source_mgr
*src
;
9006 if (cinfo
->src
== NULL
)
9008 /* First time for this JPEG object? */
9009 cinfo
->src
= (struct jpeg_source_mgr
*)
9010 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9011 sizeof (struct jpeg_source_mgr
));
9012 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9013 src
->next_input_byte
= data
;
9016 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9017 src
->init_source
= our_init_source
;
9018 src
->fill_input_buffer
= our_fill_input_buffer
;
9019 src
->skip_input_data
= our_skip_input_data
;
9020 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9021 src
->term_source
= our_term_source
;
9022 src
->bytes_in_buffer
= len
;
9023 src
->next_input_byte
= data
;
9027 /* Load image IMG for use on frame F. Patterned after example.c
9028 from the JPEG lib. */
9035 struct jpeg_decompress_struct cinfo
;
9036 struct my_jpeg_error_mgr mgr
;
9037 Lisp_Object file
, specified_file
;
9038 Lisp_Object specified_data
;
9039 FILE * volatile fp
= NULL
;
9041 int row_stride
, x
, y
;
9042 XImage
*ximg
= NULL
;
9044 unsigned long *colors
;
9046 struct gcpro gcpro1
;
9048 /* Open the JPEG file. */
9049 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9050 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9054 if (NILP (specified_data
))
9056 file
= x_find_image_file (specified_file
);
9057 if (!STRINGP (file
))
9059 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9064 fp
= fopen (XSTRING (file
)->data
, "r");
9067 image_error ("Cannot open `%s'", file
, Qnil
);
9073 /* Customize libjpeg's error handling to call my_error_exit when an
9074 error is detected. This function will perform a longjmp. */
9075 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9076 mgr
.pub
.error_exit
= my_error_exit
;
9078 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9082 /* Called from my_error_exit. Display a JPEG error. */
9083 char buffer
[JMSG_LENGTH_MAX
];
9084 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9085 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9086 build_string (buffer
));
9089 /* Close the input file and destroy the JPEG object. */
9091 fclose ((FILE *) fp
);
9092 jpeg_destroy_decompress (&cinfo
);
9094 /* If we already have an XImage, free that. */
9095 x_destroy_x_image (ximg
);
9097 /* Free pixmap and colors. */
9098 x_clear_image (f
, img
);
9104 /* Create the JPEG decompression object. Let it read from fp.
9105 Read the JPEG image header. */
9106 jpeg_create_decompress (&cinfo
);
9108 if (NILP (specified_data
))
9109 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9111 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9112 STRING_BYTES (XSTRING (specified_data
)));
9114 jpeg_read_header (&cinfo
, TRUE
);
9116 /* Customize decompression so that color quantization will be used.
9117 Start decompression. */
9118 cinfo
.quantize_colors
= TRUE
;
9119 jpeg_start_decompress (&cinfo
);
9120 width
= img
->width
= cinfo
.output_width
;
9121 height
= img
->height
= cinfo
.output_height
;
9123 /* Create X image and pixmap. */
9124 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9125 longjmp (mgr
.setjmp_buffer
, 2);
9127 /* Allocate colors. When color quantization is used,
9128 cinfo.actual_number_of_colors has been set with the number of
9129 colors generated, and cinfo.colormap is a two-dimensional array
9130 of color indices in the range 0..cinfo.actual_number_of_colors.
9131 No more than 255 colors will be generated. */
9135 if (cinfo
.out_color_components
> 2)
9136 ir
= 0, ig
= 1, ib
= 2;
9137 else if (cinfo
.out_color_components
> 1)
9138 ir
= 0, ig
= 1, ib
= 0;
9140 ir
= 0, ig
= 0, ib
= 0;
9142 /* Use the color table mechanism because it handles colors that
9143 cannot be allocated nicely. Such colors will be replaced with
9144 a default color, and we don't have to care about which colors
9145 can be freed safely, and which can't. */
9146 init_color_table ();
9147 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9150 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9152 /* Multiply RGB values with 255 because X expects RGB values
9153 in the range 0..0xffff. */
9154 int r
= cinfo
.colormap
[ir
][i
] << 8;
9155 int g
= cinfo
.colormap
[ig
][i
] << 8;
9156 int b
= cinfo
.colormap
[ib
][i
] << 8;
9157 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9160 /* Remember those colors actually allocated. */
9161 img
->colors
= colors_in_color_table (&img
->ncolors
);
9162 free_color_table ();
9166 row_stride
= width
* cinfo
.output_components
;
9167 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9169 for (y
= 0; y
< height
; ++y
)
9171 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9172 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9173 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9177 jpeg_finish_decompress (&cinfo
);
9178 jpeg_destroy_decompress (&cinfo
);
9180 fclose ((FILE *) fp
);
9182 /* Put the image into the pixmap. */
9183 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9184 x_destroy_x_image (ximg
);
9189 #endif /* HAVE_JPEG */
9193 /***********************************************************************
9195 ***********************************************************************/
9201 static int tiff_image_p
P_ ((Lisp_Object object
));
9202 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9204 /* The symbol `tiff' identifying images of this type. */
9208 /* Indices of image specification fields in tiff_format, below. */
9210 enum tiff_keyword_index
9219 TIFF_HEURISTIC_MASK
,
9224 /* Vector of image_keyword structures describing the format
9225 of valid user-defined image specifications. */
9227 static struct image_keyword tiff_format
[TIFF_LAST
] =
9229 {":type", IMAGE_SYMBOL_VALUE
, 1},
9230 {":data", IMAGE_STRING_VALUE
, 0},
9231 {":file", IMAGE_STRING_VALUE
, 0},
9232 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9233 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9234 {":relief", IMAGE_INTEGER_VALUE
, 0},
9235 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9236 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9237 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9240 /* Structure describing the image type `tiff'. */
9242 static struct image_type tiff_type
=
9252 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9255 tiff_image_p (object
)
9258 struct image_keyword fmt
[TIFF_LAST
];
9259 bcopy (tiff_format
, fmt
, sizeof fmt
);
9261 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9264 /* Must specify either the :data or :file keyword. */
9265 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9269 /* Reading from a memory buffer for TIFF images Based on the PNG
9270 memory source, but we have to provide a lot of extra functions.
9273 We really only need to implement read and seek, but I am not
9274 convinced that the TIFF library is smart enough not to destroy
9275 itself if we only hand it the function pointers we need to
9280 unsigned char *bytes
;
9288 tiff_read_from_memory (data
, buf
, size
)
9293 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9295 if (size
> src
->len
- src
->index
)
9297 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9304 tiff_write_from_memory (data
, buf
, size
)
9314 tiff_seek_in_memory (data
, off
, whence
)
9319 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9324 case SEEK_SET
: /* Go from beginning of source. */
9328 case SEEK_END
: /* Go from end of source. */
9329 idx
= src
->len
+ off
;
9332 case SEEK_CUR
: /* Go from current position. */
9333 idx
= src
->index
+ off
;
9336 default: /* Invalid `whence'. */
9340 if (idx
> src
->len
|| idx
< 0)
9349 tiff_close_memory (data
)
9358 tiff_mmap_memory (data
, pbase
, psize
)
9363 /* It is already _IN_ memory. */
9369 tiff_unmap_memory (data
, base
, size
)
9374 /* We don't need to do this. */
9379 tiff_size_of_memory (data
)
9382 return ((tiff_memory_source
*) data
)->len
;
9386 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9394 Lisp_Object file
, specified_file
;
9395 Lisp_Object specified_data
;
9397 int width
, height
, x
, y
;
9401 struct gcpro gcpro1
;
9402 tiff_memory_source memsrc
;
9404 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9405 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9409 if (NILP (specified_data
))
9411 /* Read from a file */
9412 file
= x_find_image_file (specified_file
);
9413 if (!STRINGP (file
))
9415 image_error ("Cannot find image file `%s'", file
, Qnil
);
9420 /* Try to open the image file. */
9421 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9424 image_error ("Cannot open `%s'", file
, Qnil
);
9431 /* Memory source! */
9432 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9433 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9436 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9437 (TIFFReadWriteProc
) tiff_read_from_memory
,
9438 (TIFFReadWriteProc
) tiff_write_from_memory
,
9439 tiff_seek_in_memory
,
9441 tiff_size_of_memory
,
9447 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9453 /* Get width and height of the image, and allocate a raster buffer
9454 of width x height 32-bit values. */
9455 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9456 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9457 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9459 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9463 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9469 /* Create the X image and pixmap. */
9470 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9477 /* Initialize the color table. */
9478 init_color_table ();
9480 /* Process the pixel raster. Origin is in the lower-left corner. */
9481 for (y
= 0; y
< height
; ++y
)
9483 uint32
*row
= buf
+ y
* width
;
9485 for (x
= 0; x
< width
; ++x
)
9487 uint32 abgr
= row
[x
];
9488 int r
= TIFFGetR (abgr
) << 8;
9489 int g
= TIFFGetG (abgr
) << 8;
9490 int b
= TIFFGetB (abgr
) << 8;
9491 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9495 /* Remember the colors allocated for the image. Free the color table. */
9496 img
->colors
= colors_in_color_table (&img
->ncolors
);
9497 free_color_table ();
9499 /* Put the image into the pixmap, then free the X image and its buffer. */
9500 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9501 x_destroy_x_image (ximg
);
9505 img
->height
= height
;
9511 #endif /* HAVE_TIFF != 0 */
9515 /***********************************************************************
9517 ***********************************************************************/
9521 #include <gif_lib.h>
9523 static int gif_image_p
P_ ((Lisp_Object object
));
9524 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9526 /* The symbol `gif' identifying images of this type. */
9530 /* Indices of image specification fields in gif_format, below. */
9532 enum gif_keyword_index
9547 /* Vector of image_keyword structures describing the format
9548 of valid user-defined image specifications. */
9550 static struct image_keyword gif_format
[GIF_LAST
] =
9552 {":type", IMAGE_SYMBOL_VALUE
, 1},
9553 {":data", IMAGE_STRING_VALUE
, 0},
9554 {":file", IMAGE_STRING_VALUE
, 0},
9555 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9556 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9557 {":relief", IMAGE_INTEGER_VALUE
, 0},
9558 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9559 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9560 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9561 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9564 /* Structure describing the image type `gif'. */
9566 static struct image_type gif_type
=
9576 /* Return non-zero if OBJECT is a valid GIF image specification. */
9579 gif_image_p (object
)
9582 struct image_keyword fmt
[GIF_LAST
];
9583 bcopy (gif_format
, fmt
, sizeof fmt
);
9585 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9588 /* Must specify either the :data or :file keyword. */
9589 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9593 /* Reading a GIF image from memory
9594 Based on the PNG memory stuff to a certain extent. */
9598 unsigned char *bytes
;
9605 /* Make the current memory source available to gif_read_from_memory.
9606 It's done this way because not all versions of libungif support
9607 a UserData field in the GifFileType structure. */
9608 static gif_memory_source
*current_gif_memory_src
;
9611 gif_read_from_memory (file
, buf
, len
)
9616 gif_memory_source
*src
= current_gif_memory_src
;
9618 if (len
> src
->len
- src
->index
)
9621 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9627 /* Load GIF image IMG for use on frame F. Value is non-zero if
9635 Lisp_Object file
, specified_file
;
9636 Lisp_Object specified_data
;
9637 int rc
, width
, height
, x
, y
, i
;
9639 ColorMapObject
*gif_color_map
;
9640 unsigned long pixel_colors
[256];
9642 struct gcpro gcpro1
;
9644 int ino
, image_left
, image_top
, image_width
, image_height
;
9645 gif_memory_source memsrc
;
9646 unsigned char *raster
;
9648 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9649 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9653 if (NILP (specified_data
))
9655 file
= x_find_image_file (specified_file
);
9656 if (!STRINGP (file
))
9658 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9663 /* Open the GIF file. */
9664 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9667 image_error ("Cannot open `%s'", file
, Qnil
);
9674 /* Read from memory! */
9675 current_gif_memory_src
= &memsrc
;
9676 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9677 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9680 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9683 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9689 /* Read entire contents. */
9690 rc
= DGifSlurp (gif
);
9691 if (rc
== GIF_ERROR
)
9693 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9694 DGifCloseFile (gif
);
9699 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9700 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9701 if (ino
>= gif
->ImageCount
)
9703 image_error ("Invalid image number `%s' in image `%s'",
9705 DGifCloseFile (gif
);
9710 width
= img
->width
= gif
->SWidth
;
9711 height
= img
->height
= gif
->SHeight
;
9713 /* Create the X image and pixmap. */
9714 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9716 DGifCloseFile (gif
);
9721 /* Allocate colors. */
9722 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9724 gif_color_map
= gif
->SColorMap
;
9725 init_color_table ();
9726 bzero (pixel_colors
, sizeof pixel_colors
);
9728 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9730 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9731 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9732 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9733 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9736 img
->colors
= colors_in_color_table (&img
->ncolors
);
9737 free_color_table ();
9739 /* Clear the part of the screen image that are not covered by
9740 the image from the GIF file. Full animated GIF support
9741 requires more than can be done here (see the gif89 spec,
9742 disposal methods). Let's simply assume that the part
9743 not covered by a sub-image is in the frame's background color. */
9744 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9745 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9746 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9747 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9749 for (y
= 0; y
< image_top
; ++y
)
9750 for (x
= 0; x
< width
; ++x
)
9751 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9753 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9754 for (x
= 0; x
< width
; ++x
)
9755 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9757 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9759 for (x
= 0; x
< image_left
; ++x
)
9760 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9761 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9762 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9765 /* Read the GIF image into the X image. We use a local variable
9766 `raster' here because RasterBits below is a char *, and invites
9767 problems with bytes >= 0x80. */
9768 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9770 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9772 static int interlace_start
[] = {0, 4, 2, 1};
9773 static int interlace_increment
[] = {8, 8, 4, 2};
9775 int row
= interlace_start
[0];
9779 for (y
= 0; y
< image_height
; y
++)
9781 if (row
>= image_height
)
9783 row
= interlace_start
[++pass
];
9784 while (row
>= image_height
)
9785 row
= interlace_start
[++pass
];
9788 for (x
= 0; x
< image_width
; x
++)
9790 int i
= raster
[(y
* image_width
) + x
];
9791 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9795 row
+= interlace_increment
[pass
];
9800 for (y
= 0; y
< image_height
; ++y
)
9801 for (x
= 0; x
< image_width
; ++x
)
9803 int i
= raster
[y
* image_width
+ x
];
9804 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9808 DGifCloseFile (gif
);
9810 /* Put the image into the pixmap, then free the X image and its buffer. */
9811 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9812 x_destroy_x_image (ximg
);
9818 #endif /* HAVE_GIF != 0 */
9822 /***********************************************************************
9824 ***********************************************************************/
9826 static int gs_image_p
P_ ((Lisp_Object object
));
9827 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9828 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9830 /* The symbol `postscript' identifying images of this type. */
9832 Lisp_Object Qpostscript
;
9834 /* Keyword symbols. */
9836 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9838 /* Indices of image specification fields in gs_format, below. */
9840 enum gs_keyword_index
9857 /* Vector of image_keyword structures describing the format
9858 of valid user-defined image specifications. */
9860 static struct image_keyword gs_format
[GS_LAST
] =
9862 {":type", IMAGE_SYMBOL_VALUE
, 1},
9863 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9864 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9865 {":file", IMAGE_STRING_VALUE
, 1},
9866 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9867 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9868 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9869 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9870 {":relief", IMAGE_INTEGER_VALUE
, 0},
9871 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9872 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9873 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9876 /* Structure describing the image type `ghostscript'. */
9878 static struct image_type gs_type
=
9888 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9891 gs_clear_image (f
, img
)
9895 /* IMG->data.ptr_val may contain a recorded colormap. */
9896 xfree (img
->data
.ptr_val
);
9897 x_clear_image (f
, img
);
9901 /* Return non-zero if OBJECT is a valid Ghostscript image
9908 struct image_keyword fmt
[GS_LAST
];
9912 bcopy (gs_format
, fmt
, sizeof fmt
);
9914 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
9917 /* Bounding box must be a list or vector containing 4 integers. */
9918 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9921 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9922 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9927 else if (VECTORP (tem
))
9929 if (XVECTOR (tem
)->size
!= 4)
9931 for (i
= 0; i
< 4; ++i
)
9932 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9942 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9951 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9952 struct gcpro gcpro1
, gcpro2
;
9954 double in_width
, in_height
;
9955 Lisp_Object pixel_colors
= Qnil
;
9957 /* Compute pixel size of pixmap needed from the given size in the
9958 image specification. Sizes in the specification are in pt. 1 pt
9959 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9961 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9962 in_width
= XFASTINT (pt_width
) / 72.0;
9963 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9964 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9965 in_height
= XFASTINT (pt_height
) / 72.0;
9966 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9968 /* Create the pixmap. */
9969 xassert (img
->pixmap
== None
);
9970 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9971 img
->width
, img
->height
,
9972 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9976 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9980 /* Call the loader to fill the pixmap. It returns a process object
9981 if successful. We do not record_unwind_protect here because
9982 other places in redisplay like calling window scroll functions
9983 don't either. Let the Lisp loader use `unwind-protect' instead. */
9984 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9986 sprintf (buffer
, "%lu %lu",
9987 (unsigned long) FRAME_X_WINDOW (f
),
9988 (unsigned long) img
->pixmap
);
9989 window_and_pixmap_id
= build_string (buffer
);
9991 sprintf (buffer
, "%lu %lu",
9992 FRAME_FOREGROUND_PIXEL (f
),
9993 FRAME_BACKGROUND_PIXEL (f
));
9994 pixel_colors
= build_string (buffer
);
9996 XSETFRAME (frame
, f
);
9997 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9999 loader
= intern ("gs-load-image");
10001 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10002 make_number (img
->width
),
10003 make_number (img
->height
),
10004 window_and_pixmap_id
,
10007 return PROCESSP (img
->data
.lisp_val
);
10011 /* Kill the Ghostscript process that was started to fill PIXMAP on
10012 frame F. Called from XTread_socket when receiving an event
10013 telling Emacs that Ghostscript has finished drawing. */
10016 x_kill_gs_process (pixmap
, f
)
10020 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10024 /* Find the image containing PIXMAP. */
10025 for (i
= 0; i
< c
->used
; ++i
)
10026 if (c
->images
[i
]->pixmap
== pixmap
)
10029 /* Kill the GS process. We should have found PIXMAP in the image
10030 cache and its image should contain a process object. */
10031 xassert (i
< c
->used
);
10032 img
= c
->images
[i
];
10033 xassert (PROCESSP (img
->data
.lisp_val
));
10034 Fkill_process (img
->data
.lisp_val
, Qnil
);
10035 img
->data
.lisp_val
= Qnil
;
10037 /* On displays with a mutable colormap, figure out the colors
10038 allocated for the image by looking at the pixels of an XImage for
10040 class = FRAME_X_VISUAL (f
)->class;
10041 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10047 /* Try to get an XImage for img->pixmep. */
10048 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10049 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10054 /* Initialize the color table. */
10055 init_color_table ();
10057 /* For each pixel of the image, look its color up in the
10058 color table. After having done so, the color table will
10059 contain an entry for each color used by the image. */
10060 for (y
= 0; y
< img
->height
; ++y
)
10061 for (x
= 0; x
< img
->width
; ++x
)
10063 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10064 lookup_pixel_color (f
, pixel
);
10067 /* Record colors in the image. Free color table and XImage. */
10068 img
->colors
= colors_in_color_table (&img
->ncolors
);
10069 free_color_table ();
10070 XDestroyImage (ximg
);
10072 #if 0 /* This doesn't seem to be the case. If we free the colors
10073 here, we get a BadAccess later in x_clear_image when
10074 freeing the colors. */
10075 /* We have allocated colors once, but Ghostscript has also
10076 allocated colors on behalf of us. So, to get the
10077 reference counts right, free them once. */
10079 x_free_colors (f
, img
->colors
, img
->ncolors
);
10083 image_error ("Cannot get X image of `%s'; colors will not be freed",
10092 /***********************************************************************
10094 ***********************************************************************/
10096 DEFUN ("x-change-window-property", Fx_change_window_property
,
10097 Sx_change_window_property
, 2, 3, 0,
10098 "Change window property PROP to VALUE on the X window of FRAME.\n\
10099 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
10100 selected frame. Value is VALUE.")
10101 (prop
, value
, frame
)
10102 Lisp_Object frame
, prop
, value
;
10104 struct frame
*f
= check_x_frame (frame
);
10107 CHECK_STRING (prop
, 1);
10108 CHECK_STRING (value
, 2);
10111 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10112 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10113 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10114 XSTRING (value
)->data
, XSTRING (value
)->size
);
10116 /* Make sure the property is set when we return. */
10117 XFlush (FRAME_X_DISPLAY (f
));
10124 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10125 Sx_delete_window_property
, 1, 2, 0,
10126 "Remove window property PROP from X window of FRAME.\n\
10127 FRAME nil or omitted means use the selected frame. Value is PROP.")
10129 Lisp_Object prop
, frame
;
10131 struct frame
*f
= check_x_frame (frame
);
10134 CHECK_STRING (prop
, 1);
10136 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10137 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10139 /* Make sure the property is removed when we return. */
10140 XFlush (FRAME_X_DISPLAY (f
));
10147 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10149 "Value is the value of window property PROP on FRAME.\n\
10150 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10151 if FRAME hasn't a property with name PROP or if PROP has no string\n\
10154 Lisp_Object prop
, frame
;
10156 struct frame
*f
= check_x_frame (frame
);
10159 Lisp_Object prop_value
= Qnil
;
10160 char *tmp_data
= NULL
;
10163 unsigned long actual_size
, bytes_remaining
;
10165 CHECK_STRING (prop
, 1);
10167 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10168 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10169 prop_atom
, 0, 0, False
, XA_STRING
,
10170 &actual_type
, &actual_format
, &actual_size
,
10171 &bytes_remaining
, (unsigned char **) &tmp_data
);
10174 int size
= bytes_remaining
;
10179 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10180 prop_atom
, 0, bytes_remaining
,
10182 &actual_type
, &actual_format
,
10183 &actual_size
, &bytes_remaining
,
10184 (unsigned char **) &tmp_data
);
10186 prop_value
= make_string (tmp_data
, size
);
10197 /***********************************************************************
10199 ***********************************************************************/
10201 /* If non-null, an asynchronous timer that, when it expires, displays
10202 an hourglass cursor on all frames. */
10204 static struct atimer
*hourglass_atimer
;
10206 /* Non-zero means an hourglass cursor is currently shown. */
10208 static int hourglass_shown_p
;
10210 /* Number of seconds to wait before displaying an hourglass cursor. */
10212 static Lisp_Object Vhourglass_delay
;
10214 /* Default number of seconds to wait before displaying an hourglass
10217 #define DEFAULT_HOURGLASS_DELAY 1
10219 /* Function prototypes. */
10221 static void show_hourglass
P_ ((struct atimer
*));
10222 static void hide_hourglass
P_ ((void));
10225 /* Cancel a currently active hourglass timer, and start a new one. */
10231 int secs
, usecs
= 0;
10233 cancel_hourglass ();
10235 if (INTEGERP (Vhourglass_delay
)
10236 && XINT (Vhourglass_delay
) > 0)
10237 secs
= XFASTINT (Vhourglass_delay
);
10238 else if (FLOATP (Vhourglass_delay
)
10239 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10242 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10243 secs
= XFASTINT (tem
);
10244 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10247 secs
= DEFAULT_HOURGLASS_DELAY
;
10249 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10250 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10251 show_hourglass
, NULL
);
10255 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10259 cancel_hourglass ()
10261 if (hourglass_atimer
)
10263 cancel_atimer (hourglass_atimer
);
10264 hourglass_atimer
= NULL
;
10267 if (hourglass_shown_p
)
10272 /* Timer function of hourglass_atimer. TIMER is equal to
10275 Display an hourglass pointer on all frames by mapping the frames'
10276 hourglass_window. Set the hourglass_p flag in the frames'
10277 output_data.x structure to indicate that an hourglass cursor is
10278 shown on the frames. */
10281 show_hourglass (timer
)
10282 struct atimer
*timer
;
10284 /* The timer implementation will cancel this timer automatically
10285 after this function has run. Set hourglass_atimer to null
10286 so that we know the timer doesn't have to be canceled. */
10287 hourglass_atimer
= NULL
;
10289 if (!hourglass_shown_p
)
10291 Lisp_Object rest
, frame
;
10295 FOR_EACH_FRAME (rest
, frame
)
10297 struct frame
*f
= XFRAME (frame
);
10299 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10301 Display
*dpy
= FRAME_X_DISPLAY (f
);
10303 #ifdef USE_X_TOOLKIT
10304 if (f
->output_data
.x
->widget
)
10306 if (FRAME_OUTER_WINDOW (f
))
10309 f
->output_data
.x
->hourglass_p
= 1;
10311 if (!f
->output_data
.x
->hourglass_window
)
10313 unsigned long mask
= CWCursor
;
10314 XSetWindowAttributes attrs
;
10316 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10318 f
->output_data
.x
->hourglass_window
10319 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10320 0, 0, 32000, 32000, 0, 0,
10326 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10332 hourglass_shown_p
= 1;
10338 /* Hide the hourglass pointer on all frames, if it is currently
10344 if (hourglass_shown_p
)
10346 Lisp_Object rest
, frame
;
10349 FOR_EACH_FRAME (rest
, frame
)
10351 struct frame
*f
= XFRAME (frame
);
10354 /* Watch out for newly created frames. */
10355 && f
->output_data
.x
->hourglass_window
)
10357 XUnmapWindow (FRAME_X_DISPLAY (f
),
10358 f
->output_data
.x
->hourglass_window
);
10359 /* Sync here because XTread_socket looks at the
10360 hourglass_p flag that is reset to zero below. */
10361 XSync (FRAME_X_DISPLAY (f
), False
);
10362 f
->output_data
.x
->hourglass_p
= 0;
10366 hourglass_shown_p
= 0;
10373 /***********************************************************************
10375 ***********************************************************************/
10377 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10379 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10380 Lisp_Object
, int *, int *));
10382 /* The frame of a currently visible tooltip. */
10384 Lisp_Object tip_frame
;
10386 /* If non-nil, a timer started that hides the last tooltip when it
10389 Lisp_Object tip_timer
;
10392 /* If non-nil, a vector of 3 elements containing the last args
10393 with which x-show-tip was called. See there. */
10395 Lisp_Object last_show_tip_args
;
10399 unwind_create_tip_frame (frame
)
10402 Lisp_Object deleted
;
10404 deleted
= unwind_create_frame (frame
);
10405 if (EQ (deleted
, Qt
))
10415 /* Create a frame for a tooltip on the display described by DPYINFO.
10416 PARMS is a list of frame parameters. Value is the frame.
10418 Note that functions called here, esp. x_default_parameter can
10419 signal errors, for instance when a specified color name is
10420 undefined. We have to make sure that we're in a consistent state
10421 when this happens. */
10424 x_create_tip_frame (dpyinfo
, parms
)
10425 struct x_display_info
*dpyinfo
;
10429 Lisp_Object frame
, tem
;
10431 long window_prompting
= 0;
10433 int count
= BINDING_STACK_SIZE ();
10434 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10436 int face_change_count_before
= face_change_count
;
10440 /* Use this general default value to start with until we know if
10441 this frame has a specified name. */
10442 Vx_resource_name
= Vinvocation_name
;
10444 #ifdef MULTI_KBOARD
10445 kb
= dpyinfo
->kboard
;
10447 kb
= &the_only_kboard
;
10450 /* Get the name of the frame to use for resource lookup. */
10451 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10452 if (!STRINGP (name
)
10453 && !EQ (name
, Qunbound
)
10455 error ("Invalid frame name--not a string or nil");
10456 Vx_resource_name
= name
;
10459 GCPRO3 (parms
, name
, frame
);
10460 f
= make_frame (1);
10461 XSETFRAME (frame
, f
);
10462 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10463 record_unwind_protect (unwind_create_tip_frame
, frame
);
10465 /* By setting the output method, we're essentially saying that
10466 the frame is live, as per FRAME_LIVE_P. If we get a signal
10467 from this point on, x_destroy_window might screw up reference
10469 f
->output_method
= output_x_window
;
10470 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10471 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10472 f
->output_data
.x
->icon_bitmap
= -1;
10473 f
->output_data
.x
->fontset
= -1;
10474 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10475 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10476 f
->icon_name
= Qnil
;
10477 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10479 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10480 dpyinfo_refcount
= dpyinfo
->reference_count
;
10481 #endif /* GLYPH_DEBUG */
10482 #ifdef MULTI_KBOARD
10483 FRAME_KBOARD (f
) = kb
;
10485 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10486 f
->output_data
.x
->explicit_parent
= 0;
10488 /* These colors will be set anyway later, but it's important
10489 to get the color reference counts right, so initialize them! */
10492 struct gcpro gcpro1
;
10494 black
= build_string ("black");
10496 f
->output_data
.x
->foreground_pixel
10497 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10498 f
->output_data
.x
->background_pixel
10499 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10500 f
->output_data
.x
->cursor_pixel
10501 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10502 f
->output_data
.x
->cursor_foreground_pixel
10503 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10504 f
->output_data
.x
->border_pixel
10505 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10506 f
->output_data
.x
->mouse_pixel
10507 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10511 /* Set the name; the functions to which we pass f expect the name to
10513 if (EQ (name
, Qunbound
) || NILP (name
))
10515 f
->name
= build_string (dpyinfo
->x_id_name
);
10516 f
->explicit_name
= 0;
10521 f
->explicit_name
= 1;
10522 /* use the frame's title when getting resources for this frame. */
10523 specbind (Qx_resource_name
, name
);
10526 /* Extract the window parameters from the supplied values that are
10527 needed to determine window geometry. */
10531 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10534 /* First, try whatever font the caller has specified. */
10535 if (STRINGP (font
))
10537 tem
= Fquery_fontset (font
, Qnil
);
10539 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10541 font
= x_new_font (f
, XSTRING (font
)->data
);
10544 /* Try out a font which we hope has bold and italic variations. */
10545 if (!STRINGP (font
))
10546 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10547 if (!STRINGP (font
))
10548 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10549 if (! STRINGP (font
))
10550 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10551 if (! STRINGP (font
))
10552 /* This was formerly the first thing tried, but it finds too many fonts
10553 and takes too long. */
10554 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10555 /* If those didn't work, look for something which will at least work. */
10556 if (! STRINGP (font
))
10557 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10559 if (! STRINGP (font
))
10560 font
= build_string ("fixed");
10562 x_default_parameter (f
, parms
, Qfont
, font
,
10563 "font", "Font", RES_TYPE_STRING
);
10566 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10567 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10569 /* This defaults to 2 in order to match xterm. We recognize either
10570 internalBorderWidth or internalBorder (which is what xterm calls
10572 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10576 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10577 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10578 if (! EQ (value
, Qunbound
))
10579 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10583 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10584 "internalBorderWidth", "internalBorderWidth",
10587 /* Also do the stuff which must be set before the window exists. */
10588 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10589 "foreground", "Foreground", RES_TYPE_STRING
);
10590 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10591 "background", "Background", RES_TYPE_STRING
);
10592 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10593 "pointerColor", "Foreground", RES_TYPE_STRING
);
10594 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10595 "cursorColor", "Foreground", RES_TYPE_STRING
);
10596 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10597 "borderColor", "BorderColor", RES_TYPE_STRING
);
10599 /* Init faces before x_default_parameter is called for scroll-bar
10600 parameters because that function calls x_set_scroll_bar_width,
10601 which calls change_frame_size, which calls Fset_window_buffer,
10602 which runs hooks, which call Fvertical_motion. At the end, we
10603 end up in init_iterator with a null face cache, which should not
10605 init_frame_faces (f
);
10607 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10608 window_prompting
= x_figure_window_size (f
, parms
);
10610 if (window_prompting
& XNegative
)
10612 if (window_prompting
& YNegative
)
10613 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10615 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10619 if (window_prompting
& YNegative
)
10620 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10622 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10625 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10627 XSetWindowAttributes attrs
;
10628 unsigned long mask
;
10631 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10632 if (DoesSaveUnders (dpyinfo
->screen
))
10633 mask
|= CWSaveUnder
;
10635 /* Window managers look at the override-redirect flag to determine
10636 whether or net to give windows a decoration (Xlib spec, chapter
10638 attrs
.override_redirect
= True
;
10639 attrs
.save_under
= True
;
10640 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10641 /* Arrange for getting MapNotify and UnmapNotify events. */
10642 attrs
.event_mask
= StructureNotifyMask
;
10644 = FRAME_X_WINDOW (f
)
10645 = XCreateWindow (FRAME_X_DISPLAY (f
),
10646 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10647 /* x, y, width, height */
10651 CopyFromParent
, InputOutput
, CopyFromParent
,
10658 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10659 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10660 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10661 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10662 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10663 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10665 /* Dimensions, especially f->height, must be done via change_frame_size.
10666 Change will not be effected unless different from the current
10669 height
= f
->height
;
10671 SET_FRAME_WIDTH (f
, 0);
10672 change_frame_size (f
, height
, width
, 1, 0, 0);
10674 /* Set up faces after all frame parameters are known. This call
10675 also merges in face attributes specified for new frames.
10677 Frame parameters may be changed if .Xdefaults contains
10678 specifications for the default font. For example, if there is an
10679 `Emacs.default.attributeBackground: pink', the `background-color'
10680 attribute of the frame get's set, which let's the internal border
10681 of the tooltip frame appear in pink. Prevent this. */
10683 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
10685 /* Set tip_frame here, so that */
10687 call1 (Qface_set_after_frame_default
, frame
);
10689 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
10690 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
10698 /* It is now ok to make the frame official even if we get an error
10699 below. And the frame needs to be on Vframe_list or making it
10700 visible won't work. */
10701 Vframe_list
= Fcons (frame
, Vframe_list
);
10703 /* Now that the frame is official, it counts as a reference to
10705 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10707 /* Setting attributes of faces of the tooltip frame from resources
10708 and similar will increment face_change_count, which leads to the
10709 clearing of all current matrices. Since this isn't necessary
10710 here, avoid it by resetting face_change_count to the value it
10711 had before we created the tip frame. */
10712 face_change_count
= face_change_count_before
;
10714 /* Discard the unwind_protect. */
10715 return unbind_to (count
, frame
);
10719 /* Compute where to display tip frame F. PARMS is the list of frame
10720 parameters for F. DX and DY are specified offsets from the current
10721 location of the mouse. Return coordinates relative to the root
10722 window of the display in *ROOT_X, and *ROOT_Y. */
10725 compute_tip_xy (f
, parms
, dx
, dy
, root_x
, root_y
)
10727 Lisp_Object parms
, dx
, dy
;
10728 int *root_x
, *root_y
;
10730 Lisp_Object left
, top
;
10732 Window root
, child
;
10735 /* User-specified position? */
10736 left
= Fcdr (Fassq (Qleft
, parms
));
10737 top
= Fcdr (Fassq (Qtop
, parms
));
10739 /* Move the tooltip window where the mouse pointer is. Resize and
10742 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10743 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
10746 *root_x
+= XINT (dx
);
10747 *root_y
+= XINT (dy
);
10749 if (INTEGERP (left
))
10750 *root_x
= XINT (left
);
10751 if (INTEGERP (top
))
10752 *root_y
= XINT (top
);
10756 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10757 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10758 A tooltip window is a small X window displaying a string.\n\
10760 FRAME nil or omitted means use the selected frame.\n\
10762 PARMS is an optional list of frame parameters which can be\n\
10763 used to change the tooltip's appearance.\n\
10765 Automatically hide the tooltip after TIMEOUT seconds.\n\
10766 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10768 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10769 the tooltip is displayed at that x-position. Otherwise it is\n\
10770 displayed at the mouse position, with offset DX added (default is 5 if\n\
10771 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10772 parameter is specified, it determines the y-position of the tooltip\n\
10773 window, otherwise it is displayed at the mouse position, with offset\n\
10774 DY added (default is -10).")
10775 (string
, frame
, parms
, timeout
, dx
, dy
)
10776 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10780 Lisp_Object buffer
, top
, left
;
10781 int root_x
, root_y
;
10782 struct buffer
*old_buffer
;
10783 struct text_pos pos
;
10784 int i
, width
, height
;
10785 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10786 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10787 int count
= BINDING_STACK_SIZE ();
10789 specbind (Qinhibit_redisplay
, Qt
);
10791 GCPRO4 (string
, parms
, frame
, timeout
);
10793 CHECK_STRING (string
, 0);
10794 f
= check_x_frame (frame
);
10795 if (NILP (timeout
))
10796 timeout
= make_number (5);
10798 CHECK_NATNUM (timeout
, 2);
10801 dx
= make_number (5);
10803 CHECK_NUMBER (dx
, 5);
10806 dy
= make_number (-10);
10808 CHECK_NUMBER (dy
, 6);
10810 if (NILP (last_show_tip_args
))
10811 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
10813 if (!NILP (tip_frame
))
10815 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
10816 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
10817 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
10819 if (EQ (frame
, last_frame
)
10820 && !NILP (Fequal (last_string
, string
))
10821 && !NILP (Fequal (last_parms
, parms
)))
10823 struct frame
*f
= XFRAME (tip_frame
);
10825 /* Only DX and DY have changed. */
10826 if (!NILP (tip_timer
))
10828 Lisp_Object timer
= tip_timer
;
10830 call1 (Qcancel_timer
, timer
);
10834 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
10835 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10836 root_x
, root_y
- PIXEL_HEIGHT (f
));
10842 /* Hide a previous tip, if any. */
10845 ASET (last_show_tip_args
, 0, string
);
10846 ASET (last_show_tip_args
, 1, frame
);
10847 ASET (last_show_tip_args
, 2, parms
);
10849 /* Add default values to frame parameters. */
10850 if (NILP (Fassq (Qname
, parms
)))
10851 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10852 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10853 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10854 if (NILP (Fassq (Qborder_width
, parms
)))
10855 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10856 if (NILP (Fassq (Qborder_color
, parms
)))
10857 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10858 if (NILP (Fassq (Qbackground_color
, parms
)))
10859 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10862 /* Create a frame for the tooltip, and record it in the global
10863 variable tip_frame. */
10864 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
10865 f
= XFRAME (frame
);
10867 /* Set up the frame's root window. Currently we use a size of 80
10868 columns x 40 lines. If someone wants to show a larger tip, he
10869 will loose. I don't think this is a realistic case. */
10870 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10871 w
->left
= w
->top
= make_number (0);
10872 w
->width
= make_number (80);
10873 w
->height
= make_number (40);
10875 w
->pseudo_window_p
= 1;
10877 /* Display the tooltip text in a temporary buffer. */
10878 buffer
= Fget_buffer_create (build_string (" *tip*"));
10879 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10880 old_buffer
= current_buffer
;
10881 set_buffer_internal_1 (XBUFFER (buffer
));
10883 Finsert (1, &string
);
10884 clear_glyph_matrix (w
->desired_matrix
);
10885 clear_glyph_matrix (w
->current_matrix
);
10886 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10887 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10889 /* Compute width and height of the tooltip. */
10890 width
= height
= 0;
10891 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10893 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10894 struct glyph
*last
;
10897 /* Stop at the first empty row at the end. */
10898 if (!row
->enabled_p
|| !row
->displays_text_p
)
10901 /* Let the row go over the full width of the frame. */
10902 row
->full_width_p
= 1;
10904 /* There's a glyph at the end of rows that is used to place
10905 the cursor there. Don't include the width of this glyph. */
10906 if (row
->used
[TEXT_AREA
])
10908 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10909 row_width
= row
->pixel_width
- last
->pixel_width
;
10912 row_width
= row
->pixel_width
;
10914 height
+= row
->height
;
10915 width
= max (width
, row_width
);
10918 /* Add the frame's internal border to the width and height the X
10919 window should have. */
10920 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10921 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10923 /* Move the tooltip window where the mouse pointer is. Resize and
10925 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
10928 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10929 root_x
, root_y
- height
, width
, height
);
10930 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10933 /* Draw into the window. */
10934 w
->must_be_updated_p
= 1;
10935 update_single_window (w
, 1);
10937 /* Restore original current buffer. */
10938 set_buffer_internal_1 (old_buffer
);
10939 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
10942 /* Let the tip disappear after timeout seconds. */
10943 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
10944 intern ("x-hide-tip"));
10947 return unbind_to (count
, Qnil
);
10951 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
10952 "Hide the current tooltip window, if there is any.\n\
10953 Value is t is tooltip was open, nil otherwise.")
10957 Lisp_Object deleted
, frame
, timer
;
10958 struct gcpro gcpro1
, gcpro2
;
10960 /* Return quickly if nothing to do. */
10961 if (NILP (tip_timer
) && NILP (tip_frame
))
10966 GCPRO2 (frame
, timer
);
10967 tip_frame
= tip_timer
= deleted
= Qnil
;
10969 count
= BINDING_STACK_SIZE ();
10970 specbind (Qinhibit_redisplay
, Qt
);
10971 specbind (Qinhibit_quit
, Qt
);
10974 call1 (Qcancel_timer
, timer
);
10976 if (FRAMEP (frame
))
10978 Fdelete_frame (frame
, Qnil
);
10982 /* Bloodcurdling hack alert: The Lucid menu bar widget's
10983 redisplay procedure is not called when a tip frame over menu
10984 items is unmapped. Redisplay the menu manually... */
10986 struct frame
*f
= SELECTED_FRAME ();
10987 Widget w
= f
->output_data
.x
->menubar_widget
;
10988 extern void xlwmenu_redisplay
P_ ((Widget
));
10990 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
10994 xlwmenu_redisplay (w
);
10998 #endif /* USE_LUCID */
11002 return unbind_to (count
, deleted
);
11007 /***********************************************************************
11008 File selection dialog
11009 ***********************************************************************/
11013 /* Callback for "OK" and "Cancel" on file selection dialog. */
11016 file_dialog_cb (widget
, client_data
, call_data
)
11018 XtPointer call_data
, client_data
;
11020 int *result
= (int *) client_data
;
11021 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11022 *result
= cb
->reason
;
11026 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11027 "Read file name, prompting with PROMPT in directory DIR.\n\
11028 Use a file selection dialog.\n\
11029 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
11030 specified. Don't let the user enter a file name in the file\n\
11031 selection dialog's entry field, if MUSTMATCH is non-nil.")
11032 (prompt
, dir
, default_filename
, mustmatch
)
11033 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11036 struct frame
*f
= SELECTED_FRAME ();
11037 Lisp_Object file
= Qnil
;
11038 Widget dialog
, text
, list
, help
;
11041 extern XtAppContext Xt_app_con
;
11043 XmString dir_xmstring
, pattern_xmstring
;
11044 int popup_activated_flag
;
11045 int count
= specpdl_ptr
- specpdl
;
11046 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11048 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11049 CHECK_STRING (prompt
, 0);
11050 CHECK_STRING (dir
, 1);
11052 /* Prevent redisplay. */
11053 specbind (Qinhibit_redisplay
, Qt
);
11057 /* Create the dialog with PROMPT as title, using DIR as initial
11058 directory and using "*" as pattern. */
11059 dir
= Fexpand_file_name (dir
, Qnil
);
11060 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11061 pattern_xmstring
= XmStringCreateLocalized ("*");
11063 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11064 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11065 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11066 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11067 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11068 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11070 XmStringFree (dir_xmstring
);
11071 XmStringFree (pattern_xmstring
);
11073 /* Add callbacks for OK and Cancel. */
11074 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11075 (XtPointer
) &result
);
11076 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11077 (XtPointer
) &result
);
11079 /* Disable the help button since we can't display help. */
11080 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11081 XtSetSensitive (help
, False
);
11083 /* Mark OK button as default. */
11084 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11085 XmNshowAsDefault
, True
, NULL
);
11087 /* If MUSTMATCH is non-nil, disable the file entry field of the
11088 dialog, so that the user must select a file from the files list
11089 box. We can't remove it because we wouldn't have a way to get at
11090 the result file name, then. */
11091 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11092 if (!NILP (mustmatch
))
11095 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11096 XtSetSensitive (text
, False
);
11097 XtSetSensitive (label
, False
);
11100 /* Manage the dialog, so that list boxes get filled. */
11101 XtManageChild (dialog
);
11103 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11104 must include the path for this to work. */
11105 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11106 if (STRINGP (default_filename
))
11108 XmString default_xmstring
;
11112 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11114 if (!XmListItemExists (list
, default_xmstring
))
11116 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11117 XmListAddItem (list
, default_xmstring
, 0);
11121 item_pos
= XmListItemPos (list
, default_xmstring
);
11122 XmStringFree (default_xmstring
);
11124 /* Select the item and scroll it into view. */
11125 XmListSelectPos (list
, item_pos
, True
);
11126 XmListSetPos (list
, item_pos
);
11129 /* Process events until the user presses Cancel or OK. */
11131 while (result
== 0 || XtAppPending (Xt_app_con
))
11132 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11134 /* Get the result. */
11135 if (result
== XmCR_OK
)
11140 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11141 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11142 XmStringFree (text
);
11143 file
= build_string (data
);
11150 XtUnmanageChild (dialog
);
11151 XtDestroyWidget (dialog
);
11155 /* Make "Cancel" equivalent to C-g. */
11157 Fsignal (Qquit
, Qnil
);
11159 return unbind_to (count
, file
);
11162 #endif /* USE_MOTIF */
11166 /***********************************************************************
11168 ***********************************************************************/
11170 #ifdef HAVE_XKBGETKEYBOARD
11171 #include <X11/XKBlib.h>
11172 #include <X11/keysym.h>
11175 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11176 Sx_backspace_delete_keys_p
, 0, 1, 0,
11177 "Check if both Backspace and Delete keys are on the keyboard of FRAME.\n\
11178 FRAME nil means use the selected frame.\n\
11179 Value is t if we know that both keys are present, and are mapped to the\n\
11184 #ifdef HAVE_XKBGETKEYBOARD
11186 struct frame
*f
= check_x_frame (frame
);
11187 Display
*dpy
= FRAME_X_DISPLAY (f
);
11188 Lisp_Object have_keys
;
11189 int major
, minor
, op
, event
, error
;
11193 /* Check library version in case we're dynamically linked. */
11194 major
= XkbMajorVersion
;
11195 minor
= XkbMinorVersion
;
11196 if (!XkbLibraryVersion (&major
, &minor
))
11202 /* Check that the server supports XKB. */
11203 major
= XkbMajorVersion
;
11204 minor
= XkbMinorVersion
;
11205 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11212 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11215 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11217 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11219 for (i
= kb
->min_key_code
;
11220 (i
< kb
->max_key_code
11221 && (delete_keycode
== 0 || backspace_keycode
== 0));
11224 /* The XKB symbolic key names can be seen most easily
11225 in the PS file generated by `xkbprint -label name $DISPLAY'. */
11226 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11227 delete_keycode
= i
;
11228 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11229 backspace_keycode
= i
;
11232 XkbFreeNames (kb
, 0, True
);
11235 XkbFreeClientMap (kb
, 0, True
);
11238 && backspace_keycode
11239 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11240 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11245 #else /* not HAVE_XKBGETKEYBOARD */
11247 #endif /* not HAVE_XKBGETKEYBOARD */
11252 /***********************************************************************
11254 ***********************************************************************/
11259 /* This is zero if not using X windows. */
11262 /* The section below is built by the lisp expression at the top of the file,
11263 just above where these variables are declared. */
11264 /*&&& init symbols here &&&*/
11265 Qauto_raise
= intern ("auto-raise");
11266 staticpro (&Qauto_raise
);
11267 Qauto_lower
= intern ("auto-lower");
11268 staticpro (&Qauto_lower
);
11269 Qbar
= intern ("bar");
11271 Qborder_color
= intern ("border-color");
11272 staticpro (&Qborder_color
);
11273 Qborder_width
= intern ("border-width");
11274 staticpro (&Qborder_width
);
11275 Qbox
= intern ("box");
11277 Qcursor_color
= intern ("cursor-color");
11278 staticpro (&Qcursor_color
);
11279 Qcursor_type
= intern ("cursor-type");
11280 staticpro (&Qcursor_type
);
11281 Qgeometry
= intern ("geometry");
11282 staticpro (&Qgeometry
);
11283 Qicon_left
= intern ("icon-left");
11284 staticpro (&Qicon_left
);
11285 Qicon_top
= intern ("icon-top");
11286 staticpro (&Qicon_top
);
11287 Qicon_type
= intern ("icon-type");
11288 staticpro (&Qicon_type
);
11289 Qicon_name
= intern ("icon-name");
11290 staticpro (&Qicon_name
);
11291 Qinternal_border_width
= intern ("internal-border-width");
11292 staticpro (&Qinternal_border_width
);
11293 Qleft
= intern ("left");
11294 staticpro (&Qleft
);
11295 Qright
= intern ("right");
11296 staticpro (&Qright
);
11297 Qmouse_color
= intern ("mouse-color");
11298 staticpro (&Qmouse_color
);
11299 Qnone
= intern ("none");
11300 staticpro (&Qnone
);
11301 Qparent_id
= intern ("parent-id");
11302 staticpro (&Qparent_id
);
11303 Qscroll_bar_width
= intern ("scroll-bar-width");
11304 staticpro (&Qscroll_bar_width
);
11305 Qsuppress_icon
= intern ("suppress-icon");
11306 staticpro (&Qsuppress_icon
);
11307 Qundefined_color
= intern ("undefined-color");
11308 staticpro (&Qundefined_color
);
11309 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11310 staticpro (&Qvertical_scroll_bars
);
11311 Qvisibility
= intern ("visibility");
11312 staticpro (&Qvisibility
);
11313 Qwindow_id
= intern ("window-id");
11314 staticpro (&Qwindow_id
);
11315 Qouter_window_id
= intern ("outer-window-id");
11316 staticpro (&Qouter_window_id
);
11317 Qx_frame_parameter
= intern ("x-frame-parameter");
11318 staticpro (&Qx_frame_parameter
);
11319 Qx_resource_name
= intern ("x-resource-name");
11320 staticpro (&Qx_resource_name
);
11321 Quser_position
= intern ("user-position");
11322 staticpro (&Quser_position
);
11323 Quser_size
= intern ("user-size");
11324 staticpro (&Quser_size
);
11325 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11326 staticpro (&Qscroll_bar_foreground
);
11327 Qscroll_bar_background
= intern ("scroll-bar-background");
11328 staticpro (&Qscroll_bar_background
);
11329 Qscreen_gamma
= intern ("screen-gamma");
11330 staticpro (&Qscreen_gamma
);
11331 Qline_spacing
= intern ("line-spacing");
11332 staticpro (&Qline_spacing
);
11333 Qcenter
= intern ("center");
11334 staticpro (&Qcenter
);
11335 Qcompound_text
= intern ("compound-text");
11336 staticpro (&Qcompound_text
);
11337 Qcancel_timer
= intern ("cancel-timer");
11338 staticpro (&Qcancel_timer
);
11339 /* This is the end of symbol initialization. */
11341 /* Text property `display' should be nonsticky by default. */
11342 Vtext_property_default_nonsticky
11343 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11346 Qlaplace
= intern ("laplace");
11347 staticpro (&Qlaplace
);
11348 Qemboss
= intern ("emboss");
11349 staticpro (&Qemboss
);
11350 Qedge_detection
= intern ("edge-detection");
11351 staticpro (&Qedge_detection
);
11352 Qheuristic
= intern ("heuristic");
11353 staticpro (&Qheuristic
);
11354 QCmatrix
= intern (":matrix");
11355 staticpro (&QCmatrix
);
11356 QCcolor_adjustment
= intern (":color-adjustment");
11357 staticpro (&QCcolor_adjustment
);
11358 QCmask
= intern (":mask");
11359 staticpro (&QCmask
);
11361 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11362 staticpro (&Qface_set_after_frame_default
);
11364 Fput (Qundefined_color
, Qerror_conditions
,
11365 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11366 Fput (Qundefined_color
, Qerror_message
,
11367 build_string ("Undefined color"));
11369 init_x_parm_symbols ();
11371 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11372 "Non-nil means always draw a cross over disabled images.\n\
11373 Disabled images are those having an `:conversion disabled' property.\n\
11374 A cross is always drawn on black & white displays.");
11375 cross_disabled_images
= 0;
11377 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11378 "List of directories to search for bitmap files for X.");
11379 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11381 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11382 "The shape of the pointer when over text.\n\
11383 Changing the value does not affect existing frames\n\
11384 unless you set the mouse color.");
11385 Vx_pointer_shape
= Qnil
;
11387 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11388 "The name Emacs uses to look up X resources.\n\
11389 `x-get-resource' uses this as the first component of the instance name\n\
11390 when requesting resource values.\n\
11391 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
11392 was invoked, or to the value specified with the `-name' or `-rn'\n\
11393 switches, if present.\n\
11395 It may be useful to bind this variable locally around a call\n\
11396 to `x-get-resource'. See also the variable `x-resource-class'.");
11397 Vx_resource_name
= Qnil
;
11399 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11400 "The class Emacs uses to look up X resources.\n\
11401 `x-get-resource' uses this as the first component of the instance class\n\
11402 when requesting resource values.\n\
11403 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
11405 Setting this variable permanently is not a reasonable thing to do,\n\
11406 but binding this variable locally around a call to `x-get-resource'\n\
11407 is a reasonable practice. See also the variable `x-resource-name'.");
11408 Vx_resource_class
= build_string (EMACS_CLASS
);
11410 #if 0 /* This doesn't really do anything. */
11411 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11412 "The shape of the pointer when not over text.\n\
11413 This variable takes effect when you create a new frame\n\
11414 or when you set the mouse color.");
11416 Vx_nontext_pointer_shape
= Qnil
;
11418 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
11419 "The shape of the pointer when Emacs is busy.\n\
11420 This variable takes effect when you create a new frame\n\
11421 or when you set the mouse color.");
11422 Vx_hourglass_pointer_shape
= Qnil
;
11424 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
11425 "Non-zero means Emacs displays an hourglass pointer on window systems.");
11426 display_hourglass_p
= 1;
11428 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
11429 "*Seconds to wait before displaying an hourglass pointer.\n\
11430 Value must be an integer or float.");
11431 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
11433 #if 0 /* This doesn't really do anything. */
11434 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11435 "The shape of the pointer when over the mode line.\n\
11436 This variable takes effect when you create a new frame\n\
11437 or when you set the mouse color.");
11439 Vx_mode_pointer_shape
= Qnil
;
11441 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11442 &Vx_sensitive_text_pointer_shape
,
11443 "The shape of the pointer when over mouse-sensitive text.\n\
11444 This variable takes effect when you create a new frame\n\
11445 or when you set the mouse color.");
11446 Vx_sensitive_text_pointer_shape
= Qnil
;
11448 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11449 &Vx_window_horizontal_drag_shape
,
11450 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
11451 This variable takes effect when you create a new frame\n\
11452 or when you set the mouse color.");
11453 Vx_window_horizontal_drag_shape
= Qnil
;
11455 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11456 "A string indicating the foreground color of the cursor box.");
11457 Vx_cursor_fore_pixel
= Qnil
;
11459 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11460 "Non-nil if no X window manager is in use.\n\
11461 Emacs doesn't try to figure this out; this is always nil\n\
11462 unless you set it to something else.");
11463 /* We don't have any way to find this out, so set it to nil
11464 and maybe the user would like to set it to t. */
11465 Vx_no_window_manager
= Qnil
;
11467 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11468 &Vx_pixel_size_width_font_regexp
,
11469 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11471 Since Emacs gets width of a font matching with this regexp from\n\
11472 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11473 such a font. This is especially effective for such large fonts as\n\
11474 Chinese, Japanese, and Korean.");
11475 Vx_pixel_size_width_font_regexp
= Qnil
;
11477 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11478 "Time after which cached images are removed from the cache.\n\
11479 When an image has not been displayed this many seconds, remove it\n\
11480 from the image cache. Value must be an integer or nil with nil\n\
11481 meaning don't clear the cache.");
11482 Vimage_cache_eviction_delay
= make_number (30 * 60);
11484 #ifdef USE_X_TOOLKIT
11485 Fprovide (intern ("x-toolkit"));
11488 Fprovide (intern ("motif"));
11491 defsubr (&Sx_get_resource
);
11493 /* X window properties. */
11494 defsubr (&Sx_change_window_property
);
11495 defsubr (&Sx_delete_window_property
);
11496 defsubr (&Sx_window_property
);
11498 defsubr (&Sxw_display_color_p
);
11499 defsubr (&Sx_display_grayscale_p
);
11500 defsubr (&Sxw_color_defined_p
);
11501 defsubr (&Sxw_color_values
);
11502 defsubr (&Sx_server_max_request_size
);
11503 defsubr (&Sx_server_vendor
);
11504 defsubr (&Sx_server_version
);
11505 defsubr (&Sx_display_pixel_width
);
11506 defsubr (&Sx_display_pixel_height
);
11507 defsubr (&Sx_display_mm_width
);
11508 defsubr (&Sx_display_mm_height
);
11509 defsubr (&Sx_display_screens
);
11510 defsubr (&Sx_display_planes
);
11511 defsubr (&Sx_display_color_cells
);
11512 defsubr (&Sx_display_visual_class
);
11513 defsubr (&Sx_display_backing_store
);
11514 defsubr (&Sx_display_save_under
);
11515 defsubr (&Sx_parse_geometry
);
11516 defsubr (&Sx_create_frame
);
11517 defsubr (&Sx_open_connection
);
11518 defsubr (&Sx_close_connection
);
11519 defsubr (&Sx_display_list
);
11520 defsubr (&Sx_synchronize
);
11521 defsubr (&Sx_focus_frame
);
11522 defsubr (&Sx_backspace_delete_keys_p
);
11524 /* Setting callback functions for fontset handler. */
11525 get_font_info_func
= x_get_font_info
;
11527 #if 0 /* This function pointer doesn't seem to be used anywhere.
11528 And the pointer assigned has the wrong type, anyway. */
11529 list_fonts_func
= x_list_fonts
;
11532 load_font_func
= x_load_font
;
11533 find_ccl_program_func
= x_find_ccl_program
;
11534 query_font_func
= x_query_font
;
11535 set_frame_fontset_func
= x_set_font
;
11536 check_window_system_func
= check_x
;
11539 Qxbm
= intern ("xbm");
11541 QCtype
= intern (":type");
11542 staticpro (&QCtype
);
11543 QCconversion
= intern (":conversion");
11544 staticpro (&QCconversion
);
11545 QCheuristic_mask
= intern (":heuristic-mask");
11546 staticpro (&QCheuristic_mask
);
11547 QCcolor_symbols
= intern (":color-symbols");
11548 staticpro (&QCcolor_symbols
);
11549 QCascent
= intern (":ascent");
11550 staticpro (&QCascent
);
11551 QCmargin
= intern (":margin");
11552 staticpro (&QCmargin
);
11553 QCrelief
= intern (":relief");
11554 staticpro (&QCrelief
);
11555 Qpostscript
= intern ("postscript");
11556 staticpro (&Qpostscript
);
11557 QCloader
= intern (":loader");
11558 staticpro (&QCloader
);
11559 QCbounding_box
= intern (":bounding-box");
11560 staticpro (&QCbounding_box
);
11561 QCpt_width
= intern (":pt-width");
11562 staticpro (&QCpt_width
);
11563 QCpt_height
= intern (":pt-height");
11564 staticpro (&QCpt_height
);
11565 QCindex
= intern (":index");
11566 staticpro (&QCindex
);
11567 Qpbm
= intern ("pbm");
11571 Qxpm
= intern ("xpm");
11576 Qjpeg
= intern ("jpeg");
11577 staticpro (&Qjpeg
);
11581 Qtiff
= intern ("tiff");
11582 staticpro (&Qtiff
);
11586 Qgif
= intern ("gif");
11591 Qpng
= intern ("png");
11595 defsubr (&Sclear_image_cache
);
11596 defsubr (&Simage_size
);
11597 defsubr (&Simage_mask_p
);
11599 hourglass_atimer
= NULL
;
11600 hourglass_shown_p
= 0;
11602 defsubr (&Sx_show_tip
);
11603 defsubr (&Sx_hide_tip
);
11605 staticpro (&tip_timer
);
11607 staticpro (&tip_frame
);
11609 last_show_tip_args
= Qnil
;
11610 staticpro (&last_show_tip_args
);
11613 defsubr (&Sx_file_dialog
);
11621 image_types
= NULL
;
11622 Vimage_types
= Qnil
;
11624 define_image_type (&xbm_type
);
11625 define_image_type (&gs_type
);
11626 define_image_type (&pbm_type
);
11629 define_image_type (&xpm_type
);
11633 define_image_type (&jpeg_type
);
11637 define_image_type (&tiff_type
);
11641 define_image_type (&gif_type
);
11645 define_image_type (&png_type
);
11649 #endif /* HAVE_X_WINDOWS */