1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999, 2000, 2001
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
27 /* This makes the fields of a Display accessible, in Xlib header files. */
29 #define XLIB_ILLEGAL_ACCESS
36 #include "intervals.h"
37 #include "dispextern.h"
39 #include "blockinput.h"
45 #include "termhooks.h"
51 #include <sys/types.h>
55 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
56 #include "bitmaps/gray.xbm"
58 #include <X11/bitmaps/gray>
61 #include "[.bitmaps]gray.xbm"
65 #include <X11/Shell.h>
68 #include <X11/Xaw/Paned.h>
69 #include <X11/Xaw/Label.h>
70 #endif /* USE_MOTIF */
73 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
82 #include "../lwlib/lwlib.h"
86 #include <Xm/DialogS.h>
87 #include <Xm/FileSB.h>
90 /* Do the EDITRES protocol if running X11R5
91 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
93 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
95 extern void _XEditResCheckMessages ();
96 #endif /* R5 + Athena */
98 /* Unique id counter for widgets created by the Lucid Widget Library. */
100 extern LWLIB_ID widget_id_tick
;
103 /* This is part of a kludge--see lwlib/xlwmenu.c. */
104 extern XFontStruct
*xlwmenu_default_font
;
107 extern void free_frame_menubar ();
108 extern double atof ();
110 #endif /* USE_X_TOOLKIT */
112 #define min(a,b) ((a) < (b) ? (a) : (b))
113 #define max(a,b) ((a) > (b) ? (a) : (b))
116 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
118 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
121 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
122 it, and including `bitmaps/gray' more than once is a problem when
123 config.h defines `static' as an empty replacement string. */
125 int gray_bitmap_width
= gray_width
;
126 int gray_bitmap_height
= gray_height
;
127 char *gray_bitmap_bits
= gray_bits
;
129 /* The name we're using in resource queries. Most often "emacs". */
131 Lisp_Object Vx_resource_name
;
133 /* The application class we're using in resource queries.
136 Lisp_Object Vx_resource_class
;
138 /* Non-zero means we're allowed to display a busy cursor. */
140 int display_busy_cursor_p
;
142 /* The background and shape of the mouse pointer, and shape when not
143 over text or in the modeline. */
145 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
146 Lisp_Object Vx_busy_pointer_shape
;
148 /* The shape when over mouse-sensitive text. */
150 Lisp_Object Vx_sensitive_text_pointer_shape
;
152 /* If non-nil, the pointer shape to indicate that windows can be
153 dragged horizontally. */
155 Lisp_Object Vx_window_horizontal_drag_shape
;
157 /* Color of chars displayed in cursor box. */
159 Lisp_Object Vx_cursor_fore_pixel
;
161 /* Nonzero if using X. */
165 /* Non nil if no window manager is in use. */
167 Lisp_Object Vx_no_window_manager
;
169 /* Search path for bitmap files. */
171 Lisp_Object Vx_bitmap_file_path
;
173 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
175 Lisp_Object Vx_pixel_size_width_font_regexp
;
177 Lisp_Object Qauto_raise
;
178 Lisp_Object Qauto_lower
;
180 Lisp_Object Qborder_color
;
181 Lisp_Object Qborder_width
;
183 Lisp_Object Qcursor_color
;
184 Lisp_Object Qcursor_type
;
185 Lisp_Object Qgeometry
;
186 Lisp_Object Qicon_left
;
187 Lisp_Object Qicon_top
;
188 Lisp_Object Qicon_type
;
189 Lisp_Object Qicon_name
;
190 Lisp_Object Qinternal_border_width
;
193 Lisp_Object Qmouse_color
;
195 Lisp_Object Qouter_window_id
;
196 Lisp_Object Qparent_id
;
197 Lisp_Object Qscroll_bar_width
;
198 Lisp_Object Qsuppress_icon
;
199 extern Lisp_Object Qtop
;
200 Lisp_Object Qundefined_color
;
201 Lisp_Object Qvertical_scroll_bars
;
202 Lisp_Object Qvisibility
;
203 Lisp_Object Qwindow_id
;
204 Lisp_Object Qx_frame_parameter
;
205 Lisp_Object Qx_resource_name
;
206 Lisp_Object Quser_position
;
207 Lisp_Object Quser_size
;
208 extern Lisp_Object Qdisplay
;
209 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
210 Lisp_Object Qscreen_gamma
, Qline_spacing
, Qcenter
;
211 Lisp_Object Qcompound_text
, Qcancel_timer
;
213 /* The below are defined in frame.c. */
215 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
216 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
217 extern Lisp_Object Qtool_bar_lines
;
219 extern Lisp_Object Vwindow_system_version
;
221 Lisp_Object Qface_set_after_frame_default
;
224 int image_cache_refcount
, dpyinfo_refcount
;
229 /* Error if we are not connected to X. */
235 error ("X windows are not in use or not initialized");
238 /* Nonzero if we can use mouse menus.
239 You should not call this unless HAVE_MENUS is defined. */
247 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
248 and checking validity for X. */
251 check_x_frame (frame
)
257 frame
= selected_frame
;
258 CHECK_LIVE_FRAME (frame
, 0);
261 error ("Non-X frame used");
265 /* Let the user specify an X display with a frame.
266 nil stands for the selected frame--or, if that is not an X frame,
267 the first X display on the list. */
269 static struct x_display_info
*
270 check_x_display_info (frame
)
273 struct x_display_info
*dpyinfo
= NULL
;
277 struct frame
*sf
= XFRAME (selected_frame
);
279 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
280 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
281 else if (x_display_list
!= 0)
282 dpyinfo
= x_display_list
;
284 error ("X windows are not in use or not initialized");
286 else if (STRINGP (frame
))
287 dpyinfo
= x_display_info_for_name (frame
);
292 CHECK_LIVE_FRAME (frame
, 0);
295 error ("Non-X frame used");
296 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
303 /* Return the Emacs frame-object corresponding to an X window.
304 It could be the frame's main window or an icon window. */
306 /* This function can be called during GC, so use GC_xxx type test macros. */
309 x_window_to_frame (dpyinfo
, wdesc
)
310 struct x_display_info
*dpyinfo
;
313 Lisp_Object tail
, frame
;
316 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
319 if (!GC_FRAMEP (frame
))
322 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
324 if (f
->output_data
.x
->busy_window
== wdesc
)
327 if ((f
->output_data
.x
->edit_widget
328 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
329 /* A tooltip frame? */
330 || (!f
->output_data
.x
->edit_widget
331 && FRAME_X_WINDOW (f
) == wdesc
)
332 || f
->output_data
.x
->icon_desc
== wdesc
)
334 #else /* not USE_X_TOOLKIT */
335 if (FRAME_X_WINDOW (f
) == wdesc
336 || f
->output_data
.x
->icon_desc
== wdesc
)
338 #endif /* not USE_X_TOOLKIT */
344 /* Like x_window_to_frame but also compares the window with the widget's
348 x_any_window_to_frame (dpyinfo
, wdesc
)
349 struct x_display_info
*dpyinfo
;
352 Lisp_Object tail
, frame
;
353 struct frame
*f
, *found
;
357 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
360 if (!GC_FRAMEP (frame
))
364 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
366 /* This frame matches if the window is any of its widgets. */
367 x
= f
->output_data
.x
;
368 if (x
->busy_window
== wdesc
)
372 if (wdesc
== XtWindow (x
->widget
)
373 || wdesc
== XtWindow (x
->column_widget
)
374 || wdesc
== XtWindow (x
->edit_widget
))
376 /* Match if the window is this frame's menubar. */
377 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
380 else if (FRAME_X_WINDOW (f
) == wdesc
)
381 /* A tooltip frame. */
389 /* Likewise, but exclude the menu bar widget. */
392 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
393 struct x_display_info
*dpyinfo
;
396 Lisp_Object tail
, frame
;
400 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
403 if (!GC_FRAMEP (frame
))
406 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
408 x
= f
->output_data
.x
;
409 /* This frame matches if the window is any of its widgets. */
410 if (x
->busy_window
== wdesc
)
414 if (wdesc
== XtWindow (x
->widget
)
415 || wdesc
== XtWindow (x
->column_widget
)
416 || wdesc
== XtWindow (x
->edit_widget
))
419 else if (FRAME_X_WINDOW (f
) == wdesc
)
420 /* A tooltip frame. */
426 /* Likewise, but consider only the menu bar widget. */
429 x_menubar_window_to_frame (dpyinfo
, wdesc
)
430 struct x_display_info
*dpyinfo
;
433 Lisp_Object tail
, frame
;
437 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
440 if (!GC_FRAMEP (frame
))
443 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
445 x
= f
->output_data
.x
;
446 /* Match if the window is this frame's menubar. */
447 if (x
->menubar_widget
448 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
454 /* Return the frame whose principal (outermost) window is WDESC.
455 If WDESC is some other (smaller) window, we return 0. */
458 x_top_window_to_frame (dpyinfo
, wdesc
)
459 struct x_display_info
*dpyinfo
;
462 Lisp_Object tail
, frame
;
466 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
469 if (!GC_FRAMEP (frame
))
472 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
474 x
= f
->output_data
.x
;
478 /* This frame matches if the window is its topmost widget. */
479 if (wdesc
== XtWindow (x
->widget
))
481 #if 0 /* I don't know why it did this,
482 but it seems logically wrong,
483 and it causes trouble for MapNotify events. */
484 /* Match if the window is this frame's menubar. */
485 if (x
->menubar_widget
486 && wdesc
== XtWindow (x
->menubar_widget
))
490 else if (FRAME_X_WINDOW (f
) == wdesc
)
496 #endif /* USE_X_TOOLKIT */
500 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
501 id, which is just an int that this section returns. Bitmaps are
502 reference counted so they can be shared among frames.
504 Bitmap indices are guaranteed to be > 0, so a negative number can
505 be used to indicate no bitmap.
507 If you use x_create_bitmap_from_data, then you must keep track of
508 the bitmaps yourself. That is, creating a bitmap from the same
509 data more than once will not be caught. */
512 /* Functions to access the contents of a bitmap, given an id. */
515 x_bitmap_height (f
, id
)
519 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
523 x_bitmap_width (f
, id
)
527 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
531 x_bitmap_pixmap (f
, id
)
535 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
539 /* Allocate a new bitmap record. Returns index of new record. */
542 x_allocate_bitmap_record (f
)
545 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
548 if (dpyinfo
->bitmaps
== NULL
)
550 dpyinfo
->bitmaps_size
= 10;
552 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
553 dpyinfo
->bitmaps_last
= 1;
557 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
558 return ++dpyinfo
->bitmaps_last
;
560 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
561 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
564 dpyinfo
->bitmaps_size
*= 2;
566 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
567 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
568 return ++dpyinfo
->bitmaps_last
;
571 /* Add one reference to the reference count of the bitmap with id ID. */
574 x_reference_bitmap (f
, id
)
578 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
581 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
584 x_create_bitmap_from_data (f
, bits
, width
, height
)
587 unsigned int width
, height
;
589 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
593 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
594 bits
, width
, height
);
599 id
= x_allocate_bitmap_record (f
);
600 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
601 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
602 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
603 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
604 dpyinfo
->bitmaps
[id
- 1].height
= height
;
605 dpyinfo
->bitmaps
[id
- 1].width
= width
;
610 /* Create bitmap from file FILE for frame F. */
613 x_create_bitmap_from_file (f
, file
)
617 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
618 unsigned int width
, height
;
620 int xhot
, yhot
, result
, id
;
625 /* Look for an existing bitmap with the same name. */
626 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
628 if (dpyinfo
->bitmaps
[id
].refcount
629 && dpyinfo
->bitmaps
[id
].file
630 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
632 ++dpyinfo
->bitmaps
[id
].refcount
;
637 /* Search bitmap-file-path for the file, if appropriate. */
638 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
643 filename
= (char *) XSTRING (found
)->data
;
645 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
646 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
647 if (result
!= BitmapSuccess
)
650 id
= x_allocate_bitmap_record (f
);
651 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
652 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
653 dpyinfo
->bitmaps
[id
- 1].file
654 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
655 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
656 dpyinfo
->bitmaps
[id
- 1].height
= height
;
657 dpyinfo
->bitmaps
[id
- 1].width
= width
;
658 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
663 /* Remove reference to bitmap with id number ID. */
666 x_destroy_bitmap (f
, id
)
670 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
674 --dpyinfo
->bitmaps
[id
- 1].refcount
;
675 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
678 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
679 if (dpyinfo
->bitmaps
[id
- 1].file
)
681 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
682 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
689 /* Free all the bitmaps for the display specified by DPYINFO. */
692 x_destroy_all_bitmaps (dpyinfo
)
693 struct x_display_info
*dpyinfo
;
696 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
697 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
699 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
700 if (dpyinfo
->bitmaps
[i
].file
)
701 xfree (dpyinfo
->bitmaps
[i
].file
);
703 dpyinfo
->bitmaps_last
= 0;
706 /* Connect the frame-parameter names for X frames
707 to the ways of passing the parameter values to the window system.
709 The name of a parameter, as a Lisp symbol,
710 has an `x-frame-parameter' property which is an integer in Lisp
711 that is an index in this table. */
713 struct x_frame_parm_table
716 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
719 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
720 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
721 static void x_change_window_heights
P_ ((Lisp_Object
, int));
722 static void x_disable_image
P_ ((struct frame
*, struct image
*));
723 static void x_create_im
P_ ((struct frame
*));
724 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
725 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
726 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
727 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
728 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
729 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
730 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
731 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
732 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
733 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
734 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
735 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
737 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
738 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
739 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
740 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
742 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
743 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
744 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
745 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
746 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
750 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
752 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
757 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
760 static void init_color_table
P_ ((void));
761 static void free_color_table
P_ ((void));
762 static unsigned long *colors_in_color_table
P_ ((int *n
));
763 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
764 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
768 static struct x_frame_parm_table x_frame_parms
[] =
770 "auto-raise", x_set_autoraise
,
771 "auto-lower", x_set_autolower
,
772 "background-color", x_set_background_color
,
773 "border-color", x_set_border_color
,
774 "border-width", x_set_border_width
,
775 "cursor-color", x_set_cursor_color
,
776 "cursor-type", x_set_cursor_type
,
778 "foreground-color", x_set_foreground_color
,
779 "icon-name", x_set_icon_name
,
780 "icon-type", x_set_icon_type
,
781 "internal-border-width", x_set_internal_border_width
,
782 "menu-bar-lines", x_set_menu_bar_lines
,
783 "mouse-color", x_set_mouse_color
,
784 "name", x_explicitly_set_name
,
785 "scroll-bar-width", x_set_scroll_bar_width
,
786 "title", x_set_title
,
787 "unsplittable", x_set_unsplittable
,
788 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
789 "visibility", x_set_visibility
,
790 "tool-bar-lines", x_set_tool_bar_lines
,
791 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
792 "scroll-bar-background", x_set_scroll_bar_background
,
793 "screen-gamma", x_set_screen_gamma
,
794 "line-spacing", x_set_line_spacing
797 /* Attach the `x-frame-parameter' properties to
798 the Lisp symbol names of parameters relevant to X. */
801 init_x_parm_symbols ()
805 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
806 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
810 /* Change the parameters of frame F as specified by ALIST.
811 If a parameter is not specially recognized, do nothing special;
812 otherwise call the `x_set_...' function for that parameter.
813 Except for certain geometry properties, always call store_frame_param
814 to store the new value in the parameter alist. */
817 x_set_frame_parameters (f
, alist
)
823 /* If both of these parameters are present, it's more efficient to
824 set them both at once. So we wait until we've looked at the
825 entire list before we set them. */
829 Lisp_Object left
, top
;
831 /* Same with these. */
832 Lisp_Object icon_left
, icon_top
;
834 /* Record in these vectors all the parms specified. */
838 int left_no_change
= 0, top_no_change
= 0;
839 int icon_left_no_change
= 0, icon_top_no_change
= 0;
841 struct gcpro gcpro1
, gcpro2
;
844 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
847 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
848 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
850 /* Extract parm names and values into those vectors. */
853 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
858 parms
[i
] = Fcar (elt
);
859 values
[i
] = Fcdr (elt
);
862 /* TAIL and ALIST are not used again below here. */
865 GCPRO2 (*parms
, *values
);
869 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
870 because their values appear in VALUES and strings are not valid. */
871 top
= left
= Qunbound
;
872 icon_left
= icon_top
= Qunbound
;
874 /* Provide default values for HEIGHT and WIDTH. */
875 if (FRAME_NEW_WIDTH (f
))
876 width
= FRAME_NEW_WIDTH (f
);
878 width
= FRAME_WIDTH (f
);
880 if (FRAME_NEW_HEIGHT (f
))
881 height
= FRAME_NEW_HEIGHT (f
);
883 height
= FRAME_HEIGHT (f
);
885 /* Process foreground_color and background_color before anything else.
886 They are independent of other properties, but other properties (e.g.,
887 cursor_color) are dependent upon them. */
888 for (p
= 0; p
< i
; p
++)
890 Lisp_Object prop
, val
;
894 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
896 register Lisp_Object param_index
, old_value
;
898 param_index
= Fget (prop
, Qx_frame_parameter
);
899 old_value
= get_frame_param (f
, prop
);
900 store_frame_param (f
, prop
, val
);
901 if (NATNUMP (param_index
)
902 && (XFASTINT (param_index
)
903 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
904 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
908 /* Now process them in reverse of specified order. */
909 for (i
--; i
>= 0; i
--)
911 Lisp_Object prop
, val
;
916 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
917 width
= XFASTINT (val
);
918 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
919 height
= XFASTINT (val
);
920 else if (EQ (prop
, Qtop
))
922 else if (EQ (prop
, Qleft
))
924 else if (EQ (prop
, Qicon_top
))
926 else if (EQ (prop
, Qicon_left
))
928 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
929 /* Processed above. */
933 register Lisp_Object param_index
, old_value
;
935 param_index
= Fget (prop
, Qx_frame_parameter
);
936 old_value
= get_frame_param (f
, prop
);
937 store_frame_param (f
, prop
, val
);
938 if (NATNUMP (param_index
)
939 && (XFASTINT (param_index
)
940 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
941 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
945 /* Don't die if just one of these was set. */
946 if (EQ (left
, Qunbound
))
949 if (f
->output_data
.x
->left_pos
< 0)
950 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
952 XSETINT (left
, f
->output_data
.x
->left_pos
);
954 if (EQ (top
, Qunbound
))
957 if (f
->output_data
.x
->top_pos
< 0)
958 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
960 XSETINT (top
, f
->output_data
.x
->top_pos
);
963 /* If one of the icon positions was not set, preserve or default it. */
964 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
966 icon_left_no_change
= 1;
967 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
968 if (NILP (icon_left
))
969 XSETINT (icon_left
, 0);
971 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
973 icon_top_no_change
= 1;
974 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
976 XSETINT (icon_top
, 0);
979 /* Don't set these parameters unless they've been explicitly
980 specified. The window might be mapped or resized while we're in
981 this function, and we don't want to override that unless the lisp
982 code has asked for it.
984 Don't set these parameters unless they actually differ from the
985 window's current parameters; the window may not actually exist
990 check_frame_size (f
, &height
, &width
);
992 XSETFRAME (frame
, f
);
994 if (width
!= FRAME_WIDTH (f
)
995 || height
!= FRAME_HEIGHT (f
)
996 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
997 Fset_frame_size (frame
, make_number (width
), make_number (height
));
999 if ((!NILP (left
) || !NILP (top
))
1000 && ! (left_no_change
&& top_no_change
)
1001 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1002 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1007 /* Record the signs. */
1008 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1009 if (EQ (left
, Qminus
))
1010 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1011 else if (INTEGERP (left
))
1013 leftpos
= XINT (left
);
1015 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1017 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1018 && CONSP (XCDR (left
))
1019 && INTEGERP (XCAR (XCDR (left
))))
1021 leftpos
= - XINT (XCAR (XCDR (left
)));
1022 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1024 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1025 && CONSP (XCDR (left
))
1026 && INTEGERP (XCAR (XCDR (left
))))
1028 leftpos
= XINT (XCAR (XCDR (left
)));
1031 if (EQ (top
, Qminus
))
1032 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1033 else if (INTEGERP (top
))
1035 toppos
= XINT (top
);
1037 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1039 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1040 && CONSP (XCDR (top
))
1041 && INTEGERP (XCAR (XCDR (top
))))
1043 toppos
= - XINT (XCAR (XCDR (top
)));
1044 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1046 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1047 && CONSP (XCDR (top
))
1048 && INTEGERP (XCAR (XCDR (top
))))
1050 toppos
= XINT (XCAR (XCDR (top
)));
1054 /* Store the numeric value of the position. */
1055 f
->output_data
.x
->top_pos
= toppos
;
1056 f
->output_data
.x
->left_pos
= leftpos
;
1058 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1060 /* Actually set that position, and convert to absolute. */
1061 x_set_offset (f
, leftpos
, toppos
, -1);
1064 if ((!NILP (icon_left
) || !NILP (icon_top
))
1065 && ! (icon_left_no_change
&& icon_top_no_change
))
1066 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1072 /* Store the screen positions of frame F into XPTR and YPTR.
1073 These are the positions of the containing window manager window,
1074 not Emacs's own window. */
1077 x_real_positions (f
, xptr
, yptr
)
1084 /* This is pretty gross, but seems to be the easiest way out of
1085 the problem that arises when restarting window-managers. */
1087 #ifdef USE_X_TOOLKIT
1088 Window outer
= (f
->output_data
.x
->widget
1089 ? XtWindow (f
->output_data
.x
->widget
)
1090 : FRAME_X_WINDOW (f
));
1092 Window outer
= f
->output_data
.x
->window_desc
;
1094 Window tmp_root_window
;
1095 Window
*tmp_children
;
1096 unsigned int tmp_nchildren
;
1100 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1101 Window outer_window
;
1103 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1104 &f
->output_data
.x
->parent_desc
,
1105 &tmp_children
, &tmp_nchildren
);
1106 XFree ((char *) tmp_children
);
1110 /* Find the position of the outside upper-left corner of
1111 the inner window, with respect to the outer window. */
1112 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1113 outer_window
= f
->output_data
.x
->parent_desc
;
1115 outer_window
= outer
;
1117 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1119 /* From-window, to-window. */
1121 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1123 /* From-position, to-position. */
1124 0, 0, &win_x
, &win_y
,
1129 /* It is possible for the window returned by the XQueryNotify
1130 to become invalid by the time we call XTranslateCoordinates.
1131 That can happen when you restart some window managers.
1132 If so, we get an error in XTranslateCoordinates.
1133 Detect that and try the whole thing over. */
1134 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1136 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1140 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1147 /* Insert a description of internally-recorded parameters of frame X
1148 into the parameter alist *ALISTPTR that is to be given to the user.
1149 Only parameters that are specific to the X window system
1150 and whose values are not correctly recorded in the frame's
1151 param_alist need to be considered here. */
1154 x_report_frame_params (f
, alistptr
)
1156 Lisp_Object
*alistptr
;
1161 /* Represent negative positions (off the top or left screen edge)
1162 in a way that Fmodify_frame_parameters will understand correctly. */
1163 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1164 if (f
->output_data
.x
->left_pos
>= 0)
1165 store_in_alist (alistptr
, Qleft
, tem
);
1167 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1169 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1170 if (f
->output_data
.x
->top_pos
>= 0)
1171 store_in_alist (alistptr
, Qtop
, tem
);
1173 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1175 store_in_alist (alistptr
, Qborder_width
,
1176 make_number (f
->output_data
.x
->border_width
));
1177 store_in_alist (alistptr
, Qinternal_border_width
,
1178 make_number (f
->output_data
.x
->internal_border_width
));
1179 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1180 store_in_alist (alistptr
, Qwindow_id
,
1181 build_string (buf
));
1182 #ifdef USE_X_TOOLKIT
1183 /* Tooltip frame may not have this widget. */
1184 if (f
->output_data
.x
->widget
)
1186 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1187 store_in_alist (alistptr
, Qouter_window_id
,
1188 build_string (buf
));
1189 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1190 FRAME_SAMPLE_VISIBILITY (f
);
1191 store_in_alist (alistptr
, Qvisibility
,
1192 (FRAME_VISIBLE_P (f
) ? Qt
1193 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1194 store_in_alist (alistptr
, Qdisplay
,
1195 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1197 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1200 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1201 store_in_alist (alistptr
, Qparent_id
, tem
);
1206 /* Gamma-correct COLOR on frame F. */
1209 gamma_correct (f
, color
)
1215 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1216 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1217 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1222 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1223 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1224 allocate the color. Value is zero if COLOR_NAME is invalid, or
1225 no color could be allocated. */
1228 x_defined_color (f
, color_name
, color
, alloc_p
)
1235 Display
*dpy
= FRAME_X_DISPLAY (f
);
1236 Colormap cmap
= FRAME_X_COLORMAP (f
);
1239 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1240 if (success_p
&& alloc_p
)
1241 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1248 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1249 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1250 Signal an error if color can't be allocated. */
1253 x_decode_color (f
, color_name
, mono_color
)
1255 Lisp_Object color_name
;
1260 CHECK_STRING (color_name
, 0);
1262 #if 0 /* Don't do this. It's wrong when we're not using the default
1263 colormap, it makes freeing difficult, and it's probably not
1264 an important optimization. */
1265 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1266 return BLACK_PIX_DEFAULT (f
);
1267 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1268 return WHITE_PIX_DEFAULT (f
);
1271 /* Return MONO_COLOR for monochrome frames. */
1272 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1275 /* x_defined_color is responsible for coping with failures
1276 by looking for a near-miss. */
1277 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1280 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1281 Fcons (color_name
, Qnil
)));
1287 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1288 the previous value of that parameter, NEW_VALUE is the new value. */
1291 x_set_line_spacing (f
, new_value
, old_value
)
1293 Lisp_Object new_value
, old_value
;
1295 if (NILP (new_value
))
1296 f
->extra_line_spacing
= 0;
1297 else if (NATNUMP (new_value
))
1298 f
->extra_line_spacing
= XFASTINT (new_value
);
1300 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1301 Fcons (new_value
, Qnil
)));
1302 if (FRAME_VISIBLE_P (f
))
1307 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1308 the previous value of that parameter, NEW_VALUE is the new value. */
1311 x_set_screen_gamma (f
, new_value
, old_value
)
1313 Lisp_Object new_value
, old_value
;
1315 if (NILP (new_value
))
1317 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1318 /* The value 0.4545 is the normal viewing gamma. */
1319 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1321 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1322 Fcons (new_value
, Qnil
)));
1324 clear_face_cache (0);
1328 /* Functions called only from `x_set_frame_param'
1329 to set individual parameters.
1331 If FRAME_X_WINDOW (f) is 0,
1332 the frame is being created and its X-window does not exist yet.
1333 In that case, just record the parameter's new value
1334 in the standard place; do not attempt to change the window. */
1337 x_set_foreground_color (f
, arg
, oldval
)
1339 Lisp_Object arg
, oldval
;
1341 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1343 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1344 f
->output_data
.x
->foreground_pixel
= pixel
;
1346 if (FRAME_X_WINDOW (f
) != 0)
1349 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1350 f
->output_data
.x
->foreground_pixel
);
1351 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1352 f
->output_data
.x
->foreground_pixel
);
1354 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1355 if (FRAME_VISIBLE_P (f
))
1361 x_set_background_color (f
, arg
, oldval
)
1363 Lisp_Object arg
, oldval
;
1365 unsigned long pixel
= x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1367 unload_color (f
, f
->output_data
.x
->background_pixel
);
1368 f
->output_data
.x
->background_pixel
= pixel
;
1370 if (FRAME_X_WINDOW (f
) != 0)
1373 /* The main frame area. */
1374 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1375 f
->output_data
.x
->background_pixel
);
1376 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1377 f
->output_data
.x
->background_pixel
);
1378 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1379 f
->output_data
.x
->background_pixel
);
1380 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1381 f
->output_data
.x
->background_pixel
);
1384 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1385 bar
= XSCROLL_BAR (bar
)->next
)
1386 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1387 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1388 f
->output_data
.x
->background_pixel
);
1392 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1394 if (FRAME_VISIBLE_P (f
))
1400 x_set_mouse_color (f
, arg
, oldval
)
1402 Lisp_Object arg
, oldval
;
1404 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1405 Cursor busy_cursor
, horizontal_drag_cursor
;
1407 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1408 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1410 /* Don't let pointers be invisible. */
1411 if (mask_color
== pixel
1412 && mask_color
== f
->output_data
.x
->background_pixel
)
1414 x_free_colors (f
, &pixel
, 1);
1415 pixel
= x_copy_color (f
, f
->output_data
.x
->foreground_pixel
);
1418 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1419 f
->output_data
.x
->mouse_pixel
= pixel
;
1423 /* It's not okay to crash if the user selects a screwy cursor. */
1424 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1426 if (!EQ (Qnil
, Vx_pointer_shape
))
1428 CHECK_NUMBER (Vx_pointer_shape
, 0);
1429 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1432 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1433 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1435 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1437 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1438 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1439 XINT (Vx_nontext_pointer_shape
));
1442 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1443 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1445 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1447 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1448 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1449 XINT (Vx_busy_pointer_shape
));
1452 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1453 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1455 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1456 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1458 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1459 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1460 XINT (Vx_mode_pointer_shape
));
1463 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1464 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1466 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1468 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1470 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1471 XINT (Vx_sensitive_text_pointer_shape
));
1474 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1476 if (!NILP (Vx_window_horizontal_drag_shape
))
1478 CHECK_NUMBER (Vx_window_horizontal_drag_shape
, 0);
1479 horizontal_drag_cursor
1480 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1481 XINT (Vx_window_horizontal_drag_shape
));
1484 horizontal_drag_cursor
1485 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
1487 /* Check and report errors with the above calls. */
1488 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1489 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1492 XColor fore_color
, back_color
;
1494 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1495 x_query_color (f
, &fore_color
);
1496 back_color
.pixel
= mask_color
;
1497 x_query_color (f
, &back_color
);
1499 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1500 &fore_color
, &back_color
);
1501 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1502 &fore_color
, &back_color
);
1503 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1504 &fore_color
, &back_color
);
1505 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1506 &fore_color
, &back_color
);
1507 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1508 &fore_color
, &back_color
);
1509 XRecolorCursor (FRAME_X_DISPLAY (f
), horizontal_drag_cursor
,
1510 &fore_color
, &back_color
);
1513 if (FRAME_X_WINDOW (f
) != 0)
1514 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1516 if (cursor
!= f
->output_data
.x
->text_cursor
1517 && f
->output_data
.x
->text_cursor
!= 0)
1518 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1519 f
->output_data
.x
->text_cursor
= cursor
;
1521 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1522 && f
->output_data
.x
->nontext_cursor
!= 0)
1523 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1524 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1526 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1527 && f
->output_data
.x
->busy_cursor
!= 0)
1528 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1529 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1531 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1532 && f
->output_data
.x
->modeline_cursor
!= 0)
1533 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1534 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1536 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1537 && f
->output_data
.x
->cross_cursor
!= 0)
1538 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1539 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1541 if (horizontal_drag_cursor
!= f
->output_data
.x
->horizontal_drag_cursor
1542 && f
->output_data
.x
->horizontal_drag_cursor
!= 0)
1543 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->horizontal_drag_cursor
);
1544 f
->output_data
.x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1546 XFlush (FRAME_X_DISPLAY (f
));
1549 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1553 x_set_cursor_color (f
, arg
, oldval
)
1555 Lisp_Object arg
, oldval
;
1557 unsigned long fore_pixel
, pixel
;
1558 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1560 if (!NILP (Vx_cursor_fore_pixel
))
1562 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1563 WHITE_PIX_DEFAULT (f
));
1564 fore_pixel_allocated_p
= 1;
1567 fore_pixel
= f
->output_data
.x
->background_pixel
;
1569 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1570 pixel_allocated_p
= 1;
1572 /* Make sure that the cursor color differs from the background color. */
1573 if (pixel
== f
->output_data
.x
->background_pixel
)
1575 if (pixel_allocated_p
)
1577 x_free_colors (f
, &pixel
, 1);
1578 pixel_allocated_p
= 0;
1581 pixel
= f
->output_data
.x
->mouse_pixel
;
1582 if (pixel
== fore_pixel
)
1584 if (fore_pixel_allocated_p
)
1586 x_free_colors (f
, &fore_pixel
, 1);
1587 fore_pixel_allocated_p
= 0;
1589 fore_pixel
= f
->output_data
.x
->background_pixel
;
1593 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1594 if (!fore_pixel_allocated_p
)
1595 fore_pixel
= x_copy_color (f
, fore_pixel
);
1596 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1598 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1599 if (!pixel_allocated_p
)
1600 pixel
= x_copy_color (f
, pixel
);
1601 f
->output_data
.x
->cursor_pixel
= pixel
;
1603 if (FRAME_X_WINDOW (f
) != 0)
1606 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1607 f
->output_data
.x
->cursor_pixel
);
1608 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1612 if (FRAME_VISIBLE_P (f
))
1614 x_update_cursor (f
, 0);
1615 x_update_cursor (f
, 1);
1619 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1622 /* Set the border-color of frame F to value described by ARG.
1623 ARG can be a string naming a color.
1624 The border-color is used for the border that is drawn by the X server.
1625 Note that this does not fully take effect if done before
1626 F has an x-window; it must be redone when the window is created.
1628 Note: this is done in two routines because of the way X10 works.
1630 Note: under X11, this is normally the province of the window manager,
1631 and so emacs' border colors may be overridden. */
1634 x_set_border_color (f
, arg
, oldval
)
1636 Lisp_Object arg
, oldval
;
1640 CHECK_STRING (arg
, 0);
1641 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1642 x_set_border_pixel (f
, pix
);
1643 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1646 /* Set the border-color of frame F to pixel value PIX.
1647 Note that this does not fully take effect if done before
1648 F has an x-window. */
1651 x_set_border_pixel (f
, pix
)
1655 unload_color (f
, f
->output_data
.x
->border_pixel
);
1656 f
->output_data
.x
->border_pixel
= pix
;
1658 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1661 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1662 (unsigned long)pix
);
1665 if (FRAME_VISIBLE_P (f
))
1671 /* Value is the internal representation of the specified cursor type
1672 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1673 of the bar cursor. */
1675 enum text_cursor_kinds
1676 x_specified_cursor_type (arg
, width
)
1680 enum text_cursor_kinds type
;
1687 else if (CONSP (arg
)
1688 && EQ (XCAR (arg
), Qbar
)
1689 && INTEGERP (XCDR (arg
))
1690 && XINT (XCDR (arg
)) >= 0)
1693 *width
= XINT (XCDR (arg
));
1695 else if (NILP (arg
))
1698 /* Treat anything unknown as "box cursor".
1699 It was bad to signal an error; people have trouble fixing
1700 .Xdefaults with Emacs, when it has something bad in it. */
1701 type
= FILLED_BOX_CURSOR
;
1707 x_set_cursor_type (f
, arg
, oldval
)
1709 Lisp_Object arg
, oldval
;
1713 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1714 f
->output_data
.x
->cursor_width
= width
;
1716 /* Make sure the cursor gets redrawn. This is overkill, but how
1717 often do people change cursor types? */
1718 update_mode_lines
++;
1722 x_set_icon_type (f
, arg
, oldval
)
1724 Lisp_Object arg
, oldval
;
1730 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1733 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1738 result
= x_text_icon (f
,
1739 (char *) XSTRING ((!NILP (f
->icon_name
)
1743 result
= x_bitmap_icon (f
, arg
);
1748 error ("No icon window available");
1751 XFlush (FRAME_X_DISPLAY (f
));
1755 /* Return non-nil if frame F wants a bitmap icon. */
1763 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1771 x_set_icon_name (f
, arg
, oldval
)
1773 Lisp_Object arg
, oldval
;
1779 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1782 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1787 if (f
->output_data
.x
->icon_bitmap
!= 0)
1792 result
= x_text_icon (f
,
1793 (char *) XSTRING ((!NILP (f
->icon_name
)
1802 error ("No icon window available");
1805 XFlush (FRAME_X_DISPLAY (f
));
1810 x_set_font (f
, arg
, oldval
)
1812 Lisp_Object arg
, oldval
;
1815 Lisp_Object fontset_name
;
1818 CHECK_STRING (arg
, 1);
1820 fontset_name
= Fquery_fontset (arg
, Qnil
);
1823 result
= (STRINGP (fontset_name
)
1824 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1825 : x_new_font (f
, XSTRING (arg
)->data
));
1828 if (EQ (result
, Qnil
))
1829 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1830 else if (EQ (result
, Qt
))
1831 error ("The characters of the given font have varying widths");
1832 else if (STRINGP (result
))
1834 store_frame_param (f
, Qfont
, result
);
1835 recompute_basic_faces (f
);
1840 do_pending_window_change (0);
1842 /* Don't call `face-set-after-frame-default' when faces haven't been
1843 initialized yet. This is the case when called from
1844 Fx_create_frame. In that case, the X widget or window doesn't
1845 exist either, and we can end up in x_report_frame_params with a
1846 null widget which gives a segfault. */
1847 if (FRAME_FACE_CACHE (f
))
1849 XSETFRAME (frame
, f
);
1850 call1 (Qface_set_after_frame_default
, frame
);
1855 x_set_border_width (f
, arg
, oldval
)
1857 Lisp_Object arg
, oldval
;
1859 CHECK_NUMBER (arg
, 0);
1861 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1864 if (FRAME_X_WINDOW (f
) != 0)
1865 error ("Cannot change the border width of a window");
1867 f
->output_data
.x
->border_width
= XINT (arg
);
1871 x_set_internal_border_width (f
, arg
, oldval
)
1873 Lisp_Object arg
, oldval
;
1875 int old
= f
->output_data
.x
->internal_border_width
;
1877 CHECK_NUMBER (arg
, 0);
1878 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1879 if (f
->output_data
.x
->internal_border_width
< 0)
1880 f
->output_data
.x
->internal_border_width
= 0;
1882 #ifdef USE_X_TOOLKIT
1883 if (f
->output_data
.x
->edit_widget
)
1884 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1887 if (f
->output_data
.x
->internal_border_width
== old
)
1890 if (FRAME_X_WINDOW (f
) != 0)
1892 x_set_window_size (f
, 0, f
->width
, f
->height
);
1893 SET_FRAME_GARBAGED (f
);
1894 do_pending_window_change (0);
1899 x_set_visibility (f
, value
, oldval
)
1901 Lisp_Object value
, oldval
;
1904 XSETFRAME (frame
, f
);
1907 Fmake_frame_invisible (frame
, Qt
);
1908 else if (EQ (value
, Qicon
))
1909 Ficonify_frame (frame
);
1911 Fmake_frame_visible (frame
);
1915 /* Change window heights in windows rooted in WINDOW by N lines. */
1918 x_change_window_heights (window
, n
)
1922 struct window
*w
= XWINDOW (window
);
1924 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1925 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1927 if (INTEGERP (w
->orig_top
))
1928 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1929 if (INTEGERP (w
->orig_height
))
1930 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1932 /* Handle just the top child in a vertical split. */
1933 if (!NILP (w
->vchild
))
1934 x_change_window_heights (w
->vchild
, n
);
1936 /* Adjust all children in a horizontal split. */
1937 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1939 w
= XWINDOW (window
);
1940 x_change_window_heights (window
, n
);
1945 x_set_menu_bar_lines (f
, value
, oldval
)
1947 Lisp_Object value
, oldval
;
1950 #ifndef USE_X_TOOLKIT
1951 int olines
= FRAME_MENU_BAR_LINES (f
);
1954 /* Right now, menu bars don't work properly in minibuf-only frames;
1955 most of the commands try to apply themselves to the minibuffer
1956 frame itself, and get an error because you can't switch buffers
1957 in or split the minibuffer window. */
1958 if (FRAME_MINIBUF_ONLY_P (f
))
1961 if (INTEGERP (value
))
1962 nlines
= XINT (value
);
1966 /* Make sure we redisplay all windows in this frame. */
1967 windows_or_buffers_changed
++;
1969 #ifdef USE_X_TOOLKIT
1970 FRAME_MENU_BAR_LINES (f
) = 0;
1973 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1974 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1975 /* Make sure next redisplay shows the menu bar. */
1976 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1980 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1981 free_frame_menubar (f
);
1982 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1984 f
->output_data
.x
->menubar_widget
= 0;
1986 #else /* not USE_X_TOOLKIT */
1987 FRAME_MENU_BAR_LINES (f
) = nlines
;
1988 x_change_window_heights (f
->root_window
, nlines
- olines
);
1989 #endif /* not USE_X_TOOLKIT */
1994 /* Set the number of lines used for the tool bar of frame F to VALUE.
1995 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1996 is the old number of tool bar lines. This function changes the
1997 height of all windows on frame F to match the new tool bar height.
1998 The frame's height doesn't change. */
2001 x_set_tool_bar_lines (f
, value
, oldval
)
2003 Lisp_Object value
, oldval
;
2005 int delta
, nlines
, root_height
;
2006 Lisp_Object root_window
;
2008 /* Treat tool bars like menu bars. */
2009 if (FRAME_MINIBUF_ONLY_P (f
))
2012 /* Use VALUE only if an integer >= 0. */
2013 if (INTEGERP (value
) && XINT (value
) >= 0)
2014 nlines
= XFASTINT (value
);
2018 /* Make sure we redisplay all windows in this frame. */
2019 ++windows_or_buffers_changed
;
2021 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2023 /* Don't resize the tool-bar to more than we have room for. */
2024 root_window
= FRAME_ROOT_WINDOW (f
);
2025 root_height
= XINT (XWINDOW (root_window
)->height
);
2026 if (root_height
- delta
< 1)
2028 delta
= root_height
- 1;
2029 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2032 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2033 x_change_window_heights (root_window
, delta
);
2036 /* We also have to make sure that the internal border at the top of
2037 the frame, below the menu bar or tool bar, is redrawn when the
2038 tool bar disappears. This is so because the internal border is
2039 below the tool bar if one is displayed, but is below the menu bar
2040 if there isn't a tool bar. The tool bar draws into the area
2041 below the menu bar. */
2042 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2046 clear_current_matrices (f
);
2047 updating_frame
= NULL
;
2050 /* If the tool bar gets smaller, the internal border below it
2051 has to be cleared. It was formerly part of the display
2052 of the larger tool bar, and updating windows won't clear it. */
2055 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2056 int width
= PIXEL_WIDTH (f
);
2057 int y
= nlines
* CANON_Y_UNIT (f
);
2060 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2061 0, y
, width
, height
, False
);
2067 /* Set the foreground color for scroll bars on frame F to VALUE.
2068 VALUE should be a string, a color name. If it isn't a string or
2069 isn't a valid color name, do nothing. OLDVAL is the old value of
2070 the frame parameter. */
2073 x_set_scroll_bar_foreground (f
, value
, oldval
)
2075 Lisp_Object value
, oldval
;
2077 unsigned long pixel
;
2079 if (STRINGP (value
))
2080 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2084 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2085 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2087 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2088 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2090 /* Remove all scroll bars because they have wrong colors. */
2091 if (condemn_scroll_bars_hook
)
2092 (*condemn_scroll_bars_hook
) (f
);
2093 if (judge_scroll_bars_hook
)
2094 (*judge_scroll_bars_hook
) (f
);
2096 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2102 /* Set the background color for scroll bars on frame F to VALUE VALUE
2103 should be a string, a color name. If it isn't a string or isn't a
2104 valid color name, do nothing. OLDVAL is the old value of the frame
2108 x_set_scroll_bar_background (f
, value
, oldval
)
2110 Lisp_Object value
, oldval
;
2112 unsigned long pixel
;
2114 if (STRINGP (value
))
2115 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2119 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2120 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2122 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2123 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2125 /* Remove all scroll bars because they have wrong colors. */
2126 if (condemn_scroll_bars_hook
)
2127 (*condemn_scroll_bars_hook
) (f
);
2128 if (judge_scroll_bars_hook
)
2129 (*judge_scroll_bars_hook
) (f
);
2131 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2137 /* Encode Lisp string STRING as a text in a format appropriate for
2138 XICCC (X Inter Client Communication Conventions).
2140 If STRING contains only ASCII characters, do no conversion and
2141 return the string data of STRING. Otherwise, encode the text by
2142 CODING_SYSTEM, and return a newly allocated memory area which
2143 should be freed by `xfree' by a caller.
2145 Store the byte length of resulting text in *TEXT_BYTES.
2147 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2148 which means that the `encoding' of the result can be `STRING'.
2149 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2150 the result should be `COMPOUND_TEXT'. */
2153 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2154 Lisp_Object string
, coding_system
;
2155 int *text_bytes
, *stringp
;
2157 unsigned char *str
= XSTRING (string
)->data
;
2158 int chars
= XSTRING (string
)->size
;
2159 int bytes
= STRING_BYTES (XSTRING (string
));
2163 struct coding_system coding
;
2165 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2166 if (charset_info
== 0)
2168 /* No multibyte character in OBJ. We need not encode it. */
2169 *text_bytes
= bytes
;
2174 setup_coding_system (coding_system
, &coding
);
2175 coding
.src_multibyte
= 1;
2176 coding
.dst_multibyte
= 0;
2177 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2178 if (coding
.type
== coding_type_iso2022
)
2179 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2180 /* We suppress producing escape sequences for composition. */
2181 coding
.composing
= COMPOSITION_DISABLED
;
2182 bufsize
= encoding_buffer_size (&coding
, bytes
);
2183 buf
= (unsigned char *) xmalloc (bufsize
);
2184 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2185 *text_bytes
= coding
.produced
;
2186 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2191 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2194 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2195 name; if NAME is a string, set F's name to NAME and set
2196 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2198 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2199 suggesting a new name, which lisp code should override; if
2200 F->explicit_name is set, ignore the new name; otherwise, set it. */
2203 x_set_name (f
, name
, explicit)
2208 /* Make sure that requests from lisp code override requests from
2209 Emacs redisplay code. */
2212 /* If we're switching from explicit to implicit, we had better
2213 update the mode lines and thereby update the title. */
2214 if (f
->explicit_name
&& NILP (name
))
2215 update_mode_lines
= 1;
2217 f
->explicit_name
= ! NILP (name
);
2219 else if (f
->explicit_name
)
2222 /* If NAME is nil, set the name to the x_id_name. */
2225 /* Check for no change needed in this very common case
2226 before we do any consing. */
2227 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2228 XSTRING (f
->name
)->data
))
2230 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2233 CHECK_STRING (name
, 0);
2235 /* Don't change the name if it's already NAME. */
2236 if (! NILP (Fstring_equal (name
, f
->name
)))
2241 /* For setting the frame title, the title parameter should override
2242 the name parameter. */
2243 if (! NILP (f
->title
))
2246 if (FRAME_X_WINDOW (f
))
2251 XTextProperty text
, icon
;
2253 Lisp_Object coding_system
;
2255 coding_system
= Vlocale_coding_system
;
2256 if (NILP (coding_system
))
2257 coding_system
= Qcompound_text
;
2258 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2259 text
.encoding
= (stringp
? XA_STRING
2260 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2262 text
.nitems
= bytes
;
2264 if (NILP (f
->icon_name
))
2270 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2272 icon
.encoding
= (stringp
? XA_STRING
2273 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2275 icon
.nitems
= bytes
;
2277 #ifdef USE_X_TOOLKIT
2278 XSetWMName (FRAME_X_DISPLAY (f
),
2279 XtWindow (f
->output_data
.x
->widget
), &text
);
2280 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2282 #else /* not USE_X_TOOLKIT */
2283 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2284 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2285 #endif /* not USE_X_TOOLKIT */
2286 if (!NILP (f
->icon_name
)
2287 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2289 if (text
.value
!= XSTRING (name
)->data
)
2292 #else /* not HAVE_X11R4 */
2293 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2294 XSTRING (name
)->data
);
2295 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2296 XSTRING (name
)->data
);
2297 #endif /* not HAVE_X11R4 */
2302 /* This function should be called when the user's lisp code has
2303 specified a name for the frame; the name will override any set by the
2306 x_explicitly_set_name (f
, arg
, oldval
)
2308 Lisp_Object arg
, oldval
;
2310 x_set_name (f
, arg
, 1);
2313 /* This function should be called by Emacs redisplay code to set the
2314 name; names set this way will never override names set by the user's
2317 x_implicitly_set_name (f
, arg
, oldval
)
2319 Lisp_Object arg
, oldval
;
2321 x_set_name (f
, arg
, 0);
2324 /* Change the title of frame F to NAME.
2325 If NAME is nil, use the frame name as the title.
2327 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2328 name; if NAME is a string, set F's name to NAME and set
2329 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2331 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2332 suggesting a new name, which lisp code should override; if
2333 F->explicit_name is set, ignore the new name; otherwise, set it. */
2336 x_set_title (f
, name
, old_name
)
2338 Lisp_Object name
, old_name
;
2340 /* Don't change the title if it's already NAME. */
2341 if (EQ (name
, f
->title
))
2344 update_mode_lines
= 1;
2351 CHECK_STRING (name
, 0);
2353 if (FRAME_X_WINDOW (f
))
2358 XTextProperty text
, icon
;
2360 Lisp_Object coding_system
;
2362 coding_system
= Vlocale_coding_system
;
2363 if (NILP (coding_system
))
2364 coding_system
= Qcompound_text
;
2365 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2366 text
.encoding
= (stringp
? XA_STRING
2367 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2369 text
.nitems
= bytes
;
2371 if (NILP (f
->icon_name
))
2377 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2379 icon
.encoding
= (stringp
? XA_STRING
2380 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2382 icon
.nitems
= bytes
;
2384 #ifdef USE_X_TOOLKIT
2385 XSetWMName (FRAME_X_DISPLAY (f
),
2386 XtWindow (f
->output_data
.x
->widget
), &text
);
2387 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2389 #else /* not USE_X_TOOLKIT */
2390 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2391 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2392 #endif /* not USE_X_TOOLKIT */
2393 if (!NILP (f
->icon_name
)
2394 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2396 if (text
.value
!= XSTRING (name
)->data
)
2399 #else /* not HAVE_X11R4 */
2400 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2401 XSTRING (name
)->data
);
2402 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2403 XSTRING (name
)->data
);
2404 #endif /* not HAVE_X11R4 */
2410 x_set_autoraise (f
, arg
, oldval
)
2412 Lisp_Object arg
, oldval
;
2414 f
->auto_raise
= !EQ (Qnil
, arg
);
2418 x_set_autolower (f
, arg
, oldval
)
2420 Lisp_Object arg
, oldval
;
2422 f
->auto_lower
= !EQ (Qnil
, arg
);
2426 x_set_unsplittable (f
, arg
, oldval
)
2428 Lisp_Object arg
, oldval
;
2430 f
->no_split
= !NILP (arg
);
2434 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2436 Lisp_Object arg
, oldval
;
2438 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2439 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2440 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2441 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2443 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2445 ? vertical_scroll_bar_none
2447 ? vertical_scroll_bar_right
2448 : vertical_scroll_bar_left
);
2450 /* We set this parameter before creating the X window for the
2451 frame, so we can get the geometry right from the start.
2452 However, if the window hasn't been created yet, we shouldn't
2453 call x_set_window_size. */
2454 if (FRAME_X_WINDOW (f
))
2455 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2456 do_pending_window_change (0);
2461 x_set_scroll_bar_width (f
, arg
, oldval
)
2463 Lisp_Object arg
, oldval
;
2465 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2469 #ifdef USE_TOOLKIT_SCROLL_BARS
2470 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2471 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2472 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2473 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2475 /* Make the actual width at least 14 pixels and a multiple of a
2477 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2479 /* Use all of that space (aside from required margins) for the
2481 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2484 if (FRAME_X_WINDOW (f
))
2485 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2486 do_pending_window_change (0);
2488 else if (INTEGERP (arg
) && XINT (arg
) > 0
2489 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2491 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2492 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2494 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2495 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2496 if (FRAME_X_WINDOW (f
))
2497 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2500 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2501 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2502 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2507 /* Subroutines of creating an X frame. */
2509 /* Make sure that Vx_resource_name is set to a reasonable value.
2510 Fix it up, or set it to `emacs' if it is too hopeless. */
2513 validate_x_resource_name ()
2516 /* Number of valid characters in the resource name. */
2518 /* Number of invalid characters in the resource name. */
2523 if (!STRINGP (Vx_resource_class
))
2524 Vx_resource_class
= build_string (EMACS_CLASS
);
2526 if (STRINGP (Vx_resource_name
))
2528 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2531 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2533 /* Only letters, digits, - and _ are valid in resource names.
2534 Count the valid characters and count the invalid ones. */
2535 for (i
= 0; i
< len
; i
++)
2538 if (! ((c
>= 'a' && c
<= 'z')
2539 || (c
>= 'A' && c
<= 'Z')
2540 || (c
>= '0' && c
<= '9')
2541 || c
== '-' || c
== '_'))
2548 /* Not a string => completely invalid. */
2549 bad_count
= 5, good_count
= 0;
2551 /* If name is valid already, return. */
2555 /* If name is entirely invalid, or nearly so, use `emacs'. */
2557 || (good_count
== 1 && bad_count
> 0))
2559 Vx_resource_name
= build_string ("emacs");
2563 /* Name is partly valid. Copy it and replace the invalid characters
2564 with underscores. */
2566 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2568 for (i
= 0; i
< len
; i
++)
2570 int c
= XSTRING (new)->data
[i
];
2571 if (! ((c
>= 'a' && c
<= 'z')
2572 || (c
>= 'A' && c
<= 'Z')
2573 || (c
>= '0' && c
<= '9')
2574 || c
== '-' || c
== '_'))
2575 XSTRING (new)->data
[i
] = '_';
2580 extern char *x_get_string_resource ();
2582 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2583 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2584 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2585 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2586 the name specified by the `-name' or `-rn' command-line arguments.\n\
2588 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2589 class, respectively. You must specify both of them or neither.\n\
2590 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2591 and the class is `Emacs.CLASS.SUBCLASS'.")
2592 (attribute
, class, component
, subclass
)
2593 Lisp_Object attribute
, class, component
, subclass
;
2595 register char *value
;
2601 CHECK_STRING (attribute
, 0);
2602 CHECK_STRING (class, 0);
2604 if (!NILP (component
))
2605 CHECK_STRING (component
, 1);
2606 if (!NILP (subclass
))
2607 CHECK_STRING (subclass
, 2);
2608 if (NILP (component
) != NILP (subclass
))
2609 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2611 validate_x_resource_name ();
2613 /* Allocate space for the components, the dots which separate them,
2614 and the final '\0'. Make them big enough for the worst case. */
2615 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2616 + (STRINGP (component
)
2617 ? STRING_BYTES (XSTRING (component
)) : 0)
2618 + STRING_BYTES (XSTRING (attribute
))
2621 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2622 + STRING_BYTES (XSTRING (class))
2623 + (STRINGP (subclass
)
2624 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2627 /* Start with emacs.FRAMENAME for the name (the specific one)
2628 and with `Emacs' for the class key (the general one). */
2629 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2630 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2632 strcat (class_key
, ".");
2633 strcat (class_key
, XSTRING (class)->data
);
2635 if (!NILP (component
))
2637 strcat (class_key
, ".");
2638 strcat (class_key
, XSTRING (subclass
)->data
);
2640 strcat (name_key
, ".");
2641 strcat (name_key
, XSTRING (component
)->data
);
2644 strcat (name_key
, ".");
2645 strcat (name_key
, XSTRING (attribute
)->data
);
2647 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2648 name_key
, class_key
);
2650 if (value
!= (char *) 0)
2651 return build_string (value
);
2656 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2659 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2660 struct x_display_info
*dpyinfo
;
2661 Lisp_Object attribute
, class, component
, subclass
;
2663 register char *value
;
2667 CHECK_STRING (attribute
, 0);
2668 CHECK_STRING (class, 0);
2670 if (!NILP (component
))
2671 CHECK_STRING (component
, 1);
2672 if (!NILP (subclass
))
2673 CHECK_STRING (subclass
, 2);
2674 if (NILP (component
) != NILP (subclass
))
2675 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2677 validate_x_resource_name ();
2679 /* Allocate space for the components, the dots which separate them,
2680 and the final '\0'. Make them big enough for the worst case. */
2681 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2682 + (STRINGP (component
)
2683 ? STRING_BYTES (XSTRING (component
)) : 0)
2684 + STRING_BYTES (XSTRING (attribute
))
2687 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2688 + STRING_BYTES (XSTRING (class))
2689 + (STRINGP (subclass
)
2690 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2693 /* Start with emacs.FRAMENAME for the name (the specific one)
2694 and with `Emacs' for the class key (the general one). */
2695 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2696 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2698 strcat (class_key
, ".");
2699 strcat (class_key
, XSTRING (class)->data
);
2701 if (!NILP (component
))
2703 strcat (class_key
, ".");
2704 strcat (class_key
, XSTRING (subclass
)->data
);
2706 strcat (name_key
, ".");
2707 strcat (name_key
, XSTRING (component
)->data
);
2710 strcat (name_key
, ".");
2711 strcat (name_key
, XSTRING (attribute
)->data
);
2713 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2715 if (value
!= (char *) 0)
2716 return build_string (value
);
2721 /* Used when C code wants a resource value. */
2724 x_get_resource_string (attribute
, class)
2725 char *attribute
, *class;
2729 struct frame
*sf
= SELECTED_FRAME ();
2731 /* Allocate space for the components, the dots which separate them,
2732 and the final '\0'. */
2733 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2734 + strlen (attribute
) + 2);
2735 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2736 + strlen (class) + 2);
2738 sprintf (name_key
, "%s.%s",
2739 XSTRING (Vinvocation_name
)->data
,
2741 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2743 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2744 name_key
, class_key
);
2747 /* Types we might convert a resource string into. */
2757 /* Return the value of parameter PARAM.
2759 First search ALIST, then Vdefault_frame_alist, then the X defaults
2760 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2762 Convert the resource to the type specified by desired_type.
2764 If no default is specified, return Qunbound. If you call
2765 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2766 and don't let it get stored in any Lisp-visible variables! */
2769 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2770 struct x_display_info
*dpyinfo
;
2771 Lisp_Object alist
, param
;
2774 enum resource_types type
;
2776 register Lisp_Object tem
;
2778 tem
= Fassq (param
, alist
);
2780 tem
= Fassq (param
, Vdefault_frame_alist
);
2786 tem
= display_x_get_resource (dpyinfo
,
2787 build_string (attribute
),
2788 build_string (class),
2796 case RES_TYPE_NUMBER
:
2797 return make_number (atoi (XSTRING (tem
)->data
));
2799 case RES_TYPE_FLOAT
:
2800 return make_float (atof (XSTRING (tem
)->data
));
2802 case RES_TYPE_BOOLEAN
:
2803 tem
= Fdowncase (tem
);
2804 if (!strcmp (XSTRING (tem
)->data
, "on")
2805 || !strcmp (XSTRING (tem
)->data
, "true"))
2810 case RES_TYPE_STRING
:
2813 case RES_TYPE_SYMBOL
:
2814 /* As a special case, we map the values `true' and `on'
2815 to Qt, and `false' and `off' to Qnil. */
2818 lower
= Fdowncase (tem
);
2819 if (!strcmp (XSTRING (lower
)->data
, "on")
2820 || !strcmp (XSTRING (lower
)->data
, "true"))
2822 else if (!strcmp (XSTRING (lower
)->data
, "off")
2823 || !strcmp (XSTRING (lower
)->data
, "false"))
2826 return Fintern (tem
, Qnil
);
2839 /* Like x_get_arg, but also record the value in f->param_alist. */
2842 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2844 Lisp_Object alist
, param
;
2847 enum resource_types type
;
2851 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2852 attribute
, class, type
);
2854 store_frame_param (f
, param
, value
);
2859 /* Record in frame F the specified or default value according to ALIST
2860 of the parameter named PROP (a Lisp symbol).
2861 If no value is specified for PROP, look for an X default for XPROP
2862 on the frame named NAME.
2863 If that is not found either, use the value DEFLT. */
2866 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2873 enum resource_types type
;
2877 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2878 if (EQ (tem
, Qunbound
))
2880 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2885 /* Record in frame F the specified or default value according to ALIST
2886 of the parameter named PROP (a Lisp symbol). If no value is
2887 specified for PROP, look for an X default for XPROP on the frame
2888 named NAME. If that is not found either, use the value DEFLT. */
2891 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2900 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2903 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2904 if (EQ (tem
, Qunbound
))
2906 #ifdef USE_TOOLKIT_SCROLL_BARS
2908 /* See if an X resource for the scroll bar color has been
2910 tem
= display_x_get_resource (dpyinfo
,
2911 build_string (foreground_p
2915 build_string ("verticalScrollBar"),
2919 /* If nothing has been specified, scroll bars will use a
2920 toolkit-dependent default. Because these defaults are
2921 difficult to get at without actually creating a scroll
2922 bar, use nil to indicate that no color has been
2927 #else /* not USE_TOOLKIT_SCROLL_BARS */
2931 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2934 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2940 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2941 "Parse an X-style geometry string STRING.\n\
2942 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2943 The properties returned may include `top', `left', `height', and `width'.\n\
2944 The value of `left' or `top' may be an integer,\n\
2945 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2946 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2951 unsigned int width
, height
;
2954 CHECK_STRING (string
, 0);
2956 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2957 &x
, &y
, &width
, &height
);
2960 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2961 error ("Must specify both x and y position, or neither");
2965 if (geometry
& XValue
)
2967 Lisp_Object element
;
2969 if (x
>= 0 && (geometry
& XNegative
))
2970 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2971 else if (x
< 0 && ! (geometry
& XNegative
))
2972 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2974 element
= Fcons (Qleft
, make_number (x
));
2975 result
= Fcons (element
, result
);
2978 if (geometry
& YValue
)
2980 Lisp_Object element
;
2982 if (y
>= 0 && (geometry
& YNegative
))
2983 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2984 else if (y
< 0 && ! (geometry
& YNegative
))
2985 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2987 element
= Fcons (Qtop
, make_number (y
));
2988 result
= Fcons (element
, result
);
2991 if (geometry
& WidthValue
)
2992 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2993 if (geometry
& HeightValue
)
2994 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2999 /* Calculate the desired size and position of this window,
3000 and return the flags saying which aspects were specified.
3002 This function does not make the coordinates positive. */
3004 #define DEFAULT_ROWS 40
3005 #define DEFAULT_COLS 80
3008 x_figure_window_size (f
, parms
)
3012 register Lisp_Object tem0
, tem1
, tem2
;
3013 long window_prompting
= 0;
3014 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3016 /* Default values if we fall through.
3017 Actually, if that happens we should get
3018 window manager prompting. */
3019 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3020 f
->height
= DEFAULT_ROWS
;
3021 /* Window managers expect that if program-specified
3022 positions are not (0,0), they're intentional, not defaults. */
3023 f
->output_data
.x
->top_pos
= 0;
3024 f
->output_data
.x
->left_pos
= 0;
3026 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3027 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3028 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3029 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3031 if (!EQ (tem0
, Qunbound
))
3033 CHECK_NUMBER (tem0
, 0);
3034 f
->height
= XINT (tem0
);
3036 if (!EQ (tem1
, Qunbound
))
3038 CHECK_NUMBER (tem1
, 0);
3039 SET_FRAME_WIDTH (f
, XINT (tem1
));
3041 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3042 window_prompting
|= USSize
;
3044 window_prompting
|= PSize
;
3047 f
->output_data
.x
->vertical_scroll_bar_extra
3048 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3050 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3051 f
->output_data
.x
->flags_areas_extra
3052 = FRAME_FLAGS_AREA_WIDTH (f
);
3053 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3054 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3056 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3057 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3058 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3059 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3061 if (EQ (tem0
, Qminus
))
3063 f
->output_data
.x
->top_pos
= 0;
3064 window_prompting
|= YNegative
;
3066 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3067 && CONSP (XCDR (tem0
))
3068 && INTEGERP (XCAR (XCDR (tem0
))))
3070 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3071 window_prompting
|= YNegative
;
3073 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3074 && CONSP (XCDR (tem0
))
3075 && INTEGERP (XCAR (XCDR (tem0
))))
3077 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3079 else if (EQ (tem0
, Qunbound
))
3080 f
->output_data
.x
->top_pos
= 0;
3083 CHECK_NUMBER (tem0
, 0);
3084 f
->output_data
.x
->top_pos
= XINT (tem0
);
3085 if (f
->output_data
.x
->top_pos
< 0)
3086 window_prompting
|= YNegative
;
3089 if (EQ (tem1
, Qminus
))
3091 f
->output_data
.x
->left_pos
= 0;
3092 window_prompting
|= XNegative
;
3094 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3095 && CONSP (XCDR (tem1
))
3096 && INTEGERP (XCAR (XCDR (tem1
))))
3098 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3099 window_prompting
|= XNegative
;
3101 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3102 && CONSP (XCDR (tem1
))
3103 && INTEGERP (XCAR (XCDR (tem1
))))
3105 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3107 else if (EQ (tem1
, Qunbound
))
3108 f
->output_data
.x
->left_pos
= 0;
3111 CHECK_NUMBER (tem1
, 0);
3112 f
->output_data
.x
->left_pos
= XINT (tem1
);
3113 if (f
->output_data
.x
->left_pos
< 0)
3114 window_prompting
|= XNegative
;
3117 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3118 window_prompting
|= USPosition
;
3120 window_prompting
|= PPosition
;
3123 return window_prompting
;
3126 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3129 XSetWMProtocols (dpy
, w
, protocols
, count
)
3136 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3137 if (prop
== None
) return False
;
3138 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3139 (unsigned char *) protocols
, count
);
3142 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3144 #ifdef USE_X_TOOLKIT
3146 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3147 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3148 already be present because of the toolkit (Motif adds some of them,
3149 for example, but Xt doesn't). */
3152 hack_wm_protocols (f
, widget
)
3156 Display
*dpy
= XtDisplay (widget
);
3157 Window w
= XtWindow (widget
);
3158 int need_delete
= 1;
3164 Atom type
, *atoms
= 0;
3166 unsigned long nitems
= 0;
3167 unsigned long bytes_after
;
3169 if ((XGetWindowProperty (dpy
, w
,
3170 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3171 (long)0, (long)100, False
, XA_ATOM
,
3172 &type
, &format
, &nitems
, &bytes_after
,
3173 (unsigned char **) &atoms
)
3175 && format
== 32 && type
== XA_ATOM
)
3179 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3181 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3183 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3186 if (atoms
) XFree ((char *) atoms
);
3192 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3194 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3196 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3198 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3199 XA_ATOM
, 32, PropModeAppend
,
3200 (unsigned char *) props
, count
);
3208 /* Support routines for XIC (X Input Context). */
3212 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3213 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3216 /* Supported XIM styles, ordered by preferenc. */
3218 static XIMStyle supported_xim_styles
[] =
3220 XIMPreeditPosition
| XIMStatusArea
,
3221 XIMPreeditPosition
| XIMStatusNothing
,
3222 XIMPreeditPosition
| XIMStatusNone
,
3223 XIMPreeditNothing
| XIMStatusArea
,
3224 XIMPreeditNothing
| XIMStatusNothing
,
3225 XIMPreeditNothing
| XIMStatusNone
,
3226 XIMPreeditNone
| XIMStatusArea
,
3227 XIMPreeditNone
| XIMStatusNothing
,
3228 XIMPreeditNone
| XIMStatusNone
,
3233 /* Create an X fontset on frame F with base font name
3237 xic_create_xfontset (f
, base_fontname
)
3239 char *base_fontname
;
3242 char **missing_list
;
3246 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3247 base_fontname
, &missing_list
,
3248 &missing_count
, &def_string
);
3250 XFreeStringList (missing_list
);
3252 /* No need to free def_string. */
3257 /* Value is the best input style, given user preferences USER (already
3258 checked to be supported by Emacs), and styles supported by the
3259 input method XIM. */
3262 best_xim_style (user
, xim
)
3268 for (i
= 0; i
< user
->count_styles
; ++i
)
3269 for (j
= 0; j
< xim
->count_styles
; ++j
)
3270 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3271 return user
->supported_styles
[i
];
3273 /* Return the default style. */
3274 return XIMPreeditNothing
| XIMStatusNothing
;
3277 /* Create XIC for frame F. */
3279 static XIMStyle xic_style
;
3282 create_frame_xic (f
)
3287 XFontSet xfs
= NULL
;
3292 xim
= FRAME_X_XIM (f
);
3297 XVaNestedList preedit_attr
;
3298 XVaNestedList status_attr
;
3299 char *base_fontname
;
3302 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3303 spot
.x
= 0; spot
.y
= 1;
3304 /* Create X fontset. */
3305 fontset
= FRAME_FONTSET (f
);
3307 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3310 /* Determine the base fontname from the ASCII font name of
3312 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3313 char *p
= ascii_font
;
3316 for (i
= 0; *p
; p
++)
3319 /* As the font name doesn't conform to XLFD, we can't
3320 modify it to get a suitable base fontname for the
3322 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3325 int len
= strlen (ascii_font
) + 1;
3328 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3337 base_fontname
= (char *) alloca (len
);
3338 bzero (base_fontname
, len
);
3339 strcpy (base_fontname
, "-*-*-");
3340 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3341 strcat (base_fontname
, "*-*-*-*-*-*-*");
3344 xfs
= xic_create_xfontset (f
, base_fontname
);
3346 /* Determine XIC style. */
3349 XIMStyles supported_list
;
3350 supported_list
.count_styles
= (sizeof supported_xim_styles
3351 / sizeof supported_xim_styles
[0]);
3352 supported_list
.supported_styles
= supported_xim_styles
;
3353 xic_style
= best_xim_style (&supported_list
,
3354 FRAME_X_XIM_STYLES (f
));
3357 preedit_attr
= XVaCreateNestedList (0,
3360 FRAME_FOREGROUND_PIXEL (f
),
3362 FRAME_BACKGROUND_PIXEL (f
),
3363 (xic_style
& XIMPreeditPosition
3368 status_attr
= XVaCreateNestedList (0,
3374 FRAME_FOREGROUND_PIXEL (f
),
3376 FRAME_BACKGROUND_PIXEL (f
),
3379 xic
= XCreateIC (xim
,
3380 XNInputStyle
, xic_style
,
3381 XNClientWindow
, FRAME_X_WINDOW(f
),
3382 XNFocusWindow
, FRAME_X_WINDOW(f
),
3383 XNStatusAttributes
, status_attr
,
3384 XNPreeditAttributes
, preedit_attr
,
3386 XFree (preedit_attr
);
3387 XFree (status_attr
);
3390 FRAME_XIC (f
) = xic
;
3391 FRAME_XIC_STYLE (f
) = xic_style
;
3392 FRAME_XIC_FONTSET (f
) = xfs
;
3396 /* Destroy XIC and free XIC fontset of frame F, if any. */
3402 if (FRAME_XIC (f
) == NULL
)
3405 XDestroyIC (FRAME_XIC (f
));
3406 if (FRAME_XIC_FONTSET (f
))
3407 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3409 FRAME_XIC (f
) = NULL
;
3410 FRAME_XIC_FONTSET (f
) = NULL
;
3414 /* Place preedit area for XIC of window W's frame to specified
3415 pixel position X/Y. X and Y are relative to window W. */
3418 xic_set_preeditarea (w
, x
, y
)
3422 struct frame
*f
= XFRAME (w
->frame
);
3426 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3427 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3428 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3429 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3434 /* Place status area for XIC in bottom right corner of frame F.. */
3437 xic_set_statusarea (f
)
3440 XIC xic
= FRAME_XIC (f
);
3445 /* Negotiate geometry of status area. If input method has existing
3446 status area, use its current size. */
3447 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3448 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3449 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3452 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3453 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3456 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3458 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3459 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3463 area
.width
= needed
->width
;
3464 area
.height
= needed
->height
;
3465 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3466 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3467 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3470 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3471 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3476 /* Set X fontset for XIC of frame F, using base font name
3477 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3480 xic_set_xfontset (f
, base_fontname
)
3482 char *base_fontname
;
3487 xfs
= xic_create_xfontset (f
, base_fontname
);
3489 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3490 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3491 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3492 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3493 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3496 if (FRAME_XIC_FONTSET (f
))
3497 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3498 FRAME_XIC_FONTSET (f
) = xfs
;
3501 #endif /* HAVE_X_I18N */
3505 #ifdef USE_X_TOOLKIT
3507 /* Create and set up the X widget for frame F. */
3510 x_window (f
, window_prompting
, minibuffer_only
)
3512 long window_prompting
;
3513 int minibuffer_only
;
3515 XClassHint class_hints
;
3516 XSetWindowAttributes attributes
;
3517 unsigned long attribute_mask
;
3518 Widget shell_widget
;
3520 Widget frame_widget
;
3526 /* Use the resource name as the top-level widget name
3527 for looking up resources. Make a non-Lisp copy
3528 for the window manager, so GC relocation won't bother it.
3530 Elsewhere we specify the window name for the window manager. */
3533 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3534 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3535 strcpy (f
->namebuf
, str
);
3539 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3540 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3541 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3542 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3543 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3544 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3545 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3546 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3547 applicationShellWidgetClass
,
3548 FRAME_X_DISPLAY (f
), al
, ac
);
3550 f
->output_data
.x
->widget
= shell_widget
;
3551 /* maybe_set_screen_title_format (shell_widget); */
3553 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3554 (widget_value
*) NULL
,
3555 shell_widget
, False
,
3559 (lw_callback
) NULL
);
3562 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3563 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3564 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3565 XtSetValues (pane_widget
, al
, ac
);
3566 f
->output_data
.x
->column_widget
= pane_widget
;
3568 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3569 the emacs screen when changing menubar. This reduces flickering. */
3572 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3573 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3574 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3575 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3576 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3577 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3578 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3579 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3580 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3583 f
->output_data
.x
->edit_widget
= frame_widget
;
3585 XtManageChild (frame_widget
);
3587 /* Do some needed geometry management. */
3590 char *tem
, shell_position
[32];
3593 int extra_borders
= 0;
3595 = (f
->output_data
.x
->menubar_widget
3596 ? (f
->output_data
.x
->menubar_widget
->core
.height
3597 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3600 #if 0 /* Experimentally, we now get the right results
3601 for -geometry -0-0 without this. 24 Aug 96, rms. */
3602 if (FRAME_EXTERNAL_MENU_BAR (f
))
3605 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3606 menubar_size
+= ibw
;
3610 f
->output_data
.x
->menubar_height
= menubar_size
;
3613 /* Motif seems to need this amount added to the sizes
3614 specified for the shell widget. The Athena/Lucid widgets don't.
3615 Both conclusions reached experimentally. -- rms. */
3616 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3617 &extra_borders
, NULL
);
3621 /* Convert our geometry parameters into a geometry string
3623 Note that we do not specify here whether the position
3624 is a user-specified or program-specified one.
3625 We pass that information later, in x_wm_set_size_hints. */
3627 int left
= f
->output_data
.x
->left_pos
;
3628 int xneg
= window_prompting
& XNegative
;
3629 int top
= f
->output_data
.x
->top_pos
;
3630 int yneg
= window_prompting
& YNegative
;
3636 if (window_prompting
& USPosition
)
3637 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3638 PIXEL_WIDTH (f
) + extra_borders
,
3639 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3640 (xneg
? '-' : '+'), left
,
3641 (yneg
? '-' : '+'), top
);
3643 sprintf (shell_position
, "=%dx%d",
3644 PIXEL_WIDTH (f
) + extra_borders
,
3645 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3648 len
= strlen (shell_position
) + 1;
3649 /* We don't free this because we don't know whether
3650 it is safe to free it while the frame exists.
3651 It isn't worth the trouble of arranging to free it
3652 when the frame is deleted. */
3653 tem
= (char *) xmalloc (len
);
3654 strncpy (tem
, shell_position
, len
);
3655 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3656 XtSetValues (shell_widget
, al
, ac
);
3659 XtManageChild (pane_widget
);
3660 XtRealizeWidget (shell_widget
);
3662 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3664 validate_x_resource_name ();
3666 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3667 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3668 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3671 FRAME_XIC (f
) = NULL
;
3673 create_frame_xic (f
);
3677 f
->output_data
.x
->wm_hints
.input
= True
;
3678 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3679 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3680 &f
->output_data
.x
->wm_hints
);
3682 hack_wm_protocols (f
, shell_widget
);
3685 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3688 /* Do a stupid property change to force the server to generate a
3689 PropertyNotify event so that the event_stream server timestamp will
3690 be initialized to something relevant to the time we created the window.
3692 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3693 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3694 XA_ATOM
, 32, PropModeAppend
,
3695 (unsigned char*) NULL
, 0);
3697 /* Make all the standard events reach the Emacs frame. */
3698 attributes
.event_mask
= STANDARD_EVENT_SET
;
3703 /* XIM server might require some X events. */
3704 unsigned long fevent
= NoEventMask
;
3705 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3706 attributes
.event_mask
|= fevent
;
3708 #endif /* HAVE_X_I18N */
3710 attribute_mask
= CWEventMask
;
3711 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3712 attribute_mask
, &attributes
);
3714 XtMapWidget (frame_widget
);
3716 /* x_set_name normally ignores requests to set the name if the
3717 requested name is the same as the current name. This is the one
3718 place where that assumption isn't correct; f->name is set, but
3719 the X server hasn't been told. */
3722 int explicit = f
->explicit_name
;
3724 f
->explicit_name
= 0;
3727 x_set_name (f
, name
, explicit);
3730 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3731 f
->output_data
.x
->text_cursor
);
3735 /* This is a no-op, except under Motif. Make sure main areas are
3736 set to something reasonable, in case we get an error later. */
3737 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3740 #else /* not USE_X_TOOLKIT */
3742 /* Create and set up the X window for frame F. */
3749 XClassHint class_hints
;
3750 XSetWindowAttributes attributes
;
3751 unsigned long attribute_mask
;
3753 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3754 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3755 attributes
.bit_gravity
= StaticGravity
;
3756 attributes
.backing_store
= NotUseful
;
3757 attributes
.save_under
= True
;
3758 attributes
.event_mask
= STANDARD_EVENT_SET
;
3759 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3760 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3765 = XCreateWindow (FRAME_X_DISPLAY (f
),
3766 f
->output_data
.x
->parent_desc
,
3767 f
->output_data
.x
->left_pos
,
3768 f
->output_data
.x
->top_pos
,
3769 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3770 f
->output_data
.x
->border_width
,
3771 CopyFromParent
, /* depth */
3772 InputOutput
, /* class */
3774 attribute_mask
, &attributes
);
3778 create_frame_xic (f
);
3781 /* XIM server might require some X events. */
3782 unsigned long fevent
= NoEventMask
;
3783 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3784 attributes
.event_mask
|= fevent
;
3785 attribute_mask
= CWEventMask
;
3786 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3787 attribute_mask
, &attributes
);
3790 #endif /* HAVE_X_I18N */
3792 validate_x_resource_name ();
3794 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3795 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3796 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3798 /* The menubar is part of the ordinary display;
3799 it does not count in addition to the height of the window. */
3800 f
->output_data
.x
->menubar_height
= 0;
3802 /* This indicates that we use the "Passive Input" input model.
3803 Unless we do this, we don't get the Focus{In,Out} events that we
3804 need to draw the cursor correctly. Accursed bureaucrats.
3805 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3807 f
->output_data
.x
->wm_hints
.input
= True
;
3808 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3809 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3810 &f
->output_data
.x
->wm_hints
);
3811 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3813 /* Request "save yourself" and "delete window" commands from wm. */
3816 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3817 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3818 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3821 /* x_set_name normally ignores requests to set the name if the
3822 requested name is the same as the current name. This is the one
3823 place where that assumption isn't correct; f->name is set, but
3824 the X server hasn't been told. */
3827 int explicit = f
->explicit_name
;
3829 f
->explicit_name
= 0;
3832 x_set_name (f
, name
, explicit);
3835 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3836 f
->output_data
.x
->text_cursor
);
3840 if (FRAME_X_WINDOW (f
) == 0)
3841 error ("Unable to create window");
3844 #endif /* not USE_X_TOOLKIT */
3846 /* Handle the icon stuff for this window. Perhaps later we might
3847 want an x_set_icon_position which can be called interactively as
3855 Lisp_Object icon_x
, icon_y
;
3856 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3858 /* Set the position of the icon. Note that twm groups all
3859 icons in an icon window. */
3860 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3861 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3862 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3864 CHECK_NUMBER (icon_x
, 0);
3865 CHECK_NUMBER (icon_y
, 0);
3867 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3868 error ("Both left and top icon corners of icon must be specified");
3872 if (! EQ (icon_x
, Qunbound
))
3873 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3875 /* Start up iconic or window? */
3876 x_wm_set_window_state
3877 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3882 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3889 /* Make the GCs needed for this window, setting the
3890 background, border and mouse colors; also create the
3891 mouse cursor and the gray border tile. */
3893 static char cursor_bits
[] =
3895 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3896 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3897 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3898 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3905 XGCValues gc_values
;
3909 /* Create the GCs of this frame.
3910 Note that many default values are used. */
3913 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3914 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3915 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3916 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3917 f
->output_data
.x
->normal_gc
3918 = XCreateGC (FRAME_X_DISPLAY (f
),
3920 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
3923 /* Reverse video style. */
3924 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3925 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3926 f
->output_data
.x
->reverse_gc
3927 = XCreateGC (FRAME_X_DISPLAY (f
),
3929 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
3932 /* Cursor has cursor-color background, background-color foreground. */
3933 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3934 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3935 gc_values
.fill_style
= FillOpaqueStippled
;
3937 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3938 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3939 cursor_bits
, 16, 16);
3940 f
->output_data
.x
->cursor_gc
3941 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3942 (GCFont
| GCForeground
| GCBackground
3943 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3947 f
->output_data
.x
->white_relief
.gc
= 0;
3948 f
->output_data
.x
->black_relief
.gc
= 0;
3950 /* Create the gray border tile used when the pointer is not in
3951 the frame. Since this depends on the frame's pixel values,
3952 this must be done on a per-frame basis. */
3953 f
->output_data
.x
->border_tile
3954 = (XCreatePixmapFromBitmapData
3955 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3956 gray_bits
, gray_width
, gray_height
,
3957 f
->output_data
.x
->foreground_pixel
,
3958 f
->output_data
.x
->background_pixel
,
3959 DefaultDepth (FRAME_X_DISPLAY (f
),
3960 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3966 /* Free what was was allocated in x_make_gc. */
3972 Display
*dpy
= FRAME_X_DISPLAY (f
);
3976 if (f
->output_data
.x
->normal_gc
)
3978 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
3979 f
->output_data
.x
->normal_gc
= 0;
3982 if (f
->output_data
.x
->reverse_gc
)
3984 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
3985 f
->output_data
.x
->reverse_gc
= 0;
3988 if (f
->output_data
.x
->cursor_gc
)
3990 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
3991 f
->output_data
.x
->cursor_gc
= 0;
3994 if (f
->output_data
.x
->border_tile
)
3996 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
3997 f
->output_data
.x
->border_tile
= 0;
4004 /* Handler for signals raised during x_create_frame and
4005 x_create_top_frame. FRAME is the frame which is partially
4009 unwind_create_frame (frame
)
4012 struct frame
*f
= XFRAME (frame
);
4014 /* If frame is ``official'', nothing to do. */
4015 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4018 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4021 x_free_frame_resources (f
);
4023 /* Check that reference counts are indeed correct. */
4024 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4025 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4033 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4035 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
4036 Returns an Emacs frame object.\n\
4037 ALIST is an alist of frame parameters.\n\
4038 If the parameters specify that the frame should not have a minibuffer,\n\
4039 and do not specify a specific minibuffer window to use,\n\
4040 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4041 be shared by the new frame.\n\
4043 This function is an internal primitive--use `make-frame' instead.")
4048 Lisp_Object frame
, tem
;
4050 int minibuffer_only
= 0;
4051 long window_prompting
= 0;
4053 int count
= BINDING_STACK_SIZE ();
4054 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4055 Lisp_Object display
;
4056 struct x_display_info
*dpyinfo
= NULL
;
4062 /* Use this general default value to start with
4063 until we know if this frame has a specified name. */
4064 Vx_resource_name
= Vinvocation_name
;
4066 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4067 if (EQ (display
, Qunbound
))
4069 dpyinfo
= check_x_display_info (display
);
4071 kb
= dpyinfo
->kboard
;
4073 kb
= &the_only_kboard
;
4076 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4078 && ! EQ (name
, Qunbound
)
4080 error ("Invalid frame name--not a string or nil");
4083 Vx_resource_name
= name
;
4085 /* See if parent window is specified. */
4086 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4087 if (EQ (parent
, Qunbound
))
4089 if (! NILP (parent
))
4090 CHECK_NUMBER (parent
, 0);
4092 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4093 /* No need to protect DISPLAY because that's not used after passing
4094 it to make_frame_without_minibuffer. */
4096 GCPRO4 (parms
, parent
, name
, frame
);
4097 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4099 if (EQ (tem
, Qnone
) || NILP (tem
))
4100 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4101 else if (EQ (tem
, Qonly
))
4103 f
= make_minibuffer_frame ();
4104 minibuffer_only
= 1;
4106 else if (WINDOWP (tem
))
4107 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4111 XSETFRAME (frame
, f
);
4113 /* Note that X Windows does support scroll bars. */
4114 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4116 f
->output_method
= output_x_window
;
4117 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4118 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4119 f
->output_data
.x
->icon_bitmap
= -1;
4120 f
->output_data
.x
->fontset
= -1;
4121 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4122 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4123 record_unwind_protect (unwind_create_frame
, frame
);
4126 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4128 if (! STRINGP (f
->icon_name
))
4129 f
->icon_name
= Qnil
;
4131 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4133 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4134 dpyinfo_refcount
= dpyinfo
->reference_count
;
4135 #endif /* GLYPH_DEBUG */
4137 FRAME_KBOARD (f
) = kb
;
4140 /* These colors will be set anyway later, but it's important
4141 to get the color reference counts right, so initialize them! */
4144 struct gcpro gcpro1
;
4146 black
= build_string ("black");
4148 f
->output_data
.x
->foreground_pixel
4149 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4150 f
->output_data
.x
->background_pixel
4151 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4152 f
->output_data
.x
->cursor_pixel
4153 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4154 f
->output_data
.x
->cursor_foreground_pixel
4155 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4156 f
->output_data
.x
->border_pixel
4157 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4158 f
->output_data
.x
->mouse_pixel
4159 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4163 /* Specify the parent under which to make this X window. */
4167 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4168 f
->output_data
.x
->explicit_parent
= 1;
4172 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4173 f
->output_data
.x
->explicit_parent
= 0;
4176 /* Set the name; the functions to which we pass f expect the name to
4178 if (EQ (name
, Qunbound
) || NILP (name
))
4180 f
->name
= build_string (dpyinfo
->x_id_name
);
4181 f
->explicit_name
= 0;
4186 f
->explicit_name
= 1;
4187 /* use the frame's title when getting resources for this frame. */
4188 specbind (Qx_resource_name
, name
);
4191 /* Extract the window parameters from the supplied values
4192 that are needed to determine window geometry. */
4196 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4199 /* First, try whatever font the caller has specified. */
4202 tem
= Fquery_fontset (font
, Qnil
);
4204 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4206 font
= x_new_font (f
, XSTRING (font
)->data
);
4209 /* Try out a font which we hope has bold and italic variations. */
4210 if (!STRINGP (font
))
4211 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4212 if (!STRINGP (font
))
4213 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4214 if (! STRINGP (font
))
4215 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4216 if (! STRINGP (font
))
4217 /* This was formerly the first thing tried, but it finds too many fonts
4218 and takes too long. */
4219 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4220 /* If those didn't work, look for something which will at least work. */
4221 if (! STRINGP (font
))
4222 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4224 if (! STRINGP (font
))
4225 font
= build_string ("fixed");
4227 x_default_parameter (f
, parms
, Qfont
, font
,
4228 "font", "Font", RES_TYPE_STRING
);
4232 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4233 whereby it fails to get any font. */
4234 xlwmenu_default_font
= f
->output_data
.x
->font
;
4237 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4238 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4240 /* This defaults to 2 in order to match xterm. We recognize either
4241 internalBorderWidth or internalBorder (which is what xterm calls
4243 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4247 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4248 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4249 if (! EQ (value
, Qunbound
))
4250 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4253 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4254 "internalBorderWidth", "internalBorderWidth",
4256 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4257 "verticalScrollBars", "ScrollBars",
4260 /* Also do the stuff which must be set before the window exists. */
4261 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4262 "foreground", "Foreground", RES_TYPE_STRING
);
4263 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4264 "background", "Background", RES_TYPE_STRING
);
4265 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4266 "pointerColor", "Foreground", RES_TYPE_STRING
);
4267 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4268 "cursorColor", "Foreground", RES_TYPE_STRING
);
4269 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4270 "borderColor", "BorderColor", RES_TYPE_STRING
);
4271 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4272 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4273 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4274 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4276 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4277 "scrollBarForeground",
4278 "ScrollBarForeground", 1);
4279 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4280 "scrollBarBackground",
4281 "ScrollBarBackground", 0);
4283 /* Init faces before x_default_parameter is called for scroll-bar
4284 parameters because that function calls x_set_scroll_bar_width,
4285 which calls change_frame_size, which calls Fset_window_buffer,
4286 which runs hooks, which call Fvertical_motion. At the end, we
4287 end up in init_iterator with a null face cache, which should not
4289 init_frame_faces (f
);
4291 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4292 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4293 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4294 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4295 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4296 "bufferPredicate", "BufferPredicate",
4298 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4299 "title", "Title", RES_TYPE_STRING
);
4301 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4302 window_prompting
= x_figure_window_size (f
, parms
);
4304 if (window_prompting
& XNegative
)
4306 if (window_prompting
& YNegative
)
4307 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4309 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4313 if (window_prompting
& YNegative
)
4314 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4316 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4319 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4321 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4322 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4324 /* Create the X widget or window. */
4325 #ifdef USE_X_TOOLKIT
4326 x_window (f
, window_prompting
, minibuffer_only
);
4334 /* Now consider the frame official. */
4335 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4336 Vframe_list
= Fcons (frame
, Vframe_list
);
4338 /* We need to do this after creating the X window, so that the
4339 icon-creation functions can say whose icon they're describing. */
4340 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4341 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4343 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4344 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4345 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4346 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4347 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4348 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4349 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4350 "scrollBarWidth", "ScrollBarWidth",
4353 /* Dimensions, especially f->height, must be done via change_frame_size.
4354 Change will not be effected unless different from the current
4359 /* Add the tool-bar height to the initial frame height so that the
4360 user gets a text display area of the size he specified with -g or
4361 via .Xdefaults. Later changes of the tool-bar height don't
4362 change the frame size. This is done so that users can create
4363 tall Emacs frames without having to guess how tall the tool-bar
4365 if (FRAME_TOOL_BAR_LINES (f
))
4367 int margin
, relief
, bar_height
;
4369 relief
= (tool_bar_button_relief
> 0
4370 ? tool_bar_button_relief
4371 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4373 if (INTEGERP (Vtool_bar_button_margin
)
4374 && XINT (Vtool_bar_button_margin
) > 0)
4375 margin
= XFASTINT (Vtool_bar_button_margin
);
4376 else if (CONSP (Vtool_bar_button_margin
)
4377 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4378 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4379 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4383 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4384 height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4388 SET_FRAME_WIDTH (f
, 0);
4389 change_frame_size (f
, height
, width
, 1, 0, 0);
4391 /* Set up faces after all frame parameters are known. This call
4392 also merges in face attributes specified for new frames. If we
4393 don't do this, the `menu' face for instance won't have the right
4394 colors, and the menu bar won't appear in the specified colors for
4396 call1 (Qface_set_after_frame_default
, frame
);
4398 #ifdef USE_X_TOOLKIT
4399 /* Create the menu bar. */
4400 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4402 /* If this signals an error, we haven't set size hints for the
4403 frame and we didn't make it visible. */
4404 initialize_frame_menubar (f
);
4406 /* This is a no-op, except under Motif where it arranges the
4407 main window for the widgets on it. */
4408 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4409 f
->output_data
.x
->menubar_widget
,
4410 f
->output_data
.x
->edit_widget
);
4412 #endif /* USE_X_TOOLKIT */
4414 /* Tell the server what size and position, etc, we want, and how
4415 badly we want them. This should be done after we have the menu
4416 bar so that its size can be taken into account. */
4418 x_wm_set_size_hint (f
, window_prompting
, 0);
4421 /* Make the window appear on the frame and enable display, unless
4422 the caller says not to. However, with explicit parent, Emacs
4423 cannot control visibility, so don't try. */
4424 if (! f
->output_data
.x
->explicit_parent
)
4426 Lisp_Object visibility
;
4428 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4430 if (EQ (visibility
, Qunbound
))
4433 if (EQ (visibility
, Qicon
))
4434 x_iconify_frame (f
);
4435 else if (! NILP (visibility
))
4436 x_make_frame_visible (f
);
4438 /* Must have been Qnil. */
4443 return unbind_to (count
, frame
);
4447 /* FRAME is used only to get a handle on the X display. We don't pass the
4448 display info directly because we're called from frame.c, which doesn't
4449 know about that structure. */
4452 x_get_focus_frame (frame
)
4453 struct frame
*frame
;
4455 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4457 if (! dpyinfo
->x_focus_frame
)
4460 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4465 /* In certain situations, when the window manager follows a
4466 click-to-focus policy, there seems to be no way around calling
4467 XSetInputFocus to give another frame the input focus .
4469 In an ideal world, XSetInputFocus should generally be avoided so
4470 that applications don't interfere with the window manager's focus
4471 policy. But I think it's okay to use when it's clearly done
4472 following a user-command. */
4474 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4475 "Set the input focus to FRAME.\n\
4476 FRAME nil means use the selected frame.")
4480 struct frame
*f
= check_x_frame (frame
);
4481 Display
*dpy
= FRAME_X_DISPLAY (f
);
4485 count
= x_catch_errors (dpy
);
4486 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4487 RevertToParent
, CurrentTime
);
4488 x_uncatch_errors (dpy
, count
);
4495 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4496 "Internal function called by `color-defined-p', which see.")
4498 Lisp_Object color
, frame
;
4501 FRAME_PTR f
= check_x_frame (frame
);
4503 CHECK_STRING (color
, 1);
4505 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4511 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4512 "Internal function called by `color-values', which see.")
4514 Lisp_Object color
, frame
;
4517 FRAME_PTR f
= check_x_frame (frame
);
4519 CHECK_STRING (color
, 1);
4521 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4525 rgb
[0] = make_number (foo
.red
);
4526 rgb
[1] = make_number (foo
.green
);
4527 rgb
[2] = make_number (foo
.blue
);
4528 return Flist (3, rgb
);
4534 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4535 "Internal function called by `display-color-p', which see.")
4537 Lisp_Object display
;
4539 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4541 if (dpyinfo
->n_planes
<= 2)
4544 switch (dpyinfo
->visual
->class)
4557 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4559 "Return t if the X display supports shades of gray.\n\
4560 Note that color displays do support shades of gray.\n\
4561 The optional argument DISPLAY specifies which display to ask about.\n\
4562 DISPLAY should be either a frame or a display name (a string).\n\
4563 If omitted or nil, that stands for the selected frame's display.")
4565 Lisp_Object display
;
4567 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4569 if (dpyinfo
->n_planes
<= 1)
4572 switch (dpyinfo
->visual
->class)
4587 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4589 "Returns the width in pixels of the X display DISPLAY.\n\
4590 The optional argument DISPLAY specifies which display to ask about.\n\
4591 DISPLAY should be either a frame or a display name (a string).\n\
4592 If omitted or nil, that stands for the selected frame's display.")
4594 Lisp_Object display
;
4596 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4598 return make_number (dpyinfo
->width
);
4601 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4602 Sx_display_pixel_height
, 0, 1, 0,
4603 "Returns the height in pixels of the X display DISPLAY.\n\
4604 The optional argument DISPLAY specifies which display to ask about.\n\
4605 DISPLAY should be either a frame or a display name (a string).\n\
4606 If omitted or nil, that stands for the selected frame's display.")
4608 Lisp_Object display
;
4610 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4612 return make_number (dpyinfo
->height
);
4615 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4617 "Returns the number of bitplanes of the X display DISPLAY.\n\
4618 The optional argument DISPLAY specifies which display to ask about.\n\
4619 DISPLAY should be either a frame or a display name (a string).\n\
4620 If omitted or nil, that stands for the selected frame's display.")
4622 Lisp_Object display
;
4624 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4626 return make_number (dpyinfo
->n_planes
);
4629 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4631 "Returns the number of color cells of the X display DISPLAY.\n\
4632 The optional argument DISPLAY specifies which display to ask about.\n\
4633 DISPLAY should be either a frame or a display name (a string).\n\
4634 If omitted or nil, that stands for the selected frame's display.")
4636 Lisp_Object display
;
4638 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4640 return make_number (DisplayCells (dpyinfo
->display
,
4641 XScreenNumberOfScreen (dpyinfo
->screen
)));
4644 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4645 Sx_server_max_request_size
,
4647 "Returns the maximum request size of the X server of display DISPLAY.\n\
4648 The optional argument DISPLAY specifies which display to ask about.\n\
4649 DISPLAY should be either a frame or a display name (a string).\n\
4650 If omitted or nil, that stands for the selected frame's display.")
4652 Lisp_Object display
;
4654 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4656 return make_number (MAXREQUEST (dpyinfo
->display
));
4659 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4660 "Returns the vendor ID string 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
);
4668 char *vendor
= ServerVendor (dpyinfo
->display
);
4670 if (! vendor
) vendor
= "";
4671 return build_string (vendor
);
4674 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4675 "Returns the version numbers of the X server of display DISPLAY.\n\
4676 The value is a list of three integers: the major and minor\n\
4677 version numbers of the X Protocol in use, and the vendor-specific release\n\
4678 number. See also the function `x-server-vendor'.\n\n\
4679 The optional argument DISPLAY specifies which display to ask about.\n\
4680 DISPLAY should be either a frame or a display name (a string).\n\
4681 If omitted or nil, that stands for the selected frame's display.")
4683 Lisp_Object display
;
4685 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4686 Display
*dpy
= dpyinfo
->display
;
4688 return Fcons (make_number (ProtocolVersion (dpy
)),
4689 Fcons (make_number (ProtocolRevision (dpy
)),
4690 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4693 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4694 "Returns the number of screens on the X server of display DISPLAY.\n\
4695 The optional argument DISPLAY specifies which display to ask about.\n\
4696 DISPLAY should be either a frame or a display name (a string).\n\
4697 If omitted or nil, that stands for the selected frame's display.")
4699 Lisp_Object display
;
4701 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4703 return make_number (ScreenCount (dpyinfo
->display
));
4706 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4707 "Returns the height in millimeters of the X 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 (HeightMMOfScreen (dpyinfo
->screen
));
4719 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4720 "Returns the width 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 (WidthMMOfScreen (dpyinfo
->screen
));
4732 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4733 Sx_display_backing_store
, 0, 1, 0,
4734 "Returns an indication of whether X display DISPLAY does backing store.\n\
4735 The value may be `always', `when-mapped', or `not-useful'.\n\
4736 The optional argument DISPLAY specifies which display to ask about.\n\
4737 DISPLAY should be either a frame or a display name (a string).\n\
4738 If omitted or nil, that stands for the selected frame's display.")
4740 Lisp_Object display
;
4742 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4745 switch (DoesBackingStore (dpyinfo
->screen
))
4748 result
= intern ("always");
4752 result
= intern ("when-mapped");
4756 result
= intern ("not-useful");
4760 error ("Strange value for BackingStore parameter of screen");
4767 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4768 Sx_display_visual_class
, 0, 1, 0,
4769 "Returns the visual class of the X display DISPLAY.\n\
4770 The value is one of the symbols `static-gray', `gray-scale',\n\
4771 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4772 The optional argument DISPLAY specifies which display to ask about.\n\
4773 DISPLAY should be either a frame or a display name (a string).\n\
4774 If omitted or nil, that stands for the selected frame's display.")
4776 Lisp_Object display
;
4778 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4781 switch (dpyinfo
->visual
->class)
4784 result
= intern ("static-gray");
4787 result
= intern ("gray-scale");
4790 result
= intern ("static-color");
4793 result
= intern ("pseudo-color");
4796 result
= intern ("true-color");
4799 result
= intern ("direct-color");
4802 error ("Display has an unknown visual class");
4809 DEFUN ("x-display-save-under", Fx_display_save_under
,
4810 Sx_display_save_under
, 0, 1, 0,
4811 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4812 The optional argument DISPLAY specifies which display to ask about.\n\
4813 DISPLAY should be either a frame or a display name (a string).\n\
4814 If omitted or nil, that stands for the selected frame's display.")
4816 Lisp_Object display
;
4818 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4820 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4828 register struct frame
*f
;
4830 return PIXEL_WIDTH (f
);
4835 register struct frame
*f
;
4837 return PIXEL_HEIGHT (f
);
4842 register struct frame
*f
;
4844 return FONT_WIDTH (f
->output_data
.x
->font
);
4849 register struct frame
*f
;
4851 return f
->output_data
.x
->line_height
;
4856 register struct frame
*f
;
4858 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4863 /************************************************************************
4865 ************************************************************************/
4868 /* Mapping visual names to visuals. */
4870 static struct visual_class
4877 {"StaticGray", StaticGray
},
4878 {"GrayScale", GrayScale
},
4879 {"StaticColor", StaticColor
},
4880 {"PseudoColor", PseudoColor
},
4881 {"TrueColor", TrueColor
},
4882 {"DirectColor", DirectColor
},
4887 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4889 /* Value is the screen number of screen SCR. This is a substitute for
4890 the X function with the same name when that doesn't exist. */
4893 XScreenNumberOfScreen (scr
)
4894 register Screen
*scr
;
4896 Display
*dpy
= scr
->display
;
4899 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4900 if (scr
== dpy
->screens
[i
])
4906 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4909 /* Select the visual that should be used on display DPYINFO. Set
4910 members of DPYINFO appropriately. Called from x_term_init. */
4913 select_visual (dpyinfo
)
4914 struct x_display_info
*dpyinfo
;
4916 Display
*dpy
= dpyinfo
->display
;
4917 Screen
*screen
= dpyinfo
->screen
;
4920 /* See if a visual is specified. */
4921 value
= display_x_get_resource (dpyinfo
,
4922 build_string ("visualClass"),
4923 build_string ("VisualClass"),
4925 if (STRINGP (value
))
4927 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4928 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4929 depth, a decimal number. NAME is compared with case ignored. */
4930 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4935 strcpy (s
, XSTRING (value
)->data
);
4936 dash
= index (s
, '-');
4939 dpyinfo
->n_planes
= atoi (dash
+ 1);
4943 /* We won't find a matching visual with depth 0, so that
4944 an error will be printed below. */
4945 dpyinfo
->n_planes
= 0;
4947 /* Determine the visual class. */
4948 for (i
= 0; visual_classes
[i
].name
; ++i
)
4949 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4951 class = visual_classes
[i
].class;
4955 /* Look up a matching visual for the specified class. */
4957 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4958 dpyinfo
->n_planes
, class, &vinfo
))
4959 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4961 dpyinfo
->visual
= vinfo
.visual
;
4966 XVisualInfo
*vinfo
, vinfo_template
;
4968 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
4971 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
4973 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
4975 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4976 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
4977 &vinfo_template
, &n_visuals
);
4979 fatal ("Can't get proper X visual info");
4981 dpyinfo
->n_planes
= vinfo
->depth
;
4982 XFree ((char *) vinfo
);
4987 /* Return the X display structure for the display named NAME.
4988 Open a new connection if necessary. */
4990 struct x_display_info
*
4991 x_display_info_for_name (name
)
4995 struct x_display_info
*dpyinfo
;
4997 CHECK_STRING (name
, 0);
4999 if (! EQ (Vwindow_system
, intern ("x")))
5000 error ("Not using X Windows");
5002 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5004 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5007 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5012 /* Use this general default value to start with. */
5013 Vx_resource_name
= Vinvocation_name
;
5015 validate_x_resource_name ();
5017 dpyinfo
= x_term_init (name
, (char *)0,
5018 (char *) XSTRING (Vx_resource_name
)->data
);
5021 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5024 XSETFASTINT (Vwindow_system_version
, 11);
5030 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5031 1, 3, 0, "Open a connection to an X server.\n\
5032 DISPLAY is the name of the display to connect to.\n\
5033 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5034 If the optional third arg MUST-SUCCEED is non-nil,\n\
5035 terminate Emacs if we can't open the connection.")
5036 (display
, xrm_string
, must_succeed
)
5037 Lisp_Object display
, xrm_string
, must_succeed
;
5039 unsigned char *xrm_option
;
5040 struct x_display_info
*dpyinfo
;
5042 CHECK_STRING (display
, 0);
5043 if (! NILP (xrm_string
))
5044 CHECK_STRING (xrm_string
, 1);
5046 if (! EQ (Vwindow_system
, intern ("x")))
5047 error ("Not using X Windows");
5049 if (! NILP (xrm_string
))
5050 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5052 xrm_option
= (unsigned char *) 0;
5054 validate_x_resource_name ();
5056 /* This is what opens the connection and sets x_current_display.
5057 This also initializes many symbols, such as those used for input. */
5058 dpyinfo
= x_term_init (display
, xrm_option
,
5059 (char *) XSTRING (Vx_resource_name
)->data
);
5063 if (!NILP (must_succeed
))
5064 fatal ("Cannot connect to X server %s.\n\
5065 Check the DISPLAY environment variable or use `-d'.\n\
5066 Also use the `xhost' program to verify that it is set to permit\n\
5067 connections from your machine.\n",
5068 XSTRING (display
)->data
);
5070 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5075 XSETFASTINT (Vwindow_system_version
, 11);
5079 DEFUN ("x-close-connection", Fx_close_connection
,
5080 Sx_close_connection
, 1, 1, 0,
5081 "Close the connection to DISPLAY's X server.\n\
5082 For DISPLAY, specify either a frame or a display name (a string).\n\
5083 If DISPLAY is nil, that stands for the selected frame's display.")
5085 Lisp_Object display
;
5087 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5090 if (dpyinfo
->reference_count
> 0)
5091 error ("Display still has frames on it");
5094 /* Free the fonts in the font table. */
5095 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5096 if (dpyinfo
->font_table
[i
].name
)
5098 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5099 xfree (dpyinfo
->font_table
[i
].full_name
);
5100 xfree (dpyinfo
->font_table
[i
].name
);
5101 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5104 x_destroy_all_bitmaps (dpyinfo
);
5105 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5107 #ifdef USE_X_TOOLKIT
5108 XtCloseDisplay (dpyinfo
->display
);
5110 XCloseDisplay (dpyinfo
->display
);
5113 x_delete_display (dpyinfo
);
5119 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5120 "Return the list of display names that Emacs has connections to.")
5123 Lisp_Object tail
, result
;
5126 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5127 result
= Fcons (XCAR (XCAR (tail
)), result
);
5132 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5133 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5134 If ON is nil, allow buffering of requests.\n\
5135 Turning on synchronization prohibits the Xlib routines from buffering\n\
5136 requests and seriously degrades performance, but makes debugging much\n\
5138 The optional second argument DISPLAY specifies which display to act on.\n\
5139 DISPLAY should be either a frame or a display name (a string).\n\
5140 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5142 Lisp_Object display
, on
;
5144 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5146 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5151 /* Wait for responses to all X commands issued so far for frame F. */
5158 XSync (FRAME_X_DISPLAY (f
), False
);
5163 /***********************************************************************
5165 ***********************************************************************/
5167 /* Value is the number of elements of vector VECTOR. */
5169 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5171 /* List of supported image types. Use define_image_type to add new
5172 types. Use lookup_image_type to find a type for a given symbol. */
5174 static struct image_type
*image_types
;
5176 /* The symbol `image' which is the car of the lists used to represent
5179 extern Lisp_Object Qimage
;
5181 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5187 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5188 extern Lisp_Object QCdata
;
5189 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5190 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5191 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5193 /* Other symbols. */
5195 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5197 /* Time in seconds after which images should be removed from the cache
5198 if not displayed. */
5200 Lisp_Object Vimage_cache_eviction_delay
;
5202 /* Function prototypes. */
5204 static void define_image_type
P_ ((struct image_type
*type
));
5205 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5206 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5207 static void x_laplace
P_ ((struct frame
*, struct image
*));
5208 static void x_emboss
P_ ((struct frame
*, struct image
*));
5209 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5213 /* Define a new image type from TYPE. This adds a copy of TYPE to
5214 image_types and adds the symbol *TYPE->type to Vimage_types. */
5217 define_image_type (type
)
5218 struct image_type
*type
;
5220 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5221 The initialized data segment is read-only. */
5222 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5223 bcopy (type
, p
, sizeof *p
);
5224 p
->next
= image_types
;
5226 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5230 /* Look up image type SYMBOL, and return a pointer to its image_type
5231 structure. Value is null if SYMBOL is not a known image type. */
5233 static INLINE
struct image_type
*
5234 lookup_image_type (symbol
)
5237 struct image_type
*type
;
5239 for (type
= image_types
; type
; type
= type
->next
)
5240 if (EQ (symbol
, *type
->type
))
5247 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5248 valid image specification is a list whose car is the symbol
5249 `image', and whose rest is a property list. The property list must
5250 contain a value for key `:type'. That value must be the name of a
5251 supported image type. The rest of the property list depends on the
5255 valid_image_p (object
)
5260 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5262 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5263 struct image_type
*type
= lookup_image_type (symbol
);
5266 valid_p
= type
->valid_p (object
);
5273 /* Log error message with format string FORMAT and argument ARG.
5274 Signaling an error, e.g. when an image cannot be loaded, is not a
5275 good idea because this would interrupt redisplay, and the error
5276 message display would lead to another redisplay. This function
5277 therefore simply displays a message. */
5280 image_error (format
, arg1
, arg2
)
5282 Lisp_Object arg1
, arg2
;
5284 add_to_log (format
, arg1
, arg2
);
5289 /***********************************************************************
5290 Image specifications
5291 ***********************************************************************/
5293 enum image_value_type
5295 IMAGE_DONT_CHECK_VALUE_TYPE
,
5298 IMAGE_POSITIVE_INTEGER_VALUE
,
5299 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5300 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5302 IMAGE_INTEGER_VALUE
,
5303 IMAGE_FUNCTION_VALUE
,
5308 /* Structure used when parsing image specifications. */
5310 struct image_keyword
5312 /* Name of keyword. */
5315 /* The type of value allowed. */
5316 enum image_value_type type
;
5318 /* Non-zero means key must be present. */
5321 /* Used to recognize duplicate keywords in a property list. */
5324 /* The value that was found. */
5329 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5331 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5334 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5335 has the format (image KEYWORD VALUE ...). One of the keyword/
5336 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5337 image_keywords structures of size NKEYWORDS describing other
5338 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5341 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5343 struct image_keyword
*keywords
;
5350 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5353 plist
= XCDR (spec
);
5354 while (CONSP (plist
))
5356 Lisp_Object key
, value
;
5358 /* First element of a pair must be a symbol. */
5360 plist
= XCDR (plist
);
5364 /* There must follow a value. */
5367 value
= XCAR (plist
);
5368 plist
= XCDR (plist
);
5370 /* Find key in KEYWORDS. Error if not found. */
5371 for (i
= 0; i
< nkeywords
; ++i
)
5372 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5378 /* Record that we recognized the keyword. If a keywords
5379 was found more than once, it's an error. */
5380 keywords
[i
].value
= value
;
5381 ++keywords
[i
].count
;
5383 if (keywords
[i
].count
> 1)
5386 /* Check type of value against allowed type. */
5387 switch (keywords
[i
].type
)
5389 case IMAGE_STRING_VALUE
:
5390 if (!STRINGP (value
))
5394 case IMAGE_SYMBOL_VALUE
:
5395 if (!SYMBOLP (value
))
5399 case IMAGE_POSITIVE_INTEGER_VALUE
:
5400 if (!INTEGERP (value
) || XINT (value
) <= 0)
5404 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5405 if (INTEGERP (value
) && XINT (value
) >= 0)
5408 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5409 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5413 case IMAGE_ASCENT_VALUE
:
5414 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5416 else if (INTEGERP (value
)
5417 && XINT (value
) >= 0
5418 && XINT (value
) <= 100)
5422 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5423 if (!INTEGERP (value
) || XINT (value
) < 0)
5427 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5430 case IMAGE_FUNCTION_VALUE
:
5431 value
= indirect_function (value
);
5433 || COMPILEDP (value
)
5434 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5438 case IMAGE_NUMBER_VALUE
:
5439 if (!INTEGERP (value
) && !FLOATP (value
))
5443 case IMAGE_INTEGER_VALUE
:
5444 if (!INTEGERP (value
))
5448 case IMAGE_BOOL_VALUE
:
5449 if (!NILP (value
) && !EQ (value
, Qt
))
5458 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5462 /* Check that all mandatory fields are present. */
5463 for (i
= 0; i
< nkeywords
; ++i
)
5464 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5467 return NILP (plist
);
5471 /* Return the value of KEY in image specification SPEC. Value is nil
5472 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5473 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5476 image_spec_value (spec
, key
, found
)
5477 Lisp_Object spec
, key
;
5482 xassert (valid_image_p (spec
));
5484 for (tail
= XCDR (spec
);
5485 CONSP (tail
) && CONSP (XCDR (tail
));
5486 tail
= XCDR (XCDR (tail
)))
5488 if (EQ (XCAR (tail
), key
))
5492 return XCAR (XCDR (tail
));
5502 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5503 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5504 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5505 size in canonical character units.\n\
5506 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5507 or omitted means use the selected frame.")
5508 (spec
, pixels
, frame
)
5509 Lisp_Object spec
, pixels
, frame
;
5514 if (valid_image_p (spec
))
5516 struct frame
*f
= check_x_frame (frame
);
5517 int id
= lookup_image (f
, spec
);
5518 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5519 int width
= img
->width
+ 2 * img
->hmargin
;
5520 int height
= img
->height
+ 2 * img
->vmargin
;
5523 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5524 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5526 size
= Fcons (make_number (width
), make_number (height
));
5529 error ("Invalid image specification");
5535 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5536 "Return t if image SPEC has a mask bitmap.\n\
5537 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5538 or omitted means use the selected frame.")
5540 Lisp_Object spec
, frame
;
5545 if (valid_image_p (spec
))
5547 struct frame
*f
= check_x_frame (frame
);
5548 int id
= lookup_image (f
, spec
);
5549 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5554 error ("Invalid image specification");
5561 /***********************************************************************
5562 Image type independent image structures
5563 ***********************************************************************/
5565 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5566 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5569 /* Allocate and return a new image structure for image specification
5570 SPEC. SPEC has a hash value of HASH. */
5572 static struct image
*
5573 make_image (spec
, hash
)
5577 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5579 xassert (valid_image_p (spec
));
5580 bzero (img
, sizeof *img
);
5581 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5582 xassert (img
->type
!= NULL
);
5584 img
->data
.lisp_val
= Qnil
;
5585 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5591 /* Free image IMG which was used on frame F, including its resources. */
5600 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5602 /* Remove IMG from the hash table of its cache. */
5604 img
->prev
->next
= img
->next
;
5606 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5609 img
->next
->prev
= img
->prev
;
5611 c
->images
[img
->id
] = NULL
;
5613 /* Free resources, then free IMG. */
5614 img
->type
->free (f
, img
);
5620 /* Prepare image IMG for display on frame F. Must be called before
5621 drawing an image. */
5624 prepare_image_for_display (f
, img
)
5630 /* We're about to display IMG, so set its timestamp to `now'. */
5632 img
->timestamp
= EMACS_SECS (t
);
5634 /* If IMG doesn't have a pixmap yet, load it now, using the image
5635 type dependent loader function. */
5636 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5637 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5641 /* Value is the number of pixels for the ascent of image IMG when
5642 drawn in face FACE. */
5645 image_ascent (img
, face
)
5649 int height
= img
->height
+ img
->vmargin
;
5652 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5655 /* This expression is arranged so that if the image can't be
5656 exactly centered, it will be moved slightly up. This is
5657 because a typical font is `top-heavy' (due to the presence
5658 uppercase letters), so the image placement should err towards
5659 being top-heavy too. It also just generally looks better. */
5660 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5662 ascent
= height
/ 2;
5665 ascent
= height
* img
->ascent
/ 100.0;
5672 /***********************************************************************
5673 Helper functions for X image types
5674 ***********************************************************************/
5676 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5678 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5679 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5681 Lisp_Object color_name
,
5682 unsigned long dflt
));
5685 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5686 free the pixmap if any. MASK_P non-zero means clear the mask
5687 pixmap if any. COLORS_P non-zero means free colors allocated for
5688 the image, if any. */
5691 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5694 int pixmap_p
, mask_p
, colors_p
;
5696 if (pixmap_p
&& img
->pixmap
)
5698 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5702 if (mask_p
&& img
->mask
)
5704 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5708 if (colors_p
&& img
->ncolors
)
5710 x_free_colors (f
, img
->colors
, img
->ncolors
);
5711 xfree (img
->colors
);
5717 /* Free X resources of image IMG which is used on frame F. */
5720 x_clear_image (f
, img
)
5725 x_clear_image_1 (f
, img
, 1, 1, 1);
5730 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5731 cannot be allocated, use DFLT. Add a newly allocated color to
5732 IMG->colors, so that it can be freed again. Value is the pixel
5735 static unsigned long
5736 x_alloc_image_color (f
, img
, color_name
, dflt
)
5739 Lisp_Object color_name
;
5743 unsigned long result
;
5745 xassert (STRINGP (color_name
));
5747 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5749 /* This isn't called frequently so we get away with simply
5750 reallocating the color vector to the needed size, here. */
5753 (unsigned long *) xrealloc (img
->colors
,
5754 img
->ncolors
* sizeof *img
->colors
);
5755 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5756 result
= color
.pixel
;
5766 /***********************************************************************
5768 ***********************************************************************/
5770 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5773 /* Return a new, initialized image cache that is allocated from the
5774 heap. Call free_image_cache to free an image cache. */
5776 struct image_cache
*
5779 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5782 bzero (c
, sizeof *c
);
5784 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5785 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5786 c
->buckets
= (struct image
**) xmalloc (size
);
5787 bzero (c
->buckets
, size
);
5792 /* Free image cache of frame F. Be aware that X frames share images
5796 free_image_cache (f
)
5799 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5804 /* Cache should not be referenced by any frame when freed. */
5805 xassert (c
->refcount
== 0);
5807 for (i
= 0; i
< c
->used
; ++i
)
5808 free_image (f
, c
->images
[i
]);
5812 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5817 /* Clear image cache of frame F. FORCE_P non-zero means free all
5818 images. FORCE_P zero means clear only images that haven't been
5819 displayed for some time. Should be called from time to time to
5820 reduce the number of loaded images. If image-eviction-seconds is
5821 non-nil, this frees images in the cache which weren't displayed for
5822 at least that many seconds. */
5825 clear_image_cache (f
, force_p
)
5829 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5831 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5838 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5840 /* Block input so that we won't be interrupted by a SIGIO
5841 while being in an inconsistent state. */
5844 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5846 struct image
*img
= c
->images
[i
];
5848 && (force_p
|| img
->timestamp
< old
))
5850 free_image (f
, img
);
5855 /* We may be clearing the image cache because, for example,
5856 Emacs was iconified for a longer period of time. In that
5857 case, current matrices may still contain references to
5858 images freed above. So, clear these matrices. */
5861 Lisp_Object tail
, frame
;
5863 FOR_EACH_FRAME (tail
, frame
)
5865 struct frame
*f
= XFRAME (frame
);
5867 && FRAME_X_IMAGE_CACHE (f
) == c
)
5868 clear_current_matrices (f
);
5871 ++windows_or_buffers_changed
;
5879 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5881 "Clear the image cache of FRAME.\n\
5882 FRAME nil or omitted means use the selected frame.\n\
5883 FRAME t means clear the image caches of all frames.")
5891 FOR_EACH_FRAME (tail
, frame
)
5892 if (FRAME_X_P (XFRAME (frame
)))
5893 clear_image_cache (XFRAME (frame
), 1);
5896 clear_image_cache (check_x_frame (frame
), 1);
5902 /* Return the id of image with Lisp specification SPEC on frame F.
5903 SPEC must be a valid Lisp image specification (see valid_image_p). */
5906 lookup_image (f
, spec
)
5910 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5914 struct gcpro gcpro1
;
5917 /* F must be a window-system frame, and SPEC must be a valid image
5919 xassert (FRAME_WINDOW_P (f
));
5920 xassert (valid_image_p (spec
));
5924 /* Look up SPEC in the hash table of the image cache. */
5925 hash
= sxhash (spec
, 0);
5926 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5928 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
5929 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
5932 /* If not found, create a new image and cache it. */
5936 img
= make_image (spec
, hash
);
5937 cache_image (f
, img
);
5938 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5940 /* If we can't load the image, and we don't have a width and
5941 height, use some arbitrary width and height so that we can
5942 draw a rectangle for it. */
5943 if (img
->load_failed_p
)
5947 value
= image_spec_value (spec
, QCwidth
, NULL
);
5948 img
->width
= (INTEGERP (value
)
5949 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
5950 value
= image_spec_value (spec
, QCheight
, NULL
);
5951 img
->height
= (INTEGERP (value
)
5952 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
5956 /* Handle image type independent image attributes
5957 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
5958 Lisp_Object ascent
, margin
, relief
;
5960 ascent
= image_spec_value (spec
, QCascent
, NULL
);
5961 if (INTEGERP (ascent
))
5962 img
->ascent
= XFASTINT (ascent
);
5963 else if (EQ (ascent
, Qcenter
))
5964 img
->ascent
= CENTERED_IMAGE_ASCENT
;
5966 margin
= image_spec_value (spec
, QCmargin
, NULL
);
5967 if (INTEGERP (margin
) && XINT (margin
) >= 0)
5968 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
5969 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
5970 && INTEGERP (XCDR (margin
)))
5972 if (XINT (XCAR (margin
)) > 0)
5973 img
->hmargin
= XFASTINT (XCAR (margin
));
5974 if (XINT (XCDR (margin
)) > 0)
5975 img
->vmargin
= XFASTINT (XCDR (margin
));
5978 relief
= image_spec_value (spec
, QCrelief
, NULL
);
5979 if (INTEGERP (relief
))
5981 img
->relief
= XINT (relief
);
5982 img
->hmargin
+= abs (img
->relief
);
5983 img
->vmargin
+= abs (img
->relief
);
5986 /* Manipulation of the image's mask. */
5989 /* `:heuristic-mask t'
5991 means build a mask heuristically.
5992 `:heuristic-mask (R G B)'
5993 `:mask (heuristic (R G B))'
5994 means build a mask from color (R G B) in the
5997 means remove a mask, if any. */
6001 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6003 x_build_heuristic_mask (f
, img
, mask
);
6008 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6010 if (EQ (mask
, Qheuristic
))
6011 x_build_heuristic_mask (f
, img
, Qt
);
6012 else if (CONSP (mask
)
6013 && EQ (XCAR (mask
), Qheuristic
))
6015 if (CONSP (XCDR (mask
)))
6016 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6018 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6020 else if (NILP (mask
) && found_p
&& img
->mask
)
6022 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6028 /* Should we apply an image transformation algorithm? */
6031 Lisp_Object conversion
;
6033 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6034 if (EQ (conversion
, Qdisabled
))
6035 x_disable_image (f
, img
);
6036 else if (EQ (conversion
, Qlaplace
))
6038 else if (EQ (conversion
, Qemboss
))
6040 else if (CONSP (conversion
)
6041 && EQ (XCAR (conversion
), Qedge_detection
))
6044 tem
= XCDR (conversion
);
6046 x_edge_detection (f
, img
,
6047 Fplist_get (tem
, QCmatrix
),
6048 Fplist_get (tem
, QCcolor_adjustment
));
6054 xassert (!interrupt_input_blocked
);
6057 /* We're using IMG, so set its timestamp to `now'. */
6058 EMACS_GET_TIME (now
);
6059 img
->timestamp
= EMACS_SECS (now
);
6063 /* Value is the image id. */
6068 /* Cache image IMG in the image cache of frame F. */
6071 cache_image (f
, img
)
6075 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6078 /* Find a free slot in c->images. */
6079 for (i
= 0; i
< c
->used
; ++i
)
6080 if (c
->images
[i
] == NULL
)
6083 /* If no free slot found, maybe enlarge c->images. */
6084 if (i
== c
->used
&& c
->used
== c
->size
)
6087 c
->images
= (struct image
**) xrealloc (c
->images
,
6088 c
->size
* sizeof *c
->images
);
6091 /* Add IMG to c->images, and assign IMG an id. */
6097 /* Add IMG to the cache's hash table. */
6098 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6099 img
->next
= c
->buckets
[i
];
6101 img
->next
->prev
= img
;
6103 c
->buckets
[i
] = img
;
6107 /* Call FN on every image in the image cache of frame F. Used to mark
6108 Lisp Objects in the image cache. */
6111 forall_images_in_image_cache (f
, fn
)
6113 void (*fn
) P_ ((struct image
*img
));
6115 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6117 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6121 for (i
= 0; i
< c
->used
; ++i
)
6130 /***********************************************************************
6132 ***********************************************************************/
6134 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6135 XImage
**, Pixmap
*));
6136 static void x_destroy_x_image
P_ ((XImage
*));
6137 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6140 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6141 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6142 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6143 via xmalloc. Print error messages via image_error if an error
6144 occurs. Value is non-zero if successful. */
6147 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6149 int width
, height
, depth
;
6153 Display
*display
= FRAME_X_DISPLAY (f
);
6154 Screen
*screen
= FRAME_X_SCREEN (f
);
6155 Window window
= FRAME_X_WINDOW (f
);
6157 xassert (interrupt_input_blocked
);
6160 depth
= DefaultDepthOfScreen (screen
);
6161 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6162 depth
, ZPixmap
, 0, NULL
, width
, height
,
6163 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6166 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6170 /* Allocate image raster. */
6171 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6173 /* Allocate a pixmap of the same size. */
6174 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6175 if (*pixmap
== None
)
6177 x_destroy_x_image (*ximg
);
6179 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6187 /* Destroy XImage XIMG. Free XIMG->data. */
6190 x_destroy_x_image (ximg
)
6193 xassert (interrupt_input_blocked
);
6198 XDestroyImage (ximg
);
6203 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6204 are width and height of both the image and pixmap. */
6207 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6214 xassert (interrupt_input_blocked
);
6215 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6216 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6217 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6222 /***********************************************************************
6224 ***********************************************************************/
6226 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6227 static char *slurp_file
P_ ((char *, int *));
6230 /* Find image file FILE. Look in data-directory, then
6231 x-bitmap-file-path. Value is the full name of the file found, or
6232 nil if not found. */
6235 x_find_image_file (file
)
6238 Lisp_Object file_found
, search_path
;
6239 struct gcpro gcpro1
, gcpro2
;
6243 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6244 GCPRO2 (file_found
, search_path
);
6246 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6247 fd
= openp (search_path
, file
, "", &file_found
, 0);
6259 /* Read FILE into memory. Value is a pointer to a buffer allocated
6260 with xmalloc holding FILE's contents. Value is null if an error
6261 occurred. *SIZE is set to the size of the file. */
6264 slurp_file (file
, size
)
6272 if (stat (file
, &st
) == 0
6273 && (fp
= fopen (file
, "r")) != NULL
6274 && (buf
= (char *) xmalloc (st
.st_size
),
6275 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6296 /***********************************************************************
6298 ***********************************************************************/
6300 static int xbm_scan
P_ ((char **, char *, char *, int *));
6301 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6302 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6304 static int xbm_image_p
P_ ((Lisp_Object object
));
6305 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6307 static int xbm_file_p
P_ ((Lisp_Object
));
6310 /* Indices of image specification fields in xbm_format, below. */
6312 enum xbm_keyword_index
6330 /* Vector of image_keyword structures describing the format
6331 of valid XBM image specifications. */
6333 static struct image_keyword xbm_format
[XBM_LAST
] =
6335 {":type", IMAGE_SYMBOL_VALUE
, 1},
6336 {":file", IMAGE_STRING_VALUE
, 0},
6337 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6338 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6339 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6340 {":foreground", IMAGE_STRING_VALUE
, 0},
6341 {":background", IMAGE_STRING_VALUE
, 0},
6342 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6343 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6344 {":relief", IMAGE_INTEGER_VALUE
, 0},
6345 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6346 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6347 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6350 /* Structure describing the image type XBM. */
6352 static struct image_type xbm_type
=
6361 /* Tokens returned from xbm_scan. */
6370 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6371 A valid specification is a list starting with the symbol `image'
6372 The rest of the list is a property list which must contain an
6375 If the specification specifies a file to load, it must contain
6376 an entry `:file FILENAME' where FILENAME is a string.
6378 If the specification is for a bitmap loaded from memory it must
6379 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6380 WIDTH and HEIGHT are integers > 0. DATA may be:
6382 1. a string large enough to hold the bitmap data, i.e. it must
6383 have a size >= (WIDTH + 7) / 8 * HEIGHT
6385 2. a bool-vector of size >= WIDTH * HEIGHT
6387 3. a vector of strings or bool-vectors, one for each line of the
6390 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6391 may not be specified in this case because they are defined in the
6394 Both the file and data forms may contain the additional entries
6395 `:background COLOR' and `:foreground COLOR'. If not present,
6396 foreground and background of the frame on which the image is
6397 displayed is used. */
6400 xbm_image_p (object
)
6403 struct image_keyword kw
[XBM_LAST
];
6405 bcopy (xbm_format
, kw
, sizeof kw
);
6406 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6409 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6411 if (kw
[XBM_FILE
].count
)
6413 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6416 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6418 /* In-memory XBM file. */
6419 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6427 /* Entries for `:width', `:height' and `:data' must be present. */
6428 if (!kw
[XBM_WIDTH
].count
6429 || !kw
[XBM_HEIGHT
].count
6430 || !kw
[XBM_DATA
].count
)
6433 data
= kw
[XBM_DATA
].value
;
6434 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6435 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6437 /* Check type of data, and width and height against contents of
6443 /* Number of elements of the vector must be >= height. */
6444 if (XVECTOR (data
)->size
< height
)
6447 /* Each string or bool-vector in data must be large enough
6448 for one line of the image. */
6449 for (i
= 0; i
< height
; ++i
)
6451 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6455 if (XSTRING (elt
)->size
6456 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6459 else if (BOOL_VECTOR_P (elt
))
6461 if (XBOOL_VECTOR (elt
)->size
< width
)
6468 else if (STRINGP (data
))
6470 if (XSTRING (data
)->size
6471 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6474 else if (BOOL_VECTOR_P (data
))
6476 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6487 /* Scan a bitmap file. FP is the stream to read from. Value is
6488 either an enumerator from enum xbm_token, or a character for a
6489 single-character token, or 0 at end of file. If scanning an
6490 identifier, store the lexeme of the identifier in SVAL. If
6491 scanning a number, store its value in *IVAL. */
6494 xbm_scan (s
, end
, sval
, ival
)
6503 /* Skip white space. */
6504 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6509 else if (isdigit (c
))
6511 int value
= 0, digit
;
6513 if (c
== '0' && *s
< end
)
6516 if (c
== 'x' || c
== 'X')
6523 else if (c
>= 'a' && c
<= 'f')
6524 digit
= c
- 'a' + 10;
6525 else if (c
>= 'A' && c
<= 'F')
6526 digit
= c
- 'A' + 10;
6529 value
= 16 * value
+ digit
;
6532 else if (isdigit (c
))
6536 && (c
= *(*s
)++, isdigit (c
)))
6537 value
= 8 * value
+ c
- '0';
6544 && (c
= *(*s
)++, isdigit (c
)))
6545 value
= 10 * value
+ c
- '0';
6553 else if (isalpha (c
) || c
== '_')
6557 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6564 else if (c
== '/' && **s
== '*')
6566 /* C-style comment. */
6568 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6581 /* Replacement for XReadBitmapFileData which isn't available under old
6582 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6583 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6584 the image. Return in *DATA the bitmap data allocated with xmalloc.
6585 Value is non-zero if successful. DATA null means just test if
6586 CONTENTS looks like an in-memory XBM file. */
6589 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6590 char *contents
, *end
;
6591 int *width
, *height
;
6592 unsigned char **data
;
6595 char buffer
[BUFSIZ
];
6598 int bytes_per_line
, i
, nbytes
;
6604 LA1 = xbm_scan (&s, end, buffer, &value)
6606 #define expect(TOKEN) \
6607 if (LA1 != (TOKEN)) \
6612 #define expect_ident(IDENT) \
6613 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6618 *width
= *height
= -1;
6621 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6623 /* Parse defines for width, height and hot-spots. */
6627 expect_ident ("define");
6628 expect (XBM_TK_IDENT
);
6630 if (LA1
== XBM_TK_NUMBER
);
6632 char *p
= strrchr (buffer
, '_');
6633 p
= p
? p
+ 1 : buffer
;
6634 if (strcmp (p
, "width") == 0)
6636 else if (strcmp (p
, "height") == 0)
6639 expect (XBM_TK_NUMBER
);
6642 if (*width
< 0 || *height
< 0)
6644 else if (data
== NULL
)
6647 /* Parse bits. Must start with `static'. */
6648 expect_ident ("static");
6649 if (LA1
== XBM_TK_IDENT
)
6651 if (strcmp (buffer
, "unsigned") == 0)
6654 expect_ident ("char");
6656 else if (strcmp (buffer
, "short") == 0)
6660 if (*width
% 16 && *width
% 16 < 9)
6663 else if (strcmp (buffer
, "char") == 0)
6671 expect (XBM_TK_IDENT
);
6677 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6678 nbytes
= bytes_per_line
* *height
;
6679 p
= *data
= (char *) xmalloc (nbytes
);
6683 for (i
= 0; i
< nbytes
; i
+= 2)
6686 expect (XBM_TK_NUMBER
);
6689 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6692 if (LA1
== ',' || LA1
== '}')
6700 for (i
= 0; i
< nbytes
; ++i
)
6703 expect (XBM_TK_NUMBER
);
6707 if (LA1
== ',' || LA1
== '}')
6732 /* Load XBM image IMG which will be displayed on frame F from buffer
6733 CONTENTS. END is the end of the buffer. Value is non-zero if
6737 xbm_load_image (f
, img
, contents
, end
)
6740 char *contents
, *end
;
6743 unsigned char *data
;
6746 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6749 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6750 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6751 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6754 xassert (img
->width
> 0 && img
->height
> 0);
6756 /* Get foreground and background colors, maybe allocate colors. */
6757 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6759 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6761 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6763 background
= x_alloc_image_color (f
, img
, value
, background
);
6766 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6769 img
->width
, img
->height
,
6770 foreground
, background
,
6774 if (img
->pixmap
== None
)
6776 x_clear_image (f
, img
);
6777 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6783 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6789 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6796 return (STRINGP (data
)
6797 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6798 (XSTRING (data
)->data
6799 + STRING_BYTES (XSTRING (data
))),
6804 /* Fill image IMG which is used on frame F with pixmap data. Value is
6805 non-zero if successful. */
6813 Lisp_Object file_name
;
6815 xassert (xbm_image_p (img
->spec
));
6817 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6818 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6819 if (STRINGP (file_name
))
6824 struct gcpro gcpro1
;
6826 file
= x_find_image_file (file_name
);
6828 if (!STRINGP (file
))
6830 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6835 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6836 if (contents
== NULL
)
6838 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6843 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6848 struct image_keyword fmt
[XBM_LAST
];
6851 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6852 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6855 int in_memory_file_p
= 0;
6857 /* See if data looks like an in-memory XBM file. */
6858 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6859 in_memory_file_p
= xbm_file_p (data
);
6861 /* Parse the image specification. */
6862 bcopy (xbm_format
, fmt
, sizeof fmt
);
6863 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6866 /* Get specified width, and height. */
6867 if (!in_memory_file_p
)
6869 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6870 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6871 xassert (img
->width
> 0 && img
->height
> 0);
6874 /* Get foreground and background colors, maybe allocate colors. */
6875 if (fmt
[XBM_FOREGROUND
].count
)
6876 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6878 if (fmt
[XBM_BACKGROUND
].count
)
6879 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6882 if (in_memory_file_p
)
6883 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6884 (XSTRING (data
)->data
6885 + STRING_BYTES (XSTRING (data
))));
6892 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6894 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6895 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6897 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6899 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6901 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6904 else if (STRINGP (data
))
6905 bits
= XSTRING (data
)->data
;
6907 bits
= XBOOL_VECTOR (data
)->data
;
6909 /* Create the pixmap. */
6910 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6912 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6915 img
->width
, img
->height
,
6916 foreground
, background
,
6922 image_error ("Unable to create pixmap for XBM image `%s'",
6924 x_clear_image (f
, img
);
6934 /***********************************************************************
6936 ***********************************************************************/
6940 static int xpm_image_p
P_ ((Lisp_Object object
));
6941 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6942 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6944 #include "X11/xpm.h"
6946 /* The symbol `xpm' identifying XPM-format images. */
6950 /* Indices of image specification fields in xpm_format, below. */
6952 enum xpm_keyword_index
6967 /* Vector of image_keyword structures describing the format
6968 of valid XPM image specifications. */
6970 static struct image_keyword xpm_format
[XPM_LAST
] =
6972 {":type", IMAGE_SYMBOL_VALUE
, 1},
6973 {":file", IMAGE_STRING_VALUE
, 0},
6974 {":data", IMAGE_STRING_VALUE
, 0},
6975 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6976 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6977 {":relief", IMAGE_INTEGER_VALUE
, 0},
6978 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6979 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6980 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6981 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6984 /* Structure describing the image type XBM. */
6986 static struct image_type xpm_type
=
6996 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
6997 functions for allocating image colors. Our own functions handle
6998 color allocation failures more gracefully than the ones on the XPM
7001 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7002 #define ALLOC_XPM_COLORS
7005 #ifdef ALLOC_XPM_COLORS
7007 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7008 static void xpm_free_color_cache
P_ ((void));
7009 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7010 static int xpm_color_bucket
P_ ((char *));
7011 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7014 /* An entry in a hash table used to cache color definitions of named
7015 colors. This cache is necessary to speed up XPM image loading in
7016 case we do color allocations ourselves. Without it, we would need
7017 a call to XParseColor per pixel in the image. */
7019 struct xpm_cached_color
7021 /* Next in collision chain. */
7022 struct xpm_cached_color
*next
;
7024 /* Color definition (RGB and pixel color). */
7031 /* The hash table used for the color cache, and its bucket vector
7034 #define XPM_COLOR_CACHE_BUCKETS 1001
7035 struct xpm_cached_color
**xpm_color_cache
;
7037 /* Initialize the color cache. */
7040 xpm_init_color_cache (f
, attrs
)
7042 XpmAttributes
*attrs
;
7044 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7045 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7046 memset (xpm_color_cache
, 0, nbytes
);
7047 init_color_table ();
7049 if (attrs
->valuemask
& XpmColorSymbols
)
7054 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7055 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7056 attrs
->colorsymbols
[i
].value
, &color
))
7058 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7060 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7066 /* Free the color cache. */
7069 xpm_free_color_cache ()
7071 struct xpm_cached_color
*p
, *next
;
7074 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7075 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7081 xfree (xpm_color_cache
);
7082 xpm_color_cache
= NULL
;
7083 free_color_table ();
7087 /* Return the bucket index for color named COLOR_NAME in the color
7091 xpm_color_bucket (color_name
)
7097 for (s
= color_name
; *s
; ++s
)
7099 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7103 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7104 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7107 static struct xpm_cached_color
*
7108 xpm_cache_color (f
, color_name
, color
, bucket
)
7115 struct xpm_cached_color
*p
;
7118 bucket
= xpm_color_bucket (color_name
);
7120 nbytes
= sizeof *p
+ strlen (color_name
);
7121 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7122 strcpy (p
->name
, color_name
);
7124 p
->next
= xpm_color_cache
[bucket
];
7125 xpm_color_cache
[bucket
] = p
;
7130 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7131 return the cached definition in *COLOR. Otherwise, make a new
7132 entry in the cache and allocate the color. Value is zero if color
7133 allocation failed. */
7136 xpm_lookup_color (f
, color_name
, color
)
7141 struct xpm_cached_color
*p
;
7142 int h
= xpm_color_bucket (color_name
);
7144 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7145 if (strcmp (p
->name
, color_name
) == 0)
7150 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7153 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7155 p
= xpm_cache_color (f
, color_name
, color
, h
);
7162 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7163 CLOSURE is a pointer to the frame on which we allocate the
7164 color. Return in *COLOR the allocated color. Value is non-zero
7168 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7175 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7179 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7180 is a pointer to the frame on which we allocate the color. Value is
7181 non-zero if successful. */
7184 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7194 #endif /* ALLOC_XPM_COLORS */
7197 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7198 for XPM images. Such a list must consist of conses whose car and
7202 xpm_valid_color_symbols_p (color_symbols
)
7203 Lisp_Object color_symbols
;
7205 while (CONSP (color_symbols
))
7207 Lisp_Object sym
= XCAR (color_symbols
);
7209 || !STRINGP (XCAR (sym
))
7210 || !STRINGP (XCDR (sym
)))
7212 color_symbols
= XCDR (color_symbols
);
7215 return NILP (color_symbols
);
7219 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7222 xpm_image_p (object
)
7225 struct image_keyword fmt
[XPM_LAST
];
7226 bcopy (xpm_format
, fmt
, sizeof fmt
);
7227 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7228 /* Either `:file' or `:data' must be present. */
7229 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7230 /* Either no `:color-symbols' or it's a list of conses
7231 whose car and cdr are strings. */
7232 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7233 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7237 /* Load image IMG which will be displayed on frame F. Value is
7238 non-zero if successful. */
7246 XpmAttributes attrs
;
7247 Lisp_Object specified_file
, color_symbols
;
7249 /* Configure the XPM lib. Use the visual of frame F. Allocate
7250 close colors. Return colors allocated. */
7251 bzero (&attrs
, sizeof attrs
);
7252 attrs
.visual
= FRAME_X_VISUAL (f
);
7253 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7254 attrs
.valuemask
|= XpmVisual
;
7255 attrs
.valuemask
|= XpmColormap
;
7257 #ifdef ALLOC_XPM_COLORS
7258 /* Allocate colors with our own functions which handle
7259 failing color allocation more gracefully. */
7260 attrs
.color_closure
= f
;
7261 attrs
.alloc_color
= xpm_alloc_color
;
7262 attrs
.free_colors
= xpm_free_colors
;
7263 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7264 #else /* not ALLOC_XPM_COLORS */
7265 /* Let the XPM lib allocate colors. */
7266 attrs
.valuemask
|= XpmReturnAllocPixels
;
7267 #ifdef XpmAllocCloseColors
7268 attrs
.alloc_close_colors
= 1;
7269 attrs
.valuemask
|= XpmAllocCloseColors
;
7270 #else /* not XpmAllocCloseColors */
7271 attrs
.closeness
= 600;
7272 attrs
.valuemask
|= XpmCloseness
;
7273 #endif /* not XpmAllocCloseColors */
7274 #endif /* ALLOC_XPM_COLORS */
7276 /* If image specification contains symbolic color definitions, add
7277 these to `attrs'. */
7278 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7279 if (CONSP (color_symbols
))
7282 XpmColorSymbol
*xpm_syms
;
7285 attrs
.valuemask
|= XpmColorSymbols
;
7287 /* Count number of symbols. */
7288 attrs
.numsymbols
= 0;
7289 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7292 /* Allocate an XpmColorSymbol array. */
7293 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7294 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7295 bzero (xpm_syms
, size
);
7296 attrs
.colorsymbols
= xpm_syms
;
7298 /* Fill the color symbol array. */
7299 for (tail
= color_symbols
, i
= 0;
7301 ++i
, tail
= XCDR (tail
))
7303 Lisp_Object name
= XCAR (XCAR (tail
));
7304 Lisp_Object color
= XCDR (XCAR (tail
));
7305 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7306 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7307 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7308 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7312 /* Create a pixmap for the image, either from a file, or from a
7313 string buffer containing data in the same format as an XPM file. */
7314 #ifdef ALLOC_XPM_COLORS
7315 xpm_init_color_cache (f
, &attrs
);
7318 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7319 if (STRINGP (specified_file
))
7321 Lisp_Object file
= x_find_image_file (specified_file
);
7322 if (!STRINGP (file
))
7324 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7328 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7329 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7334 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7335 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7336 XSTRING (buffer
)->data
,
7337 &img
->pixmap
, &img
->mask
,
7341 if (rc
== XpmSuccess
)
7343 #ifdef ALLOC_XPM_COLORS
7344 img
->colors
= colors_in_color_table (&img
->ncolors
);
7345 #else /* not ALLOC_XPM_COLORS */
7348 img
->ncolors
= attrs
.nalloc_pixels
;
7349 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7350 * sizeof *img
->colors
);
7351 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7353 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7354 #ifdef DEBUG_X_COLORS
7355 register_color (img
->colors
[i
]);
7358 #endif /* not ALLOC_XPM_COLORS */
7360 img
->width
= attrs
.width
;
7361 img
->height
= attrs
.height
;
7362 xassert (img
->width
> 0 && img
->height
> 0);
7364 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7365 XpmFreeAttributes (&attrs
);
7372 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7375 case XpmFileInvalid
:
7376 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7380 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7383 case XpmColorFailed
:
7384 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7388 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7393 #ifdef ALLOC_XPM_COLORS
7394 xpm_free_color_cache ();
7396 return rc
== XpmSuccess
;
7399 #endif /* HAVE_XPM != 0 */
7402 /***********************************************************************
7404 ***********************************************************************/
7406 /* An entry in the color table mapping an RGB color to a pixel color. */
7411 unsigned long pixel
;
7413 /* Next in color table collision list. */
7414 struct ct_color
*next
;
7417 /* The bucket vector size to use. Must be prime. */
7421 /* Value is a hash of the RGB color given by R, G, and B. */
7423 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7425 /* The color hash table. */
7427 struct ct_color
**ct_table
;
7429 /* Number of entries in the color table. */
7431 int ct_colors_allocated
;
7433 /* Initialize the color table. */
7438 int size
= CT_SIZE
* sizeof (*ct_table
);
7439 ct_table
= (struct ct_color
**) xmalloc (size
);
7440 bzero (ct_table
, size
);
7441 ct_colors_allocated
= 0;
7445 /* Free memory associated with the color table. */
7451 struct ct_color
*p
, *next
;
7453 for (i
= 0; i
< CT_SIZE
; ++i
)
7454 for (p
= ct_table
[i
]; p
; p
= next
)
7465 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7466 entry for that color already is in the color table, return the
7467 pixel color of that entry. Otherwise, allocate a new color for R,
7468 G, B, and make an entry in the color table. */
7470 static unsigned long
7471 lookup_rgb_color (f
, r
, g
, b
)
7475 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7476 int i
= hash
% CT_SIZE
;
7479 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7480 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7493 cmap
= FRAME_X_COLORMAP (f
);
7494 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7498 ++ct_colors_allocated
;
7500 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7504 p
->pixel
= color
.pixel
;
7505 p
->next
= ct_table
[i
];
7509 return FRAME_FOREGROUND_PIXEL (f
);
7516 /* Look up pixel color PIXEL which is used on frame F in the color
7517 table. If not already present, allocate it. Value is PIXEL. */
7519 static unsigned long
7520 lookup_pixel_color (f
, pixel
)
7522 unsigned long pixel
;
7524 int i
= pixel
% CT_SIZE
;
7527 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7528 if (p
->pixel
== pixel
)
7537 cmap
= FRAME_X_COLORMAP (f
);
7538 color
.pixel
= pixel
;
7539 x_query_color (f
, &color
);
7540 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7544 ++ct_colors_allocated
;
7546 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7551 p
->next
= ct_table
[i
];
7555 return FRAME_FOREGROUND_PIXEL (f
);
7562 /* Value is a vector of all pixel colors contained in the color table,
7563 allocated via xmalloc. Set *N to the number of colors. */
7565 static unsigned long *
7566 colors_in_color_table (n
)
7571 unsigned long *colors
;
7573 if (ct_colors_allocated
== 0)
7580 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7582 *n
= ct_colors_allocated
;
7584 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7585 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7586 colors
[j
++] = p
->pixel
;
7594 /***********************************************************************
7596 ***********************************************************************/
7598 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7599 int, XImage
*, int));
7600 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7601 XColor
*, int, XImage
*, int));
7602 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7603 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7604 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7606 /* Non-zero means draw a cross on images having `:conversion
7609 int cross_disabled_images
;
7611 /* Edge detection matrices for different edge-detection
7614 static int emboss_matrix
[9] = {
7616 2, -1, 0, /* y - 1 */
7618 0, 1, -2 /* y + 1 */
7621 static int laplace_matrix
[9] = {
7623 1, 0, 0, /* y - 1 */
7625 0, 0, -1 /* y + 1 */
7628 /* Value is the intensity of the color whose red/green/blue values
7631 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7634 /* On frame F, return an array of XColor structures describing image
7635 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7636 non-zero means also fill the red/green/blue members of the XColor
7637 structures. Value is a pointer to the array of XColors structures,
7638 allocated with xmalloc; it must be freed by the caller. */
7641 x_to_xcolors (f
, img
, rgb_p
)
7650 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7652 /* Get the X image IMG->pixmap. */
7653 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7654 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7656 /* Fill the `pixel' members of the XColor array. I wished there
7657 were an easy and portable way to circumvent XGetPixel. */
7659 for (y
= 0; y
< img
->height
; ++y
)
7663 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7664 p
->pixel
= XGetPixel (ximg
, x
, y
);
7667 x_query_colors (f
, row
, img
->width
);
7670 XDestroyImage (ximg
);
7675 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7676 RGB members are set. F is the frame on which this all happens.
7677 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7680 x_from_xcolors (f
, img
, colors
)
7690 init_color_table ();
7692 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7695 for (y
= 0; y
< img
->height
; ++y
)
7696 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7698 unsigned long pixel
;
7699 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7700 XPutPixel (oimg
, x
, y
, pixel
);
7704 x_clear_image_1 (f
, img
, 1, 0, 1);
7706 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7707 x_destroy_x_image (oimg
);
7708 img
->pixmap
= pixmap
;
7709 img
->colors
= colors_in_color_table (&img
->ncolors
);
7710 free_color_table ();
7714 /* On frame F, perform edge-detection on image IMG.
7716 MATRIX is a nine-element array specifying the transformation
7717 matrix. See emboss_matrix for an example.
7719 COLOR_ADJUST is a color adjustment added to each pixel of the
7723 x_detect_edges (f
, img
, matrix
, color_adjust
)
7726 int matrix
[9], color_adjust
;
7728 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7732 for (i
= sum
= 0; i
< 9; ++i
)
7733 sum
+= abs (matrix
[i
]);
7735 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7737 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7739 for (y
= 0; y
< img
->height
; ++y
)
7741 p
= COLOR (new, 0, y
);
7742 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7743 p
= COLOR (new, img
->width
- 1, y
);
7744 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7747 for (x
= 1; x
< img
->width
- 1; ++x
)
7749 p
= COLOR (new, x
, 0);
7750 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7751 p
= COLOR (new, x
, img
->height
- 1);
7752 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7755 for (y
= 1; y
< img
->height
- 1; ++y
)
7757 p
= COLOR (new, 1, y
);
7759 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7761 int r
, g
, b
, y1
, x1
;
7764 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7765 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7768 XColor
*t
= COLOR (colors
, x1
, y1
);
7769 r
+= matrix
[i
] * t
->red
;
7770 g
+= matrix
[i
] * t
->green
;
7771 b
+= matrix
[i
] * t
->blue
;
7774 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7775 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7776 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7777 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7782 x_from_xcolors (f
, img
, new);
7788 /* Perform the pre-defined `emboss' edge-detection on image IMG
7796 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7800 /* Perform the pre-defined `laplace' edge-detection on image IMG
7808 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7812 /* Perform edge-detection on image IMG on frame F, with specified
7813 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7815 MATRIX must be either
7817 - a list of at least 9 numbers in row-major form
7818 - a vector of at least 9 numbers
7820 COLOR_ADJUST nil means use a default; otherwise it must be a
7824 x_edge_detection (f
, img
, matrix
, color_adjust
)
7827 Lisp_Object matrix
, color_adjust
;
7835 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7836 ++i
, matrix
= XCDR (matrix
))
7837 trans
[i
] = XFLOATINT (XCAR (matrix
));
7839 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7841 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7842 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7845 if (NILP (color_adjust
))
7846 color_adjust
= make_number (0xffff / 2);
7848 if (i
== 9 && NUMBERP (color_adjust
))
7849 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7853 /* Transform image IMG on frame F so that it looks disabled. */
7856 x_disable_image (f
, img
)
7860 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7862 if (dpyinfo
->n_planes
>= 2)
7864 /* Color (or grayscale). Convert to gray, and equalize. Just
7865 drawing such images with a stipple can look very odd, so
7866 we're using this method instead. */
7867 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7869 const int h
= 15000;
7870 const int l
= 30000;
7872 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7876 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7877 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7878 p
->red
= p
->green
= p
->blue
= i2
;
7881 x_from_xcolors (f
, img
, colors
);
7884 /* Draw a cross over the disabled image, if we must or if we
7886 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
7888 Display
*dpy
= FRAME_X_DISPLAY (f
);
7891 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
7892 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
7893 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
7894 img
->width
- 1, img
->height
- 1);
7895 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
7901 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
7902 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
7903 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
7904 img
->width
- 1, img
->height
- 1);
7905 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
7913 /* Build a mask for image IMG which is used on frame F. FILE is the
7914 name of an image file, for error messages. HOW determines how to
7915 determine the background color of IMG. If it is a list '(R G B)',
7916 with R, G, and B being integers >= 0, take that as the color of the
7917 background. Otherwise, determine the background color of IMG
7918 heuristically. Value is non-zero if successful. */
7921 x_build_heuristic_mask (f
, img
, how
)
7926 Display
*dpy
= FRAME_X_DISPLAY (f
);
7927 XImage
*ximg
, *mask_img
;
7928 int x
, y
, rc
, look_at_corners_p
;
7929 unsigned long bg
= 0;
7933 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
7937 /* Create an image and pixmap serving as mask. */
7938 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7939 &mask_img
, &img
->mask
);
7943 /* Get the X image of IMG->pixmap. */
7944 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7947 /* Determine the background color of ximg. If HOW is `(R G B)'
7948 take that as color. Otherwise, try to determine the color
7950 look_at_corners_p
= 1;
7958 && NATNUMP (XCAR (how
)))
7960 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7964 if (i
== 3 && NILP (how
))
7966 char color_name
[30];
7967 XColor exact
, color
;
7970 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7972 cmap
= FRAME_X_COLORMAP (f
);
7973 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7976 look_at_corners_p
= 0;
7981 if (look_at_corners_p
)
7983 unsigned long corners
[4];
7986 /* Get the colors at the corners of ximg. */
7987 corners
[0] = XGetPixel (ximg
, 0, 0);
7988 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7989 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7990 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7992 /* Choose the most frequently found color as background. */
7993 for (i
= best_count
= 0; i
< 4; ++i
)
7997 for (j
= n
= 0; j
< 4; ++j
)
7998 if (corners
[i
] == corners
[j
])
8002 bg
= corners
[i
], best_count
= n
;
8006 /* Set all bits in mask_img to 1 whose color in ximg is different
8007 from the background color bg. */
8008 for (y
= 0; y
< img
->height
; ++y
)
8009 for (x
= 0; x
< img
->width
; ++x
)
8010 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8012 /* Put mask_img into img->mask. */
8013 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8014 x_destroy_x_image (mask_img
);
8015 XDestroyImage (ximg
);
8022 /***********************************************************************
8023 PBM (mono, gray, color)
8024 ***********************************************************************/
8026 static int pbm_image_p
P_ ((Lisp_Object object
));
8027 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8028 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8030 /* The symbol `pbm' identifying images of this type. */
8034 /* Indices of image specification fields in gs_format, below. */
8036 enum pbm_keyword_index
8052 /* Vector of image_keyword structures describing the format
8053 of valid user-defined image specifications. */
8055 static struct image_keyword pbm_format
[PBM_LAST
] =
8057 {":type", IMAGE_SYMBOL_VALUE
, 1},
8058 {":file", IMAGE_STRING_VALUE
, 0},
8059 {":data", IMAGE_STRING_VALUE
, 0},
8060 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8061 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8062 {":relief", IMAGE_INTEGER_VALUE
, 0},
8063 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8064 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8065 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8066 {":foreground", IMAGE_STRING_VALUE
, 0},
8067 {":background", IMAGE_STRING_VALUE
, 0}
8070 /* Structure describing the image type `pbm'. */
8072 static struct image_type pbm_type
=
8082 /* Return non-zero if OBJECT is a valid PBM image specification. */
8085 pbm_image_p (object
)
8088 struct image_keyword fmt
[PBM_LAST
];
8090 bcopy (pbm_format
, fmt
, sizeof fmt
);
8092 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8095 /* Must specify either :data or :file. */
8096 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8100 /* Scan a decimal number from *S and return it. Advance *S while
8101 reading the number. END is the end of the string. Value is -1 at
8105 pbm_scan_number (s
, end
)
8106 unsigned char **s
, *end
;
8108 int c
= 0, val
= -1;
8112 /* Skip white-space. */
8113 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8118 /* Skip comment to end of line. */
8119 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8122 else if (isdigit (c
))
8124 /* Read decimal number. */
8126 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8127 val
= 10 * val
+ c
- '0';
8138 /* Load PBM image IMG for use on frame F. */
8146 int width
, height
, max_color_idx
= 0;
8148 Lisp_Object file
, specified_file
;
8149 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8150 struct gcpro gcpro1
;
8151 unsigned char *contents
= NULL
;
8152 unsigned char *end
, *p
;
8155 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8159 if (STRINGP (specified_file
))
8161 file
= x_find_image_file (specified_file
);
8162 if (!STRINGP (file
))
8164 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8169 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8170 if (contents
== NULL
)
8172 image_error ("Error reading `%s'", file
, Qnil
);
8178 end
= contents
+ size
;
8183 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8184 p
= XSTRING (data
)->data
;
8185 end
= p
+ STRING_BYTES (XSTRING (data
));
8188 /* Check magic number. */
8189 if (end
- p
< 2 || *p
++ != 'P')
8191 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8201 raw_p
= 0, type
= PBM_MONO
;
8205 raw_p
= 0, type
= PBM_GRAY
;
8209 raw_p
= 0, type
= PBM_COLOR
;
8213 raw_p
= 1, type
= PBM_MONO
;
8217 raw_p
= 1, type
= PBM_GRAY
;
8221 raw_p
= 1, type
= PBM_COLOR
;
8225 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8229 /* Read width, height, maximum color-component. Characters
8230 starting with `#' up to the end of a line are ignored. */
8231 width
= pbm_scan_number (&p
, end
);
8232 height
= pbm_scan_number (&p
, end
);
8234 if (type
!= PBM_MONO
)
8236 max_color_idx
= pbm_scan_number (&p
, end
);
8237 if (raw_p
&& max_color_idx
> 255)
8238 max_color_idx
= 255;
8243 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8246 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8247 &ximg
, &img
->pixmap
))
8250 /* Initialize the color hash table. */
8251 init_color_table ();
8253 if (type
== PBM_MONO
)
8256 struct image_keyword fmt
[PBM_LAST
];
8257 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8258 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8260 /* Parse the image specification. */
8261 bcopy (pbm_format
, fmt
, sizeof fmt
);
8262 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8264 /* Get foreground and background colors, maybe allocate colors. */
8265 if (fmt
[PBM_FOREGROUND
].count
)
8266 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8267 if (fmt
[PBM_BACKGROUND
].count
)
8268 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8270 for (y
= 0; y
< height
; ++y
)
8271 for (x
= 0; x
< width
; ++x
)
8281 g
= pbm_scan_number (&p
, end
);
8283 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8288 for (y
= 0; y
< height
; ++y
)
8289 for (x
= 0; x
< width
; ++x
)
8293 if (type
== PBM_GRAY
)
8294 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8303 r
= pbm_scan_number (&p
, end
);
8304 g
= pbm_scan_number (&p
, end
);
8305 b
= pbm_scan_number (&p
, end
);
8308 if (r
< 0 || g
< 0 || b
< 0)
8312 XDestroyImage (ximg
);
8313 image_error ("Invalid pixel value in image `%s'",
8318 /* RGB values are now in the range 0..max_color_idx.
8319 Scale this to the range 0..0xffff supported by X. */
8320 r
= (double) r
* 65535 / max_color_idx
;
8321 g
= (double) g
* 65535 / max_color_idx
;
8322 b
= (double) b
* 65535 / max_color_idx
;
8323 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8327 /* Store in IMG->colors the colors allocated for the image, and
8328 free the color table. */
8329 img
->colors
= colors_in_color_table (&img
->ncolors
);
8330 free_color_table ();
8332 /* Put the image into a pixmap. */
8333 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8334 x_destroy_x_image (ximg
);
8337 img
->height
= height
;
8346 /***********************************************************************
8348 ***********************************************************************/
8354 /* Function prototypes. */
8356 static int png_image_p
P_ ((Lisp_Object object
));
8357 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8359 /* The symbol `png' identifying images of this type. */
8363 /* Indices of image specification fields in png_format, below. */
8365 enum png_keyword_index
8379 /* Vector of image_keyword structures describing the format
8380 of valid user-defined image specifications. */
8382 static struct image_keyword png_format
[PNG_LAST
] =
8384 {":type", IMAGE_SYMBOL_VALUE
, 1},
8385 {":data", IMAGE_STRING_VALUE
, 0},
8386 {":file", IMAGE_STRING_VALUE
, 0},
8387 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8388 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8389 {":relief", IMAGE_INTEGER_VALUE
, 0},
8390 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8391 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8392 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8395 /* Structure describing the image type `png'. */
8397 static struct image_type png_type
=
8407 /* Return non-zero if OBJECT is a valid PNG image specification. */
8410 png_image_p (object
)
8413 struct image_keyword fmt
[PNG_LAST
];
8414 bcopy (png_format
, fmt
, sizeof fmt
);
8416 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8419 /* Must specify either the :data or :file keyword. */
8420 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8424 /* Error and warning handlers installed when the PNG library
8428 my_png_error (png_ptr
, msg
)
8429 png_struct
*png_ptr
;
8432 xassert (png_ptr
!= NULL
);
8433 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8434 longjmp (png_ptr
->jmpbuf
, 1);
8439 my_png_warning (png_ptr
, msg
)
8440 png_struct
*png_ptr
;
8443 xassert (png_ptr
!= NULL
);
8444 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8447 /* Memory source for PNG decoding. */
8449 struct png_memory_storage
8451 unsigned char *bytes
; /* The data */
8452 size_t len
; /* How big is it? */
8453 int index
; /* Where are we? */
8457 /* Function set as reader function when reading PNG image from memory.
8458 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8459 bytes from the input to DATA. */
8462 png_read_from_memory (png_ptr
, data
, length
)
8463 png_structp png_ptr
;
8467 struct png_memory_storage
*tbr
8468 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8470 if (length
> tbr
->len
- tbr
->index
)
8471 png_error (png_ptr
, "Read error");
8473 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8474 tbr
->index
= tbr
->index
+ length
;
8477 /* Load PNG image IMG for use on frame F. Value is non-zero if
8485 Lisp_Object file
, specified_file
;
8486 Lisp_Object specified_data
;
8488 XImage
*ximg
, *mask_img
= NULL
;
8489 struct gcpro gcpro1
;
8490 png_struct
*png_ptr
= NULL
;
8491 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8492 FILE *volatile fp
= NULL
;
8494 png_byte
* volatile pixels
= NULL
;
8495 png_byte
** volatile rows
= NULL
;
8496 png_uint_32 width
, height
;
8497 int bit_depth
, color_type
, interlace_type
;
8499 png_uint_32 row_bytes
;
8502 double screen_gamma
, image_gamma
;
8504 struct png_memory_storage tbr
; /* Data to be read */
8506 /* Find out what file to load. */
8507 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8508 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8512 if (NILP (specified_data
))
8514 file
= x_find_image_file (specified_file
);
8515 if (!STRINGP (file
))
8517 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8522 /* Open the image file. */
8523 fp
= fopen (XSTRING (file
)->data
, "rb");
8526 image_error ("Cannot open image file `%s'", file
, Qnil
);
8532 /* Check PNG signature. */
8533 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8534 || !png_check_sig (sig
, sizeof sig
))
8536 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8544 /* Read from memory. */
8545 tbr
.bytes
= XSTRING (specified_data
)->data
;
8546 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8549 /* Check PNG signature. */
8550 if (tbr
.len
< sizeof sig
8551 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8553 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8558 /* Need to skip past the signature. */
8559 tbr
.bytes
+= sizeof (sig
);
8562 /* Initialize read and info structs for PNG lib. */
8563 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8564 my_png_error
, my_png_warning
);
8567 if (fp
) fclose (fp
);
8572 info_ptr
= png_create_info_struct (png_ptr
);
8575 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8576 if (fp
) fclose (fp
);
8581 end_info
= png_create_info_struct (png_ptr
);
8584 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8585 if (fp
) fclose (fp
);
8590 /* Set error jump-back. We come back here when the PNG library
8591 detects an error. */
8592 if (setjmp (png_ptr
->jmpbuf
))
8596 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8599 if (fp
) fclose (fp
);
8604 /* Read image info. */
8605 if (!NILP (specified_data
))
8606 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8608 png_init_io (png_ptr
, fp
);
8610 png_set_sig_bytes (png_ptr
, sizeof sig
);
8611 png_read_info (png_ptr
, info_ptr
);
8612 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8613 &interlace_type
, NULL
, NULL
);
8615 /* If image contains simply transparency data, we prefer to
8616 construct a clipping mask. */
8617 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8622 /* This function is easier to write if we only have to handle
8623 one data format: RGB or RGBA with 8 bits per channel. Let's
8624 transform other formats into that format. */
8626 /* Strip more than 8 bits per channel. */
8627 if (bit_depth
== 16)
8628 png_set_strip_16 (png_ptr
);
8630 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8632 png_set_expand (png_ptr
);
8634 /* Convert grayscale images to RGB. */
8635 if (color_type
== PNG_COLOR_TYPE_GRAY
8636 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8637 png_set_gray_to_rgb (png_ptr
);
8639 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8640 gamma_str
= getenv ("SCREEN_GAMMA");
8641 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8643 /* Tell the PNG lib to handle gamma correction for us. */
8645 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8646 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8647 /* There is a special chunk in the image specifying the gamma. */
8648 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8651 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8652 /* Image contains gamma information. */
8653 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8655 /* Use a default of 0.5 for the image gamma. */
8656 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8658 /* Handle alpha channel by combining the image with a background
8659 color. Do this only if a real alpha channel is supplied. For
8660 simple transparency, we prefer a clipping mask. */
8663 png_color_16
*image_background
;
8665 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8666 /* Image contains a background color with which to
8667 combine the image. */
8668 png_set_background (png_ptr
, image_background
,
8669 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8672 /* Image does not contain a background color with which
8673 to combine the image data via an alpha channel. Use
8674 the frame's background instead. */
8677 png_color_16 frame_background
;
8679 cmap
= FRAME_X_COLORMAP (f
);
8680 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8681 x_query_color (f
, &color
);
8683 bzero (&frame_background
, sizeof frame_background
);
8684 frame_background
.red
= color
.red
;
8685 frame_background
.green
= color
.green
;
8686 frame_background
.blue
= color
.blue
;
8688 png_set_background (png_ptr
, &frame_background
,
8689 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8693 /* Update info structure. */
8694 png_read_update_info (png_ptr
, info_ptr
);
8696 /* Get number of channels. Valid values are 1 for grayscale images
8697 and images with a palette, 2 for grayscale images with transparency
8698 information (alpha channel), 3 for RGB images, and 4 for RGB
8699 images with alpha channel, i.e. RGBA. If conversions above were
8700 sufficient we should only have 3 or 4 channels here. */
8701 channels
= png_get_channels (png_ptr
, info_ptr
);
8702 xassert (channels
== 3 || channels
== 4);
8704 /* Number of bytes needed for one row of the image. */
8705 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8707 /* Allocate memory for the image. */
8708 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8709 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8710 for (i
= 0; i
< height
; ++i
)
8711 rows
[i
] = pixels
+ i
* row_bytes
;
8713 /* Read the entire image. */
8714 png_read_image (png_ptr
, rows
);
8715 png_read_end (png_ptr
, info_ptr
);
8722 /* Create the X image and pixmap. */
8723 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8727 /* Create an image and pixmap serving as mask if the PNG image
8728 contains an alpha channel. */
8731 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8732 &mask_img
, &img
->mask
))
8734 x_destroy_x_image (ximg
);
8735 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8740 /* Fill the X image and mask from PNG data. */
8741 init_color_table ();
8743 for (y
= 0; y
< height
; ++y
)
8745 png_byte
*p
= rows
[y
];
8747 for (x
= 0; x
< width
; ++x
)
8754 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8756 /* An alpha channel, aka mask channel, associates variable
8757 transparency with an image. Where other image formats
8758 support binary transparency---fully transparent or fully
8759 opaque---PNG allows up to 254 levels of partial transparency.
8760 The PNG library implements partial transparency by combining
8761 the image with a specified background color.
8763 I'm not sure how to handle this here nicely: because the
8764 background on which the image is displayed may change, for
8765 real alpha channel support, it would be necessary to create
8766 a new image for each possible background.
8768 What I'm doing now is that a mask is created if we have
8769 boolean transparency information. Otherwise I'm using
8770 the frame's background color to combine the image with. */
8775 XPutPixel (mask_img
, x
, y
, *p
> 0);
8781 /* Remember colors allocated for this image. */
8782 img
->colors
= colors_in_color_table (&img
->ncolors
);
8783 free_color_table ();
8786 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8791 img
->height
= height
;
8793 /* Put the image into the pixmap, then free the X image and its buffer. */
8794 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8795 x_destroy_x_image (ximg
);
8797 /* Same for the mask. */
8800 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8801 x_destroy_x_image (mask_img
);
8808 #endif /* HAVE_PNG != 0 */
8812 /***********************************************************************
8814 ***********************************************************************/
8818 /* Work around a warning about HAVE_STDLIB_H being redefined in
8820 #ifdef HAVE_STDLIB_H
8821 #define HAVE_STDLIB_H_1
8822 #undef HAVE_STDLIB_H
8823 #endif /* HAVE_STLIB_H */
8825 #include <jpeglib.h>
8829 #ifdef HAVE_STLIB_H_1
8830 #define HAVE_STDLIB_H 1
8833 static int jpeg_image_p
P_ ((Lisp_Object object
));
8834 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8836 /* The symbol `jpeg' identifying images of this type. */
8840 /* Indices of image specification fields in gs_format, below. */
8842 enum jpeg_keyword_index
8851 JPEG_HEURISTIC_MASK
,
8856 /* Vector of image_keyword structures describing the format
8857 of valid user-defined image specifications. */
8859 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8861 {":type", IMAGE_SYMBOL_VALUE
, 1},
8862 {":data", IMAGE_STRING_VALUE
, 0},
8863 {":file", IMAGE_STRING_VALUE
, 0},
8864 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8865 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8866 {":relief", IMAGE_INTEGER_VALUE
, 0},
8867 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8868 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8869 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8872 /* Structure describing the image type `jpeg'. */
8874 static struct image_type jpeg_type
=
8884 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8887 jpeg_image_p (object
)
8890 struct image_keyword fmt
[JPEG_LAST
];
8892 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8894 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8897 /* Must specify either the :data or :file keyword. */
8898 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8902 struct my_jpeg_error_mgr
8904 struct jpeg_error_mgr pub
;
8905 jmp_buf setjmp_buffer
;
8910 my_error_exit (cinfo
)
8913 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8914 longjmp (mgr
->setjmp_buffer
, 1);
8918 /* Init source method for JPEG data source manager. Called by
8919 jpeg_read_header() before any data is actually read. See
8920 libjpeg.doc from the JPEG lib distribution. */
8923 our_init_source (cinfo
)
8924 j_decompress_ptr cinfo
;
8929 /* Fill input buffer method for JPEG data source manager. Called
8930 whenever more data is needed. We read the whole image in one step,
8931 so this only adds a fake end of input marker at the end. */
8934 our_fill_input_buffer (cinfo
)
8935 j_decompress_ptr cinfo
;
8937 /* Insert a fake EOI marker. */
8938 struct jpeg_source_mgr
*src
= cinfo
->src
;
8939 static JOCTET buffer
[2];
8941 buffer
[0] = (JOCTET
) 0xFF;
8942 buffer
[1] = (JOCTET
) JPEG_EOI
;
8944 src
->next_input_byte
= buffer
;
8945 src
->bytes_in_buffer
= 2;
8950 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8951 is the JPEG data source manager. */
8954 our_skip_input_data (cinfo
, num_bytes
)
8955 j_decompress_ptr cinfo
;
8958 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8962 if (num_bytes
> src
->bytes_in_buffer
)
8963 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8965 src
->bytes_in_buffer
-= num_bytes
;
8966 src
->next_input_byte
+= num_bytes
;
8971 /* Method to terminate data source. Called by
8972 jpeg_finish_decompress() after all data has been processed. */
8975 our_term_source (cinfo
)
8976 j_decompress_ptr cinfo
;
8981 /* Set up the JPEG lib for reading an image from DATA which contains
8982 LEN bytes. CINFO is the decompression info structure created for
8983 reading the image. */
8986 jpeg_memory_src (cinfo
, data
, len
)
8987 j_decompress_ptr cinfo
;
8991 struct jpeg_source_mgr
*src
;
8993 if (cinfo
->src
== NULL
)
8995 /* First time for this JPEG object? */
8996 cinfo
->src
= (struct jpeg_source_mgr
*)
8997 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8998 sizeof (struct jpeg_source_mgr
));
8999 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9000 src
->next_input_byte
= data
;
9003 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9004 src
->init_source
= our_init_source
;
9005 src
->fill_input_buffer
= our_fill_input_buffer
;
9006 src
->skip_input_data
= our_skip_input_data
;
9007 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9008 src
->term_source
= our_term_source
;
9009 src
->bytes_in_buffer
= len
;
9010 src
->next_input_byte
= data
;
9014 /* Load image IMG for use on frame F. Patterned after example.c
9015 from the JPEG lib. */
9022 struct jpeg_decompress_struct cinfo
;
9023 struct my_jpeg_error_mgr mgr
;
9024 Lisp_Object file
, specified_file
;
9025 Lisp_Object specified_data
;
9026 FILE * volatile fp
= NULL
;
9028 int row_stride
, x
, y
;
9029 XImage
*ximg
= NULL
;
9031 unsigned long *colors
;
9033 struct gcpro gcpro1
;
9035 /* Open the JPEG file. */
9036 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9037 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9041 if (NILP (specified_data
))
9043 file
= x_find_image_file (specified_file
);
9044 if (!STRINGP (file
))
9046 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9051 fp
= fopen (XSTRING (file
)->data
, "r");
9054 image_error ("Cannot open `%s'", file
, Qnil
);
9060 /* Customize libjpeg's error handling to call my_error_exit when an
9061 error is detected. This function will perform a longjmp. */
9062 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9063 mgr
.pub
.error_exit
= my_error_exit
;
9065 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9069 /* Called from my_error_exit. Display a JPEG error. */
9070 char buffer
[JMSG_LENGTH_MAX
];
9071 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9072 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9073 build_string (buffer
));
9076 /* Close the input file and destroy the JPEG object. */
9078 fclose ((FILE *) fp
);
9079 jpeg_destroy_decompress (&cinfo
);
9081 /* If we already have an XImage, free that. */
9082 x_destroy_x_image (ximg
);
9084 /* Free pixmap and colors. */
9085 x_clear_image (f
, img
);
9091 /* Create the JPEG decompression object. Let it read from fp.
9092 Read the JPEG image header. */
9093 jpeg_create_decompress (&cinfo
);
9095 if (NILP (specified_data
))
9096 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9098 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9099 STRING_BYTES (XSTRING (specified_data
)));
9101 jpeg_read_header (&cinfo
, TRUE
);
9103 /* Customize decompression so that color quantization will be used.
9104 Start decompression. */
9105 cinfo
.quantize_colors
= TRUE
;
9106 jpeg_start_decompress (&cinfo
);
9107 width
= img
->width
= cinfo
.output_width
;
9108 height
= img
->height
= cinfo
.output_height
;
9110 /* Create X image and pixmap. */
9111 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9112 longjmp (mgr
.setjmp_buffer
, 2);
9114 /* Allocate colors. When color quantization is used,
9115 cinfo.actual_number_of_colors has been set with the number of
9116 colors generated, and cinfo.colormap is a two-dimensional array
9117 of color indices in the range 0..cinfo.actual_number_of_colors.
9118 No more than 255 colors will be generated. */
9122 if (cinfo
.out_color_components
> 2)
9123 ir
= 0, ig
= 1, ib
= 2;
9124 else if (cinfo
.out_color_components
> 1)
9125 ir
= 0, ig
= 1, ib
= 0;
9127 ir
= 0, ig
= 0, ib
= 0;
9129 /* Use the color table mechanism because it handles colors that
9130 cannot be allocated nicely. Such colors will be replaced with
9131 a default color, and we don't have to care about which colors
9132 can be freed safely, and which can't. */
9133 init_color_table ();
9134 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9137 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9139 /* Multiply RGB values with 255 because X expects RGB values
9140 in the range 0..0xffff. */
9141 int r
= cinfo
.colormap
[ir
][i
] << 8;
9142 int g
= cinfo
.colormap
[ig
][i
] << 8;
9143 int b
= cinfo
.colormap
[ib
][i
] << 8;
9144 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9147 /* Remember those colors actually allocated. */
9148 img
->colors
= colors_in_color_table (&img
->ncolors
);
9149 free_color_table ();
9153 row_stride
= width
* cinfo
.output_components
;
9154 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9156 for (y
= 0; y
< height
; ++y
)
9158 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9159 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9160 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9164 jpeg_finish_decompress (&cinfo
);
9165 jpeg_destroy_decompress (&cinfo
);
9167 fclose ((FILE *) fp
);
9169 /* Put the image into the pixmap. */
9170 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9171 x_destroy_x_image (ximg
);
9176 #endif /* HAVE_JPEG */
9180 /***********************************************************************
9182 ***********************************************************************/
9188 static int tiff_image_p
P_ ((Lisp_Object object
));
9189 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9191 /* The symbol `tiff' identifying images of this type. */
9195 /* Indices of image specification fields in tiff_format, below. */
9197 enum tiff_keyword_index
9206 TIFF_HEURISTIC_MASK
,
9211 /* Vector of image_keyword structures describing the format
9212 of valid user-defined image specifications. */
9214 static struct image_keyword tiff_format
[TIFF_LAST
] =
9216 {":type", IMAGE_SYMBOL_VALUE
, 1},
9217 {":data", IMAGE_STRING_VALUE
, 0},
9218 {":file", IMAGE_STRING_VALUE
, 0},
9219 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9220 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9221 {":relief", IMAGE_INTEGER_VALUE
, 0},
9222 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9223 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9224 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9227 /* Structure describing the image type `tiff'. */
9229 static struct image_type tiff_type
=
9239 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9242 tiff_image_p (object
)
9245 struct image_keyword fmt
[TIFF_LAST
];
9246 bcopy (tiff_format
, fmt
, sizeof fmt
);
9248 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9251 /* Must specify either the :data or :file keyword. */
9252 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9256 /* Reading from a memory buffer for TIFF images Based on the PNG
9257 memory source, but we have to provide a lot of extra functions.
9260 We really only need to implement read and seek, but I am not
9261 convinced that the TIFF library is smart enough not to destroy
9262 itself if we only hand it the function pointers we need to
9267 unsigned char *bytes
;
9275 tiff_read_from_memory (data
, buf
, size
)
9280 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9282 if (size
> src
->len
- src
->index
)
9284 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9291 tiff_write_from_memory (data
, buf
, size
)
9301 tiff_seek_in_memory (data
, off
, whence
)
9306 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9311 case SEEK_SET
: /* Go from beginning of source. */
9315 case SEEK_END
: /* Go from end of source. */
9316 idx
= src
->len
+ off
;
9319 case SEEK_CUR
: /* Go from current position. */
9320 idx
= src
->index
+ off
;
9323 default: /* Invalid `whence'. */
9327 if (idx
> src
->len
|| idx
< 0)
9336 tiff_close_memory (data
)
9345 tiff_mmap_memory (data
, pbase
, psize
)
9350 /* It is already _IN_ memory. */
9356 tiff_unmap_memory (data
, base
, size
)
9361 /* We don't need to do this. */
9366 tiff_size_of_memory (data
)
9369 return ((tiff_memory_source
*) data
)->len
;
9373 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9381 Lisp_Object file
, specified_file
;
9382 Lisp_Object specified_data
;
9384 int width
, height
, x
, y
;
9388 struct gcpro gcpro1
;
9389 tiff_memory_source memsrc
;
9391 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9392 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9396 if (NILP (specified_data
))
9398 /* Read from a file */
9399 file
= x_find_image_file (specified_file
);
9400 if (!STRINGP (file
))
9402 image_error ("Cannot find image file `%s'", file
, Qnil
);
9407 /* Try to open the image file. */
9408 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9411 image_error ("Cannot open `%s'", file
, Qnil
);
9418 /* Memory source! */
9419 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9420 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9423 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9424 (TIFFReadWriteProc
) tiff_read_from_memory
,
9425 (TIFFReadWriteProc
) tiff_write_from_memory
,
9426 tiff_seek_in_memory
,
9428 tiff_size_of_memory
,
9434 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9440 /* Get width and height of the image, and allocate a raster buffer
9441 of width x height 32-bit values. */
9442 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9443 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9444 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9446 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9450 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9456 /* Create the X image and pixmap. */
9457 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9464 /* Initialize the color table. */
9465 init_color_table ();
9467 /* Process the pixel raster. Origin is in the lower-left corner. */
9468 for (y
= 0; y
< height
; ++y
)
9470 uint32
*row
= buf
+ y
* width
;
9472 for (x
= 0; x
< width
; ++x
)
9474 uint32 abgr
= row
[x
];
9475 int r
= TIFFGetR (abgr
) << 8;
9476 int g
= TIFFGetG (abgr
) << 8;
9477 int b
= TIFFGetB (abgr
) << 8;
9478 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9482 /* Remember the colors allocated for the image. Free the color table. */
9483 img
->colors
= colors_in_color_table (&img
->ncolors
);
9484 free_color_table ();
9486 /* Put the image into the pixmap, then free the X image and its buffer. */
9487 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9488 x_destroy_x_image (ximg
);
9492 img
->height
= height
;
9498 #endif /* HAVE_TIFF != 0 */
9502 /***********************************************************************
9504 ***********************************************************************/
9508 #include <gif_lib.h>
9510 static int gif_image_p
P_ ((Lisp_Object object
));
9511 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9513 /* The symbol `gif' identifying images of this type. */
9517 /* Indices of image specification fields in gif_format, below. */
9519 enum gif_keyword_index
9534 /* Vector of image_keyword structures describing the format
9535 of valid user-defined image specifications. */
9537 static struct image_keyword gif_format
[GIF_LAST
] =
9539 {":type", IMAGE_SYMBOL_VALUE
, 1},
9540 {":data", IMAGE_STRING_VALUE
, 0},
9541 {":file", IMAGE_STRING_VALUE
, 0},
9542 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9543 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9544 {":relief", IMAGE_INTEGER_VALUE
, 0},
9545 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9546 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9547 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9548 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9551 /* Structure describing the image type `gif'. */
9553 static struct image_type gif_type
=
9563 /* Return non-zero if OBJECT is a valid GIF image specification. */
9566 gif_image_p (object
)
9569 struct image_keyword fmt
[GIF_LAST
];
9570 bcopy (gif_format
, fmt
, sizeof fmt
);
9572 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9575 /* Must specify either the :data or :file keyword. */
9576 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9580 /* Reading a GIF image from memory
9581 Based on the PNG memory stuff to a certain extent. */
9585 unsigned char *bytes
;
9592 /* Make the current memory source available to gif_read_from_memory.
9593 It's done this way because not all versions of libungif support
9594 a UserData field in the GifFileType structure. */
9595 static gif_memory_source
*current_gif_memory_src
;
9598 gif_read_from_memory (file
, buf
, len
)
9603 gif_memory_source
*src
= current_gif_memory_src
;
9605 if (len
> src
->len
- src
->index
)
9608 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9614 /* Load GIF image IMG for use on frame F. Value is non-zero if
9622 Lisp_Object file
, specified_file
;
9623 Lisp_Object specified_data
;
9624 int rc
, width
, height
, x
, y
, i
;
9626 ColorMapObject
*gif_color_map
;
9627 unsigned long pixel_colors
[256];
9629 struct gcpro gcpro1
;
9631 int ino
, image_left
, image_top
, image_width
, image_height
;
9632 gif_memory_source memsrc
;
9633 unsigned char *raster
;
9635 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9636 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9640 if (NILP (specified_data
))
9642 file
= x_find_image_file (specified_file
);
9643 if (!STRINGP (file
))
9645 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9650 /* Open the GIF file. */
9651 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9654 image_error ("Cannot open `%s'", file
, Qnil
);
9661 /* Read from memory! */
9662 current_gif_memory_src
= &memsrc
;
9663 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9664 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9667 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9670 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9676 /* Read entire contents. */
9677 rc
= DGifSlurp (gif
);
9678 if (rc
== GIF_ERROR
)
9680 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9681 DGifCloseFile (gif
);
9686 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9687 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9688 if (ino
>= gif
->ImageCount
)
9690 image_error ("Invalid image number `%s' in image `%s'",
9692 DGifCloseFile (gif
);
9697 width
= img
->width
= gif
->SWidth
;
9698 height
= img
->height
= gif
->SHeight
;
9700 /* Create the X image and pixmap. */
9701 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9703 DGifCloseFile (gif
);
9708 /* Allocate colors. */
9709 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9711 gif_color_map
= gif
->SColorMap
;
9712 init_color_table ();
9713 bzero (pixel_colors
, sizeof pixel_colors
);
9715 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9717 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9718 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9719 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9720 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9723 img
->colors
= colors_in_color_table (&img
->ncolors
);
9724 free_color_table ();
9726 /* Clear the part of the screen image that are not covered by
9727 the image from the GIF file. Full animated GIF support
9728 requires more than can be done here (see the gif89 spec,
9729 disposal methods). Let's simply assume that the part
9730 not covered by a sub-image is in the frame's background color. */
9731 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9732 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9733 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9734 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9736 for (y
= 0; y
< image_top
; ++y
)
9737 for (x
= 0; x
< width
; ++x
)
9738 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9740 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9741 for (x
= 0; x
< width
; ++x
)
9742 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9744 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9746 for (x
= 0; x
< image_left
; ++x
)
9747 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9748 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9749 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9752 /* Read the GIF image into the X image. We use a local variable
9753 `raster' here because RasterBits below is a char *, and invites
9754 problems with bytes >= 0x80. */
9755 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9757 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9759 static int interlace_start
[] = {0, 4, 2, 1};
9760 static int interlace_increment
[] = {8, 8, 4, 2};
9762 int row
= interlace_start
[0];
9766 for (y
= 0; y
< image_height
; y
++)
9768 if (row
>= image_height
)
9770 row
= interlace_start
[++pass
];
9771 while (row
>= image_height
)
9772 row
= interlace_start
[++pass
];
9775 for (x
= 0; x
< image_width
; x
++)
9777 int i
= raster
[(y
* image_width
) + x
];
9778 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9782 row
+= interlace_increment
[pass
];
9787 for (y
= 0; y
< image_height
; ++y
)
9788 for (x
= 0; x
< image_width
; ++x
)
9790 int i
= raster
[y
* image_width
+ x
];
9791 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9795 DGifCloseFile (gif
);
9797 /* Put the image into the pixmap, then free the X image and its buffer. */
9798 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9799 x_destroy_x_image (ximg
);
9805 #endif /* HAVE_GIF != 0 */
9809 /***********************************************************************
9811 ***********************************************************************/
9813 static int gs_image_p
P_ ((Lisp_Object object
));
9814 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9815 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9817 /* The symbol `postscript' identifying images of this type. */
9819 Lisp_Object Qpostscript
;
9821 /* Keyword symbols. */
9823 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9825 /* Indices of image specification fields in gs_format, below. */
9827 enum gs_keyword_index
9844 /* Vector of image_keyword structures describing the format
9845 of valid user-defined image specifications. */
9847 static struct image_keyword gs_format
[GS_LAST
] =
9849 {":type", IMAGE_SYMBOL_VALUE
, 1},
9850 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9851 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9852 {":file", IMAGE_STRING_VALUE
, 1},
9853 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9854 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9855 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9856 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9857 {":relief", IMAGE_INTEGER_VALUE
, 0},
9858 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9859 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9860 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9863 /* Structure describing the image type `ghostscript'. */
9865 static struct image_type gs_type
=
9875 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9878 gs_clear_image (f
, img
)
9882 /* IMG->data.ptr_val may contain a recorded colormap. */
9883 xfree (img
->data
.ptr_val
);
9884 x_clear_image (f
, img
);
9888 /* Return non-zero if OBJECT is a valid Ghostscript image
9895 struct image_keyword fmt
[GS_LAST
];
9899 bcopy (gs_format
, fmt
, sizeof fmt
);
9901 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
9904 /* Bounding box must be a list or vector containing 4 integers. */
9905 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9908 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9909 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9914 else if (VECTORP (tem
))
9916 if (XVECTOR (tem
)->size
!= 4)
9918 for (i
= 0; i
< 4; ++i
)
9919 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9929 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9938 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9939 struct gcpro gcpro1
, gcpro2
;
9941 double in_width
, in_height
;
9942 Lisp_Object pixel_colors
= Qnil
;
9944 /* Compute pixel size of pixmap needed from the given size in the
9945 image specification. Sizes in the specification are in pt. 1 pt
9946 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9948 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9949 in_width
= XFASTINT (pt_width
) / 72.0;
9950 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9951 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9952 in_height
= XFASTINT (pt_height
) / 72.0;
9953 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9955 /* Create the pixmap. */
9956 xassert (img
->pixmap
== None
);
9957 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9958 img
->width
, img
->height
,
9959 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9963 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9967 /* Call the loader to fill the pixmap. It returns a process object
9968 if successful. We do not record_unwind_protect here because
9969 other places in redisplay like calling window scroll functions
9970 don't either. Let the Lisp loader use `unwind-protect' instead. */
9971 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9973 sprintf (buffer
, "%lu %lu",
9974 (unsigned long) FRAME_X_WINDOW (f
),
9975 (unsigned long) img
->pixmap
);
9976 window_and_pixmap_id
= build_string (buffer
);
9978 sprintf (buffer
, "%lu %lu",
9979 FRAME_FOREGROUND_PIXEL (f
),
9980 FRAME_BACKGROUND_PIXEL (f
));
9981 pixel_colors
= build_string (buffer
);
9983 XSETFRAME (frame
, f
);
9984 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9986 loader
= intern ("gs-load-image");
9988 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9989 make_number (img
->width
),
9990 make_number (img
->height
),
9991 window_and_pixmap_id
,
9994 return PROCESSP (img
->data
.lisp_val
);
9998 /* Kill the Ghostscript process that was started to fill PIXMAP on
9999 frame F. Called from XTread_socket when receiving an event
10000 telling Emacs that Ghostscript has finished drawing. */
10003 x_kill_gs_process (pixmap
, f
)
10007 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10011 /* Find the image containing PIXMAP. */
10012 for (i
= 0; i
< c
->used
; ++i
)
10013 if (c
->images
[i
]->pixmap
== pixmap
)
10016 /* Kill the GS process. We should have found PIXMAP in the image
10017 cache and its image should contain a process object. */
10018 xassert (i
< c
->used
);
10019 img
= c
->images
[i
];
10020 xassert (PROCESSP (img
->data
.lisp_val
));
10021 Fkill_process (img
->data
.lisp_val
, Qnil
);
10022 img
->data
.lisp_val
= Qnil
;
10024 /* On displays with a mutable colormap, figure out the colors
10025 allocated for the image by looking at the pixels of an XImage for
10027 class = FRAME_X_VISUAL (f
)->class;
10028 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10034 /* Try to get an XImage for img->pixmep. */
10035 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10036 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10041 /* Initialize the color table. */
10042 init_color_table ();
10044 /* For each pixel of the image, look its color up in the
10045 color table. After having done so, the color table will
10046 contain an entry for each color used by the image. */
10047 for (y
= 0; y
< img
->height
; ++y
)
10048 for (x
= 0; x
< img
->width
; ++x
)
10050 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10051 lookup_pixel_color (f
, pixel
);
10054 /* Record colors in the image. Free color table and XImage. */
10055 img
->colors
= colors_in_color_table (&img
->ncolors
);
10056 free_color_table ();
10057 XDestroyImage (ximg
);
10059 #if 0 /* This doesn't seem to be the case. If we free the colors
10060 here, we get a BadAccess later in x_clear_image when
10061 freeing the colors. */
10062 /* We have allocated colors once, but Ghostscript has also
10063 allocated colors on behalf of us. So, to get the
10064 reference counts right, free them once. */
10066 x_free_colors (f
, img
->colors
, img
->ncolors
);
10070 image_error ("Cannot get X image of `%s'; colors will not be freed",
10079 /***********************************************************************
10081 ***********************************************************************/
10083 DEFUN ("x-change-window-property", Fx_change_window_property
,
10084 Sx_change_window_property
, 2, 3, 0,
10085 "Change window property PROP to VALUE on the X window of FRAME.\n\
10086 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
10087 selected frame. Value is VALUE.")
10088 (prop
, value
, frame
)
10089 Lisp_Object frame
, prop
, value
;
10091 struct frame
*f
= check_x_frame (frame
);
10094 CHECK_STRING (prop
, 1);
10095 CHECK_STRING (value
, 2);
10098 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10099 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10100 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10101 XSTRING (value
)->data
, XSTRING (value
)->size
);
10103 /* Make sure the property is set when we return. */
10104 XFlush (FRAME_X_DISPLAY (f
));
10111 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10112 Sx_delete_window_property
, 1, 2, 0,
10113 "Remove window property PROP from X window of FRAME.\n\
10114 FRAME nil or omitted means use the selected frame. Value is PROP.")
10116 Lisp_Object prop
, frame
;
10118 struct frame
*f
= check_x_frame (frame
);
10121 CHECK_STRING (prop
, 1);
10123 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10124 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10126 /* Make sure the property is removed when we return. */
10127 XFlush (FRAME_X_DISPLAY (f
));
10134 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10136 "Value is the value of window property PROP on FRAME.\n\
10137 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10138 if FRAME hasn't a property with name PROP or if PROP has no string\n\
10141 Lisp_Object prop
, frame
;
10143 struct frame
*f
= check_x_frame (frame
);
10146 Lisp_Object prop_value
= Qnil
;
10147 char *tmp_data
= NULL
;
10150 unsigned long actual_size
, bytes_remaining
;
10152 CHECK_STRING (prop
, 1);
10154 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10155 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10156 prop_atom
, 0, 0, False
, XA_STRING
,
10157 &actual_type
, &actual_format
, &actual_size
,
10158 &bytes_remaining
, (unsigned char **) &tmp_data
);
10161 int size
= bytes_remaining
;
10166 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10167 prop_atom
, 0, bytes_remaining
,
10169 &actual_type
, &actual_format
,
10170 &actual_size
, &bytes_remaining
,
10171 (unsigned char **) &tmp_data
);
10173 prop_value
= make_string (tmp_data
, size
);
10184 /***********************************************************************
10186 ***********************************************************************/
10188 /* If non-null, an asynchronous timer that, when it expires, displays
10189 a busy cursor on all frames. */
10191 static struct atimer
*busy_cursor_atimer
;
10193 /* Non-zero means a busy cursor is currently shown. */
10195 static int busy_cursor_shown_p
;
10197 /* Number of seconds to wait before displaying a busy cursor. */
10199 static Lisp_Object Vbusy_cursor_delay
;
10201 /* Default number of seconds to wait before displaying a busy
10204 #define DEFAULT_BUSY_CURSOR_DELAY 1
10206 /* Function prototypes. */
10208 static void show_busy_cursor
P_ ((struct atimer
*));
10209 static void hide_busy_cursor
P_ ((void));
10212 /* Cancel a currently active busy-cursor timer, and start a new one. */
10215 start_busy_cursor ()
10218 int secs
, usecs
= 0;
10220 cancel_busy_cursor ();
10222 if (INTEGERP (Vbusy_cursor_delay
)
10223 && XINT (Vbusy_cursor_delay
) > 0)
10224 secs
= XFASTINT (Vbusy_cursor_delay
);
10225 else if (FLOATP (Vbusy_cursor_delay
)
10226 && XFLOAT_DATA (Vbusy_cursor_delay
) > 0)
10229 tem
= Ftruncate (Vbusy_cursor_delay
, Qnil
);
10230 secs
= XFASTINT (tem
);
10231 usecs
= (XFLOAT_DATA (Vbusy_cursor_delay
) - secs
) * 1000000;
10234 secs
= DEFAULT_BUSY_CURSOR_DELAY
;
10236 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10237 busy_cursor_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10238 show_busy_cursor
, NULL
);
10242 /* Cancel the busy cursor timer if active, hide a busy cursor if
10246 cancel_busy_cursor ()
10248 if (busy_cursor_atimer
)
10250 cancel_atimer (busy_cursor_atimer
);
10251 busy_cursor_atimer
= NULL
;
10254 if (busy_cursor_shown_p
)
10255 hide_busy_cursor ();
10259 /* Timer function of busy_cursor_atimer. TIMER is equal to
10260 busy_cursor_atimer.
10262 Display a busy cursor on all frames by mapping the frames'
10263 busy_window. Set the busy_p flag in the frames' output_data.x
10264 structure to indicate that a busy cursor is shown on the
10268 show_busy_cursor (timer
)
10269 struct atimer
*timer
;
10271 /* The timer implementation will cancel this timer automatically
10272 after this function has run. Set busy_cursor_atimer to null
10273 so that we know the timer doesn't have to be canceled. */
10274 busy_cursor_atimer
= NULL
;
10276 if (!busy_cursor_shown_p
)
10278 Lisp_Object rest
, frame
;
10282 FOR_EACH_FRAME (rest
, frame
)
10284 struct frame
*f
= XFRAME (frame
);
10286 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10288 Display
*dpy
= FRAME_X_DISPLAY (f
);
10290 #ifdef USE_X_TOOLKIT
10291 if (f
->output_data
.x
->widget
)
10293 if (FRAME_OUTER_WINDOW (f
))
10296 f
->output_data
.x
->busy_p
= 1;
10298 if (!f
->output_data
.x
->busy_window
)
10300 unsigned long mask
= CWCursor
;
10301 XSetWindowAttributes attrs
;
10303 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
10305 f
->output_data
.x
->busy_window
10306 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10307 0, 0, 32000, 32000, 0, 0,
10313 XMapRaised (dpy
, f
->output_data
.x
->busy_window
);
10319 busy_cursor_shown_p
= 1;
10325 /* Hide the busy cursor on all frames, if it is currently shown. */
10328 hide_busy_cursor ()
10330 if (busy_cursor_shown_p
)
10332 Lisp_Object rest
, frame
;
10335 FOR_EACH_FRAME (rest
, frame
)
10337 struct frame
*f
= XFRAME (frame
);
10340 /* Watch out for newly created frames. */
10341 && f
->output_data
.x
->busy_window
)
10343 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10344 /* Sync here because XTread_socket looks at the busy_p flag
10345 that is reset to zero below. */
10346 XSync (FRAME_X_DISPLAY (f
), False
);
10347 f
->output_data
.x
->busy_p
= 0;
10351 busy_cursor_shown_p
= 0;
10358 /***********************************************************************
10360 ***********************************************************************/
10362 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10364 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10365 Lisp_Object
, int *, int *));
10367 /* The frame of a currently visible tooltip. */
10369 Lisp_Object tip_frame
;
10371 /* If non-nil, a timer started that hides the last tooltip when it
10374 Lisp_Object tip_timer
;
10377 /* If non-nil, a vector of 3 elements containing the last args
10378 with which x-show-tip was called. See there. */
10380 Lisp_Object last_show_tip_args
;
10384 unwind_create_tip_frame (frame
)
10387 Lisp_Object deleted
;
10389 deleted
= unwind_create_frame (frame
);
10390 if (EQ (deleted
, Qt
))
10400 /* Create a frame for a tooltip on the display described by DPYINFO.
10401 PARMS is a list of frame parameters. Value is the frame.
10403 Note that functions called here, esp. x_default_parameter can
10404 signal errors, for instance when a specified color name is
10405 undefined. We have to make sure that we're in a consistent state
10406 when this happens. */
10409 x_create_tip_frame (dpyinfo
, parms
)
10410 struct x_display_info
*dpyinfo
;
10414 Lisp_Object frame
, tem
;
10416 long window_prompting
= 0;
10418 int count
= BINDING_STACK_SIZE ();
10419 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10421 int face_change_count_before
= face_change_count
;
10425 /* Use this general default value to start with until we know if
10426 this frame has a specified name. */
10427 Vx_resource_name
= Vinvocation_name
;
10429 #ifdef MULTI_KBOARD
10430 kb
= dpyinfo
->kboard
;
10432 kb
= &the_only_kboard
;
10435 /* Get the name of the frame to use for resource lookup. */
10436 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10437 if (!STRINGP (name
)
10438 && !EQ (name
, Qunbound
)
10440 error ("Invalid frame name--not a string or nil");
10441 Vx_resource_name
= name
;
10444 GCPRO3 (parms
, name
, frame
);
10445 f
= make_frame (1);
10446 XSETFRAME (frame
, f
);
10447 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10448 record_unwind_protect (unwind_create_tip_frame
, frame
);
10450 /* By setting the output method, we're essentially saying that
10451 the frame is live, as per FRAME_LIVE_P. If we get a signal
10452 from this point on, x_destroy_window might screw up reference
10454 f
->output_method
= output_x_window
;
10455 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10456 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10457 f
->output_data
.x
->icon_bitmap
= -1;
10458 f
->output_data
.x
->fontset
= -1;
10459 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10460 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10461 f
->icon_name
= Qnil
;
10462 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10464 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10465 dpyinfo_refcount
= dpyinfo
->reference_count
;
10466 #endif /* GLYPH_DEBUG */
10467 #ifdef MULTI_KBOARD
10468 FRAME_KBOARD (f
) = kb
;
10470 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10471 f
->output_data
.x
->explicit_parent
= 0;
10473 /* These colors will be set anyway later, but it's important
10474 to get the color reference counts right, so initialize them! */
10477 struct gcpro gcpro1
;
10479 black
= build_string ("black");
10481 f
->output_data
.x
->foreground_pixel
10482 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10483 f
->output_data
.x
->background_pixel
10484 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10485 f
->output_data
.x
->cursor_pixel
10486 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10487 f
->output_data
.x
->cursor_foreground_pixel
10488 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10489 f
->output_data
.x
->border_pixel
10490 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10491 f
->output_data
.x
->mouse_pixel
10492 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10496 /* Set the name; the functions to which we pass f expect the name to
10498 if (EQ (name
, Qunbound
) || NILP (name
))
10500 f
->name
= build_string (dpyinfo
->x_id_name
);
10501 f
->explicit_name
= 0;
10506 f
->explicit_name
= 1;
10507 /* use the frame's title when getting resources for this frame. */
10508 specbind (Qx_resource_name
, name
);
10511 /* Extract the window parameters from the supplied values that are
10512 needed to determine window geometry. */
10516 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10519 /* First, try whatever font the caller has specified. */
10520 if (STRINGP (font
))
10522 tem
= Fquery_fontset (font
, Qnil
);
10524 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10526 font
= x_new_font (f
, XSTRING (font
)->data
);
10529 /* Try out a font which we hope has bold and italic variations. */
10530 if (!STRINGP (font
))
10531 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10532 if (!STRINGP (font
))
10533 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10534 if (! STRINGP (font
))
10535 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10536 if (! STRINGP (font
))
10537 /* This was formerly the first thing tried, but it finds too many fonts
10538 and takes too long. */
10539 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10540 /* If those didn't work, look for something which will at least work. */
10541 if (! STRINGP (font
))
10542 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10544 if (! STRINGP (font
))
10545 font
= build_string ("fixed");
10547 x_default_parameter (f
, parms
, Qfont
, font
,
10548 "font", "Font", RES_TYPE_STRING
);
10551 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10552 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10554 /* This defaults to 2 in order to match xterm. We recognize either
10555 internalBorderWidth or internalBorder (which is what xterm calls
10557 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10561 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10562 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10563 if (! EQ (value
, Qunbound
))
10564 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10568 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10569 "internalBorderWidth", "internalBorderWidth",
10572 /* Also do the stuff which must be set before the window exists. */
10573 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10574 "foreground", "Foreground", RES_TYPE_STRING
);
10575 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10576 "background", "Background", RES_TYPE_STRING
);
10577 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10578 "pointerColor", "Foreground", RES_TYPE_STRING
);
10579 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10580 "cursorColor", "Foreground", RES_TYPE_STRING
);
10581 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10582 "borderColor", "BorderColor", RES_TYPE_STRING
);
10584 /* Init faces before x_default_parameter is called for scroll-bar
10585 parameters because that function calls x_set_scroll_bar_width,
10586 which calls change_frame_size, which calls Fset_window_buffer,
10587 which runs hooks, which call Fvertical_motion. At the end, we
10588 end up in init_iterator with a null face cache, which should not
10590 init_frame_faces (f
);
10592 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10593 window_prompting
= x_figure_window_size (f
, parms
);
10595 if (window_prompting
& XNegative
)
10597 if (window_prompting
& YNegative
)
10598 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10600 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10604 if (window_prompting
& YNegative
)
10605 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10607 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10610 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10612 XSetWindowAttributes attrs
;
10613 unsigned long mask
;
10616 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10617 if (DoesSaveUnders (dpyinfo
->screen
))
10618 mask
|= CWSaveUnder
;
10620 /* Window managers look at the override-redirect flag to determine
10621 whether or net to give windows a decoration (Xlib spec, chapter
10623 attrs
.override_redirect
= True
;
10624 attrs
.save_under
= True
;
10625 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10626 /* Arrange for getting MapNotify and UnmapNotify events. */
10627 attrs
.event_mask
= StructureNotifyMask
;
10629 = FRAME_X_WINDOW (f
)
10630 = XCreateWindow (FRAME_X_DISPLAY (f
),
10631 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10632 /* x, y, width, height */
10636 CopyFromParent
, InputOutput
, CopyFromParent
,
10643 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10644 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10645 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10646 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10647 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10648 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10650 /* Dimensions, especially f->height, must be done via change_frame_size.
10651 Change will not be effected unless different from the current
10654 height
= f
->height
;
10656 SET_FRAME_WIDTH (f
, 0);
10657 change_frame_size (f
, height
, width
, 1, 0, 0);
10659 /* Set up faces after all frame parameters are known. This call
10660 also merges in face attributes specified for new frames.
10662 Frame parameters may be changed if .Xdefaults contains
10663 specifications for the default font. For example, if there is an
10664 `Emacs.default.attributeBackground: pink', the `background-color'
10665 attribute of the frame get's set, which let's the internal border
10666 of the tooltip frame appear in pink. Prevent this. */
10668 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
10670 /* Set tip_frame here, so that */
10672 call1 (Qface_set_after_frame_default
, frame
);
10674 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
10675 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
10683 /* It is now ok to make the frame official even if we get an error
10684 below. And the frame needs to be on Vframe_list or making it
10685 visible won't work. */
10686 Vframe_list
= Fcons (frame
, Vframe_list
);
10688 /* Now that the frame is official, it counts as a reference to
10690 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10692 /* Setting attributes of faces of the tooltip frame from resources
10693 and similar will increment face_change_count, which leads to the
10694 clearing of all current matrices. Since this isn't necessary
10695 here, avoid it by resetting face_change_count to the value it
10696 had before we created the tip frame. */
10697 face_change_count
= face_change_count_before
;
10699 /* Discard the unwind_protect. */
10700 return unbind_to (count
, frame
);
10704 /* Compute where to display tip frame F. PARMS is the list of frame
10705 parameters for F. DX and DY are specified offsets from the current
10706 location of the mouse. Return coordinates relative to the root
10707 window of the display in *ROOT_X, and *ROOT_Y. */
10710 compute_tip_xy (f
, parms
, dx
, dy
, root_x
, root_y
)
10712 Lisp_Object parms
, dx
, dy
;
10713 int *root_x
, *root_y
;
10715 Lisp_Object left
, top
;
10717 Window root
, child
;
10720 /* User-specified position? */
10721 left
= Fcdr (Fassq (Qleft
, parms
));
10722 top
= Fcdr (Fassq (Qtop
, parms
));
10724 /* Move the tooltip window where the mouse pointer is. Resize and
10727 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10728 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
10731 *root_x
+= XINT (dx
);
10732 *root_y
+= XINT (dy
);
10734 if (INTEGERP (left
))
10735 *root_x
= XINT (left
);
10736 if (INTEGERP (top
))
10737 *root_y
= XINT (top
);
10741 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10742 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10743 A tooltip window is a small X window displaying a string.\n\
10745 FRAME nil or omitted means use the selected frame.\n\
10747 PARMS is an optional list of frame parameters which can be\n\
10748 used to change the tooltip's appearance.\n\
10750 Automatically hide the tooltip after TIMEOUT seconds.\n\
10751 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10753 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10754 the tooltip is displayed at that x-position. Otherwise it is\n\
10755 displayed at the mouse position, with offset DX added (default is 5 if\n\
10756 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10757 parameter is specified, it determines the y-position of the tooltip\n\
10758 window, otherwise it is displayed at the mouse position, with offset\n\
10759 DY added (default is -10).")
10760 (string
, frame
, parms
, timeout
, dx
, dy
)
10761 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10765 Lisp_Object buffer
, top
, left
;
10766 int root_x
, root_y
;
10767 struct buffer
*old_buffer
;
10768 struct text_pos pos
;
10769 int i
, width
, height
;
10770 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10771 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10772 int count
= BINDING_STACK_SIZE ();
10774 specbind (Qinhibit_redisplay
, Qt
);
10776 GCPRO4 (string
, parms
, frame
, timeout
);
10778 CHECK_STRING (string
, 0);
10779 f
= check_x_frame (frame
);
10780 if (NILP (timeout
))
10781 timeout
= make_number (5);
10783 CHECK_NATNUM (timeout
, 2);
10786 dx
= make_number (5);
10788 CHECK_NUMBER (dx
, 5);
10791 dy
= make_number (-10);
10793 CHECK_NUMBER (dy
, 6);
10795 if (NILP (last_show_tip_args
))
10796 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
10798 if (!NILP (tip_frame
))
10800 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
10801 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
10802 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
10804 if (EQ (frame
, last_frame
)
10805 && !NILP (Fequal (last_string
, string
))
10806 && !NILP (Fequal (last_parms
, parms
)))
10808 struct frame
*f
= XFRAME (tip_frame
);
10810 /* Only DX and DY have changed. */
10811 if (!NILP (tip_timer
))
10813 Lisp_Object timer
= tip_timer
;
10815 call1 (Qcancel_timer
, timer
);
10819 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
10820 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10821 root_x
, root_y
- PIXEL_HEIGHT (f
));
10827 /* Hide a previous tip, if any. */
10830 ASET (last_show_tip_args
, 0, string
);
10831 ASET (last_show_tip_args
, 1, frame
);
10832 ASET (last_show_tip_args
, 2, parms
);
10834 /* Add default values to frame parameters. */
10835 if (NILP (Fassq (Qname
, parms
)))
10836 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10837 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10838 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10839 if (NILP (Fassq (Qborder_width
, parms
)))
10840 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10841 if (NILP (Fassq (Qborder_color
, parms
)))
10842 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10843 if (NILP (Fassq (Qbackground_color
, parms
)))
10844 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10847 /* Create a frame for the tooltip, and record it in the global
10848 variable tip_frame. */
10849 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
10850 f
= XFRAME (frame
);
10852 /* Set up the frame's root window. Currently we use a size of 80
10853 columns x 40 lines. If someone wants to show a larger tip, he
10854 will loose. I don't think this is a realistic case. */
10855 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10856 w
->left
= w
->top
= make_number (0);
10857 w
->width
= make_number (80);
10858 w
->height
= make_number (40);
10860 w
->pseudo_window_p
= 1;
10862 /* Display the tooltip text in a temporary buffer. */
10863 buffer
= Fget_buffer_create (build_string (" *tip*"));
10864 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10865 old_buffer
= current_buffer
;
10866 set_buffer_internal_1 (XBUFFER (buffer
));
10868 Finsert (1, &string
);
10869 clear_glyph_matrix (w
->desired_matrix
);
10870 clear_glyph_matrix (w
->current_matrix
);
10871 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10872 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10874 /* Compute width and height of the tooltip. */
10875 width
= height
= 0;
10876 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10878 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10879 struct glyph
*last
;
10882 /* Stop at the first empty row at the end. */
10883 if (!row
->enabled_p
|| !row
->displays_text_p
)
10886 /* Let the row go over the full width of the frame. */
10887 row
->full_width_p
= 1;
10889 /* There's a glyph at the end of rows that is used to place
10890 the cursor there. Don't include the width of this glyph. */
10891 if (row
->used
[TEXT_AREA
])
10893 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10894 row_width
= row
->pixel_width
- last
->pixel_width
;
10897 row_width
= row
->pixel_width
;
10899 height
+= row
->height
;
10900 width
= max (width
, row_width
);
10903 /* Add the frame's internal border to the width and height the X
10904 window should have. */
10905 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10906 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10908 /* Move the tooltip window where the mouse pointer is. Resize and
10910 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
10913 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10914 root_x
, root_y
- height
, width
, height
);
10915 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10918 /* Draw into the window. */
10919 w
->must_be_updated_p
= 1;
10920 update_single_window (w
, 1);
10922 /* Restore original current buffer. */
10923 set_buffer_internal_1 (old_buffer
);
10924 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
10927 /* Let the tip disappear after timeout seconds. */
10928 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
10929 intern ("x-hide-tip"));
10932 return unbind_to (count
, Qnil
);
10936 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
10937 "Hide the current tooltip window, if there is any.\n\
10938 Value is t is tooltip was open, nil otherwise.")
10942 Lisp_Object deleted
, frame
, timer
;
10943 struct gcpro gcpro1
, gcpro2
;
10945 /* Return quickly if nothing to do. */
10946 if (NILP (tip_timer
) && NILP (tip_frame
))
10951 GCPRO2 (frame
, timer
);
10952 tip_frame
= tip_timer
= deleted
= Qnil
;
10954 count
= BINDING_STACK_SIZE ();
10955 specbind (Qinhibit_redisplay
, Qt
);
10956 specbind (Qinhibit_quit
, Qt
);
10959 call1 (Qcancel_timer
, timer
);
10961 if (FRAMEP (frame
))
10963 Fdelete_frame (frame
, Qnil
);
10967 /* Bloodcurdling hack alert: The Lucid menu bar widget's
10968 redisplay procedure is not called when a tip frame over menu
10969 items is unmapped. Redisplay the menu manually... */
10971 struct frame
*f
= SELECTED_FRAME ();
10972 Widget w
= f
->output_data
.x
->menubar_widget
;
10973 extern void xlwmenu_redisplay
P_ ((Widget
));
10975 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
10979 xlwmenu_redisplay (w
);
10983 #endif /* USE_LUCID */
10987 return unbind_to (count
, deleted
);
10992 /***********************************************************************
10993 File selection dialog
10994 ***********************************************************************/
10998 /* Callback for "OK" and "Cancel" on file selection dialog. */
11001 file_dialog_cb (widget
, client_data
, call_data
)
11003 XtPointer call_data
, client_data
;
11005 int *result
= (int *) client_data
;
11006 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11007 *result
= cb
->reason
;
11011 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11012 "Read file name, prompting with PROMPT in directory DIR.\n\
11013 Use a file selection dialog.\n\
11014 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
11015 specified. Don't let the user enter a file name in the file\n\
11016 selection dialog's entry field, if MUSTMATCH is non-nil.")
11017 (prompt
, dir
, default_filename
, mustmatch
)
11018 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11021 struct frame
*f
= SELECTED_FRAME ();
11022 Lisp_Object file
= Qnil
;
11023 Widget dialog
, text
, list
, help
;
11026 extern XtAppContext Xt_app_con
;
11028 XmString dir_xmstring
, pattern_xmstring
;
11029 int popup_activated_flag
;
11030 int count
= specpdl_ptr
- specpdl
;
11031 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11033 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11034 CHECK_STRING (prompt
, 0);
11035 CHECK_STRING (dir
, 1);
11037 /* Prevent redisplay. */
11038 specbind (Qinhibit_redisplay
, Qt
);
11042 /* Create the dialog with PROMPT as title, using DIR as initial
11043 directory and using "*" as pattern. */
11044 dir
= Fexpand_file_name (dir
, Qnil
);
11045 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11046 pattern_xmstring
= XmStringCreateLocalized ("*");
11048 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11049 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11050 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11051 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11052 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11053 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11055 XmStringFree (dir_xmstring
);
11056 XmStringFree (pattern_xmstring
);
11058 /* Add callbacks for OK and Cancel. */
11059 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11060 (XtPointer
) &result
);
11061 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11062 (XtPointer
) &result
);
11064 /* Disable the help button since we can't display help. */
11065 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11066 XtSetSensitive (help
, False
);
11068 /* Mark OK button as default. */
11069 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11070 XmNshowAsDefault
, True
, NULL
);
11072 /* If MUSTMATCH is non-nil, disable the file entry field of the
11073 dialog, so that the user must select a file from the files list
11074 box. We can't remove it because we wouldn't have a way to get at
11075 the result file name, then. */
11076 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11077 if (!NILP (mustmatch
))
11080 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11081 XtSetSensitive (text
, False
);
11082 XtSetSensitive (label
, False
);
11085 /* Manage the dialog, so that list boxes get filled. */
11086 XtManageChild (dialog
);
11088 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11089 must include the path for this to work. */
11090 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11091 if (STRINGP (default_filename
))
11093 XmString default_xmstring
;
11097 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11099 if (!XmListItemExists (list
, default_xmstring
))
11101 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11102 XmListAddItem (list
, default_xmstring
, 0);
11106 item_pos
= XmListItemPos (list
, default_xmstring
);
11107 XmStringFree (default_xmstring
);
11109 /* Select the item and scroll it into view. */
11110 XmListSelectPos (list
, item_pos
, True
);
11111 XmListSetPos (list
, item_pos
);
11114 /* Process events until the user presses Cancel or OK. */
11116 while (result
== 0 || XtAppPending (Xt_app_con
))
11117 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11119 /* Get the result. */
11120 if (result
== XmCR_OK
)
11125 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11126 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11127 XmStringFree (text
);
11128 file
= build_string (data
);
11135 XtUnmanageChild (dialog
);
11136 XtDestroyWidget (dialog
);
11140 /* Make "Cancel" equivalent to C-g. */
11142 Fsignal (Qquit
, Qnil
);
11144 return unbind_to (count
, file
);
11147 #endif /* USE_MOTIF */
11151 /***********************************************************************
11153 ***********************************************************************/
11155 #ifdef HAVE_XKBGETKEYBOARD
11156 #include <X11/XKBlib.h>
11157 #include <X11/keysym.h>
11160 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11161 Sx_backspace_delete_keys_p
, 0, 1, 0,
11162 "Check if both Backspace and Delete keys are on the keyboard of FRAME.\n\
11163 FRAME nil means use the selected frame.\n\
11164 Value is t if we know that both keys are present, and are mapped to the\n\
11169 #ifdef HAVE_XKBGETKEYBOARD
11171 struct frame
*f
= check_x_frame (frame
);
11172 Display
*dpy
= FRAME_X_DISPLAY (f
);
11173 Lisp_Object have_keys
;
11174 int major
, minor
, op
, event
, error
;
11178 /* Check library version in case we're dynamically linked. */
11179 major
= XkbMajorVersion
;
11180 minor
= XkbMinorVersion
;
11181 if (!XkbLibraryVersion (&major
, &minor
))
11187 /* Check that the server supports XKB. */
11188 major
= XkbMajorVersion
;
11189 minor
= XkbMinorVersion
;
11190 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11197 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11200 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11202 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11204 for (i
= kb
->min_key_code
;
11205 (i
< kb
->max_key_code
11206 && (delete_keycode
== 0 || backspace_keycode
== 0));
11209 /* The XKB symbolic key names can be seen most easily
11210 in the PS file generated by `xkbprint -label name $DISPLAY'. */
11211 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11212 delete_keycode
= i
;
11213 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11214 backspace_keycode
= i
;
11217 XkbFreeNames (kb
, 0, True
);
11220 XkbFreeClientMap (kb
, 0, True
);
11223 && backspace_keycode
11224 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11225 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11230 #else /* not HAVE_XKBGETKEYBOARD */
11232 #endif /* not HAVE_XKBGETKEYBOARD */
11237 /***********************************************************************
11239 ***********************************************************************/
11244 /* This is zero if not using X windows. */
11247 /* The section below is built by the lisp expression at the top of the file,
11248 just above where these variables are declared. */
11249 /*&&& init symbols here &&&*/
11250 Qauto_raise
= intern ("auto-raise");
11251 staticpro (&Qauto_raise
);
11252 Qauto_lower
= intern ("auto-lower");
11253 staticpro (&Qauto_lower
);
11254 Qbar
= intern ("bar");
11256 Qborder_color
= intern ("border-color");
11257 staticpro (&Qborder_color
);
11258 Qborder_width
= intern ("border-width");
11259 staticpro (&Qborder_width
);
11260 Qbox
= intern ("box");
11262 Qcursor_color
= intern ("cursor-color");
11263 staticpro (&Qcursor_color
);
11264 Qcursor_type
= intern ("cursor-type");
11265 staticpro (&Qcursor_type
);
11266 Qgeometry
= intern ("geometry");
11267 staticpro (&Qgeometry
);
11268 Qicon_left
= intern ("icon-left");
11269 staticpro (&Qicon_left
);
11270 Qicon_top
= intern ("icon-top");
11271 staticpro (&Qicon_top
);
11272 Qicon_type
= intern ("icon-type");
11273 staticpro (&Qicon_type
);
11274 Qicon_name
= intern ("icon-name");
11275 staticpro (&Qicon_name
);
11276 Qinternal_border_width
= intern ("internal-border-width");
11277 staticpro (&Qinternal_border_width
);
11278 Qleft
= intern ("left");
11279 staticpro (&Qleft
);
11280 Qright
= intern ("right");
11281 staticpro (&Qright
);
11282 Qmouse_color
= intern ("mouse-color");
11283 staticpro (&Qmouse_color
);
11284 Qnone
= intern ("none");
11285 staticpro (&Qnone
);
11286 Qparent_id
= intern ("parent-id");
11287 staticpro (&Qparent_id
);
11288 Qscroll_bar_width
= intern ("scroll-bar-width");
11289 staticpro (&Qscroll_bar_width
);
11290 Qsuppress_icon
= intern ("suppress-icon");
11291 staticpro (&Qsuppress_icon
);
11292 Qundefined_color
= intern ("undefined-color");
11293 staticpro (&Qundefined_color
);
11294 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11295 staticpro (&Qvertical_scroll_bars
);
11296 Qvisibility
= intern ("visibility");
11297 staticpro (&Qvisibility
);
11298 Qwindow_id
= intern ("window-id");
11299 staticpro (&Qwindow_id
);
11300 Qouter_window_id
= intern ("outer-window-id");
11301 staticpro (&Qouter_window_id
);
11302 Qx_frame_parameter
= intern ("x-frame-parameter");
11303 staticpro (&Qx_frame_parameter
);
11304 Qx_resource_name
= intern ("x-resource-name");
11305 staticpro (&Qx_resource_name
);
11306 Quser_position
= intern ("user-position");
11307 staticpro (&Quser_position
);
11308 Quser_size
= intern ("user-size");
11309 staticpro (&Quser_size
);
11310 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11311 staticpro (&Qscroll_bar_foreground
);
11312 Qscroll_bar_background
= intern ("scroll-bar-background");
11313 staticpro (&Qscroll_bar_background
);
11314 Qscreen_gamma
= intern ("screen-gamma");
11315 staticpro (&Qscreen_gamma
);
11316 Qline_spacing
= intern ("line-spacing");
11317 staticpro (&Qline_spacing
);
11318 Qcenter
= intern ("center");
11319 staticpro (&Qcenter
);
11320 Qcompound_text
= intern ("compound-text");
11321 staticpro (&Qcompound_text
);
11322 Qcancel_timer
= intern ("cancel-timer");
11323 staticpro (&Qcancel_timer
);
11324 /* This is the end of symbol initialization. */
11326 /* Text property `display' should be nonsticky by default. */
11327 Vtext_property_default_nonsticky
11328 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11331 Qlaplace
= intern ("laplace");
11332 staticpro (&Qlaplace
);
11333 Qemboss
= intern ("emboss");
11334 staticpro (&Qemboss
);
11335 Qedge_detection
= intern ("edge-detection");
11336 staticpro (&Qedge_detection
);
11337 Qheuristic
= intern ("heuristic");
11338 staticpro (&Qheuristic
);
11339 QCmatrix
= intern (":matrix");
11340 staticpro (&QCmatrix
);
11341 QCcolor_adjustment
= intern (":color-adjustment");
11342 staticpro (&QCcolor_adjustment
);
11343 QCmask
= intern (":mask");
11344 staticpro (&QCmask
);
11346 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11347 staticpro (&Qface_set_after_frame_default
);
11349 Fput (Qundefined_color
, Qerror_conditions
,
11350 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11351 Fput (Qundefined_color
, Qerror_message
,
11352 build_string ("Undefined color"));
11354 init_x_parm_symbols ();
11356 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11357 "Non-nil means always draw a cross over disabled images.\n\
11358 Disabled images are those having an `:conversion disabled' property.\n\
11359 A cross is always drawn on black & white displays.");
11360 cross_disabled_images
= 0;
11362 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11363 "List of directories to search for bitmap files for X.");
11364 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11366 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11367 "The shape of the pointer when over text.\n\
11368 Changing the value does not affect existing frames\n\
11369 unless you set the mouse color.");
11370 Vx_pointer_shape
= Qnil
;
11372 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11373 "The name Emacs uses to look up X resources.\n\
11374 `x-get-resource' uses this as the first component of the instance name\n\
11375 when requesting resource values.\n\
11376 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
11377 was invoked, or to the value specified with the `-name' or `-rn'\n\
11378 switches, if present.\n\
11380 It may be useful to bind this variable locally around a call\n\
11381 to `x-get-resource'. See also the variable `x-resource-class'.");
11382 Vx_resource_name
= Qnil
;
11384 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11385 "The class Emacs uses to look up X resources.\n\
11386 `x-get-resource' uses this as the first component of the instance class\n\
11387 when requesting resource values.\n\
11388 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
11390 Setting this variable permanently is not a reasonable thing to do,\n\
11391 but binding this variable locally around a call to `x-get-resource'\n\
11392 is a reasonable practice. See also the variable `x-resource-name'.");
11393 Vx_resource_class
= build_string (EMACS_CLASS
);
11395 #if 0 /* This doesn't really do anything. */
11396 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11397 "The shape of the pointer when not over text.\n\
11398 This variable takes effect when you create a new frame\n\
11399 or when you set the mouse color.");
11401 Vx_nontext_pointer_shape
= Qnil
;
11403 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
11404 "The shape of the pointer when Emacs is busy.\n\
11405 This variable takes effect when you create a new frame\n\
11406 or when you set the mouse color.");
11407 Vx_busy_pointer_shape
= Qnil
;
11409 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
11410 "Non-zero means Emacs displays a busy cursor on window systems.");
11411 display_busy_cursor_p
= 1;
11413 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay
,
11414 "*Seconds to wait before displaying a busy-cursor.\n\
11415 Value must be an integer or float.");
11416 Vbusy_cursor_delay
= make_number (DEFAULT_BUSY_CURSOR_DELAY
);
11418 #if 0 /* This doesn't really do anything. */
11419 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11420 "The shape of the pointer when over the mode line.\n\
11421 This variable takes effect when you create a new frame\n\
11422 or when you set the mouse color.");
11424 Vx_mode_pointer_shape
= Qnil
;
11426 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11427 &Vx_sensitive_text_pointer_shape
,
11428 "The shape of the pointer when over mouse-sensitive text.\n\
11429 This variable takes effect when you create a new frame\n\
11430 or when you set the mouse color.");
11431 Vx_sensitive_text_pointer_shape
= Qnil
;
11433 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11434 &Vx_window_horizontal_drag_shape
,
11435 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
11436 This variable takes effect when you create a new frame\n\
11437 or when you set the mouse color.");
11438 Vx_window_horizontal_drag_shape
= Qnil
;
11440 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11441 "A string indicating the foreground color of the cursor box.");
11442 Vx_cursor_fore_pixel
= Qnil
;
11444 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11445 "Non-nil if no X window manager is in use.\n\
11446 Emacs doesn't try to figure this out; this is always nil\n\
11447 unless you set it to something else.");
11448 /* We don't have any way to find this out, so set it to nil
11449 and maybe the user would like to set it to t. */
11450 Vx_no_window_manager
= Qnil
;
11452 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11453 &Vx_pixel_size_width_font_regexp
,
11454 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11456 Since Emacs gets width of a font matching with this regexp from\n\
11457 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11458 such a font. This is especially effective for such large fonts as\n\
11459 Chinese, Japanese, and Korean.");
11460 Vx_pixel_size_width_font_regexp
= Qnil
;
11462 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11463 "Time after which cached images are removed from the cache.\n\
11464 When an image has not been displayed this many seconds, remove it\n\
11465 from the image cache. Value must be an integer or nil with nil\n\
11466 meaning don't clear the cache.");
11467 Vimage_cache_eviction_delay
= make_number (30 * 60);
11469 #ifdef USE_X_TOOLKIT
11470 Fprovide (intern ("x-toolkit"));
11473 Fprovide (intern ("motif"));
11476 defsubr (&Sx_get_resource
);
11478 /* X window properties. */
11479 defsubr (&Sx_change_window_property
);
11480 defsubr (&Sx_delete_window_property
);
11481 defsubr (&Sx_window_property
);
11483 defsubr (&Sxw_display_color_p
);
11484 defsubr (&Sx_display_grayscale_p
);
11485 defsubr (&Sxw_color_defined_p
);
11486 defsubr (&Sxw_color_values
);
11487 defsubr (&Sx_server_max_request_size
);
11488 defsubr (&Sx_server_vendor
);
11489 defsubr (&Sx_server_version
);
11490 defsubr (&Sx_display_pixel_width
);
11491 defsubr (&Sx_display_pixel_height
);
11492 defsubr (&Sx_display_mm_width
);
11493 defsubr (&Sx_display_mm_height
);
11494 defsubr (&Sx_display_screens
);
11495 defsubr (&Sx_display_planes
);
11496 defsubr (&Sx_display_color_cells
);
11497 defsubr (&Sx_display_visual_class
);
11498 defsubr (&Sx_display_backing_store
);
11499 defsubr (&Sx_display_save_under
);
11500 defsubr (&Sx_parse_geometry
);
11501 defsubr (&Sx_create_frame
);
11502 defsubr (&Sx_open_connection
);
11503 defsubr (&Sx_close_connection
);
11504 defsubr (&Sx_display_list
);
11505 defsubr (&Sx_synchronize
);
11506 defsubr (&Sx_focus_frame
);
11507 defsubr (&Sx_backspace_delete_keys_p
);
11509 /* Setting callback functions for fontset handler. */
11510 get_font_info_func
= x_get_font_info
;
11512 #if 0 /* This function pointer doesn't seem to be used anywhere.
11513 And the pointer assigned has the wrong type, anyway. */
11514 list_fonts_func
= x_list_fonts
;
11517 load_font_func
= x_load_font
;
11518 find_ccl_program_func
= x_find_ccl_program
;
11519 query_font_func
= x_query_font
;
11520 set_frame_fontset_func
= x_set_font
;
11521 check_window_system_func
= check_x
;
11524 Qxbm
= intern ("xbm");
11526 QCtype
= intern (":type");
11527 staticpro (&QCtype
);
11528 QCconversion
= intern (":conversion");
11529 staticpro (&QCconversion
);
11530 QCheuristic_mask
= intern (":heuristic-mask");
11531 staticpro (&QCheuristic_mask
);
11532 QCcolor_symbols
= intern (":color-symbols");
11533 staticpro (&QCcolor_symbols
);
11534 QCascent
= intern (":ascent");
11535 staticpro (&QCascent
);
11536 QCmargin
= intern (":margin");
11537 staticpro (&QCmargin
);
11538 QCrelief
= intern (":relief");
11539 staticpro (&QCrelief
);
11540 Qpostscript
= intern ("postscript");
11541 staticpro (&Qpostscript
);
11542 QCloader
= intern (":loader");
11543 staticpro (&QCloader
);
11544 QCbounding_box
= intern (":bounding-box");
11545 staticpro (&QCbounding_box
);
11546 QCpt_width
= intern (":pt-width");
11547 staticpro (&QCpt_width
);
11548 QCpt_height
= intern (":pt-height");
11549 staticpro (&QCpt_height
);
11550 QCindex
= intern (":index");
11551 staticpro (&QCindex
);
11552 Qpbm
= intern ("pbm");
11556 Qxpm
= intern ("xpm");
11561 Qjpeg
= intern ("jpeg");
11562 staticpro (&Qjpeg
);
11566 Qtiff
= intern ("tiff");
11567 staticpro (&Qtiff
);
11571 Qgif
= intern ("gif");
11576 Qpng
= intern ("png");
11580 defsubr (&Sclear_image_cache
);
11581 defsubr (&Simage_size
);
11582 defsubr (&Simage_mask_p
);
11584 busy_cursor_atimer
= NULL
;
11585 busy_cursor_shown_p
= 0;
11587 defsubr (&Sx_show_tip
);
11588 defsubr (&Sx_hide_tip
);
11590 staticpro (&tip_timer
);
11592 staticpro (&tip_frame
);
11594 last_show_tip_args
= Qnil
;
11595 staticpro (&last_show_tip_args
);
11598 defsubr (&Sx_file_dialog
);
11606 image_types
= NULL
;
11607 Vimage_types
= Qnil
;
11609 define_image_type (&xbm_type
);
11610 define_image_type (&gs_type
);
11611 define_image_type (&pbm_type
);
11614 define_image_type (&xpm_type
);
11618 define_image_type (&jpeg_type
);
11622 define_image_type (&tiff_type
);
11626 define_image_type (&gif_type
);
11630 define_image_type (&png_type
);
11634 #endif /* HAVE_X_WINDOWS */