1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999, 2000, 2001, 2002
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
31 /* This makes the fields of a Display accessible, in Xlib header files. */
33 #define XLIB_ILLEGAL_ACCESS
40 #include "intervals.h"
41 #include "dispextern.h"
43 #include "blockinput.h"
49 #include "termhooks.h"
55 #include <sys/types.h>
59 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
60 #include "bitmaps/gray.xbm"
62 #include <X11/bitmaps/gray>
65 #include "[.bitmaps]gray.xbm"
69 #include <X11/Shell.h>
72 #include <X11/Xaw/Paned.h>
73 #include <X11/Xaw/Label.h>
74 #endif /* USE_MOTIF */
77 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
86 #include "../lwlib/lwlib.h"
90 #include <Xm/DialogS.h>
91 #include <Xm/FileSB.h>
94 /* Do the EDITRES protocol if running X11R5
95 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
97 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
99 extern void _XEditResCheckMessages ();
100 #endif /* R5 + Athena */
102 /* Unique id counter for widgets created by the Lucid Widget Library. */
104 extern LWLIB_ID widget_id_tick
;
107 /* This is part of a kludge--see lwlib/xlwmenu.c. */
108 extern XFontStruct
*xlwmenu_default_font
;
111 extern void free_frame_menubar ();
112 extern double atof ();
116 /* LessTif/Motif version info. */
118 static Lisp_Object Vmotif_version_string
;
120 #endif /* USE_MOTIF */
122 #endif /* USE_X_TOOLKIT */
124 #define min(a,b) ((a) < (b) ? (a) : (b))
125 #define max(a,b) ((a) > (b) ? (a) : (b))
128 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
130 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
133 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
134 it, and including `bitmaps/gray' more than once is a problem when
135 config.h defines `static' as an empty replacement string. */
137 int gray_bitmap_width
= gray_width
;
138 int gray_bitmap_height
= gray_height
;
139 char *gray_bitmap_bits
= gray_bits
;
141 /* The name we're using in resource queries. Most often "emacs". */
143 Lisp_Object Vx_resource_name
;
145 /* The application class we're using in resource queries.
148 Lisp_Object Vx_resource_class
;
150 /* Non-zero means we're allowed to display an hourglass cursor. */
152 int display_hourglass_p
;
154 /* The background and shape of the mouse pointer, and shape when not
155 over text or in the modeline. */
157 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
158 Lisp_Object Vx_hourglass_pointer_shape
;
160 /* The shape when over mouse-sensitive text. */
162 Lisp_Object Vx_sensitive_text_pointer_shape
;
164 /* If non-nil, the pointer shape to indicate that windows can be
165 dragged horizontally. */
167 Lisp_Object Vx_window_horizontal_drag_shape
;
169 /* Color of chars displayed in cursor box. */
171 Lisp_Object Vx_cursor_fore_pixel
;
173 /* Nonzero if using X. */
177 /* Non nil if no window manager is in use. */
179 Lisp_Object Vx_no_window_manager
;
181 /* Search path for bitmap files. */
183 Lisp_Object Vx_bitmap_file_path
;
185 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
187 Lisp_Object Vx_pixel_size_width_font_regexp
;
189 Lisp_Object Qauto_raise
;
190 Lisp_Object Qauto_lower
;
192 Lisp_Object Qborder_color
;
193 Lisp_Object Qborder_width
;
195 Lisp_Object Qcursor_color
;
196 Lisp_Object Qcursor_type
;
197 Lisp_Object Qgeometry
;
198 Lisp_Object Qicon_left
;
199 Lisp_Object Qicon_top
;
200 Lisp_Object Qicon_type
;
201 Lisp_Object Qicon_name
;
202 Lisp_Object Qinternal_border_width
;
205 Lisp_Object Qmouse_color
;
207 Lisp_Object Qouter_window_id
;
208 Lisp_Object Qparent_id
;
209 Lisp_Object Qscroll_bar_width
;
210 Lisp_Object Qsuppress_icon
;
211 extern Lisp_Object Qtop
;
212 Lisp_Object Qundefined_color
;
213 Lisp_Object Qvertical_scroll_bars
;
214 Lisp_Object Qvisibility
;
215 Lisp_Object Qwindow_id
;
216 Lisp_Object Qx_frame_parameter
;
217 Lisp_Object Qx_resource_name
;
218 Lisp_Object Quser_position
;
219 Lisp_Object Quser_size
;
220 extern Lisp_Object Qdisplay
;
221 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
222 Lisp_Object Qscreen_gamma
, Qline_spacing
, Qcenter
;
223 Lisp_Object Qcompound_text
, Qcancel_timer
;
224 Lisp_Object Qwait_for_wm
;
226 /* The below are defined in frame.c. */
228 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
229 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
230 extern Lisp_Object Qtool_bar_lines
;
232 extern Lisp_Object Vwindow_system_version
;
234 Lisp_Object Qface_set_after_frame_default
;
237 int image_cache_refcount
, dpyinfo_refcount
;
242 /* Error if we are not connected to X. */
248 error ("X windows are not in use or not initialized");
251 /* Nonzero if we can use mouse menus.
252 You should not call this unless HAVE_MENUS is defined. */
260 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
261 and checking validity for X. */
264 check_x_frame (frame
)
270 frame
= selected_frame
;
271 CHECK_LIVE_FRAME (frame
, 0);
274 error ("Non-X frame used");
278 /* Let the user specify an X display with a frame.
279 nil stands for the selected frame--or, if that is not an X frame,
280 the first X display on the list. */
282 static struct x_display_info
*
283 check_x_display_info (frame
)
286 struct x_display_info
*dpyinfo
= NULL
;
290 struct frame
*sf
= XFRAME (selected_frame
);
292 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
293 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
294 else if (x_display_list
!= 0)
295 dpyinfo
= x_display_list
;
297 error ("X windows are not in use or not initialized");
299 else if (STRINGP (frame
))
300 dpyinfo
= x_display_info_for_name (frame
);
305 CHECK_LIVE_FRAME (frame
, 0);
308 error ("Non-X frame used");
309 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
316 /* Return the Emacs frame-object corresponding to an X window.
317 It could be the frame's main window or an icon window. */
319 /* This function can be called during GC, so use GC_xxx type test macros. */
322 x_window_to_frame (dpyinfo
, wdesc
)
323 struct x_display_info
*dpyinfo
;
326 Lisp_Object tail
, frame
;
329 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
332 if (!GC_FRAMEP (frame
))
335 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
337 if (f
->output_data
.x
->hourglass_window
== wdesc
)
340 if ((f
->output_data
.x
->edit_widget
341 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
342 /* A tooltip frame? */
343 || (!f
->output_data
.x
->edit_widget
344 && FRAME_X_WINDOW (f
) == wdesc
)
345 || f
->output_data
.x
->icon_desc
== wdesc
)
347 #else /* not USE_X_TOOLKIT */
348 if (FRAME_X_WINDOW (f
) == wdesc
349 || f
->output_data
.x
->icon_desc
== wdesc
)
351 #endif /* not USE_X_TOOLKIT */
357 /* Like x_window_to_frame but also compares the window with the widget's
361 x_any_window_to_frame (dpyinfo
, wdesc
)
362 struct x_display_info
*dpyinfo
;
365 Lisp_Object tail
, frame
;
366 struct frame
*f
, *found
;
370 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
373 if (!GC_FRAMEP (frame
))
377 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
379 /* This frame matches if the window is any of its widgets. */
380 x
= f
->output_data
.x
;
381 if (x
->hourglass_window
== wdesc
)
385 if (wdesc
== XtWindow (x
->widget
)
386 || wdesc
== XtWindow (x
->column_widget
)
387 || wdesc
== XtWindow (x
->edit_widget
))
389 /* Match if the window is this frame's menubar. */
390 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
393 else if (FRAME_X_WINDOW (f
) == wdesc
)
394 /* A tooltip frame. */
402 /* Likewise, but exclude the menu bar widget. */
405 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
406 struct x_display_info
*dpyinfo
;
409 Lisp_Object tail
, frame
;
413 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
416 if (!GC_FRAMEP (frame
))
419 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
421 x
= f
->output_data
.x
;
422 /* This frame matches if the window is any of its widgets. */
423 if (x
->hourglass_window
== wdesc
)
427 if (wdesc
== XtWindow (x
->widget
)
428 || wdesc
== XtWindow (x
->column_widget
)
429 || wdesc
== XtWindow (x
->edit_widget
))
432 else if (FRAME_X_WINDOW (f
) == wdesc
)
433 /* A tooltip frame. */
439 /* Likewise, but consider only the menu bar widget. */
442 x_menubar_window_to_frame (dpyinfo
, wdesc
)
443 struct x_display_info
*dpyinfo
;
446 Lisp_Object tail
, frame
;
450 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
453 if (!GC_FRAMEP (frame
))
456 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
458 x
= f
->output_data
.x
;
459 /* Match if the window is this frame's menubar. */
460 if (x
->menubar_widget
461 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
467 /* Return the frame whose principal (outermost) window is WDESC.
468 If WDESC is some other (smaller) window, we return 0. */
471 x_top_window_to_frame (dpyinfo
, wdesc
)
472 struct x_display_info
*dpyinfo
;
475 Lisp_Object tail
, frame
;
479 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
482 if (!GC_FRAMEP (frame
))
485 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
487 x
= f
->output_data
.x
;
491 /* This frame matches if the window is its topmost widget. */
492 if (wdesc
== XtWindow (x
->widget
))
494 #if 0 /* I don't know why it did this,
495 but it seems logically wrong,
496 and it causes trouble for MapNotify events. */
497 /* Match if the window is this frame's menubar. */
498 if (x
->menubar_widget
499 && wdesc
== XtWindow (x
->menubar_widget
))
503 else if (FRAME_X_WINDOW (f
) == wdesc
)
509 #endif /* USE_X_TOOLKIT */
513 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
514 id, which is just an int that this section returns. Bitmaps are
515 reference counted so they can be shared among frames.
517 Bitmap indices are guaranteed to be > 0, so a negative number can
518 be used to indicate no bitmap.
520 If you use x_create_bitmap_from_data, then you must keep track of
521 the bitmaps yourself. That is, creating a bitmap from the same
522 data more than once will not be caught. */
525 /* Functions to access the contents of a bitmap, given an id. */
528 x_bitmap_height (f
, id
)
532 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
536 x_bitmap_width (f
, id
)
540 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
544 x_bitmap_pixmap (f
, id
)
548 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
552 /* Allocate a new bitmap record. Returns index of new record. */
555 x_allocate_bitmap_record (f
)
558 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
561 if (dpyinfo
->bitmaps
== NULL
)
563 dpyinfo
->bitmaps_size
= 10;
565 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
566 dpyinfo
->bitmaps_last
= 1;
570 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
571 return ++dpyinfo
->bitmaps_last
;
573 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
574 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
577 dpyinfo
->bitmaps_size
*= 2;
579 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
580 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
581 return ++dpyinfo
->bitmaps_last
;
584 /* Add one reference to the reference count of the bitmap with id ID. */
587 x_reference_bitmap (f
, id
)
591 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
594 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
597 x_create_bitmap_from_data (f
, bits
, width
, height
)
600 unsigned int width
, height
;
602 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
606 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
607 bits
, width
, height
);
612 id
= x_allocate_bitmap_record (f
);
613 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
614 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
615 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
616 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
617 dpyinfo
->bitmaps
[id
- 1].height
= height
;
618 dpyinfo
->bitmaps
[id
- 1].width
= width
;
623 /* Create bitmap from file FILE for frame F. */
626 x_create_bitmap_from_file (f
, file
)
630 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
631 unsigned int width
, height
;
633 int xhot
, yhot
, result
, id
;
638 /* Look for an existing bitmap with the same name. */
639 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
641 if (dpyinfo
->bitmaps
[id
].refcount
642 && dpyinfo
->bitmaps
[id
].file
643 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
645 ++dpyinfo
->bitmaps
[id
].refcount
;
650 /* Search bitmap-file-path for the file, if appropriate. */
651 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
656 filename
= (char *) XSTRING (found
)->data
;
658 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
659 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
660 if (result
!= BitmapSuccess
)
663 id
= x_allocate_bitmap_record (f
);
664 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
665 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
666 dpyinfo
->bitmaps
[id
- 1].file
667 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
668 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
669 dpyinfo
->bitmaps
[id
- 1].height
= height
;
670 dpyinfo
->bitmaps
[id
- 1].width
= width
;
671 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
676 /* Remove reference to bitmap with id number ID. */
679 x_destroy_bitmap (f
, id
)
683 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
687 --dpyinfo
->bitmaps
[id
- 1].refcount
;
688 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
691 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
692 if (dpyinfo
->bitmaps
[id
- 1].file
)
694 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
695 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
702 /* Free all the bitmaps for the display specified by DPYINFO. */
705 x_destroy_all_bitmaps (dpyinfo
)
706 struct x_display_info
*dpyinfo
;
709 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
710 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
712 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
713 if (dpyinfo
->bitmaps
[i
].file
)
714 xfree (dpyinfo
->bitmaps
[i
].file
);
716 dpyinfo
->bitmaps_last
= 0;
719 /* Connect the frame-parameter names for X frames
720 to the ways of passing the parameter values to the window system.
722 The name of a parameter, as a Lisp symbol,
723 has an `x-frame-parameter' property which is an integer in Lisp
724 that is an index in this table. */
726 struct x_frame_parm_table
729 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
732 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
733 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
734 static void x_change_window_heights
P_ ((Lisp_Object
, int));
735 static void x_disable_image
P_ ((struct frame
*, struct image
*));
736 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
737 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
738 static void x_set_wait_for_wm
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
739 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
740 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
741 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
742 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
743 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
744 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
745 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
746 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
750 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
755 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
759 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
760 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
761 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
763 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
765 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
770 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
771 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
773 static void init_color_table
P_ ((void));
774 static void free_color_table
P_ ((void));
775 static unsigned long *colors_in_color_table
P_ ((int *n
));
776 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
777 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
781 static struct x_frame_parm_table x_frame_parms
[] =
783 "auto-raise", x_set_autoraise
,
784 "auto-lower", x_set_autolower
,
785 "background-color", x_set_background_color
,
786 "border-color", x_set_border_color
,
787 "border-width", x_set_border_width
,
788 "cursor-color", x_set_cursor_color
,
789 "cursor-type", x_set_cursor_type
,
791 "foreground-color", x_set_foreground_color
,
792 "icon-name", x_set_icon_name
,
793 "icon-type", x_set_icon_type
,
794 "internal-border-width", x_set_internal_border_width
,
795 "menu-bar-lines", x_set_menu_bar_lines
,
796 "mouse-color", x_set_mouse_color
,
797 "name", x_explicitly_set_name
,
798 "scroll-bar-width", x_set_scroll_bar_width
,
799 "title", x_set_title
,
800 "unsplittable", x_set_unsplittable
,
801 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
802 "visibility", x_set_visibility
,
803 "tool-bar-lines", x_set_tool_bar_lines
,
804 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
805 "scroll-bar-background", x_set_scroll_bar_background
,
806 "screen-gamma", x_set_screen_gamma
,
807 "line-spacing", x_set_line_spacing
,
808 "wait-for-wm", x_set_wait_for_wm
811 /* Attach the `x-frame-parameter' properties to
812 the Lisp symbol names of parameters relevant to X. */
815 init_x_parm_symbols ()
819 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
820 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
824 /* Change the parameters of frame F as specified by ALIST.
825 If a parameter is not specially recognized, do nothing special;
826 otherwise call the `x_set_...' function for that parameter.
827 Except for certain geometry properties, always call store_frame_param
828 to store the new value in the parameter alist. */
831 x_set_frame_parameters (f
, alist
)
837 /* If both of these parameters are present, it's more efficient to
838 set them both at once. So we wait until we've looked at the
839 entire list before we set them. */
843 Lisp_Object left
, top
;
845 /* Same with these. */
846 Lisp_Object icon_left
, icon_top
;
848 /* Record in these vectors all the parms specified. */
852 int left_no_change
= 0, top_no_change
= 0;
853 int icon_left_no_change
= 0, icon_top_no_change
= 0;
855 struct gcpro gcpro1
, gcpro2
;
858 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
861 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
862 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
864 /* Extract parm names and values into those vectors. */
867 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
872 parms
[i
] = Fcar (elt
);
873 values
[i
] = Fcdr (elt
);
876 /* TAIL and ALIST are not used again below here. */
879 GCPRO2 (*parms
, *values
);
883 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
884 because their values appear in VALUES and strings are not valid. */
885 top
= left
= Qunbound
;
886 icon_left
= icon_top
= Qunbound
;
888 /* Provide default values for HEIGHT and WIDTH. */
889 if (FRAME_NEW_WIDTH (f
))
890 width
= FRAME_NEW_WIDTH (f
);
892 width
= FRAME_WIDTH (f
);
894 if (FRAME_NEW_HEIGHT (f
))
895 height
= FRAME_NEW_HEIGHT (f
);
897 height
= FRAME_HEIGHT (f
);
899 /* Process foreground_color and background_color before anything else.
900 They are independent of other properties, but other properties (e.g.,
901 cursor_color) are dependent upon them. */
902 for (p
= 0; p
< i
; p
++)
904 Lisp_Object prop
, val
;
908 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
910 register Lisp_Object param_index
, old_value
;
912 param_index
= Fget (prop
, Qx_frame_parameter
);
913 old_value
= get_frame_param (f
, prop
);
914 store_frame_param (f
, prop
, val
);
915 if (NATNUMP (param_index
)
916 && (XFASTINT (param_index
)
917 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
918 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
922 /* Now process them in reverse of specified order. */
923 for (i
--; i
>= 0; i
--)
925 Lisp_Object prop
, val
;
930 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
931 width
= XFASTINT (val
);
932 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
933 height
= XFASTINT (val
);
934 else if (EQ (prop
, Qtop
))
936 else if (EQ (prop
, Qleft
))
938 else if (EQ (prop
, Qicon_top
))
940 else if (EQ (prop
, Qicon_left
))
942 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
943 /* Processed above. */
947 register Lisp_Object param_index
, old_value
;
949 param_index
= Fget (prop
, Qx_frame_parameter
);
950 old_value
= get_frame_param (f
, prop
);
951 store_frame_param (f
, prop
, val
);
952 if (NATNUMP (param_index
)
953 && (XFASTINT (param_index
)
954 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
955 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
959 /* Don't die if just one of these was set. */
960 if (EQ (left
, Qunbound
))
963 if (f
->output_data
.x
->left_pos
< 0)
964 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
966 XSETINT (left
, f
->output_data
.x
->left_pos
);
968 if (EQ (top
, Qunbound
))
971 if (f
->output_data
.x
->top_pos
< 0)
972 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
974 XSETINT (top
, f
->output_data
.x
->top_pos
);
977 /* If one of the icon positions was not set, preserve or default it. */
978 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
980 icon_left_no_change
= 1;
981 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
982 if (NILP (icon_left
))
983 XSETINT (icon_left
, 0);
985 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
987 icon_top_no_change
= 1;
988 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
990 XSETINT (icon_top
, 0);
993 /* Don't set these parameters unless they've been explicitly
994 specified. The window might be mapped or resized while we're in
995 this function, and we don't want to override that unless the lisp
996 code has asked for it.
998 Don't set these parameters unless they actually differ from the
999 window's current parameters; the window may not actually exist
1004 check_frame_size (f
, &height
, &width
);
1006 XSETFRAME (frame
, f
);
1008 if (width
!= FRAME_WIDTH (f
)
1009 || height
!= FRAME_HEIGHT (f
)
1010 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1011 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1013 if ((!NILP (left
) || !NILP (top
))
1014 && ! (left_no_change
&& top_no_change
)
1015 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1016 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1021 /* Record the signs. */
1022 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1023 if (EQ (left
, Qminus
))
1024 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1025 else if (INTEGERP (left
))
1027 leftpos
= XINT (left
);
1029 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1031 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1032 && CONSP (XCDR (left
))
1033 && INTEGERP (XCAR (XCDR (left
))))
1035 leftpos
= - XINT (XCAR (XCDR (left
)));
1036 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1038 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1039 && CONSP (XCDR (left
))
1040 && INTEGERP (XCAR (XCDR (left
))))
1042 leftpos
= XINT (XCAR (XCDR (left
)));
1045 if (EQ (top
, Qminus
))
1046 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1047 else if (INTEGERP (top
))
1049 toppos
= XINT (top
);
1051 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1053 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1054 && CONSP (XCDR (top
))
1055 && INTEGERP (XCAR (XCDR (top
))))
1057 toppos
= - XINT (XCAR (XCDR (top
)));
1058 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1060 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1061 && CONSP (XCDR (top
))
1062 && INTEGERP (XCAR (XCDR (top
))))
1064 toppos
= XINT (XCAR (XCDR (top
)));
1068 /* Store the numeric value of the position. */
1069 f
->output_data
.x
->top_pos
= toppos
;
1070 f
->output_data
.x
->left_pos
= leftpos
;
1072 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1074 /* Actually set that position, and convert to absolute. */
1075 x_set_offset (f
, leftpos
, toppos
, -1);
1078 if ((!NILP (icon_left
) || !NILP (icon_top
))
1079 && ! (icon_left_no_change
&& icon_top_no_change
))
1080 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1086 /* Store the screen positions of frame F into XPTR and YPTR.
1087 These are the positions of the containing window manager window,
1088 not Emacs's own window. */
1091 x_real_positions (f
, xptr
, yptr
)
1098 /* This is pretty gross, but seems to be the easiest way out of
1099 the problem that arises when restarting window-managers. */
1101 #ifdef USE_X_TOOLKIT
1102 Window outer
= (f
->output_data
.x
->widget
1103 ? XtWindow (f
->output_data
.x
->widget
)
1104 : FRAME_X_WINDOW (f
));
1106 Window outer
= f
->output_data
.x
->window_desc
;
1108 Window tmp_root_window
;
1109 Window
*tmp_children
;
1110 unsigned int tmp_nchildren
;
1114 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1115 Window outer_window
;
1117 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1118 &f
->output_data
.x
->parent_desc
,
1119 &tmp_children
, &tmp_nchildren
);
1120 XFree ((char *) tmp_children
);
1124 /* Find the position of the outside upper-left corner of
1125 the inner window, with respect to the outer window. */
1126 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1127 outer_window
= f
->output_data
.x
->parent_desc
;
1129 outer_window
= outer
;
1131 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1133 /* From-window, to-window. */
1135 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1137 /* From-position, to-position. */
1138 0, 0, &win_x
, &win_y
,
1143 /* It is possible for the window returned by the XQueryNotify
1144 to become invalid by the time we call XTranslateCoordinates.
1145 That can happen when you restart some window managers.
1146 If so, we get an error in XTranslateCoordinates.
1147 Detect that and try the whole thing over. */
1148 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1150 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1154 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1161 /* Insert a description of internally-recorded parameters of frame X
1162 into the parameter alist *ALISTPTR that is to be given to the user.
1163 Only parameters that are specific to the X window system
1164 and whose values are not correctly recorded in the frame's
1165 param_alist need to be considered here. */
1168 x_report_frame_params (f
, alistptr
)
1170 Lisp_Object
*alistptr
;
1175 /* Represent negative positions (off the top or left screen edge)
1176 in a way that Fmodify_frame_parameters will understand correctly. */
1177 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1178 if (f
->output_data
.x
->left_pos
>= 0)
1179 store_in_alist (alistptr
, Qleft
, tem
);
1181 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1183 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1184 if (f
->output_data
.x
->top_pos
>= 0)
1185 store_in_alist (alistptr
, Qtop
, tem
);
1187 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1189 store_in_alist (alistptr
, Qborder_width
,
1190 make_number (f
->output_data
.x
->border_width
));
1191 store_in_alist (alistptr
, Qinternal_border_width
,
1192 make_number (f
->output_data
.x
->internal_border_width
));
1193 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1194 store_in_alist (alistptr
, Qwindow_id
,
1195 build_string (buf
));
1196 #ifdef USE_X_TOOLKIT
1197 /* Tooltip frame may not have this widget. */
1198 if (f
->output_data
.x
->widget
)
1200 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1201 store_in_alist (alistptr
, Qouter_window_id
,
1202 build_string (buf
));
1203 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1204 FRAME_SAMPLE_VISIBILITY (f
);
1205 store_in_alist (alistptr
, Qvisibility
,
1206 (FRAME_VISIBLE_P (f
) ? Qt
1207 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1208 store_in_alist (alistptr
, Qdisplay
,
1209 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1211 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1214 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1215 store_in_alist (alistptr
, Qparent_id
, tem
);
1220 /* Gamma-correct COLOR on frame F. */
1223 gamma_correct (f
, color
)
1229 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1230 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1231 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1236 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1237 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1238 allocate the color. Value is zero if COLOR_NAME is invalid, or
1239 no color could be allocated. */
1242 x_defined_color (f
, color_name
, color
, alloc_p
)
1249 Display
*dpy
= FRAME_X_DISPLAY (f
);
1250 Colormap cmap
= FRAME_X_COLORMAP (f
);
1253 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1254 if (success_p
&& alloc_p
)
1255 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1262 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1263 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1264 Signal an error if color can't be allocated. */
1267 x_decode_color (f
, color_name
, mono_color
)
1269 Lisp_Object color_name
;
1274 CHECK_STRING (color_name
, 0);
1276 #if 0 /* Don't do this. It's wrong when we're not using the default
1277 colormap, it makes freeing difficult, and it's probably not
1278 an important optimization. */
1279 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1280 return BLACK_PIX_DEFAULT (f
);
1281 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1282 return WHITE_PIX_DEFAULT (f
);
1285 /* Return MONO_COLOR for monochrome frames. */
1286 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1289 /* x_defined_color is responsible for coping with failures
1290 by looking for a near-miss. */
1291 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1294 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1295 Fcons (color_name
, Qnil
)));
1301 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1302 the previous value of that parameter, NEW_VALUE is the new value. */
1305 x_set_line_spacing (f
, new_value
, old_value
)
1307 Lisp_Object new_value
, old_value
;
1309 if (NILP (new_value
))
1310 f
->extra_line_spacing
= 0;
1311 else if (NATNUMP (new_value
))
1312 f
->extra_line_spacing
= XFASTINT (new_value
);
1314 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1315 Fcons (new_value
, Qnil
)));
1316 if (FRAME_VISIBLE_P (f
))
1321 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1322 the previous value of that parameter, NEW_VALUE is the new value.
1323 See also the comment of wait_for_wm in struct x_output. */
1326 x_set_wait_for_wm (f
, new_value
, old_value
)
1328 Lisp_Object new_value
, old_value
;
1330 f
->output_data
.x
->wait_for_wm
= !NILP (new_value
);
1334 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1335 the previous value of that parameter, NEW_VALUE is the new
1339 x_set_screen_gamma (f
, new_value
, old_value
)
1341 Lisp_Object new_value
, old_value
;
1343 if (NILP (new_value
))
1345 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1346 /* The value 0.4545 is the normal viewing gamma. */
1347 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1349 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1350 Fcons (new_value
, Qnil
)));
1352 clear_face_cache (0);
1356 /* Functions called only from `x_set_frame_param'
1357 to set individual parameters.
1359 If FRAME_X_WINDOW (f) is 0,
1360 the frame is being created and its X-window does not exist yet.
1361 In that case, just record the parameter's new value
1362 in the standard place; do not attempt to change the window. */
1365 x_set_foreground_color (f
, arg
, oldval
)
1367 Lisp_Object arg
, oldval
;
1369 struct x_output
*x
= f
->output_data
.x
;
1370 unsigned long fg
, old_fg
;
1372 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1373 old_fg
= x
->foreground_pixel
;
1374 x
->foreground_pixel
= fg
;
1376 if (FRAME_X_WINDOW (f
) != 0)
1378 Display
*dpy
= FRAME_X_DISPLAY (f
);
1381 XSetForeground (dpy
, x
->normal_gc
, fg
);
1382 XSetBackground (dpy
, x
->reverse_gc
, fg
);
1384 if (x
->cursor_pixel
== old_fg
)
1386 unload_color (f
, x
->cursor_pixel
);
1387 x
->cursor_pixel
= x_copy_color (f
, fg
);
1388 XSetBackground (dpy
, x
->cursor_gc
, x
->cursor_pixel
);
1393 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1395 if (FRAME_VISIBLE_P (f
))
1399 unload_color (f
, old_fg
);
1403 x_set_background_color (f
, arg
, oldval
)
1405 Lisp_Object arg
, oldval
;
1407 struct x_output
*x
= f
->output_data
.x
;
1410 bg
= x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1411 unload_color (f
, x
->background_pixel
);
1412 x
->background_pixel
= bg
;
1414 if (FRAME_X_WINDOW (f
) != 0)
1416 Display
*dpy
= FRAME_X_DISPLAY (f
);
1419 XSetBackground (dpy
, x
->normal_gc
, bg
);
1420 XSetForeground (dpy
, x
->reverse_gc
, bg
);
1421 XSetWindowBackground (dpy
, FRAME_X_WINDOW (f
), bg
);
1422 XSetForeground (dpy
, x
->cursor_gc
, bg
);
1424 #ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1425 toolkit scroll bars. */
1428 for (bar
= FRAME_SCROLL_BARS (f
);
1430 bar
= XSCROLL_BAR (bar
)->next
)
1432 Window window
= SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
));
1433 XSetWindowBackground (dpy
, window
, bg
);
1436 #endif /* USE_TOOLKIT_SCROLL_BARS */
1439 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1441 if (FRAME_VISIBLE_P (f
))
1447 x_set_mouse_color (f
, arg
, oldval
)
1449 Lisp_Object arg
, oldval
;
1451 struct x_output
*x
= f
->output_data
.x
;
1452 Display
*dpy
= FRAME_X_DISPLAY (f
);
1453 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1454 Cursor hourglass_cursor
, horizontal_drag_cursor
;
1456 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1457 unsigned long mask_color
= x
->background_pixel
;
1459 /* Don't let pointers be invisible. */
1460 if (mask_color
== pixel
)
1462 x_free_colors (f
, &pixel
, 1);
1463 pixel
= x_copy_color (f
, x
->foreground_pixel
);
1466 unload_color (f
, x
->mouse_pixel
);
1467 x
->mouse_pixel
= pixel
;
1471 /* It's not okay to crash if the user selects a screwy cursor. */
1472 count
= x_catch_errors (dpy
);
1474 if (!NILP (Vx_pointer_shape
))
1476 CHECK_NUMBER (Vx_pointer_shape
, 0);
1477 cursor
= XCreateFontCursor (dpy
, XINT (Vx_pointer_shape
));
1480 cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1481 x_check_errors (dpy
, "bad text pointer cursor: %s");
1483 if (!NILP (Vx_nontext_pointer_shape
))
1485 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1487 = XCreateFontCursor (dpy
, XINT (Vx_nontext_pointer_shape
));
1490 nontext_cursor
= XCreateFontCursor (dpy
, XC_left_ptr
);
1491 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1493 if (!NILP (Vx_hourglass_pointer_shape
))
1495 CHECK_NUMBER (Vx_hourglass_pointer_shape
, 0);
1497 = XCreateFontCursor (dpy
, XINT (Vx_hourglass_pointer_shape
));
1500 hourglass_cursor
= XCreateFontCursor (dpy
, XC_watch
);
1501 x_check_errors (dpy
, "bad hourglass pointer cursor: %s");
1503 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1504 if (!NILP (Vx_mode_pointer_shape
))
1506 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1507 mode_cursor
= XCreateFontCursor (dpy
, XINT (Vx_mode_pointer_shape
));
1510 mode_cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1511 x_check_errors (dpy
, "bad modeline pointer cursor: %s");
1513 if (!NILP (Vx_sensitive_text_pointer_shape
))
1515 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1517 = XCreateFontCursor (dpy
, XINT (Vx_sensitive_text_pointer_shape
));
1520 cross_cursor
= XCreateFontCursor (dpy
, XC_crosshair
);
1522 if (!NILP (Vx_window_horizontal_drag_shape
))
1524 CHECK_NUMBER (Vx_window_horizontal_drag_shape
, 0);
1525 horizontal_drag_cursor
1526 = XCreateFontCursor (dpy
, XINT (Vx_window_horizontal_drag_shape
));
1529 horizontal_drag_cursor
1530 = XCreateFontCursor (dpy
, XC_sb_h_double_arrow
);
1532 /* Check and report errors with the above calls. */
1533 x_check_errors (dpy
, "can't set cursor shape: %s");
1534 x_uncatch_errors (dpy
, count
);
1537 XColor fore_color
, back_color
;
1539 fore_color
.pixel
= x
->mouse_pixel
;
1540 x_query_color (f
, &fore_color
);
1541 back_color
.pixel
= mask_color
;
1542 x_query_color (f
, &back_color
);
1544 XRecolorCursor (dpy
, cursor
, &fore_color
, &back_color
);
1545 XRecolorCursor (dpy
, nontext_cursor
, &fore_color
, &back_color
);
1546 XRecolorCursor (dpy
, mode_cursor
, &fore_color
, &back_color
);
1547 XRecolorCursor (dpy
, cross_cursor
, &fore_color
, &back_color
);
1548 XRecolorCursor (dpy
, hourglass_cursor
, &fore_color
, &back_color
);
1549 XRecolorCursor (dpy
, horizontal_drag_cursor
, &fore_color
, &back_color
);
1552 if (FRAME_X_WINDOW (f
) != 0)
1553 XDefineCursor (dpy
, FRAME_X_WINDOW (f
), cursor
);
1555 if (cursor
!= x
->text_cursor
1556 && x
->text_cursor
!= 0)
1557 XFreeCursor (dpy
, x
->text_cursor
);
1558 x
->text_cursor
= cursor
;
1560 if (nontext_cursor
!= x
->nontext_cursor
1561 && x
->nontext_cursor
!= 0)
1562 XFreeCursor (dpy
, x
->nontext_cursor
);
1563 x
->nontext_cursor
= nontext_cursor
;
1565 if (hourglass_cursor
!= x
->hourglass_cursor
1566 && x
->hourglass_cursor
!= 0)
1567 XFreeCursor (dpy
, x
->hourglass_cursor
);
1568 x
->hourglass_cursor
= hourglass_cursor
;
1570 if (mode_cursor
!= x
->modeline_cursor
1571 && x
->modeline_cursor
!= 0)
1572 XFreeCursor (dpy
, f
->output_data
.x
->modeline_cursor
);
1573 x
->modeline_cursor
= mode_cursor
;
1575 if (cross_cursor
!= x
->cross_cursor
1576 && x
->cross_cursor
!= 0)
1577 XFreeCursor (dpy
, x
->cross_cursor
);
1578 x
->cross_cursor
= cross_cursor
;
1580 if (horizontal_drag_cursor
!= x
->horizontal_drag_cursor
1581 && x
->horizontal_drag_cursor
!= 0)
1582 XFreeCursor (dpy
, x
->horizontal_drag_cursor
);
1583 x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1588 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1592 x_set_cursor_color (f
, arg
, oldval
)
1594 Lisp_Object arg
, oldval
;
1596 unsigned long fore_pixel
, pixel
;
1597 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1598 struct x_output
*x
= f
->output_data
.x
;
1600 if (!NILP (Vx_cursor_fore_pixel
))
1602 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1603 WHITE_PIX_DEFAULT (f
));
1604 fore_pixel_allocated_p
= 1;
1607 fore_pixel
= x
->background_pixel
;
1609 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1610 pixel_allocated_p
= 1;
1612 /* Make sure that the cursor color differs from the background color. */
1613 if (pixel
== x
->background_pixel
)
1615 if (pixel_allocated_p
)
1617 x_free_colors (f
, &pixel
, 1);
1618 pixel_allocated_p
= 0;
1621 pixel
= x
->mouse_pixel
;
1622 if (pixel
== fore_pixel
)
1624 if (fore_pixel_allocated_p
)
1626 x_free_colors (f
, &fore_pixel
, 1);
1627 fore_pixel_allocated_p
= 0;
1629 fore_pixel
= x
->background_pixel
;
1633 unload_color (f
, x
->cursor_foreground_pixel
);
1634 if (!fore_pixel_allocated_p
)
1635 fore_pixel
= x_copy_color (f
, fore_pixel
);
1636 x
->cursor_foreground_pixel
= fore_pixel
;
1638 unload_color (f
, x
->cursor_pixel
);
1639 if (!pixel_allocated_p
)
1640 pixel
= x_copy_color (f
, pixel
);
1641 x
->cursor_pixel
= pixel
;
1643 if (FRAME_X_WINDOW (f
) != 0)
1646 XSetBackground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, x
->cursor_pixel
);
1647 XSetForeground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, fore_pixel
);
1650 if (FRAME_VISIBLE_P (f
))
1652 x_update_cursor (f
, 0);
1653 x_update_cursor (f
, 1);
1657 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1660 /* Set the border-color of frame F to value described by ARG.
1661 ARG can be a string naming a color.
1662 The border-color is used for the border that is drawn by the X server.
1663 Note that this does not fully take effect if done before
1664 F has an x-window; it must be redone when the window is created.
1666 Note: this is done in two routines because of the way X10 works.
1668 Note: under X11, this is normally the province of the window manager,
1669 and so emacs' border colors may be overridden. */
1672 x_set_border_color (f
, arg
, oldval
)
1674 Lisp_Object arg
, oldval
;
1678 CHECK_STRING (arg
, 0);
1679 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1680 x_set_border_pixel (f
, pix
);
1681 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1684 /* Set the border-color of frame F to pixel value PIX.
1685 Note that this does not fully take effect if done before
1686 F has an x-window. */
1689 x_set_border_pixel (f
, pix
)
1693 unload_color (f
, f
->output_data
.x
->border_pixel
);
1694 f
->output_data
.x
->border_pixel
= pix
;
1696 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1699 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1700 (unsigned long)pix
);
1703 if (FRAME_VISIBLE_P (f
))
1709 /* Value is the internal representation of the specified cursor type
1710 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1711 of the bar cursor. */
1713 enum text_cursor_kinds
1714 x_specified_cursor_type (arg
, width
)
1718 enum text_cursor_kinds type
;
1725 else if (CONSP (arg
)
1726 && EQ (XCAR (arg
), Qbar
)
1727 && INTEGERP (XCDR (arg
))
1728 && XINT (XCDR (arg
)) >= 0)
1731 *width
= XINT (XCDR (arg
));
1733 else if (NILP (arg
))
1736 /* Treat anything unknown as "box cursor".
1737 It was bad to signal an error; people have trouble fixing
1738 .Xdefaults with Emacs, when it has something bad in it. */
1739 type
= FILLED_BOX_CURSOR
;
1745 x_set_cursor_type (f
, arg
, oldval
)
1747 Lisp_Object arg
, oldval
;
1751 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1752 f
->output_data
.x
->cursor_width
= width
;
1754 /* Make sure the cursor gets redrawn. This is overkill, but how
1755 often do people change cursor types? */
1756 update_mode_lines
++;
1760 x_set_icon_type (f
, arg
, oldval
)
1762 Lisp_Object arg
, oldval
;
1768 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1771 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1776 result
= x_text_icon (f
,
1777 (char *) XSTRING ((!NILP (f
->icon_name
)
1781 result
= x_bitmap_icon (f
, arg
);
1786 error ("No icon window available");
1789 XFlush (FRAME_X_DISPLAY (f
));
1793 /* Return non-nil if frame F wants a bitmap icon. */
1801 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1809 x_set_icon_name (f
, arg
, oldval
)
1811 Lisp_Object arg
, oldval
;
1817 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1820 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1825 if (f
->output_data
.x
->icon_bitmap
!= 0)
1830 result
= x_text_icon (f
,
1831 (char *) XSTRING ((!NILP (f
->icon_name
)
1840 error ("No icon window available");
1843 XFlush (FRAME_X_DISPLAY (f
));
1848 x_set_font (f
, arg
, oldval
)
1850 Lisp_Object arg
, oldval
;
1853 Lisp_Object fontset_name
;
1855 int old_fontset
= f
->output_data
.x
->fontset
;
1857 CHECK_STRING (arg
, 1);
1859 fontset_name
= Fquery_fontset (arg
, Qnil
);
1862 result
= (STRINGP (fontset_name
)
1863 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1864 : x_new_font (f
, XSTRING (arg
)->data
));
1867 if (EQ (result
, Qnil
))
1868 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1869 else if (EQ (result
, Qt
))
1870 error ("The characters of the given font have varying widths");
1871 else if (STRINGP (result
))
1873 if (STRINGP (fontset_name
))
1875 /* Fontset names are built from ASCII font names, so the
1876 names may be equal despite there was a change. */
1877 if (old_fontset
== f
->output_data
.x
->fontset
)
1880 else if (!NILP (Fequal (result
, oldval
)))
1883 store_frame_param (f
, Qfont
, result
);
1884 recompute_basic_faces (f
);
1889 do_pending_window_change (0);
1891 /* Don't call `face-set-after-frame-default' when faces haven't been
1892 initialized yet. This is the case when called from
1893 Fx_create_frame. In that case, the X widget or window doesn't
1894 exist either, and we can end up in x_report_frame_params with a
1895 null widget which gives a segfault. */
1896 if (FRAME_FACE_CACHE (f
))
1898 XSETFRAME (frame
, f
);
1899 call1 (Qface_set_after_frame_default
, frame
);
1904 x_set_border_width (f
, arg
, oldval
)
1906 Lisp_Object arg
, oldval
;
1908 CHECK_NUMBER (arg
, 0);
1910 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1913 if (FRAME_X_WINDOW (f
) != 0)
1914 error ("Cannot change the border width of a window");
1916 f
->output_data
.x
->border_width
= XINT (arg
);
1920 x_set_internal_border_width (f
, arg
, oldval
)
1922 Lisp_Object arg
, oldval
;
1924 int old
= f
->output_data
.x
->internal_border_width
;
1926 CHECK_NUMBER (arg
, 0);
1927 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1928 if (f
->output_data
.x
->internal_border_width
< 0)
1929 f
->output_data
.x
->internal_border_width
= 0;
1931 #ifdef USE_X_TOOLKIT
1932 if (f
->output_data
.x
->edit_widget
)
1933 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1936 if (f
->output_data
.x
->internal_border_width
== old
)
1939 if (FRAME_X_WINDOW (f
) != 0)
1941 x_set_window_size (f
, 0, f
->width
, f
->height
);
1942 SET_FRAME_GARBAGED (f
);
1943 do_pending_window_change (0);
1946 SET_FRAME_GARBAGED (f
);
1950 x_set_visibility (f
, value
, oldval
)
1952 Lisp_Object value
, oldval
;
1955 XSETFRAME (frame
, f
);
1958 Fmake_frame_invisible (frame
, Qt
);
1959 else if (EQ (value
, Qicon
))
1960 Ficonify_frame (frame
);
1962 Fmake_frame_visible (frame
);
1966 /* Change window heights in windows rooted in WINDOW by N lines. */
1969 x_change_window_heights (window
, n
)
1973 struct window
*w
= XWINDOW (window
);
1975 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1976 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1978 if (INTEGERP (w
->orig_top
))
1979 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1980 if (INTEGERP (w
->orig_height
))
1981 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1983 /* Handle just the top child in a vertical split. */
1984 if (!NILP (w
->vchild
))
1985 x_change_window_heights (w
->vchild
, n
);
1987 /* Adjust all children in a horizontal split. */
1988 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1990 w
= XWINDOW (window
);
1991 x_change_window_heights (window
, n
);
1996 x_set_menu_bar_lines (f
, value
, oldval
)
1998 Lisp_Object value
, oldval
;
2001 #ifndef USE_X_TOOLKIT
2002 int olines
= FRAME_MENU_BAR_LINES (f
);
2005 /* Right now, menu bars don't work properly in minibuf-only frames;
2006 most of the commands try to apply themselves to the minibuffer
2007 frame itself, and get an error because you can't switch buffers
2008 in or split the minibuffer window. */
2009 if (FRAME_MINIBUF_ONLY_P (f
))
2012 if (INTEGERP (value
))
2013 nlines
= XINT (value
);
2017 /* Make sure we redisplay all windows in this frame. */
2018 windows_or_buffers_changed
++;
2020 #ifdef USE_X_TOOLKIT
2021 FRAME_MENU_BAR_LINES (f
) = 0;
2024 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2025 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
2026 /* Make sure next redisplay shows the menu bar. */
2027 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2031 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2032 free_frame_menubar (f
);
2033 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2035 f
->output_data
.x
->menubar_widget
= 0;
2037 #else /* not USE_X_TOOLKIT */
2038 FRAME_MENU_BAR_LINES (f
) = nlines
;
2039 x_change_window_heights (f
->root_window
, nlines
- olines
);
2040 #endif /* not USE_X_TOOLKIT */
2045 /* Set the number of lines used for the tool bar of frame F to VALUE.
2046 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2047 is the old number of tool bar lines. This function changes the
2048 height of all windows on frame F to match the new tool bar height.
2049 The frame's height doesn't change. */
2052 x_set_tool_bar_lines (f
, value
, oldval
)
2054 Lisp_Object value
, oldval
;
2056 int delta
, nlines
, root_height
;
2057 Lisp_Object root_window
;
2059 /* Treat tool bars like menu bars. */
2060 if (FRAME_MINIBUF_ONLY_P (f
))
2063 /* Use VALUE only if an integer >= 0. */
2064 if (INTEGERP (value
) && XINT (value
) >= 0)
2065 nlines
= XFASTINT (value
);
2069 /* Make sure we redisplay all windows in this frame. */
2070 ++windows_or_buffers_changed
;
2072 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2074 /* Don't resize the tool-bar to more than we have room for. */
2075 root_window
= FRAME_ROOT_WINDOW (f
);
2076 root_height
= XINT (XWINDOW (root_window
)->height
);
2077 if (root_height
- delta
< 1)
2079 delta
= root_height
- 1;
2080 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2083 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2084 x_change_window_heights (root_window
, delta
);
2087 /* We also have to make sure that the internal border at the top of
2088 the frame, below the menu bar or tool bar, is redrawn when the
2089 tool bar disappears. This is so because the internal border is
2090 below the tool bar if one is displayed, but is below the menu bar
2091 if there isn't a tool bar. The tool bar draws into the area
2092 below the menu bar. */
2093 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2097 clear_current_matrices (f
);
2098 updating_frame
= NULL
;
2101 /* If the tool bar gets smaller, the internal border below it
2102 has to be cleared. It was formerly part of the display
2103 of the larger tool bar, and updating windows won't clear it. */
2106 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2107 int width
= PIXEL_WIDTH (f
);
2108 int y
= nlines
* CANON_Y_UNIT (f
);
2111 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2112 0, y
, width
, height
, False
);
2115 if (WINDOWP (f
->tool_bar_window
))
2116 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2121 /* Set the foreground color for scroll bars on frame F to VALUE.
2122 VALUE should be a string, a color name. If it isn't a string or
2123 isn't a valid color name, do nothing. OLDVAL is the old value of
2124 the frame parameter. */
2127 x_set_scroll_bar_foreground (f
, value
, oldval
)
2129 Lisp_Object value
, oldval
;
2131 unsigned long pixel
;
2133 if (STRINGP (value
))
2134 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2138 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2139 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2141 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2142 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2144 /* Remove all scroll bars because they have wrong colors. */
2145 if (condemn_scroll_bars_hook
)
2146 (*condemn_scroll_bars_hook
) (f
);
2147 if (judge_scroll_bars_hook
)
2148 (*judge_scroll_bars_hook
) (f
);
2150 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2156 /* Set the background color for scroll bars on frame F to VALUE VALUE
2157 should be a string, a color name. If it isn't a string or isn't a
2158 valid color name, do nothing. OLDVAL is the old value of the frame
2162 x_set_scroll_bar_background (f
, value
, oldval
)
2164 Lisp_Object value
, oldval
;
2166 unsigned long pixel
;
2168 if (STRINGP (value
))
2169 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2173 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2174 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2176 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2177 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2179 /* Remove all scroll bars because they have wrong colors. */
2180 if (condemn_scroll_bars_hook
)
2181 (*condemn_scroll_bars_hook
) (f
);
2182 if (judge_scroll_bars_hook
)
2183 (*judge_scroll_bars_hook
) (f
);
2185 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2191 /* Encode Lisp string STRING as a text in a format appropriate for
2192 XICCC (X Inter Client Communication Conventions).
2194 If STRING contains only ASCII characters, do no conversion and
2195 return the string data of STRING. Otherwise, encode the text by
2196 CODING_SYSTEM, and return a newly allocated memory area which
2197 should be freed by `xfree' by a caller.
2199 SELECTIONP non-zero means the string is being encoded for an X
2200 selection, so it is safe to run pre-write conversions (which
2203 Store the byte length of resulting text in *TEXT_BYTES.
2205 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2206 which means that the `encoding' of the result can be `STRING'.
2207 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2208 the result should be `COMPOUND_TEXT'. */
2211 x_encode_text (string
, coding_system
, selectionp
, text_bytes
, stringp
)
2212 Lisp_Object string
, coding_system
;
2213 int *text_bytes
, *stringp
;
2216 unsigned char *str
= XSTRING (string
)->data
;
2217 int chars
= XSTRING (string
)->size
;
2218 int bytes
= STRING_BYTES (XSTRING (string
));
2222 struct coding_system coding
;
2224 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2225 if (charset_info
== 0)
2227 /* No multibyte character in OBJ. We need not encode it. */
2228 *text_bytes
= bytes
;
2233 setup_coding_system (coding_system
, &coding
);
2235 && SYMBOLP (coding
.pre_write_conversion
)
2236 && !NILP (Ffboundp (coding
.pre_write_conversion
)))
2238 string
= run_pre_post_conversion_on_str (string
, &coding
, 1);
2239 str
= XSTRING (string
)->data
;
2240 chars
= XSTRING (string
)->size
;
2241 bytes
= STRING_BYTES (XSTRING (string
));
2243 coding
.src_multibyte
= 1;
2244 coding
.dst_multibyte
= 0;
2245 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2246 if (coding
.type
== coding_type_iso2022
)
2247 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2248 /* We suppress producing escape sequences for composition. */
2249 coding
.composing
= COMPOSITION_DISABLED
;
2250 bufsize
= encoding_buffer_size (&coding
, bytes
);
2251 buf
= (unsigned char *) xmalloc (bufsize
);
2252 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2253 *text_bytes
= coding
.produced
;
2254 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2259 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2262 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2263 name; if NAME is a string, set F's name to NAME and set
2264 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2266 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2267 suggesting a new name, which lisp code should override; if
2268 F->explicit_name is set, ignore the new name; otherwise, set it. */
2271 x_set_name (f
, name
, explicit)
2276 /* Make sure that requests from lisp code override requests from
2277 Emacs redisplay code. */
2280 /* If we're switching from explicit to implicit, we had better
2281 update the mode lines and thereby update the title. */
2282 if (f
->explicit_name
&& NILP (name
))
2283 update_mode_lines
= 1;
2285 f
->explicit_name
= ! NILP (name
);
2287 else if (f
->explicit_name
)
2290 /* If NAME is nil, set the name to the x_id_name. */
2293 /* Check for no change needed in this very common case
2294 before we do any consing. */
2295 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2296 XSTRING (f
->name
)->data
))
2298 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2301 CHECK_STRING (name
, 0);
2303 /* Don't change the name if it's already NAME. */
2304 if (! NILP (Fstring_equal (name
, f
->name
)))
2309 /* For setting the frame title, the title parameter should override
2310 the name parameter. */
2311 if (! NILP (f
->title
))
2314 if (FRAME_X_WINDOW (f
))
2319 XTextProperty text
, icon
;
2321 Lisp_Object coding_system
;
2323 coding_system
= Vlocale_coding_system
;
2324 if (NILP (coding_system
))
2325 coding_system
= Qcompound_text
;
2326 text
.value
= x_encode_text (name
, coding_system
, 0, &bytes
, &stringp
);
2327 text
.encoding
= (stringp
? XA_STRING
2328 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2330 text
.nitems
= bytes
;
2332 if (NILP (f
->icon_name
))
2338 icon
.value
= x_encode_text (f
->icon_name
, coding_system
, 0,
2340 icon
.encoding
= (stringp
? XA_STRING
2341 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2343 icon
.nitems
= bytes
;
2345 #ifdef USE_X_TOOLKIT
2346 XSetWMName (FRAME_X_DISPLAY (f
),
2347 XtWindow (f
->output_data
.x
->widget
), &text
);
2348 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2350 #else /* not USE_X_TOOLKIT */
2351 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2352 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2353 #endif /* not USE_X_TOOLKIT */
2354 if (!NILP (f
->icon_name
)
2355 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2357 if (text
.value
!= XSTRING (name
)->data
)
2360 #else /* not HAVE_X11R4 */
2361 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2362 XSTRING (name
)->data
);
2363 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2364 XSTRING (name
)->data
);
2365 #endif /* not HAVE_X11R4 */
2370 /* This function should be called when the user's lisp code has
2371 specified a name for the frame; the name will override any set by the
2374 x_explicitly_set_name (f
, arg
, oldval
)
2376 Lisp_Object arg
, oldval
;
2378 x_set_name (f
, arg
, 1);
2381 /* This function should be called by Emacs redisplay code to set the
2382 name; names set this way will never override names set by the user's
2385 x_implicitly_set_name (f
, arg
, oldval
)
2387 Lisp_Object arg
, oldval
;
2389 x_set_name (f
, arg
, 0);
2392 /* Change the title of frame F to NAME.
2393 If NAME is nil, use the frame name as the title.
2395 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2396 name; if NAME is a string, set F's name to NAME and set
2397 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2399 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2400 suggesting a new name, which lisp code should override; if
2401 F->explicit_name is set, ignore the new name; otherwise, set it. */
2404 x_set_title (f
, name
, old_name
)
2406 Lisp_Object name
, old_name
;
2408 /* Don't change the title if it's already NAME. */
2409 if (EQ (name
, f
->title
))
2412 update_mode_lines
= 1;
2419 CHECK_STRING (name
, 0);
2421 if (FRAME_X_WINDOW (f
))
2426 XTextProperty text
, icon
;
2428 Lisp_Object coding_system
;
2430 coding_system
= Vlocale_coding_system
;
2431 if (NILP (coding_system
))
2432 coding_system
= Qcompound_text
;
2433 text
.value
= x_encode_text (name
, coding_system
, 0, &bytes
, &stringp
);
2434 text
.encoding
= (stringp
? XA_STRING
2435 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2437 text
.nitems
= bytes
;
2439 if (NILP (f
->icon_name
))
2445 icon
.value
= x_encode_text (f
->icon_name
, coding_system
, 0,
2447 icon
.encoding
= (stringp
? XA_STRING
2448 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2450 icon
.nitems
= bytes
;
2452 #ifdef USE_X_TOOLKIT
2453 XSetWMName (FRAME_X_DISPLAY (f
),
2454 XtWindow (f
->output_data
.x
->widget
), &text
);
2455 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2457 #else /* not USE_X_TOOLKIT */
2458 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2459 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2460 #endif /* not USE_X_TOOLKIT */
2461 if (!NILP (f
->icon_name
)
2462 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2464 if (text
.value
!= XSTRING (name
)->data
)
2467 #else /* not HAVE_X11R4 */
2468 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2469 XSTRING (name
)->data
);
2470 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2471 XSTRING (name
)->data
);
2472 #endif /* not HAVE_X11R4 */
2478 x_set_autoraise (f
, arg
, oldval
)
2480 Lisp_Object arg
, oldval
;
2482 f
->auto_raise
= !EQ (Qnil
, arg
);
2486 x_set_autolower (f
, arg
, oldval
)
2488 Lisp_Object arg
, oldval
;
2490 f
->auto_lower
= !EQ (Qnil
, arg
);
2494 x_set_unsplittable (f
, arg
, oldval
)
2496 Lisp_Object arg
, oldval
;
2498 f
->no_split
= !NILP (arg
);
2502 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2504 Lisp_Object arg
, oldval
;
2506 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2507 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2508 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2509 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2511 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2513 ? vertical_scroll_bar_none
2515 ? vertical_scroll_bar_right
2516 : vertical_scroll_bar_left
);
2518 /* We set this parameter before creating the X window for the
2519 frame, so we can get the geometry right from the start.
2520 However, if the window hasn't been created yet, we shouldn't
2521 call x_set_window_size. */
2522 if (FRAME_X_WINDOW (f
))
2523 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2524 do_pending_window_change (0);
2529 x_set_scroll_bar_width (f
, arg
, oldval
)
2531 Lisp_Object arg
, oldval
;
2533 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2537 #ifdef USE_TOOLKIT_SCROLL_BARS
2538 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2539 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2540 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2541 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2543 /* Make the actual width at least 14 pixels and a multiple of a
2545 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2547 /* Use all of that space (aside from required margins) for the
2549 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2552 if (FRAME_X_WINDOW (f
))
2553 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2554 do_pending_window_change (0);
2556 else if (INTEGERP (arg
) && XINT (arg
) > 0
2557 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2559 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2560 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2562 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2563 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2564 if (FRAME_X_WINDOW (f
))
2565 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2568 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2569 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2570 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2575 /* Subroutines of creating an X frame. */
2577 /* Make sure that Vx_resource_name is set to a reasonable value.
2578 Fix it up, or set it to `emacs' if it is too hopeless. */
2581 validate_x_resource_name ()
2584 /* Number of valid characters in the resource name. */
2586 /* Number of invalid characters in the resource name. */
2591 if (!STRINGP (Vx_resource_class
))
2592 Vx_resource_class
= build_string (EMACS_CLASS
);
2594 if (STRINGP (Vx_resource_name
))
2596 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2599 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2601 /* Only letters, digits, - and _ are valid in resource names.
2602 Count the valid characters and count the invalid ones. */
2603 for (i
= 0; i
< len
; i
++)
2606 if (! ((c
>= 'a' && c
<= 'z')
2607 || (c
>= 'A' && c
<= 'Z')
2608 || (c
>= '0' && c
<= '9')
2609 || c
== '-' || c
== '_'))
2616 /* Not a string => completely invalid. */
2617 bad_count
= 5, good_count
= 0;
2619 /* If name is valid already, return. */
2623 /* If name is entirely invalid, or nearly so, use `emacs'. */
2625 || (good_count
== 1 && bad_count
> 0))
2627 Vx_resource_name
= build_string ("emacs");
2631 /* Name is partly valid. Copy it and replace the invalid characters
2632 with underscores. */
2634 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2636 for (i
= 0; i
< len
; i
++)
2638 int c
= XSTRING (new)->data
[i
];
2639 if (! ((c
>= 'a' && c
<= 'z')
2640 || (c
>= 'A' && c
<= 'Z')
2641 || (c
>= '0' && c
<= '9')
2642 || c
== '-' || c
== '_'))
2643 XSTRING (new)->data
[i
] = '_';
2648 extern char *x_get_string_resource ();
2650 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2651 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2652 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2653 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2654 the name specified by the `-name' or `-rn' command-line arguments.\n\
2656 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2657 class, respectively. You must specify both of them or neither.\n\
2658 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2659 and the class is `Emacs.CLASS.SUBCLASS'.")
2660 (attribute
, class, component
, subclass
)
2661 Lisp_Object attribute
, class, component
, subclass
;
2663 register char *value
;
2669 CHECK_STRING (attribute
, 0);
2670 CHECK_STRING (class, 0);
2672 if (!NILP (component
))
2673 CHECK_STRING (component
, 1);
2674 if (!NILP (subclass
))
2675 CHECK_STRING (subclass
, 2);
2676 if (NILP (component
) != NILP (subclass
))
2677 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2679 validate_x_resource_name ();
2681 /* Allocate space for the components, the dots which separate them,
2682 and the final '\0'. Make them big enough for the worst case. */
2683 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2684 + (STRINGP (component
)
2685 ? STRING_BYTES (XSTRING (component
)) : 0)
2686 + STRING_BYTES (XSTRING (attribute
))
2689 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2690 + STRING_BYTES (XSTRING (class))
2691 + (STRINGP (subclass
)
2692 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2695 /* Start with emacs.FRAMENAME for the name (the specific one)
2696 and with `Emacs' for the class key (the general one). */
2697 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2698 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2700 strcat (class_key
, ".");
2701 strcat (class_key
, XSTRING (class)->data
);
2703 if (!NILP (component
))
2705 strcat (class_key
, ".");
2706 strcat (class_key
, XSTRING (subclass
)->data
);
2708 strcat (name_key
, ".");
2709 strcat (name_key
, XSTRING (component
)->data
);
2712 strcat (name_key
, ".");
2713 strcat (name_key
, XSTRING (attribute
)->data
);
2715 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2716 name_key
, class_key
);
2718 if (value
!= (char *) 0)
2719 return build_string (value
);
2724 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2727 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2728 struct x_display_info
*dpyinfo
;
2729 Lisp_Object attribute
, class, component
, subclass
;
2731 register char *value
;
2735 CHECK_STRING (attribute
, 0);
2736 CHECK_STRING (class, 0);
2738 if (!NILP (component
))
2739 CHECK_STRING (component
, 1);
2740 if (!NILP (subclass
))
2741 CHECK_STRING (subclass
, 2);
2742 if (NILP (component
) != NILP (subclass
))
2743 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2745 validate_x_resource_name ();
2747 /* Allocate space for the components, the dots which separate them,
2748 and the final '\0'. Make them big enough for the worst case. */
2749 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2750 + (STRINGP (component
)
2751 ? STRING_BYTES (XSTRING (component
)) : 0)
2752 + STRING_BYTES (XSTRING (attribute
))
2755 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2756 + STRING_BYTES (XSTRING (class))
2757 + (STRINGP (subclass
)
2758 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2761 /* Start with emacs.FRAMENAME for the name (the specific one)
2762 and with `Emacs' for the class key (the general one). */
2763 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2764 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2766 strcat (class_key
, ".");
2767 strcat (class_key
, XSTRING (class)->data
);
2769 if (!NILP (component
))
2771 strcat (class_key
, ".");
2772 strcat (class_key
, XSTRING (subclass
)->data
);
2774 strcat (name_key
, ".");
2775 strcat (name_key
, XSTRING (component
)->data
);
2778 strcat (name_key
, ".");
2779 strcat (name_key
, XSTRING (attribute
)->data
);
2781 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2783 if (value
!= (char *) 0)
2784 return build_string (value
);
2789 /* Used when C code wants a resource value. */
2792 x_get_resource_string (attribute
, class)
2793 char *attribute
, *class;
2797 struct frame
*sf
= SELECTED_FRAME ();
2799 /* Allocate space for the components, the dots which separate them,
2800 and the final '\0'. */
2801 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2802 + strlen (attribute
) + 2);
2803 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2804 + strlen (class) + 2);
2806 sprintf (name_key
, "%s.%s",
2807 XSTRING (Vinvocation_name
)->data
,
2809 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2811 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2812 name_key
, class_key
);
2815 /* Types we might convert a resource string into. */
2825 /* Return the value of parameter PARAM.
2827 First search ALIST, then Vdefault_frame_alist, then the X defaults
2828 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2830 Convert the resource to the type specified by desired_type.
2832 If no default is specified, return Qunbound. If you call
2833 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2834 and don't let it get stored in any Lisp-visible variables! */
2837 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2838 struct x_display_info
*dpyinfo
;
2839 Lisp_Object alist
, param
;
2842 enum resource_types type
;
2844 register Lisp_Object tem
;
2846 tem
= Fassq (param
, alist
);
2848 tem
= Fassq (param
, Vdefault_frame_alist
);
2854 tem
= display_x_get_resource (dpyinfo
,
2855 build_string (attribute
),
2856 build_string (class),
2864 case RES_TYPE_NUMBER
:
2865 return make_number (atoi (XSTRING (tem
)->data
));
2867 case RES_TYPE_FLOAT
:
2868 return make_float (atof (XSTRING (tem
)->data
));
2870 case RES_TYPE_BOOLEAN
:
2871 tem
= Fdowncase (tem
);
2872 if (!strcmp (XSTRING (tem
)->data
, "on")
2873 || !strcmp (XSTRING (tem
)->data
, "true"))
2878 case RES_TYPE_STRING
:
2881 case RES_TYPE_SYMBOL
:
2882 /* As a special case, we map the values `true' and `on'
2883 to Qt, and `false' and `off' to Qnil. */
2886 lower
= Fdowncase (tem
);
2887 if (!strcmp (XSTRING (lower
)->data
, "on")
2888 || !strcmp (XSTRING (lower
)->data
, "true"))
2890 else if (!strcmp (XSTRING (lower
)->data
, "off")
2891 || !strcmp (XSTRING (lower
)->data
, "false"))
2894 return Fintern (tem
, Qnil
);
2907 /* Like x_get_arg, but also record the value in f->param_alist. */
2910 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2912 Lisp_Object alist
, param
;
2915 enum resource_types type
;
2919 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2920 attribute
, class, type
);
2922 store_frame_param (f
, param
, value
);
2927 /* Record in frame F the specified or default value according to ALIST
2928 of the parameter named PROP (a Lisp symbol).
2929 If no value is specified for PROP, look for an X default for XPROP
2930 on the frame named NAME.
2931 If that is not found either, use the value DEFLT. */
2934 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2941 enum resource_types type
;
2945 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2946 if (EQ (tem
, Qunbound
))
2948 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2953 /* Record in frame F the specified or default value according to ALIST
2954 of the parameter named PROP (a Lisp symbol). If no value is
2955 specified for PROP, look for an X default for XPROP on the frame
2956 named NAME. If that is not found either, use the value DEFLT. */
2959 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2968 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2971 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2972 if (EQ (tem
, Qunbound
))
2974 #ifdef USE_TOOLKIT_SCROLL_BARS
2976 /* See if an X resource for the scroll bar color has been
2978 tem
= display_x_get_resource (dpyinfo
,
2979 build_string (foreground_p
2983 build_string ("verticalScrollBar"),
2987 /* If nothing has been specified, scroll bars will use a
2988 toolkit-dependent default. Because these defaults are
2989 difficult to get at without actually creating a scroll
2990 bar, use nil to indicate that no color has been
2995 #else /* not USE_TOOLKIT_SCROLL_BARS */
2999 #endif /* not USE_TOOLKIT_SCROLL_BARS */
3002 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3008 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3009 "Parse an X-style geometry string STRING.\n\
3010 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
3011 The properties returned may include `top', `left', `height', and `width'.\n\
3012 The value of `left' or `top' may be an integer,\n\
3013 or a list (+ N) meaning N pixels relative to top/left corner,\n\
3014 or a list (- N) meaning -N pixels relative to bottom/right corner.")
3019 unsigned int width
, height
;
3022 CHECK_STRING (string
, 0);
3024 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
3025 &x
, &y
, &width
, &height
);
3028 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
3029 error ("Must specify both x and y position, or neither");
3033 if (geometry
& XValue
)
3035 Lisp_Object element
;
3037 if (x
>= 0 && (geometry
& XNegative
))
3038 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3039 else if (x
< 0 && ! (geometry
& XNegative
))
3040 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3042 element
= Fcons (Qleft
, make_number (x
));
3043 result
= Fcons (element
, result
);
3046 if (geometry
& YValue
)
3048 Lisp_Object element
;
3050 if (y
>= 0 && (geometry
& YNegative
))
3051 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3052 else if (y
< 0 && ! (geometry
& YNegative
))
3053 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3055 element
= Fcons (Qtop
, make_number (y
));
3056 result
= Fcons (element
, result
);
3059 if (geometry
& WidthValue
)
3060 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3061 if (geometry
& HeightValue
)
3062 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3067 /* Calculate the desired size and position of this window,
3068 and return the flags saying which aspects were specified.
3070 This function does not make the coordinates positive. */
3072 #define DEFAULT_ROWS 40
3073 #define DEFAULT_COLS 80
3076 x_figure_window_size (f
, parms
)
3080 register Lisp_Object tem0
, tem1
, tem2
;
3081 long window_prompting
= 0;
3082 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3084 /* Default values if we fall through.
3085 Actually, if that happens we should get
3086 window manager prompting. */
3087 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3088 f
->height
= DEFAULT_ROWS
;
3089 /* Window managers expect that if program-specified
3090 positions are not (0,0), they're intentional, not defaults. */
3091 f
->output_data
.x
->top_pos
= 0;
3092 f
->output_data
.x
->left_pos
= 0;
3094 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3095 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3096 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3097 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3099 if (!EQ (tem0
, Qunbound
))
3101 CHECK_NUMBER (tem0
, 0);
3102 f
->height
= XINT (tem0
);
3104 if (!EQ (tem1
, Qunbound
))
3106 CHECK_NUMBER (tem1
, 0);
3107 SET_FRAME_WIDTH (f
, XINT (tem1
));
3109 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3110 window_prompting
|= USSize
;
3112 window_prompting
|= PSize
;
3115 f
->output_data
.x
->vertical_scroll_bar_extra
3116 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3118 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3119 f
->output_data
.x
->flags_areas_extra
3120 = FRAME_FLAGS_AREA_WIDTH (f
);
3121 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3122 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3124 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3125 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3126 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3127 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3129 if (EQ (tem0
, Qminus
))
3131 f
->output_data
.x
->top_pos
= 0;
3132 window_prompting
|= YNegative
;
3134 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3135 && CONSP (XCDR (tem0
))
3136 && INTEGERP (XCAR (XCDR (tem0
))))
3138 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3139 window_prompting
|= YNegative
;
3141 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3142 && CONSP (XCDR (tem0
))
3143 && INTEGERP (XCAR (XCDR (tem0
))))
3145 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3147 else if (EQ (tem0
, Qunbound
))
3148 f
->output_data
.x
->top_pos
= 0;
3151 CHECK_NUMBER (tem0
, 0);
3152 f
->output_data
.x
->top_pos
= XINT (tem0
);
3153 if (f
->output_data
.x
->top_pos
< 0)
3154 window_prompting
|= YNegative
;
3157 if (EQ (tem1
, Qminus
))
3159 f
->output_data
.x
->left_pos
= 0;
3160 window_prompting
|= XNegative
;
3162 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3163 && CONSP (XCDR (tem1
))
3164 && INTEGERP (XCAR (XCDR (tem1
))))
3166 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3167 window_prompting
|= XNegative
;
3169 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3170 && CONSP (XCDR (tem1
))
3171 && INTEGERP (XCAR (XCDR (tem1
))))
3173 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3175 else if (EQ (tem1
, Qunbound
))
3176 f
->output_data
.x
->left_pos
= 0;
3179 CHECK_NUMBER (tem1
, 0);
3180 f
->output_data
.x
->left_pos
= XINT (tem1
);
3181 if (f
->output_data
.x
->left_pos
< 0)
3182 window_prompting
|= XNegative
;
3185 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3186 window_prompting
|= USPosition
;
3188 window_prompting
|= PPosition
;
3191 return window_prompting
;
3194 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3197 XSetWMProtocols (dpy
, w
, protocols
, count
)
3204 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3205 if (prop
== None
) return False
;
3206 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3207 (unsigned char *) protocols
, count
);
3210 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3212 #ifdef USE_X_TOOLKIT
3214 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3215 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3216 already be present because of the toolkit (Motif adds some of them,
3217 for example, but Xt doesn't). */
3220 hack_wm_protocols (f
, widget
)
3224 Display
*dpy
= XtDisplay (widget
);
3225 Window w
= XtWindow (widget
);
3226 int need_delete
= 1;
3232 Atom type
, *atoms
= 0;
3234 unsigned long nitems
= 0;
3235 unsigned long bytes_after
;
3237 if ((XGetWindowProperty (dpy
, w
,
3238 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3239 (long)0, (long)100, False
, XA_ATOM
,
3240 &type
, &format
, &nitems
, &bytes_after
,
3241 (unsigned char **) &atoms
)
3243 && format
== 32 && type
== XA_ATOM
)
3247 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3249 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3251 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3254 if (atoms
) XFree ((char *) atoms
);
3260 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3262 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3264 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3266 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3267 XA_ATOM
, 32, PropModeAppend
,
3268 (unsigned char *) props
, count
);
3276 /* Support routines for XIC (X Input Context). */
3280 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3281 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3284 /* Supported XIM styles, ordered by preferenc. */
3286 static XIMStyle supported_xim_styles
[] =
3288 XIMPreeditPosition
| XIMStatusArea
,
3289 XIMPreeditPosition
| XIMStatusNothing
,
3290 XIMPreeditPosition
| XIMStatusNone
,
3291 XIMPreeditNothing
| XIMStatusArea
,
3292 XIMPreeditNothing
| XIMStatusNothing
,
3293 XIMPreeditNothing
| XIMStatusNone
,
3294 XIMPreeditNone
| XIMStatusArea
,
3295 XIMPreeditNone
| XIMStatusNothing
,
3296 XIMPreeditNone
| XIMStatusNone
,
3301 /* Create an X fontset on frame F with base font name
3305 xic_create_xfontset (f
, base_fontname
)
3307 char *base_fontname
;
3310 char **missing_list
;
3314 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3315 base_fontname
, &missing_list
,
3316 &missing_count
, &def_string
);
3318 XFreeStringList (missing_list
);
3320 /* No need to free def_string. */
3325 /* Value is the best input style, given user preferences USER (already
3326 checked to be supported by Emacs), and styles supported by the
3327 input method XIM. */
3330 best_xim_style (user
, xim
)
3336 for (i
= 0; i
< user
->count_styles
; ++i
)
3337 for (j
= 0; j
< xim
->count_styles
; ++j
)
3338 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3339 return user
->supported_styles
[i
];
3341 /* Return the default style. */
3342 return XIMPreeditNothing
| XIMStatusNothing
;
3345 /* Create XIC for frame F. */
3347 static XIMStyle xic_style
;
3350 create_frame_xic (f
)
3355 XFontSet xfs
= NULL
;
3360 xim
= FRAME_X_XIM (f
);
3365 XVaNestedList preedit_attr
;
3366 XVaNestedList status_attr
;
3367 char *base_fontname
;
3370 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3371 spot
.x
= 0; spot
.y
= 1;
3372 /* Create X fontset. */
3373 fontset
= FRAME_FONTSET (f
);
3375 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3378 /* Determine the base fontname from the ASCII font name of
3380 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3381 char *p
= ascii_font
;
3384 for (i
= 0; *p
; p
++)
3387 /* As the font name doesn't conform to XLFD, we can't
3388 modify it to get a suitable base fontname for the
3390 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3393 int len
= strlen (ascii_font
) + 1;
3396 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3405 base_fontname
= (char *) alloca (len
);
3406 bzero (base_fontname
, len
);
3407 strcpy (base_fontname
, "-*-*-");
3408 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3409 strcat (base_fontname
, "*-*-*-*-*-*-*");
3412 xfs
= xic_create_xfontset (f
, base_fontname
);
3414 /* Determine XIC style. */
3417 XIMStyles supported_list
;
3418 supported_list
.count_styles
= (sizeof supported_xim_styles
3419 / sizeof supported_xim_styles
[0]);
3420 supported_list
.supported_styles
= supported_xim_styles
;
3421 xic_style
= best_xim_style (&supported_list
,
3422 FRAME_X_XIM_STYLES (f
));
3425 preedit_attr
= XVaCreateNestedList (0,
3428 FRAME_FOREGROUND_PIXEL (f
),
3430 FRAME_BACKGROUND_PIXEL (f
),
3431 (xic_style
& XIMPreeditPosition
3436 status_attr
= XVaCreateNestedList (0,
3442 FRAME_FOREGROUND_PIXEL (f
),
3444 FRAME_BACKGROUND_PIXEL (f
),
3447 xic
= XCreateIC (xim
,
3448 XNInputStyle
, xic_style
,
3449 XNClientWindow
, FRAME_X_WINDOW(f
),
3450 XNFocusWindow
, FRAME_X_WINDOW(f
),
3451 XNStatusAttributes
, status_attr
,
3452 XNPreeditAttributes
, preedit_attr
,
3454 XFree (preedit_attr
);
3455 XFree (status_attr
);
3458 FRAME_XIC (f
) = xic
;
3459 FRAME_XIC_STYLE (f
) = xic_style
;
3460 FRAME_XIC_FONTSET (f
) = xfs
;
3464 /* Destroy XIC and free XIC fontset of frame F, if any. */
3470 if (FRAME_XIC (f
) == NULL
)
3473 XDestroyIC (FRAME_XIC (f
));
3474 if (FRAME_XIC_FONTSET (f
))
3475 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3477 FRAME_XIC (f
) = NULL
;
3478 FRAME_XIC_FONTSET (f
) = NULL
;
3482 /* Place preedit area for XIC of window W's frame to specified
3483 pixel position X/Y. X and Y are relative to window W. */
3486 xic_set_preeditarea (w
, x
, y
)
3490 struct frame
*f
= XFRAME (w
->frame
);
3494 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3495 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3496 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3497 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3502 /* Place status area for XIC in bottom right corner of frame F.. */
3505 xic_set_statusarea (f
)
3508 XIC xic
= FRAME_XIC (f
);
3513 /* Negotiate geometry of status area. If input method has existing
3514 status area, use its current size. */
3515 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3516 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3517 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3520 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3521 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3524 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3526 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3527 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3531 area
.width
= needed
->width
;
3532 area
.height
= needed
->height
;
3533 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3534 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3535 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3538 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3539 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3544 /* Set X fontset for XIC of frame F, using base font name
3545 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3548 xic_set_xfontset (f
, base_fontname
)
3550 char *base_fontname
;
3555 xfs
= xic_create_xfontset (f
, base_fontname
);
3557 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3558 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3559 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3560 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3561 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3564 if (FRAME_XIC_FONTSET (f
))
3565 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3566 FRAME_XIC_FONTSET (f
) = xfs
;
3569 #endif /* HAVE_X_I18N */
3573 #ifdef USE_X_TOOLKIT
3575 /* Create and set up the X widget for frame F. */
3578 x_window (f
, window_prompting
, minibuffer_only
)
3580 long window_prompting
;
3581 int minibuffer_only
;
3583 XClassHint class_hints
;
3584 XSetWindowAttributes attributes
;
3585 unsigned long attribute_mask
;
3586 Widget shell_widget
;
3588 Widget frame_widget
;
3594 /* Use the resource name as the top-level widget name
3595 for looking up resources. Make a non-Lisp copy
3596 for the window manager, so GC relocation won't bother it.
3598 Elsewhere we specify the window name for the window manager. */
3601 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3602 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3603 strcpy (f
->namebuf
, str
);
3607 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3608 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3609 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3610 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3611 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3612 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3613 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3614 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3615 applicationShellWidgetClass
,
3616 FRAME_X_DISPLAY (f
), al
, ac
);
3618 f
->output_data
.x
->widget
= shell_widget
;
3619 /* maybe_set_screen_title_format (shell_widget); */
3621 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3622 (widget_value
*) NULL
,
3623 shell_widget
, False
,
3627 (lw_callback
) NULL
);
3630 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3631 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3632 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3633 XtSetValues (pane_widget
, al
, ac
);
3634 f
->output_data
.x
->column_widget
= pane_widget
;
3636 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3637 the emacs screen when changing menubar. This reduces flickering. */
3640 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3641 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3642 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3643 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3644 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3645 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3646 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3647 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3648 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3651 f
->output_data
.x
->edit_widget
= frame_widget
;
3653 XtManageChild (frame_widget
);
3655 /* Do some needed geometry management. */
3658 char *tem
, shell_position
[32];
3661 int extra_borders
= 0;
3663 = (f
->output_data
.x
->menubar_widget
3664 ? (f
->output_data
.x
->menubar_widget
->core
.height
3665 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3668 #if 0 /* Experimentally, we now get the right results
3669 for -geometry -0-0 without this. 24 Aug 96, rms. */
3670 if (FRAME_EXTERNAL_MENU_BAR (f
))
3673 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3674 menubar_size
+= ibw
;
3678 f
->output_data
.x
->menubar_height
= menubar_size
;
3681 /* Motif seems to need this amount added to the sizes
3682 specified for the shell widget. The Athena/Lucid widgets don't.
3683 Both conclusions reached experimentally. -- rms. */
3684 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3685 &extra_borders
, NULL
);
3689 /* Convert our geometry parameters into a geometry string
3691 Note that we do not specify here whether the position
3692 is a user-specified or program-specified one.
3693 We pass that information later, in x_wm_set_size_hints. */
3695 int left
= f
->output_data
.x
->left_pos
;
3696 int xneg
= window_prompting
& XNegative
;
3697 int top
= f
->output_data
.x
->top_pos
;
3698 int yneg
= window_prompting
& YNegative
;
3704 if (window_prompting
& USPosition
)
3705 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3706 PIXEL_WIDTH (f
) + extra_borders
,
3707 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3708 (xneg
? '-' : '+'), left
,
3709 (yneg
? '-' : '+'), top
);
3711 sprintf (shell_position
, "=%dx%d",
3712 PIXEL_WIDTH (f
) + extra_borders
,
3713 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3716 len
= strlen (shell_position
) + 1;
3717 /* We don't free this because we don't know whether
3718 it is safe to free it while the frame exists.
3719 It isn't worth the trouble of arranging to free it
3720 when the frame is deleted. */
3721 tem
= (char *) xmalloc (len
);
3722 strncpy (tem
, shell_position
, len
);
3723 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3724 XtSetValues (shell_widget
, al
, ac
);
3727 XtManageChild (pane_widget
);
3728 XtRealizeWidget (shell_widget
);
3730 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3732 validate_x_resource_name ();
3734 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3735 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3736 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3739 FRAME_XIC (f
) = NULL
;
3741 create_frame_xic (f
);
3745 f
->output_data
.x
->wm_hints
.input
= True
;
3746 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3747 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3748 &f
->output_data
.x
->wm_hints
);
3750 hack_wm_protocols (f
, shell_widget
);
3753 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3756 /* Do a stupid property change to force the server to generate a
3757 PropertyNotify event so that the event_stream server timestamp will
3758 be initialized to something relevant to the time we created the window.
3760 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3761 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3762 XA_ATOM
, 32, PropModeAppend
,
3763 (unsigned char*) NULL
, 0);
3765 /* Make all the standard events reach the Emacs frame. */
3766 attributes
.event_mask
= STANDARD_EVENT_SET
;
3771 /* XIM server might require some X events. */
3772 unsigned long fevent
= NoEventMask
;
3773 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3774 attributes
.event_mask
|= fevent
;
3776 #endif /* HAVE_X_I18N */
3778 attribute_mask
= CWEventMask
;
3779 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3780 attribute_mask
, &attributes
);
3782 XtMapWidget (frame_widget
);
3784 /* x_set_name normally ignores requests to set the name if the
3785 requested name is the same as the current name. This is the one
3786 place where that assumption isn't correct; f->name is set, but
3787 the X server hasn't been told. */
3790 int explicit = f
->explicit_name
;
3792 f
->explicit_name
= 0;
3795 x_set_name (f
, name
, explicit);
3798 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3799 f
->output_data
.x
->text_cursor
);
3803 /* This is a no-op, except under Motif. Make sure main areas are
3804 set to something reasonable, in case we get an error later. */
3805 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3808 #else /* not USE_X_TOOLKIT */
3810 /* Create and set up the X window for frame F. */
3817 XClassHint class_hints
;
3818 XSetWindowAttributes attributes
;
3819 unsigned long attribute_mask
;
3821 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3822 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3823 attributes
.bit_gravity
= StaticGravity
;
3824 attributes
.backing_store
= NotUseful
;
3825 attributes
.save_under
= True
;
3826 attributes
.event_mask
= STANDARD_EVENT_SET
;
3827 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3828 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3833 = XCreateWindow (FRAME_X_DISPLAY (f
),
3834 f
->output_data
.x
->parent_desc
,
3835 f
->output_data
.x
->left_pos
,
3836 f
->output_data
.x
->top_pos
,
3837 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3838 f
->output_data
.x
->border_width
,
3839 CopyFromParent
, /* depth */
3840 InputOutput
, /* class */
3842 attribute_mask
, &attributes
);
3846 create_frame_xic (f
);
3849 /* XIM server might require some X events. */
3850 unsigned long fevent
= NoEventMask
;
3851 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3852 attributes
.event_mask
|= fevent
;
3853 attribute_mask
= CWEventMask
;
3854 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3855 attribute_mask
, &attributes
);
3858 #endif /* HAVE_X_I18N */
3860 validate_x_resource_name ();
3862 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3863 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3864 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3866 /* The menubar is part of the ordinary display;
3867 it does not count in addition to the height of the window. */
3868 f
->output_data
.x
->menubar_height
= 0;
3870 /* This indicates that we use the "Passive Input" input model.
3871 Unless we do this, we don't get the Focus{In,Out} events that we
3872 need to draw the cursor correctly. Accursed bureaucrats.
3873 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3875 f
->output_data
.x
->wm_hints
.input
= True
;
3876 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3877 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3878 &f
->output_data
.x
->wm_hints
);
3879 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3881 /* Request "save yourself" and "delete window" commands from wm. */
3884 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3885 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3886 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3889 /* x_set_name normally ignores requests to set the name if the
3890 requested name is the same as the current name. This is the one
3891 place where that assumption isn't correct; f->name is set, but
3892 the X server hasn't been told. */
3895 int explicit = f
->explicit_name
;
3897 f
->explicit_name
= 0;
3900 x_set_name (f
, name
, explicit);
3903 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3904 f
->output_data
.x
->text_cursor
);
3908 if (FRAME_X_WINDOW (f
) == 0)
3909 error ("Unable to create window");
3912 #endif /* not USE_X_TOOLKIT */
3914 /* Handle the icon stuff for this window. Perhaps later we might
3915 want an x_set_icon_position which can be called interactively as
3923 Lisp_Object icon_x
, icon_y
;
3924 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3926 /* Set the position of the icon. Note that twm groups all
3927 icons in an icon window. */
3928 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3929 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3930 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3932 CHECK_NUMBER (icon_x
, 0);
3933 CHECK_NUMBER (icon_y
, 0);
3935 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3936 error ("Both left and top icon corners of icon must be specified");
3940 if (! EQ (icon_x
, Qunbound
))
3941 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3943 /* Start up iconic or window? */
3944 x_wm_set_window_state
3945 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3950 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3957 /* Make the GCs needed for this window, setting the
3958 background, border and mouse colors; also create the
3959 mouse cursor and the gray border tile. */
3961 static char cursor_bits
[] =
3963 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3964 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3965 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3966 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3973 XGCValues gc_values
;
3977 /* Create the GCs of this frame.
3978 Note that many default values are used. */
3981 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3982 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3983 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3984 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3985 f
->output_data
.x
->normal_gc
3986 = XCreateGC (FRAME_X_DISPLAY (f
),
3988 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
3991 /* Reverse video style. */
3992 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3993 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3994 f
->output_data
.x
->reverse_gc
3995 = XCreateGC (FRAME_X_DISPLAY (f
),
3997 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
4000 /* Cursor has cursor-color background, background-color foreground. */
4001 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4002 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
4003 gc_values
.fill_style
= FillOpaqueStippled
;
4005 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
4006 FRAME_X_DISPLAY_INFO (f
)->root_window
,
4007 cursor_bits
, 16, 16);
4008 f
->output_data
.x
->cursor_gc
4009 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4010 (GCFont
| GCForeground
| GCBackground
4011 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
4015 f
->output_data
.x
->white_relief
.gc
= 0;
4016 f
->output_data
.x
->black_relief
.gc
= 0;
4018 /* Create the gray border tile used when the pointer is not in
4019 the frame. Since this depends on the frame's pixel values,
4020 this must be done on a per-frame basis. */
4021 f
->output_data
.x
->border_tile
4022 = (XCreatePixmapFromBitmapData
4023 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
4024 gray_bits
, gray_width
, gray_height
,
4025 f
->output_data
.x
->foreground_pixel
,
4026 f
->output_data
.x
->background_pixel
,
4027 DefaultDepth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
))));
4033 /* Free what was was allocated in x_make_gc. */
4039 Display
*dpy
= FRAME_X_DISPLAY (f
);
4043 if (f
->output_data
.x
->normal_gc
)
4045 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
4046 f
->output_data
.x
->normal_gc
= 0;
4049 if (f
->output_data
.x
->reverse_gc
)
4051 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4052 f
->output_data
.x
->reverse_gc
= 0;
4055 if (f
->output_data
.x
->cursor_gc
)
4057 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4058 f
->output_data
.x
->cursor_gc
= 0;
4061 if (f
->output_data
.x
->border_tile
)
4063 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4064 f
->output_data
.x
->border_tile
= 0;
4071 /* Handler for signals raised during x_create_frame and
4072 x_create_top_frame. FRAME is the frame which is partially
4076 unwind_create_frame (frame
)
4079 struct frame
*f
= XFRAME (frame
);
4081 /* If frame is ``official'', nothing to do. */
4082 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4085 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4088 x_free_frame_resources (f
);
4090 /* Check that reference counts are indeed correct. */
4091 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4092 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4100 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4102 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
4103 Returns an Emacs frame object.\n\
4104 ALIST is an alist of frame parameters.\n\
4105 If the parameters specify that the frame should not have a minibuffer,\n\
4106 and do not specify a specific minibuffer window to use,\n\
4107 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4108 be shared by the new frame.\n\
4110 This function is an internal primitive--use `make-frame' instead.")
4115 Lisp_Object frame
, tem
;
4117 int minibuffer_only
= 0;
4118 long window_prompting
= 0;
4120 int count
= BINDING_STACK_SIZE ();
4121 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4122 Lisp_Object display
;
4123 struct x_display_info
*dpyinfo
= NULL
;
4129 /* Use this general default value to start with
4130 until we know if this frame has a specified name. */
4131 Vx_resource_name
= Vinvocation_name
;
4133 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4134 if (EQ (display
, Qunbound
))
4136 dpyinfo
= check_x_display_info (display
);
4138 kb
= dpyinfo
->kboard
;
4140 kb
= &the_only_kboard
;
4143 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4145 && ! EQ (name
, Qunbound
)
4147 error ("Invalid frame name--not a string or nil");
4150 Vx_resource_name
= name
;
4152 /* See if parent window is specified. */
4153 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4154 if (EQ (parent
, Qunbound
))
4156 if (! NILP (parent
))
4157 CHECK_NUMBER (parent
, 0);
4159 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4160 /* No need to protect DISPLAY because that's not used after passing
4161 it to make_frame_without_minibuffer. */
4163 GCPRO4 (parms
, parent
, name
, frame
);
4164 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4166 if (EQ (tem
, Qnone
) || NILP (tem
))
4167 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4168 else if (EQ (tem
, Qonly
))
4170 f
= make_minibuffer_frame ();
4171 minibuffer_only
= 1;
4173 else if (WINDOWP (tem
))
4174 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4178 XSETFRAME (frame
, f
);
4180 /* Note that X Windows does support scroll bars. */
4181 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4183 f
->output_method
= output_x_window
;
4184 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4185 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4186 f
->output_data
.x
->icon_bitmap
= -1;
4187 f
->output_data
.x
->fontset
= -1;
4188 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4189 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4190 record_unwind_protect (unwind_create_frame
, frame
);
4193 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4195 if (! STRINGP (f
->icon_name
))
4196 f
->icon_name
= Qnil
;
4198 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4200 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4201 dpyinfo_refcount
= dpyinfo
->reference_count
;
4202 #endif /* GLYPH_DEBUG */
4204 FRAME_KBOARD (f
) = kb
;
4207 /* These colors will be set anyway later, but it's important
4208 to get the color reference counts right, so initialize them! */
4211 struct gcpro gcpro1
;
4213 /* Function x_decode_color can signal an error. Make
4214 sure to initialize color slots so that we won't try
4215 to free colors we haven't allocated. */
4216 f
->output_data
.x
->foreground_pixel
= -1;
4217 f
->output_data
.x
->background_pixel
= -1;
4218 f
->output_data
.x
->cursor_pixel
= -1;
4219 f
->output_data
.x
->cursor_foreground_pixel
= -1;
4220 f
->output_data
.x
->border_pixel
= -1;
4221 f
->output_data
.x
->mouse_pixel
= -1;
4223 black
= build_string ("black");
4225 f
->output_data
.x
->foreground_pixel
4226 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4227 f
->output_data
.x
->background_pixel
4228 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4229 f
->output_data
.x
->cursor_pixel
4230 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4231 f
->output_data
.x
->cursor_foreground_pixel
4232 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4233 f
->output_data
.x
->border_pixel
4234 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4235 f
->output_data
.x
->mouse_pixel
4236 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4240 /* Specify the parent under which to make this X window. */
4244 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4245 f
->output_data
.x
->explicit_parent
= 1;
4249 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4250 f
->output_data
.x
->explicit_parent
= 0;
4253 /* Set the name; the functions to which we pass f expect the name to
4255 if (EQ (name
, Qunbound
) || NILP (name
))
4257 f
->name
= build_string (dpyinfo
->x_id_name
);
4258 f
->explicit_name
= 0;
4263 f
->explicit_name
= 1;
4264 /* use the frame's title when getting resources for this frame. */
4265 specbind (Qx_resource_name
, name
);
4268 /* Extract the window parameters from the supplied values
4269 that are needed to determine window geometry. */
4273 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4276 /* First, try whatever font the caller has specified. */
4279 tem
= Fquery_fontset (font
, Qnil
);
4281 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4283 font
= x_new_font (f
, XSTRING (font
)->data
);
4286 /* Try out a font which we hope has bold and italic variations. */
4287 if (!STRINGP (font
))
4288 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4289 if (!STRINGP (font
))
4290 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4291 if (! STRINGP (font
))
4292 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4293 if (! STRINGP (font
))
4294 /* This was formerly the first thing tried, but it finds too many fonts
4295 and takes too long. */
4296 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4297 /* If those didn't work, look for something which will at least work. */
4298 if (! STRINGP (font
))
4299 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4301 if (! STRINGP (font
))
4302 font
= build_string ("fixed");
4304 x_default_parameter (f
, parms
, Qfont
, font
,
4305 "font", "Font", RES_TYPE_STRING
);
4309 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4310 whereby it fails to get any font. */
4311 xlwmenu_default_font
= f
->output_data
.x
->font
;
4314 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4315 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4317 /* This defaults to 2 in order to match xterm. We recognize either
4318 internalBorderWidth or internalBorder (which is what xterm calls
4320 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4324 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4325 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4326 if (! EQ (value
, Qunbound
))
4327 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4330 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4331 "internalBorderWidth", "internalBorderWidth",
4333 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4334 "verticalScrollBars", "ScrollBars",
4337 /* Also do the stuff which must be set before the window exists. */
4338 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4339 "foreground", "Foreground", RES_TYPE_STRING
);
4340 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4341 "background", "Background", RES_TYPE_STRING
);
4342 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4343 "pointerColor", "Foreground", RES_TYPE_STRING
);
4344 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4345 "cursorColor", "Foreground", RES_TYPE_STRING
);
4346 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4347 "borderColor", "BorderColor", RES_TYPE_STRING
);
4348 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4349 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4350 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4351 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4353 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4354 "scrollBarForeground",
4355 "ScrollBarForeground", 1);
4356 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4357 "scrollBarBackground",
4358 "ScrollBarBackground", 0);
4360 /* Init faces before x_default_parameter is called for scroll-bar
4361 parameters because that function calls x_set_scroll_bar_width,
4362 which calls change_frame_size, which calls Fset_window_buffer,
4363 which runs hooks, which call Fvertical_motion. At the end, we
4364 end up in init_iterator with a null face cache, which should not
4366 init_frame_faces (f
);
4368 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4369 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4370 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4371 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4372 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4373 "bufferPredicate", "BufferPredicate",
4375 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4376 "title", "Title", RES_TYPE_STRING
);
4377 x_default_parameter (f
, parms
, Qwait_for_wm
, Qt
,
4378 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN
);
4380 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4382 /* Add the tool-bar height to the initial frame height so that the
4383 user gets a text display area of the size he specified with -g or
4384 via .Xdefaults. Later changes of the tool-bar height don't
4385 change the frame size. This is done so that users can create
4386 tall Emacs frames without having to guess how tall the tool-bar
4388 if (FRAME_TOOL_BAR_LINES (f
))
4390 int margin
, relief
, bar_height
;
4392 relief
= (tool_bar_button_relief
> 0
4393 ? tool_bar_button_relief
4394 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4396 if (INTEGERP (Vtool_bar_button_margin
)
4397 && XINT (Vtool_bar_button_margin
) > 0)
4398 margin
= XFASTINT (Vtool_bar_button_margin
);
4399 else if (CONSP (Vtool_bar_button_margin
)
4400 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4401 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4402 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4406 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4407 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4410 /* Compute the size of the X window. */
4411 window_prompting
= x_figure_window_size (f
, parms
);
4413 if (window_prompting
& XNegative
)
4415 if (window_prompting
& YNegative
)
4416 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4418 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4422 if (window_prompting
& YNegative
)
4423 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4425 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4428 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4430 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4431 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4433 /* Create the X widget or window. */
4434 #ifdef USE_X_TOOLKIT
4435 x_window (f
, window_prompting
, minibuffer_only
);
4443 /* Now consider the frame official. */
4444 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4445 Vframe_list
= Fcons (frame
, Vframe_list
);
4447 /* We need to do this after creating the X window, so that the
4448 icon-creation functions can say whose icon they're describing. */
4449 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4450 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4452 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4453 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4454 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4455 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4456 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4457 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4458 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4459 "scrollBarWidth", "ScrollBarWidth",
4462 /* Dimensions, especially f->height, must be done via change_frame_size.
4463 Change will not be effected unless different from the current
4469 SET_FRAME_WIDTH (f
, 0);
4470 change_frame_size (f
, height
, width
, 1, 0, 0);
4472 /* Set up faces after all frame parameters are known. This call
4473 also merges in face attributes specified for new frames. If we
4474 don't do this, the `menu' face for instance won't have the right
4475 colors, and the menu bar won't appear in the specified colors for
4477 call1 (Qface_set_after_frame_default
, frame
);
4479 #ifdef USE_X_TOOLKIT
4480 /* Create the menu bar. */
4481 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4483 /* If this signals an error, we haven't set size hints for the
4484 frame and we didn't make it visible. */
4485 initialize_frame_menubar (f
);
4487 /* This is a no-op, except under Motif where it arranges the
4488 main window for the widgets on it. */
4489 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4490 f
->output_data
.x
->menubar_widget
,
4491 f
->output_data
.x
->edit_widget
);
4493 #endif /* USE_X_TOOLKIT */
4495 /* Tell the server what size and position, etc, we want, and how
4496 badly we want them. This should be done after we have the menu
4497 bar so that its size can be taken into account. */
4499 x_wm_set_size_hint (f
, window_prompting
, 0);
4502 /* Make the window appear on the frame and enable display, unless
4503 the caller says not to. However, with explicit parent, Emacs
4504 cannot control visibility, so don't try. */
4505 if (! f
->output_data
.x
->explicit_parent
)
4507 Lisp_Object visibility
;
4509 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4511 if (EQ (visibility
, Qunbound
))
4514 if (EQ (visibility
, Qicon
))
4515 x_iconify_frame (f
);
4516 else if (! NILP (visibility
))
4517 x_make_frame_visible (f
);
4519 /* Must have been Qnil. */
4525 /* Make sure windows on this frame appear in calls to next-window
4526 and similar functions. */
4527 Vwindow_list
= Qnil
;
4529 return unbind_to (count
, frame
);
4533 /* FRAME is used only to get a handle on the X display. We don't pass the
4534 display info directly because we're called from frame.c, which doesn't
4535 know about that structure. */
4538 x_get_focus_frame (frame
)
4539 struct frame
*frame
;
4541 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4543 if (! dpyinfo
->x_focus_frame
)
4546 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4551 /* In certain situations, when the window manager follows a
4552 click-to-focus policy, there seems to be no way around calling
4553 XSetInputFocus to give another frame the input focus .
4555 In an ideal world, XSetInputFocus should generally be avoided so
4556 that applications don't interfere with the window manager's focus
4557 policy. But I think it's okay to use when it's clearly done
4558 following a user-command. */
4560 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4561 "Set the input focus to FRAME.\n\
4562 FRAME nil means use the selected frame.")
4566 struct frame
*f
= check_x_frame (frame
);
4567 Display
*dpy
= FRAME_X_DISPLAY (f
);
4571 count
= x_catch_errors (dpy
);
4572 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4573 RevertToParent
, CurrentTime
);
4574 x_uncatch_errors (dpy
, count
);
4581 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4582 "Internal function called by `color-defined-p', which see.")
4584 Lisp_Object color
, frame
;
4587 FRAME_PTR f
= check_x_frame (frame
);
4589 CHECK_STRING (color
, 1);
4591 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4597 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4598 "Internal function called by `color-values', which see.")
4600 Lisp_Object color
, frame
;
4603 FRAME_PTR f
= check_x_frame (frame
);
4605 CHECK_STRING (color
, 1);
4607 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4611 rgb
[0] = make_number (foo
.red
);
4612 rgb
[1] = make_number (foo
.green
);
4613 rgb
[2] = make_number (foo
.blue
);
4614 return Flist (3, rgb
);
4620 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4621 "Internal function called by `display-color-p', which see.")
4623 Lisp_Object display
;
4625 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4627 if (dpyinfo
->n_planes
<= 2)
4630 switch (dpyinfo
->visual
->class)
4643 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4645 "Return t if the X display supports shades of gray.\n\
4646 Note that color displays do support shades of gray.\n\
4647 The optional argument DISPLAY specifies which display to ask about.\n\
4648 DISPLAY should be either a frame or a display name (a string).\n\
4649 If omitted or nil, that stands for the selected frame's display.")
4651 Lisp_Object display
;
4653 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4655 if (dpyinfo
->n_planes
<= 1)
4658 switch (dpyinfo
->visual
->class)
4673 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4675 "Returns the width in pixels of the X display DISPLAY.\n\
4676 The optional argument DISPLAY specifies which display to ask about.\n\
4677 DISPLAY should be either a frame or a display name (a string).\n\
4678 If omitted or nil, that stands for the selected frame's display.")
4680 Lisp_Object display
;
4682 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4684 return make_number (dpyinfo
->width
);
4687 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4688 Sx_display_pixel_height
, 0, 1, 0,
4689 "Returns the height in pixels of the X display DISPLAY.\n\
4690 The optional argument DISPLAY specifies which display to ask about.\n\
4691 DISPLAY should be either a frame or a display name (a string).\n\
4692 If omitted or nil, that stands for the selected frame's display.")
4694 Lisp_Object display
;
4696 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4698 return make_number (dpyinfo
->height
);
4701 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4703 "Returns the number of bitplanes of the X display DISPLAY.\n\
4704 The optional argument DISPLAY specifies which display to ask about.\n\
4705 DISPLAY should be either a frame or a display name (a string).\n\
4706 If omitted or nil, that stands for the selected frame's display.")
4708 Lisp_Object display
;
4710 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4712 return make_number (dpyinfo
->n_planes
);
4715 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4717 "Returns the number of color cells of the X display DISPLAY.\n\
4718 The optional argument DISPLAY specifies which display to ask about.\n\
4719 DISPLAY should be either a frame or a display name (a string).\n\
4720 If omitted or nil, that stands for the selected frame's display.")
4722 Lisp_Object display
;
4724 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4726 return make_number (DisplayCells (dpyinfo
->display
,
4727 XScreenNumberOfScreen (dpyinfo
->screen
)));
4730 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4731 Sx_server_max_request_size
,
4733 "Returns the maximum request size of the X server of display DISPLAY.\n\
4734 The optional argument DISPLAY specifies which display to ask about.\n\
4735 DISPLAY should be either a frame or a display name (a string).\n\
4736 If omitted or nil, that stands for the selected frame's display.")
4738 Lisp_Object display
;
4740 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4742 return make_number (MAXREQUEST (dpyinfo
->display
));
4745 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4746 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4747 The optional argument DISPLAY specifies which display to ask about.\n\
4748 DISPLAY should be either a frame or a display name (a string).\n\
4749 If omitted or nil, that stands for the selected frame's display.")
4751 Lisp_Object display
;
4753 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4754 char *vendor
= ServerVendor (dpyinfo
->display
);
4756 if (! vendor
) vendor
= "";
4757 return build_string (vendor
);
4760 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4761 "Returns the version numbers of the X server of display DISPLAY.\n\
4762 The value is a list of three integers: the major and minor\n\
4763 version numbers of the X Protocol in use, and the vendor-specific release\n\
4764 number. See also the function `x-server-vendor'.\n\n\
4765 The optional argument DISPLAY specifies which display to ask about.\n\
4766 DISPLAY should be either a frame or a display name (a string).\n\
4767 If omitted or nil, that stands for the selected frame's display.")
4769 Lisp_Object display
;
4771 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4772 Display
*dpy
= dpyinfo
->display
;
4774 return Fcons (make_number (ProtocolVersion (dpy
)),
4775 Fcons (make_number (ProtocolRevision (dpy
)),
4776 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4779 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4780 "Returns the number of screens on the X server of display DISPLAY.\n\
4781 The optional argument DISPLAY specifies which display to ask about.\n\
4782 DISPLAY should be either a frame or a display name (a string).\n\
4783 If omitted or nil, that stands for the selected frame's display.")
4785 Lisp_Object display
;
4787 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4789 return make_number (ScreenCount (dpyinfo
->display
));
4792 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4793 "Returns the height in millimeters of the X display DISPLAY.\n\
4794 The optional argument DISPLAY specifies which display to ask about.\n\
4795 DISPLAY should be either a frame or a display name (a string).\n\
4796 If omitted or nil, that stands for the selected frame's display.")
4798 Lisp_Object display
;
4800 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4802 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4805 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4806 "Returns the width in millimeters of the X display DISPLAY.\n\
4807 The optional argument DISPLAY specifies which display to ask about.\n\
4808 DISPLAY should be either a frame or a display name (a string).\n\
4809 If omitted or nil, that stands for the selected frame's display.")
4811 Lisp_Object display
;
4813 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4815 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4818 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4819 Sx_display_backing_store
, 0, 1, 0,
4820 "Returns an indication of whether X display DISPLAY does backing store.\n\
4821 The value may be `always', `when-mapped', or `not-useful'.\n\
4822 The optional argument DISPLAY specifies which display to ask about.\n\
4823 DISPLAY should be either a frame or a display name (a string).\n\
4824 If omitted or nil, that stands for the selected frame's display.")
4826 Lisp_Object display
;
4828 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4831 switch (DoesBackingStore (dpyinfo
->screen
))
4834 result
= intern ("always");
4838 result
= intern ("when-mapped");
4842 result
= intern ("not-useful");
4846 error ("Strange value for BackingStore parameter of screen");
4853 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4854 Sx_display_visual_class
, 0, 1, 0,
4855 "Returns the visual class of the X display DISPLAY.\n\
4856 The value is one of the symbols `static-gray', `gray-scale',\n\
4857 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4858 The optional argument DISPLAY specifies which display to ask about.\n\
4859 DISPLAY should be either a frame or a display name (a string).\n\
4860 If omitted or nil, that stands for the selected frame's display.")
4862 Lisp_Object display
;
4864 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4867 switch (dpyinfo
->visual
->class)
4870 result
= intern ("static-gray");
4873 result
= intern ("gray-scale");
4876 result
= intern ("static-color");
4879 result
= intern ("pseudo-color");
4882 result
= intern ("true-color");
4885 result
= intern ("direct-color");
4888 error ("Display has an unknown visual class");
4895 DEFUN ("x-display-save-under", Fx_display_save_under
,
4896 Sx_display_save_under
, 0, 1, 0,
4897 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4898 The optional argument DISPLAY specifies which display to ask about.\n\
4899 DISPLAY should be either a frame or a display name (a string).\n\
4900 If omitted or nil, that stands for the selected frame's display.")
4902 Lisp_Object display
;
4904 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4906 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4914 register struct frame
*f
;
4916 return PIXEL_WIDTH (f
);
4921 register struct frame
*f
;
4923 return PIXEL_HEIGHT (f
);
4928 register struct frame
*f
;
4930 return FONT_WIDTH (f
->output_data
.x
->font
);
4935 register struct frame
*f
;
4937 return f
->output_data
.x
->line_height
;
4942 register struct frame
*f
;
4944 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4949 /************************************************************************
4951 ************************************************************************/
4954 /* Mapping visual names to visuals. */
4956 static struct visual_class
4963 {"StaticGray", StaticGray
},
4964 {"GrayScale", GrayScale
},
4965 {"StaticColor", StaticColor
},
4966 {"PseudoColor", PseudoColor
},
4967 {"TrueColor", TrueColor
},
4968 {"DirectColor", DirectColor
},
4973 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4975 /* Value is the screen number of screen SCR. This is a substitute for
4976 the X function with the same name when that doesn't exist. */
4979 XScreenNumberOfScreen (scr
)
4980 register Screen
*scr
;
4982 Display
*dpy
= scr
->display
;
4985 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4986 if (scr
== dpy
->screens
+ i
)
4992 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4995 /* Select the visual that should be used on display DPYINFO. Set
4996 members of DPYINFO appropriately. Called from x_term_init. */
4999 select_visual (dpyinfo
)
5000 struct x_display_info
*dpyinfo
;
5002 Display
*dpy
= dpyinfo
->display
;
5003 Screen
*screen
= dpyinfo
->screen
;
5006 /* See if a visual is specified. */
5007 value
= display_x_get_resource (dpyinfo
,
5008 build_string ("visualClass"),
5009 build_string ("VisualClass"),
5011 if (STRINGP (value
))
5013 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
5014 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
5015 depth, a decimal number. NAME is compared with case ignored. */
5016 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
5021 strcpy (s
, XSTRING (value
)->data
);
5022 dash
= index (s
, '-');
5025 dpyinfo
->n_planes
= atoi (dash
+ 1);
5029 /* We won't find a matching visual with depth 0, so that
5030 an error will be printed below. */
5031 dpyinfo
->n_planes
= 0;
5033 /* Determine the visual class. */
5034 for (i
= 0; visual_classes
[i
].name
; ++i
)
5035 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
5037 class = visual_classes
[i
].class;
5041 /* Look up a matching visual for the specified class. */
5043 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
5044 dpyinfo
->n_planes
, class, &vinfo
))
5045 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
5047 dpyinfo
->visual
= vinfo
.visual
;
5052 XVisualInfo
*vinfo
, vinfo_template
;
5054 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
5057 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
5059 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
5061 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5062 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
5063 &vinfo_template
, &n_visuals
);
5065 fatal ("Can't get proper X visual info");
5067 dpyinfo
->n_planes
= vinfo
->depth
;
5068 XFree ((char *) vinfo
);
5073 /* Return the X display structure for the display named NAME.
5074 Open a new connection if necessary. */
5076 struct x_display_info
*
5077 x_display_info_for_name (name
)
5081 struct x_display_info
*dpyinfo
;
5083 CHECK_STRING (name
, 0);
5085 if (! EQ (Vwindow_system
, intern ("x")))
5086 error ("Not using X Windows");
5088 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5090 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5093 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5098 /* Use this general default value to start with. */
5099 Vx_resource_name
= Vinvocation_name
;
5101 validate_x_resource_name ();
5103 dpyinfo
= x_term_init (name
, (char *)0,
5104 (char *) XSTRING (Vx_resource_name
)->data
);
5107 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5110 XSETFASTINT (Vwindow_system_version
, 11);
5116 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5117 1, 3, 0, "Open a connection to an X server.\n\
5118 DISPLAY is the name of the display to connect to.\n\
5119 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5120 If the optional third arg MUST-SUCCEED is non-nil,\n\
5121 terminate Emacs if we can't open the connection.")
5122 (display
, xrm_string
, must_succeed
)
5123 Lisp_Object display
, xrm_string
, must_succeed
;
5125 unsigned char *xrm_option
;
5126 struct x_display_info
*dpyinfo
;
5128 CHECK_STRING (display
, 0);
5129 if (! NILP (xrm_string
))
5130 CHECK_STRING (xrm_string
, 1);
5132 if (! EQ (Vwindow_system
, intern ("x")))
5133 error ("Not using X Windows");
5135 if (! NILP (xrm_string
))
5136 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5138 xrm_option
= (unsigned char *) 0;
5140 validate_x_resource_name ();
5142 /* This is what opens the connection and sets x_current_display.
5143 This also initializes many symbols, such as those used for input. */
5144 dpyinfo
= x_term_init (display
, xrm_option
,
5145 (char *) XSTRING (Vx_resource_name
)->data
);
5149 if (!NILP (must_succeed
))
5150 fatal ("Cannot connect to X server %s.\n\
5151 Check the DISPLAY environment variable or use `-d'.\n\
5152 Also use the `xhost' program to verify that it is set to permit\n\
5153 connections from your machine.\n",
5154 XSTRING (display
)->data
);
5156 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5161 XSETFASTINT (Vwindow_system_version
, 11);
5165 DEFUN ("x-close-connection", Fx_close_connection
,
5166 Sx_close_connection
, 1, 1, 0,
5167 "Close the connection to DISPLAY's X server.\n\
5168 For DISPLAY, specify either a frame or a display name (a string).\n\
5169 If DISPLAY is nil, that stands for the selected frame's display.")
5171 Lisp_Object display
;
5173 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5176 if (dpyinfo
->reference_count
> 0)
5177 error ("Display still has frames on it");
5180 /* Free the fonts in the font table. */
5181 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5182 if (dpyinfo
->font_table
[i
].name
)
5184 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5185 xfree (dpyinfo
->font_table
[i
].full_name
);
5186 xfree (dpyinfo
->font_table
[i
].name
);
5187 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5190 x_destroy_all_bitmaps (dpyinfo
);
5191 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5193 #ifdef USE_X_TOOLKIT
5194 XtCloseDisplay (dpyinfo
->display
);
5196 XCloseDisplay (dpyinfo
->display
);
5199 x_delete_display (dpyinfo
);
5205 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5206 "Return the list of display names that Emacs has connections to.")
5209 Lisp_Object tail
, result
;
5212 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5213 result
= Fcons (XCAR (XCAR (tail
)), result
);
5218 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5219 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5220 If ON is nil, allow buffering of requests.\n\
5221 Turning on synchronization prohibits the Xlib routines from buffering\n\
5222 requests and seriously degrades performance, but makes debugging much\n\
5224 The optional second argument DISPLAY specifies which display to act on.\n\
5225 DISPLAY should be either a frame or a display name (a string).\n\
5226 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5228 Lisp_Object display
, on
;
5230 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5232 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5237 /* Wait for responses to all X commands issued so far for frame F. */
5244 XSync (FRAME_X_DISPLAY (f
), False
);
5249 /***********************************************************************
5251 ***********************************************************************/
5253 /* Value is the number of elements of vector VECTOR. */
5255 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5257 /* List of supported image types. Use define_image_type to add new
5258 types. Use lookup_image_type to find a type for a given symbol. */
5260 static struct image_type
*image_types
;
5262 /* The symbol `image' which is the car of the lists used to represent
5265 extern Lisp_Object Qimage
;
5267 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5273 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5274 extern Lisp_Object QCdata
;
5275 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5276 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5277 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5279 /* Other symbols. */
5281 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5283 /* Time in seconds after which images should be removed from the cache
5284 if not displayed. */
5286 Lisp_Object Vimage_cache_eviction_delay
;
5288 /* Function prototypes. */
5290 static void define_image_type
P_ ((struct image_type
*type
));
5291 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5292 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5293 static void x_laplace
P_ ((struct frame
*, struct image
*));
5294 static void x_emboss
P_ ((struct frame
*, struct image
*));
5295 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5299 /* Define a new image type from TYPE. This adds a copy of TYPE to
5300 image_types and adds the symbol *TYPE->type to Vimage_types. */
5303 define_image_type (type
)
5304 struct image_type
*type
;
5306 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5307 The initialized data segment is read-only. */
5308 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5309 bcopy (type
, p
, sizeof *p
);
5310 p
->next
= image_types
;
5312 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5316 /* Look up image type SYMBOL, and return a pointer to its image_type
5317 structure. Value is null if SYMBOL is not a known image type. */
5319 static INLINE
struct image_type
*
5320 lookup_image_type (symbol
)
5323 struct image_type
*type
;
5325 for (type
= image_types
; type
; type
= type
->next
)
5326 if (EQ (symbol
, *type
->type
))
5333 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5334 valid image specification is a list whose car is the symbol
5335 `image', and whose rest is a property list. The property list must
5336 contain a value for key `:type'. That value must be the name of a
5337 supported image type. The rest of the property list depends on the
5341 valid_image_p (object
)
5346 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5350 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
5351 if (EQ (XCAR (tem
), QCtype
))
5354 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
5356 struct image_type
*type
;
5357 type
= lookup_image_type (XCAR (tem
));
5359 valid_p
= type
->valid_p (object
);
5370 /* Log error message with format string FORMAT and argument ARG.
5371 Signaling an error, e.g. when an image cannot be loaded, is not a
5372 good idea because this would interrupt redisplay, and the error
5373 message display would lead to another redisplay. This function
5374 therefore simply displays a message. */
5377 image_error (format
, arg1
, arg2
)
5379 Lisp_Object arg1
, arg2
;
5381 add_to_log (format
, arg1
, arg2
);
5386 /***********************************************************************
5387 Image specifications
5388 ***********************************************************************/
5390 enum image_value_type
5392 IMAGE_DONT_CHECK_VALUE_TYPE
,
5394 IMAGE_STRING_OR_NIL_VALUE
,
5396 IMAGE_POSITIVE_INTEGER_VALUE
,
5397 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5398 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5400 IMAGE_INTEGER_VALUE
,
5401 IMAGE_FUNCTION_VALUE
,
5406 /* Structure used when parsing image specifications. */
5408 struct image_keyword
5410 /* Name of keyword. */
5413 /* The type of value allowed. */
5414 enum image_value_type type
;
5416 /* Non-zero means key must be present. */
5419 /* Used to recognize duplicate keywords in a property list. */
5422 /* The value that was found. */
5427 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5429 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5432 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5433 has the format (image KEYWORD VALUE ...). One of the keyword/
5434 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5435 image_keywords structures of size NKEYWORDS describing other
5436 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5439 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5441 struct image_keyword
*keywords
;
5448 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5451 plist
= XCDR (spec
);
5452 while (CONSP (plist
))
5454 Lisp_Object key
, value
;
5456 /* First element of a pair must be a symbol. */
5458 plist
= XCDR (plist
);
5462 /* There must follow a value. */
5465 value
= XCAR (plist
);
5466 plist
= XCDR (plist
);
5468 /* Find key in KEYWORDS. Error if not found. */
5469 for (i
= 0; i
< nkeywords
; ++i
)
5470 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5476 /* Record that we recognized the keyword. If a keywords
5477 was found more than once, it's an error. */
5478 keywords
[i
].value
= value
;
5479 ++keywords
[i
].count
;
5481 if (keywords
[i
].count
> 1)
5484 /* Check type of value against allowed type. */
5485 switch (keywords
[i
].type
)
5487 case IMAGE_STRING_VALUE
:
5488 if (!STRINGP (value
))
5492 case IMAGE_STRING_OR_NIL_VALUE
:
5493 if (!STRINGP (value
) && !NILP (value
))
5497 case IMAGE_SYMBOL_VALUE
:
5498 if (!SYMBOLP (value
))
5502 case IMAGE_POSITIVE_INTEGER_VALUE
:
5503 if (!INTEGERP (value
) || XINT (value
) <= 0)
5507 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5508 if (INTEGERP (value
) && XINT (value
) >= 0)
5511 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5512 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5516 case IMAGE_ASCENT_VALUE
:
5517 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5519 else if (INTEGERP (value
)
5520 && XINT (value
) >= 0
5521 && XINT (value
) <= 100)
5525 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5526 if (!INTEGERP (value
) || XINT (value
) < 0)
5530 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5533 case IMAGE_FUNCTION_VALUE
:
5534 value
= indirect_function (value
);
5536 || COMPILEDP (value
)
5537 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5541 case IMAGE_NUMBER_VALUE
:
5542 if (!INTEGERP (value
) && !FLOATP (value
))
5546 case IMAGE_INTEGER_VALUE
:
5547 if (!INTEGERP (value
))
5551 case IMAGE_BOOL_VALUE
:
5552 if (!NILP (value
) && !EQ (value
, Qt
))
5561 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5565 /* Check that all mandatory fields are present. */
5566 for (i
= 0; i
< nkeywords
; ++i
)
5567 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5570 return NILP (plist
);
5574 /* Return the value of KEY in image specification SPEC. Value is nil
5575 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5576 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5579 image_spec_value (spec
, key
, found
)
5580 Lisp_Object spec
, key
;
5585 xassert (valid_image_p (spec
));
5587 for (tail
= XCDR (spec
);
5588 CONSP (tail
) && CONSP (XCDR (tail
));
5589 tail
= XCDR (XCDR (tail
)))
5591 if (EQ (XCAR (tail
), key
))
5595 return XCAR (XCDR (tail
));
5605 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5606 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5607 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5608 size in canonical character units.\n\
5609 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5610 or omitted means use the selected frame.")
5611 (spec
, pixels
, frame
)
5612 Lisp_Object spec
, pixels
, frame
;
5617 if (valid_image_p (spec
))
5619 struct frame
*f
= check_x_frame (frame
);
5620 int id
= lookup_image (f
, spec
);
5621 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5622 int width
= img
->width
+ 2 * img
->hmargin
;
5623 int height
= img
->height
+ 2 * img
->vmargin
;
5626 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5627 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5629 size
= Fcons (make_number (width
), make_number (height
));
5632 error ("Invalid image specification");
5638 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5639 "Return t if image SPEC has a mask bitmap.\n\
5640 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5641 or omitted means use the selected frame.")
5643 Lisp_Object spec
, frame
;
5648 if (valid_image_p (spec
))
5650 struct frame
*f
= check_x_frame (frame
);
5651 int id
= lookup_image (f
, spec
);
5652 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5657 error ("Invalid image specification");
5664 /***********************************************************************
5665 Image type independent image structures
5666 ***********************************************************************/
5668 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5669 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5672 /* Allocate and return a new image structure for image specification
5673 SPEC. SPEC has a hash value of HASH. */
5675 static struct image
*
5676 make_image (spec
, hash
)
5680 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5682 xassert (valid_image_p (spec
));
5683 bzero (img
, sizeof *img
);
5684 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5685 xassert (img
->type
!= NULL
);
5687 img
->data
.lisp_val
= Qnil
;
5688 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5694 /* Free image IMG which was used on frame F, including its resources. */
5703 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5705 /* Remove IMG from the hash table of its cache. */
5707 img
->prev
->next
= img
->next
;
5709 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5712 img
->next
->prev
= img
->prev
;
5714 c
->images
[img
->id
] = NULL
;
5716 /* Free resources, then free IMG. */
5717 img
->type
->free (f
, img
);
5723 /* Prepare image IMG for display on frame F. Must be called before
5724 drawing an image. */
5727 prepare_image_for_display (f
, img
)
5733 /* We're about to display IMG, so set its timestamp to `now'. */
5735 img
->timestamp
= EMACS_SECS (t
);
5737 /* If IMG doesn't have a pixmap yet, load it now, using the image
5738 type dependent loader function. */
5739 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5740 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5744 /* Value is the number of pixels for the ascent of image IMG when
5745 drawn in face FACE. */
5748 image_ascent (img
, face
)
5752 int height
= img
->height
+ img
->vmargin
;
5755 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5758 /* This expression is arranged so that if the image can't be
5759 exactly centered, it will be moved slightly up. This is
5760 because a typical font is `top-heavy' (due to the presence
5761 uppercase letters), so the image placement should err towards
5762 being top-heavy too. It also just generally looks better. */
5763 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5765 ascent
= height
/ 2;
5768 ascent
= height
* img
->ascent
/ 100.0;
5775 /***********************************************************************
5776 Helper functions for X image types
5777 ***********************************************************************/
5779 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5781 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5782 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5784 Lisp_Object color_name
,
5785 unsigned long dflt
));
5788 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5789 free the pixmap if any. MASK_P non-zero means clear the mask
5790 pixmap if any. COLORS_P non-zero means free colors allocated for
5791 the image, if any. */
5794 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5797 int pixmap_p
, mask_p
, colors_p
;
5799 if (pixmap_p
&& img
->pixmap
)
5801 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5805 if (mask_p
&& img
->mask
)
5807 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5811 if (colors_p
&& img
->ncolors
)
5813 x_free_colors (f
, img
->colors
, img
->ncolors
);
5814 xfree (img
->colors
);
5820 /* Free X resources of image IMG which is used on frame F. */
5823 x_clear_image (f
, img
)
5828 x_clear_image_1 (f
, img
, 1, 1, 1);
5833 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5834 cannot be allocated, use DFLT. Add a newly allocated color to
5835 IMG->colors, so that it can be freed again. Value is the pixel
5838 static unsigned long
5839 x_alloc_image_color (f
, img
, color_name
, dflt
)
5842 Lisp_Object color_name
;
5846 unsigned long result
;
5848 xassert (STRINGP (color_name
));
5850 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5852 /* This isn't called frequently so we get away with simply
5853 reallocating the color vector to the needed size, here. */
5856 (unsigned long *) xrealloc (img
->colors
,
5857 img
->ncolors
* sizeof *img
->colors
);
5858 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5859 result
= color
.pixel
;
5869 /***********************************************************************
5871 ***********************************************************************/
5873 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5874 static void postprocess_image
P_ ((struct frame
*, struct image
*));
5877 /* Return a new, initialized image cache that is allocated from the
5878 heap. Call free_image_cache to free an image cache. */
5880 struct image_cache
*
5883 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5886 bzero (c
, sizeof *c
);
5888 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5889 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5890 c
->buckets
= (struct image
**) xmalloc (size
);
5891 bzero (c
->buckets
, size
);
5896 /* Free image cache of frame F. Be aware that X frames share images
5900 free_image_cache (f
)
5903 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5908 /* Cache should not be referenced by any frame when freed. */
5909 xassert (c
->refcount
== 0);
5911 for (i
= 0; i
< c
->used
; ++i
)
5912 free_image (f
, c
->images
[i
]);
5916 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5921 /* Clear image cache of frame F. FORCE_P non-zero means free all
5922 images. FORCE_P zero means clear only images that haven't been
5923 displayed for some time. Should be called from time to time to
5924 reduce the number of loaded images. If image-eviction-seconds is
5925 non-nil, this frees images in the cache which weren't displayed for
5926 at least that many seconds. */
5929 clear_image_cache (f
, force_p
)
5933 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5935 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5942 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5944 /* Block input so that we won't be interrupted by a SIGIO
5945 while being in an inconsistent state. */
5948 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5950 struct image
*img
= c
->images
[i
];
5952 && (force_p
|| img
->timestamp
< old
))
5954 free_image (f
, img
);
5959 /* We may be clearing the image cache because, for example,
5960 Emacs was iconified for a longer period of time. In that
5961 case, current matrices may still contain references to
5962 images freed above. So, clear these matrices. */
5965 Lisp_Object tail
, frame
;
5967 FOR_EACH_FRAME (tail
, frame
)
5969 struct frame
*f
= XFRAME (frame
);
5971 && FRAME_X_IMAGE_CACHE (f
) == c
)
5972 clear_current_matrices (f
);
5975 ++windows_or_buffers_changed
;
5983 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5985 "Clear the image cache of FRAME.\n\
5986 FRAME nil or omitted means use the selected frame.\n\
5987 FRAME t means clear the image caches of all frames.")
5995 FOR_EACH_FRAME (tail
, frame
)
5996 if (FRAME_X_P (XFRAME (frame
)))
5997 clear_image_cache (XFRAME (frame
), 1);
6000 clear_image_cache (check_x_frame (frame
), 1);
6006 /* Compute masks and transform image IMG on frame F, as specified
6007 by the image's specification, */
6010 postprocess_image (f
, img
)
6014 /* Manipulation of the image's mask. */
6017 Lisp_Object conversion
, spec
;
6022 /* `:heuristic-mask t'
6024 means build a mask heuristically.
6025 `:heuristic-mask (R G B)'
6026 `:mask (heuristic (R G B))'
6027 means build a mask from color (R G B) in the
6030 means remove a mask, if any. */
6032 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6034 x_build_heuristic_mask (f
, img
, mask
);
6039 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6041 if (EQ (mask
, Qheuristic
))
6042 x_build_heuristic_mask (f
, img
, Qt
);
6043 else if (CONSP (mask
)
6044 && EQ (XCAR (mask
), Qheuristic
))
6046 if (CONSP (XCDR (mask
)))
6047 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6049 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6051 else if (NILP (mask
) && found_p
&& img
->mask
)
6053 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6059 /* Should we apply an image transformation algorithm? */
6060 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6061 if (EQ (conversion
, Qdisabled
))
6062 x_disable_image (f
, img
);
6063 else if (EQ (conversion
, Qlaplace
))
6065 else if (EQ (conversion
, Qemboss
))
6067 else if (CONSP (conversion
)
6068 && EQ (XCAR (conversion
), Qedge_detection
))
6071 tem
= XCDR (conversion
);
6073 x_edge_detection (f
, img
,
6074 Fplist_get (tem
, QCmatrix
),
6075 Fplist_get (tem
, QCcolor_adjustment
));
6081 /* Return the id of image with Lisp specification SPEC on frame F.
6082 SPEC must be a valid Lisp image specification (see valid_image_p). */
6085 lookup_image (f
, spec
)
6089 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6093 struct gcpro gcpro1
;
6096 /* F must be a window-system frame, and SPEC must be a valid image
6098 xassert (FRAME_WINDOW_P (f
));
6099 xassert (valid_image_p (spec
));
6103 /* Look up SPEC in the hash table of the image cache. */
6104 hash
= sxhash (spec
, 0);
6105 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6107 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6108 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6111 /* If not found, create a new image and cache it. */
6114 extern Lisp_Object Qpostscript
;
6117 img
= make_image (spec
, hash
);
6118 cache_image (f
, img
);
6119 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6121 /* If we can't load the image, and we don't have a width and
6122 height, use some arbitrary width and height so that we can
6123 draw a rectangle for it. */
6124 if (img
->load_failed_p
)
6128 value
= image_spec_value (spec
, QCwidth
, NULL
);
6129 img
->width
= (INTEGERP (value
)
6130 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6131 value
= image_spec_value (spec
, QCheight
, NULL
);
6132 img
->height
= (INTEGERP (value
)
6133 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6137 /* Handle image type independent image attributes
6138 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
6139 Lisp_Object ascent
, margin
, relief
;
6141 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6142 if (INTEGERP (ascent
))
6143 img
->ascent
= XFASTINT (ascent
);
6144 else if (EQ (ascent
, Qcenter
))
6145 img
->ascent
= CENTERED_IMAGE_ASCENT
;
6147 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6148 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6149 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
6150 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
6151 && INTEGERP (XCDR (margin
)))
6153 if (XINT (XCAR (margin
)) > 0)
6154 img
->hmargin
= XFASTINT (XCAR (margin
));
6155 if (XINT (XCDR (margin
)) > 0)
6156 img
->vmargin
= XFASTINT (XCDR (margin
));
6159 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6160 if (INTEGERP (relief
))
6162 img
->relief
= XINT (relief
);
6163 img
->hmargin
+= abs (img
->relief
);
6164 img
->vmargin
+= abs (img
->relief
);
6167 /* Do image transformations and compute masks, unless we
6168 don't have the image yet. */
6169 if (!EQ (*img
->type
->type
, Qpostscript
))
6170 postprocess_image (f
, img
);
6174 xassert (!interrupt_input_blocked
);
6177 /* We're using IMG, so set its timestamp to `now'. */
6178 EMACS_GET_TIME (now
);
6179 img
->timestamp
= EMACS_SECS (now
);
6183 /* Value is the image id. */
6188 /* Cache image IMG in the image cache of frame F. */
6191 cache_image (f
, img
)
6195 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6198 /* Find a free slot in c->images. */
6199 for (i
= 0; i
< c
->used
; ++i
)
6200 if (c
->images
[i
] == NULL
)
6203 /* If no free slot found, maybe enlarge c->images. */
6204 if (i
== c
->used
&& c
->used
== c
->size
)
6207 c
->images
= (struct image
**) xrealloc (c
->images
,
6208 c
->size
* sizeof *c
->images
);
6211 /* Add IMG to c->images, and assign IMG an id. */
6217 /* Add IMG to the cache's hash table. */
6218 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6219 img
->next
= c
->buckets
[i
];
6221 img
->next
->prev
= img
;
6223 c
->buckets
[i
] = img
;
6227 /* Call FN on every image in the image cache of frame F. Used to mark
6228 Lisp Objects in the image cache. */
6231 forall_images_in_image_cache (f
, fn
)
6233 void (*fn
) P_ ((struct image
*img
));
6235 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6237 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6241 for (i
= 0; i
< c
->used
; ++i
)
6250 /***********************************************************************
6252 ***********************************************************************/
6254 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6255 XImage
**, Pixmap
*));
6256 static void x_destroy_x_image
P_ ((XImage
*));
6257 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6260 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6261 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6262 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6263 via xmalloc. Print error messages via image_error if an error
6264 occurs. Value is non-zero if successful. */
6267 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6269 int width
, height
, depth
;
6273 Display
*display
= FRAME_X_DISPLAY (f
);
6274 Screen
*screen
= FRAME_X_SCREEN (f
);
6275 Window window
= FRAME_X_WINDOW (f
);
6277 xassert (interrupt_input_blocked
);
6280 depth
= DefaultDepthOfScreen (screen
);
6281 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6282 depth
, ZPixmap
, 0, NULL
, width
, height
,
6283 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6286 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6290 /* Allocate image raster. */
6291 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6293 /* Allocate a pixmap of the same size. */
6294 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6295 if (*pixmap
== None
)
6297 x_destroy_x_image (*ximg
);
6299 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6307 /* Destroy XImage XIMG. Free XIMG->data. */
6310 x_destroy_x_image (ximg
)
6313 xassert (interrupt_input_blocked
);
6318 XDestroyImage (ximg
);
6323 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6324 are width and height of both the image and pixmap. */
6327 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6334 xassert (interrupt_input_blocked
);
6335 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6336 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6337 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6342 /***********************************************************************
6344 ***********************************************************************/
6346 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6347 static char *slurp_file
P_ ((char *, int *));
6350 /* Find image file FILE. Look in data-directory, then
6351 x-bitmap-file-path. Value is the full name of the file found, or
6352 nil if not found. */
6355 x_find_image_file (file
)
6358 Lisp_Object file_found
, search_path
;
6359 struct gcpro gcpro1
, gcpro2
;
6363 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6364 GCPRO2 (file_found
, search_path
);
6366 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6367 fd
= openp (search_path
, file
, "", &file_found
, 0);
6379 /* Read FILE into memory. Value is a pointer to a buffer allocated
6380 with xmalloc holding FILE's contents. Value is null if an error
6381 occurred. *SIZE is set to the size of the file. */
6384 slurp_file (file
, size
)
6392 if (stat (file
, &st
) == 0
6393 && (fp
= fopen (file
, "r")) != NULL
6394 && (buf
= (char *) xmalloc (st
.st_size
),
6395 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6416 /***********************************************************************
6418 ***********************************************************************/
6420 static int xbm_scan
P_ ((char **, char *, char *, int *));
6421 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6422 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6424 static int xbm_image_p
P_ ((Lisp_Object object
));
6425 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6427 static int xbm_file_p
P_ ((Lisp_Object
));
6430 /* Indices of image specification fields in xbm_format, below. */
6432 enum xbm_keyword_index
6450 /* Vector of image_keyword structures describing the format
6451 of valid XBM image specifications. */
6453 static struct image_keyword xbm_format
[XBM_LAST
] =
6455 {":type", IMAGE_SYMBOL_VALUE
, 1},
6456 {":file", IMAGE_STRING_VALUE
, 0},
6457 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6458 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6459 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6460 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
6461 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
6462 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6463 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6464 {":relief", IMAGE_INTEGER_VALUE
, 0},
6465 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6466 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6467 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6470 /* Structure describing the image type XBM. */
6472 static struct image_type xbm_type
=
6481 /* Tokens returned from xbm_scan. */
6490 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6491 A valid specification is a list starting with the symbol `image'
6492 The rest of the list is a property list which must contain an
6495 If the specification specifies a file to load, it must contain
6496 an entry `:file FILENAME' where FILENAME is a string.
6498 If the specification is for a bitmap loaded from memory it must
6499 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6500 WIDTH and HEIGHT are integers > 0. DATA may be:
6502 1. a string large enough to hold the bitmap data, i.e. it must
6503 have a size >= (WIDTH + 7) / 8 * HEIGHT
6505 2. a bool-vector of size >= WIDTH * HEIGHT
6507 3. a vector of strings or bool-vectors, one for each line of the
6510 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6511 may not be specified in this case because they are defined in the
6514 Both the file and data forms may contain the additional entries
6515 `:background COLOR' and `:foreground COLOR'. If not present,
6516 foreground and background of the frame on which the image is
6517 displayed is used. */
6520 xbm_image_p (object
)
6523 struct image_keyword kw
[XBM_LAST
];
6525 bcopy (xbm_format
, kw
, sizeof kw
);
6526 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6529 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6531 if (kw
[XBM_FILE
].count
)
6533 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6536 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6538 /* In-memory XBM file. */
6539 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6547 /* Entries for `:width', `:height' and `:data' must be present. */
6548 if (!kw
[XBM_WIDTH
].count
6549 || !kw
[XBM_HEIGHT
].count
6550 || !kw
[XBM_DATA
].count
)
6553 data
= kw
[XBM_DATA
].value
;
6554 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6555 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6557 /* Check type of data, and width and height against contents of
6563 /* Number of elements of the vector must be >= height. */
6564 if (XVECTOR (data
)->size
< height
)
6567 /* Each string or bool-vector in data must be large enough
6568 for one line of the image. */
6569 for (i
= 0; i
< height
; ++i
)
6571 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6575 if (XSTRING (elt
)->size
6576 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6579 else if (BOOL_VECTOR_P (elt
))
6581 if (XBOOL_VECTOR (elt
)->size
< width
)
6588 else if (STRINGP (data
))
6590 if (XSTRING (data
)->size
6591 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6594 else if (BOOL_VECTOR_P (data
))
6596 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6607 /* Scan a bitmap file. FP is the stream to read from. Value is
6608 either an enumerator from enum xbm_token, or a character for a
6609 single-character token, or 0 at end of file. If scanning an
6610 identifier, store the lexeme of the identifier in SVAL. If
6611 scanning a number, store its value in *IVAL. */
6614 xbm_scan (s
, end
, sval
, ival
)
6623 /* Skip white space. */
6624 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6629 else if (isdigit (c
))
6631 int value
= 0, digit
;
6633 if (c
== '0' && *s
< end
)
6636 if (c
== 'x' || c
== 'X')
6643 else if (c
>= 'a' && c
<= 'f')
6644 digit
= c
- 'a' + 10;
6645 else if (c
>= 'A' && c
<= 'F')
6646 digit
= c
- 'A' + 10;
6649 value
= 16 * value
+ digit
;
6652 else if (isdigit (c
))
6656 && (c
= *(*s
)++, isdigit (c
)))
6657 value
= 8 * value
+ c
- '0';
6664 && (c
= *(*s
)++, isdigit (c
)))
6665 value
= 10 * value
+ c
- '0';
6673 else if (isalpha (c
) || c
== '_')
6677 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6684 else if (c
== '/' && **s
== '*')
6686 /* C-style comment. */
6688 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6701 /* Replacement for XReadBitmapFileData which isn't available under old
6702 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6703 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6704 the image. Return in *DATA the bitmap data allocated with xmalloc.
6705 Value is non-zero if successful. DATA null means just test if
6706 CONTENTS looks like an in-memory XBM file. */
6709 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6710 char *contents
, *end
;
6711 int *width
, *height
;
6712 unsigned char **data
;
6715 char buffer
[BUFSIZ
];
6718 int bytes_per_line
, i
, nbytes
;
6724 LA1 = xbm_scan (&s, end, buffer, &value)
6726 #define expect(TOKEN) \
6727 if (LA1 != (TOKEN)) \
6732 #define expect_ident(IDENT) \
6733 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6738 *width
= *height
= -1;
6741 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6743 /* Parse defines for width, height and hot-spots. */
6747 expect_ident ("define");
6748 expect (XBM_TK_IDENT
);
6750 if (LA1
== XBM_TK_NUMBER
);
6752 char *p
= strrchr (buffer
, '_');
6753 p
= p
? p
+ 1 : buffer
;
6754 if (strcmp (p
, "width") == 0)
6756 else if (strcmp (p
, "height") == 0)
6759 expect (XBM_TK_NUMBER
);
6762 if (*width
< 0 || *height
< 0)
6764 else if (data
== NULL
)
6767 /* Parse bits. Must start with `static'. */
6768 expect_ident ("static");
6769 if (LA1
== XBM_TK_IDENT
)
6771 if (strcmp (buffer
, "unsigned") == 0)
6774 expect_ident ("char");
6776 else if (strcmp (buffer
, "short") == 0)
6780 if (*width
% 16 && *width
% 16 < 9)
6783 else if (strcmp (buffer
, "char") == 0)
6791 expect (XBM_TK_IDENT
);
6797 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6798 nbytes
= bytes_per_line
* *height
;
6799 p
= *data
= (char *) xmalloc (nbytes
);
6803 for (i
= 0; i
< nbytes
; i
+= 2)
6806 expect (XBM_TK_NUMBER
);
6809 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6812 if (LA1
== ',' || LA1
== '}')
6820 for (i
= 0; i
< nbytes
; ++i
)
6823 expect (XBM_TK_NUMBER
);
6827 if (LA1
== ',' || LA1
== '}')
6852 /* Load XBM image IMG which will be displayed on frame F from buffer
6853 CONTENTS. END is the end of the buffer. Value is non-zero if
6857 xbm_load_image (f
, img
, contents
, end
)
6860 char *contents
, *end
;
6863 unsigned char *data
;
6866 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6869 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6870 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6871 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6874 xassert (img
->width
> 0 && img
->height
> 0);
6876 /* Get foreground and background colors, maybe allocate colors. */
6877 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6879 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6881 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6883 background
= x_alloc_image_color (f
, img
, value
, background
);
6886 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6889 img
->width
, img
->height
,
6890 foreground
, background
,
6894 if (img
->pixmap
== None
)
6896 x_clear_image (f
, img
);
6897 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6903 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6909 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6916 return (STRINGP (data
)
6917 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6918 (XSTRING (data
)->data
6919 + STRING_BYTES (XSTRING (data
))),
6924 /* Fill image IMG which is used on frame F with pixmap data. Value is
6925 non-zero if successful. */
6933 Lisp_Object file_name
;
6935 xassert (xbm_image_p (img
->spec
));
6937 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6938 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6939 if (STRINGP (file_name
))
6944 struct gcpro gcpro1
;
6946 file
= x_find_image_file (file_name
);
6948 if (!STRINGP (file
))
6950 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6955 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6956 if (contents
== NULL
)
6958 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6963 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6968 struct image_keyword fmt
[XBM_LAST
];
6971 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6972 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6975 int in_memory_file_p
= 0;
6977 /* See if data looks like an in-memory XBM file. */
6978 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6979 in_memory_file_p
= xbm_file_p (data
);
6981 /* Parse the image specification. */
6982 bcopy (xbm_format
, fmt
, sizeof fmt
);
6983 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6986 /* Get specified width, and height. */
6987 if (!in_memory_file_p
)
6989 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6990 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6991 xassert (img
->width
> 0 && img
->height
> 0);
6994 /* Get foreground and background colors, maybe allocate colors. */
6995 if (fmt
[XBM_FOREGROUND
].count
6996 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
6997 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6999 if (fmt
[XBM_BACKGROUND
].count
7000 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
7001 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
7004 if (in_memory_file_p
)
7005 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
7006 (XSTRING (data
)->data
7007 + STRING_BYTES (XSTRING (data
))));
7014 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
7016 p
= bits
= (char *) alloca (nbytes
* img
->height
);
7017 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
7019 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
7021 bcopy (XSTRING (line
)->data
, p
, nbytes
);
7023 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
7026 else if (STRINGP (data
))
7027 bits
= XSTRING (data
)->data
;
7029 bits
= XBOOL_VECTOR (data
)->data
;
7031 /* Create the pixmap. */
7032 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7034 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7037 img
->width
, img
->height
,
7038 foreground
, background
,
7044 image_error ("Unable to create pixmap for XBM image `%s'",
7046 x_clear_image (f
, img
);
7056 /***********************************************************************
7058 ***********************************************************************/
7062 static int xpm_image_p
P_ ((Lisp_Object object
));
7063 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
7064 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
7066 #include "X11/xpm.h"
7068 /* The symbol `xpm' identifying XPM-format images. */
7072 /* Indices of image specification fields in xpm_format, below. */
7074 enum xpm_keyword_index
7089 /* Vector of image_keyword structures describing the format
7090 of valid XPM image specifications. */
7092 static struct image_keyword xpm_format
[XPM_LAST
] =
7094 {":type", IMAGE_SYMBOL_VALUE
, 1},
7095 {":file", IMAGE_STRING_VALUE
, 0},
7096 {":data", IMAGE_STRING_VALUE
, 0},
7097 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7098 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7099 {":relief", IMAGE_INTEGER_VALUE
, 0},
7100 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7101 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7102 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7103 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7106 /* Structure describing the image type XBM. */
7108 static struct image_type xpm_type
=
7118 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7119 functions for allocating image colors. Our own functions handle
7120 color allocation failures more gracefully than the ones on the XPM
7123 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7124 #define ALLOC_XPM_COLORS
7127 #ifdef ALLOC_XPM_COLORS
7129 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7130 static void xpm_free_color_cache
P_ ((void));
7131 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7132 static int xpm_color_bucket
P_ ((char *));
7133 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7136 /* An entry in a hash table used to cache color definitions of named
7137 colors. This cache is necessary to speed up XPM image loading in
7138 case we do color allocations ourselves. Without it, we would need
7139 a call to XParseColor per pixel in the image. */
7141 struct xpm_cached_color
7143 /* Next in collision chain. */
7144 struct xpm_cached_color
*next
;
7146 /* Color definition (RGB and pixel color). */
7153 /* The hash table used for the color cache, and its bucket vector
7156 #define XPM_COLOR_CACHE_BUCKETS 1001
7157 struct xpm_cached_color
**xpm_color_cache
;
7159 /* Initialize the color cache. */
7162 xpm_init_color_cache (f
, attrs
)
7164 XpmAttributes
*attrs
;
7166 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7167 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7168 memset (xpm_color_cache
, 0, nbytes
);
7169 init_color_table ();
7171 if (attrs
->valuemask
& XpmColorSymbols
)
7176 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7177 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7178 attrs
->colorsymbols
[i
].value
, &color
))
7180 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7182 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7188 /* Free the color cache. */
7191 xpm_free_color_cache ()
7193 struct xpm_cached_color
*p
, *next
;
7196 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7197 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7203 xfree (xpm_color_cache
);
7204 xpm_color_cache
= NULL
;
7205 free_color_table ();
7209 /* Return the bucket index for color named COLOR_NAME in the color
7213 xpm_color_bucket (color_name
)
7219 for (s
= color_name
; *s
; ++s
)
7221 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7225 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7226 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7229 static struct xpm_cached_color
*
7230 xpm_cache_color (f
, color_name
, color
, bucket
)
7237 struct xpm_cached_color
*p
;
7240 bucket
= xpm_color_bucket (color_name
);
7242 nbytes
= sizeof *p
+ strlen (color_name
);
7243 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7244 strcpy (p
->name
, color_name
);
7246 p
->next
= xpm_color_cache
[bucket
];
7247 xpm_color_cache
[bucket
] = p
;
7252 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7253 return the cached definition in *COLOR. Otherwise, make a new
7254 entry in the cache and allocate the color. Value is zero if color
7255 allocation failed. */
7258 xpm_lookup_color (f
, color_name
, color
)
7263 struct xpm_cached_color
*p
;
7264 int h
= xpm_color_bucket (color_name
);
7266 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7267 if (strcmp (p
->name
, color_name
) == 0)
7272 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7275 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7277 p
= xpm_cache_color (f
, color_name
, color
, h
);
7284 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7285 CLOSURE is a pointer to the frame on which we allocate the
7286 color. Return in *COLOR the allocated color. Value is non-zero
7290 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7297 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7301 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7302 is a pointer to the frame on which we allocate the color. Value is
7303 non-zero if successful. */
7306 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7316 #endif /* ALLOC_XPM_COLORS */
7319 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7320 for XPM images. Such a list must consist of conses whose car and
7324 xpm_valid_color_symbols_p (color_symbols
)
7325 Lisp_Object color_symbols
;
7327 while (CONSP (color_symbols
))
7329 Lisp_Object sym
= XCAR (color_symbols
);
7331 || !STRINGP (XCAR (sym
))
7332 || !STRINGP (XCDR (sym
)))
7334 color_symbols
= XCDR (color_symbols
);
7337 return NILP (color_symbols
);
7341 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7344 xpm_image_p (object
)
7347 struct image_keyword fmt
[XPM_LAST
];
7348 bcopy (xpm_format
, fmt
, sizeof fmt
);
7349 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7350 /* Either `:file' or `:data' must be present. */
7351 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7352 /* Either no `:color-symbols' or it's a list of conses
7353 whose car and cdr are strings. */
7354 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7355 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7359 /* Load image IMG which will be displayed on frame F. Value is
7360 non-zero if successful. */
7368 XpmAttributes attrs
;
7369 Lisp_Object specified_file
, color_symbols
;
7371 /* Configure the XPM lib. Use the visual of frame F. Allocate
7372 close colors. Return colors allocated. */
7373 bzero (&attrs
, sizeof attrs
);
7374 attrs
.visual
= FRAME_X_VISUAL (f
);
7375 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7376 attrs
.valuemask
|= XpmVisual
;
7377 attrs
.valuemask
|= XpmColormap
;
7379 #ifdef ALLOC_XPM_COLORS
7380 /* Allocate colors with our own functions which handle
7381 failing color allocation more gracefully. */
7382 attrs
.color_closure
= f
;
7383 attrs
.alloc_color
= xpm_alloc_color
;
7384 attrs
.free_colors
= xpm_free_colors
;
7385 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7386 #else /* not ALLOC_XPM_COLORS */
7387 /* Let the XPM lib allocate colors. */
7388 attrs
.valuemask
|= XpmReturnAllocPixels
;
7389 #ifdef XpmAllocCloseColors
7390 attrs
.alloc_close_colors
= 1;
7391 attrs
.valuemask
|= XpmAllocCloseColors
;
7392 #else /* not XpmAllocCloseColors */
7393 attrs
.closeness
= 600;
7394 attrs
.valuemask
|= XpmCloseness
;
7395 #endif /* not XpmAllocCloseColors */
7396 #endif /* ALLOC_XPM_COLORS */
7398 /* If image specification contains symbolic color definitions, add
7399 these to `attrs'. */
7400 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7401 if (CONSP (color_symbols
))
7404 XpmColorSymbol
*xpm_syms
;
7407 attrs
.valuemask
|= XpmColorSymbols
;
7409 /* Count number of symbols. */
7410 attrs
.numsymbols
= 0;
7411 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7414 /* Allocate an XpmColorSymbol array. */
7415 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7416 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7417 bzero (xpm_syms
, size
);
7418 attrs
.colorsymbols
= xpm_syms
;
7420 /* Fill the color symbol array. */
7421 for (tail
= color_symbols
, i
= 0;
7423 ++i
, tail
= XCDR (tail
))
7425 Lisp_Object name
= XCAR (XCAR (tail
));
7426 Lisp_Object color
= XCDR (XCAR (tail
));
7427 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7428 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7429 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7430 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7434 /* Create a pixmap for the image, either from a file, or from a
7435 string buffer containing data in the same format as an XPM file. */
7436 #ifdef ALLOC_XPM_COLORS
7437 xpm_init_color_cache (f
, &attrs
);
7440 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7441 if (STRINGP (specified_file
))
7443 Lisp_Object file
= x_find_image_file (specified_file
);
7444 if (!STRINGP (file
))
7446 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7450 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7451 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7456 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7457 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7458 XSTRING (buffer
)->data
,
7459 &img
->pixmap
, &img
->mask
,
7463 if (rc
== XpmSuccess
)
7465 #ifdef ALLOC_XPM_COLORS
7466 img
->colors
= colors_in_color_table (&img
->ncolors
);
7467 #else /* not ALLOC_XPM_COLORS */
7470 img
->ncolors
= attrs
.nalloc_pixels
;
7471 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7472 * sizeof *img
->colors
);
7473 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7475 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7476 #ifdef DEBUG_X_COLORS
7477 register_color (img
->colors
[i
]);
7480 #endif /* not ALLOC_XPM_COLORS */
7482 img
->width
= attrs
.width
;
7483 img
->height
= attrs
.height
;
7484 xassert (img
->width
> 0 && img
->height
> 0);
7486 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7487 XpmFreeAttributes (&attrs
);
7494 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7497 case XpmFileInvalid
:
7498 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7502 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7505 case XpmColorFailed
:
7506 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7510 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7515 #ifdef ALLOC_XPM_COLORS
7516 xpm_free_color_cache ();
7518 return rc
== XpmSuccess
;
7521 #endif /* HAVE_XPM != 0 */
7524 /***********************************************************************
7526 ***********************************************************************/
7528 /* An entry in the color table mapping an RGB color to a pixel color. */
7533 unsigned long pixel
;
7535 /* Next in color table collision list. */
7536 struct ct_color
*next
;
7539 /* The bucket vector size to use. Must be prime. */
7543 /* Value is a hash of the RGB color given by R, G, and B. */
7545 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7547 /* The color hash table. */
7549 struct ct_color
**ct_table
;
7551 /* Number of entries in the color table. */
7553 int ct_colors_allocated
;
7555 /* Initialize the color table. */
7560 int size
= CT_SIZE
* sizeof (*ct_table
);
7561 ct_table
= (struct ct_color
**) xmalloc (size
);
7562 bzero (ct_table
, size
);
7563 ct_colors_allocated
= 0;
7567 /* Free memory associated with the color table. */
7573 struct ct_color
*p
, *next
;
7575 for (i
= 0; i
< CT_SIZE
; ++i
)
7576 for (p
= ct_table
[i
]; p
; p
= next
)
7587 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7588 entry for that color already is in the color table, return the
7589 pixel color of that entry. Otherwise, allocate a new color for R,
7590 G, B, and make an entry in the color table. */
7592 static unsigned long
7593 lookup_rgb_color (f
, r
, g
, b
)
7597 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7598 int i
= hash
% CT_SIZE
;
7601 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7602 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7615 cmap
= FRAME_X_COLORMAP (f
);
7616 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7620 ++ct_colors_allocated
;
7622 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7626 p
->pixel
= color
.pixel
;
7627 p
->next
= ct_table
[i
];
7631 return FRAME_FOREGROUND_PIXEL (f
);
7638 /* Look up pixel color PIXEL which is used on frame F in the color
7639 table. If not already present, allocate it. Value is PIXEL. */
7641 static unsigned long
7642 lookup_pixel_color (f
, pixel
)
7644 unsigned long pixel
;
7646 int i
= pixel
% CT_SIZE
;
7649 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7650 if (p
->pixel
== pixel
)
7659 cmap
= FRAME_X_COLORMAP (f
);
7660 color
.pixel
= pixel
;
7661 x_query_color (f
, &color
);
7662 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7666 ++ct_colors_allocated
;
7668 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7673 p
->next
= ct_table
[i
];
7677 return FRAME_FOREGROUND_PIXEL (f
);
7684 /* Value is a vector of all pixel colors contained in the color table,
7685 allocated via xmalloc. Set *N to the number of colors. */
7687 static unsigned long *
7688 colors_in_color_table (n
)
7693 unsigned long *colors
;
7695 if (ct_colors_allocated
== 0)
7702 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7704 *n
= ct_colors_allocated
;
7706 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7707 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7708 colors
[j
++] = p
->pixel
;
7716 /***********************************************************************
7718 ***********************************************************************/
7720 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7721 int, XImage
*, int));
7722 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7723 XColor
*, int, XImage
*, int));
7724 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7725 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7726 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7728 /* Non-zero means draw a cross on images having `:conversion
7731 int cross_disabled_images
;
7733 /* Edge detection matrices for different edge-detection
7736 static int emboss_matrix
[9] = {
7738 2, -1, 0, /* y - 1 */
7740 0, 1, -2 /* y + 1 */
7743 static int laplace_matrix
[9] = {
7745 1, 0, 0, /* y - 1 */
7747 0, 0, -1 /* y + 1 */
7750 /* Value is the intensity of the color whose red/green/blue values
7753 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7756 /* On frame F, return an array of XColor structures describing image
7757 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7758 non-zero means also fill the red/green/blue members of the XColor
7759 structures. Value is a pointer to the array of XColors structures,
7760 allocated with xmalloc; it must be freed by the caller. */
7763 x_to_xcolors (f
, img
, rgb_p
)
7772 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7774 /* Get the X image IMG->pixmap. */
7775 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7776 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7778 /* Fill the `pixel' members of the XColor array. I wished there
7779 were an easy and portable way to circumvent XGetPixel. */
7781 for (y
= 0; y
< img
->height
; ++y
)
7785 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7786 p
->pixel
= XGetPixel (ximg
, x
, y
);
7789 x_query_colors (f
, row
, img
->width
);
7792 XDestroyImage (ximg
);
7797 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7798 RGB members are set. F is the frame on which this all happens.
7799 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7802 x_from_xcolors (f
, img
, colors
)
7812 init_color_table ();
7814 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7817 for (y
= 0; y
< img
->height
; ++y
)
7818 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7820 unsigned long pixel
;
7821 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7822 XPutPixel (oimg
, x
, y
, pixel
);
7826 x_clear_image_1 (f
, img
, 1, 0, 1);
7828 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7829 x_destroy_x_image (oimg
);
7830 img
->pixmap
= pixmap
;
7831 img
->colors
= colors_in_color_table (&img
->ncolors
);
7832 free_color_table ();
7836 /* On frame F, perform edge-detection on image IMG.
7838 MATRIX is a nine-element array specifying the transformation
7839 matrix. See emboss_matrix for an example.
7841 COLOR_ADJUST is a color adjustment added to each pixel of the
7845 x_detect_edges (f
, img
, matrix
, color_adjust
)
7848 int matrix
[9], color_adjust
;
7850 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7854 for (i
= sum
= 0; i
< 9; ++i
)
7855 sum
+= abs (matrix
[i
]);
7857 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7859 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7861 for (y
= 0; y
< img
->height
; ++y
)
7863 p
= COLOR (new, 0, y
);
7864 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7865 p
= COLOR (new, img
->width
- 1, y
);
7866 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7869 for (x
= 1; x
< img
->width
- 1; ++x
)
7871 p
= COLOR (new, x
, 0);
7872 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7873 p
= COLOR (new, x
, img
->height
- 1);
7874 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7877 for (y
= 1; y
< img
->height
- 1; ++y
)
7879 p
= COLOR (new, 1, y
);
7881 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7883 int r
, g
, b
, y1
, x1
;
7886 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7887 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7890 XColor
*t
= COLOR (colors
, x1
, y1
);
7891 r
+= matrix
[i
] * t
->red
;
7892 g
+= matrix
[i
] * t
->green
;
7893 b
+= matrix
[i
] * t
->blue
;
7896 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7897 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7898 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7899 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7904 x_from_xcolors (f
, img
, new);
7910 /* Perform the pre-defined `emboss' edge-detection on image IMG
7918 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7922 /* Perform the pre-defined `laplace' edge-detection on image IMG
7930 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7934 /* Perform edge-detection on image IMG on frame F, with specified
7935 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7937 MATRIX must be either
7939 - a list of at least 9 numbers in row-major form
7940 - a vector of at least 9 numbers
7942 COLOR_ADJUST nil means use a default; otherwise it must be a
7946 x_edge_detection (f
, img
, matrix
, color_adjust
)
7949 Lisp_Object matrix
, color_adjust
;
7957 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7958 ++i
, matrix
= XCDR (matrix
))
7959 trans
[i
] = XFLOATINT (XCAR (matrix
));
7961 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7963 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7964 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7967 if (NILP (color_adjust
))
7968 color_adjust
= make_number (0xffff / 2);
7970 if (i
== 9 && NUMBERP (color_adjust
))
7971 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7975 /* Transform image IMG on frame F so that it looks disabled. */
7978 x_disable_image (f
, img
)
7982 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7984 if (dpyinfo
->n_planes
>= 2)
7986 /* Color (or grayscale). Convert to gray, and equalize. Just
7987 drawing such images with a stipple can look very odd, so
7988 we're using this method instead. */
7989 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7991 const int h
= 15000;
7992 const int l
= 30000;
7994 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7998 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7999 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
8000 p
->red
= p
->green
= p
->blue
= i2
;
8003 x_from_xcolors (f
, img
, colors
);
8006 /* Draw a cross over the disabled image, if we must or if we
8008 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
8010 Display
*dpy
= FRAME_X_DISPLAY (f
);
8013 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
8014 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
8015 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
8016 img
->width
- 1, img
->height
- 1);
8017 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
8023 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
8024 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
8025 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
8026 img
->width
- 1, img
->height
- 1);
8027 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
8035 /* Build a mask for image IMG which is used on frame F. FILE is the
8036 name of an image file, for error messages. HOW determines how to
8037 determine the background color of IMG. If it is a list '(R G B)',
8038 with R, G, and B being integers >= 0, take that as the color of the
8039 background. Otherwise, determine the background color of IMG
8040 heuristically. Value is non-zero if successful. */
8043 x_build_heuristic_mask (f
, img
, how
)
8048 Display
*dpy
= FRAME_X_DISPLAY (f
);
8049 XImage
*ximg
, *mask_img
;
8050 int x
, y
, rc
, look_at_corners_p
;
8051 unsigned long bg
= 0;
8055 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8059 /* Create an image and pixmap serving as mask. */
8060 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
8061 &mask_img
, &img
->mask
);
8065 /* Get the X image of IMG->pixmap. */
8066 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
8069 /* Determine the background color of ximg. If HOW is `(R G B)'
8070 take that as color. Otherwise, try to determine the color
8072 look_at_corners_p
= 1;
8078 for (i
= 0; i
< 3 && CONSP (how
) && NATNUMP (XCAR (how
)); ++i
)
8080 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
8084 if (i
== 3 && NILP (how
))
8086 char color_name
[30];
8087 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
8088 bg
= x_alloc_image_color (f
, img
, build_string (color_name
), 0);
8089 look_at_corners_p
= 0;
8093 if (look_at_corners_p
)
8095 unsigned long corners
[4];
8098 /* Get the colors at the corners of ximg. */
8099 corners
[0] = XGetPixel (ximg
, 0, 0);
8100 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
8101 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
8102 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
8104 /* Choose the most frequently found color as background. */
8105 for (i
= best_count
= 0; i
< 4; ++i
)
8109 for (j
= n
= 0; j
< 4; ++j
)
8110 if (corners
[i
] == corners
[j
])
8114 bg
= corners
[i
], best_count
= n
;
8118 /* Set all bits in mask_img to 1 whose color in ximg is different
8119 from the background color bg. */
8120 for (y
= 0; y
< img
->height
; ++y
)
8121 for (x
= 0; x
< img
->width
; ++x
)
8122 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8124 /* Put mask_img into img->mask. */
8125 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8126 x_destroy_x_image (mask_img
);
8127 XDestroyImage (ximg
);
8134 /***********************************************************************
8135 PBM (mono, gray, color)
8136 ***********************************************************************/
8138 static int pbm_image_p
P_ ((Lisp_Object object
));
8139 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8140 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8142 /* The symbol `pbm' identifying images of this type. */
8146 /* Indices of image specification fields in gs_format, below. */
8148 enum pbm_keyword_index
8164 /* Vector of image_keyword structures describing the format
8165 of valid user-defined image specifications. */
8167 static struct image_keyword pbm_format
[PBM_LAST
] =
8169 {":type", IMAGE_SYMBOL_VALUE
, 1},
8170 {":file", IMAGE_STRING_VALUE
, 0},
8171 {":data", IMAGE_STRING_VALUE
, 0},
8172 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8173 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8174 {":relief", IMAGE_INTEGER_VALUE
, 0},
8175 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8176 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8177 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8178 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8179 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8182 /* Structure describing the image type `pbm'. */
8184 static struct image_type pbm_type
=
8194 /* Return non-zero if OBJECT is a valid PBM image specification. */
8197 pbm_image_p (object
)
8200 struct image_keyword fmt
[PBM_LAST
];
8202 bcopy (pbm_format
, fmt
, sizeof fmt
);
8204 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8207 /* Must specify either :data or :file. */
8208 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8212 /* Scan a decimal number from *S and return it. Advance *S while
8213 reading the number. END is the end of the string. Value is -1 at
8217 pbm_scan_number (s
, end
)
8218 unsigned char **s
, *end
;
8220 int c
= 0, val
= -1;
8224 /* Skip white-space. */
8225 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8230 /* Skip comment to end of line. */
8231 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8234 else if (isdigit (c
))
8236 /* Read decimal number. */
8238 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8239 val
= 10 * val
+ c
- '0';
8250 /* Load PBM image IMG for use on frame F. */
8258 int width
, height
, max_color_idx
= 0;
8260 Lisp_Object file
, specified_file
;
8261 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8262 struct gcpro gcpro1
;
8263 unsigned char *contents
= NULL
;
8264 unsigned char *end
, *p
;
8267 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8271 if (STRINGP (specified_file
))
8273 file
= x_find_image_file (specified_file
);
8274 if (!STRINGP (file
))
8276 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8281 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8282 if (contents
== NULL
)
8284 image_error ("Error reading `%s'", file
, Qnil
);
8290 end
= contents
+ size
;
8295 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8296 p
= XSTRING (data
)->data
;
8297 end
= p
+ STRING_BYTES (XSTRING (data
));
8300 /* Check magic number. */
8301 if (end
- p
< 2 || *p
++ != 'P')
8303 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8313 raw_p
= 0, type
= PBM_MONO
;
8317 raw_p
= 0, type
= PBM_GRAY
;
8321 raw_p
= 0, type
= PBM_COLOR
;
8325 raw_p
= 1, type
= PBM_MONO
;
8329 raw_p
= 1, type
= PBM_GRAY
;
8333 raw_p
= 1, type
= PBM_COLOR
;
8337 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8341 /* Read width, height, maximum color-component. Characters
8342 starting with `#' up to the end of a line are ignored. */
8343 width
= pbm_scan_number (&p
, end
);
8344 height
= pbm_scan_number (&p
, end
);
8346 if (type
!= PBM_MONO
)
8348 max_color_idx
= pbm_scan_number (&p
, end
);
8349 if (raw_p
&& max_color_idx
> 255)
8350 max_color_idx
= 255;
8355 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8358 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8359 &ximg
, &img
->pixmap
))
8362 /* Initialize the color hash table. */
8363 init_color_table ();
8365 if (type
== PBM_MONO
)
8368 struct image_keyword fmt
[PBM_LAST
];
8369 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8370 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8372 /* Parse the image specification. */
8373 bcopy (pbm_format
, fmt
, sizeof fmt
);
8374 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8376 /* Get foreground and background colors, maybe allocate colors. */
8377 if (fmt
[PBM_FOREGROUND
].count
8378 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
8379 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8380 if (fmt
[PBM_BACKGROUND
].count
8381 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
8382 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8384 for (y
= 0; y
< height
; ++y
)
8385 for (x
= 0; x
< width
; ++x
)
8395 g
= pbm_scan_number (&p
, end
);
8397 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8402 for (y
= 0; y
< height
; ++y
)
8403 for (x
= 0; x
< width
; ++x
)
8407 if (type
== PBM_GRAY
)
8408 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8417 r
= pbm_scan_number (&p
, end
);
8418 g
= pbm_scan_number (&p
, end
);
8419 b
= pbm_scan_number (&p
, end
);
8422 if (r
< 0 || g
< 0 || b
< 0)
8426 XDestroyImage (ximg
);
8427 image_error ("Invalid pixel value in image `%s'",
8432 /* RGB values are now in the range 0..max_color_idx.
8433 Scale this to the range 0..0xffff supported by X. */
8434 r
= (double) r
* 65535 / max_color_idx
;
8435 g
= (double) g
* 65535 / max_color_idx
;
8436 b
= (double) b
* 65535 / max_color_idx
;
8437 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8441 /* Store in IMG->colors the colors allocated for the image, and
8442 free the color table. */
8443 img
->colors
= colors_in_color_table (&img
->ncolors
);
8444 free_color_table ();
8446 /* Put the image into a pixmap. */
8447 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8448 x_destroy_x_image (ximg
);
8451 img
->height
= height
;
8460 /***********************************************************************
8462 ***********************************************************************/
8468 /* Function prototypes. */
8470 static int png_image_p
P_ ((Lisp_Object object
));
8471 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8473 /* The symbol `png' identifying images of this type. */
8477 /* Indices of image specification fields in png_format, below. */
8479 enum png_keyword_index
8493 /* Vector of image_keyword structures describing the format
8494 of valid user-defined image specifications. */
8496 static struct image_keyword png_format
[PNG_LAST
] =
8498 {":type", IMAGE_SYMBOL_VALUE
, 1},
8499 {":data", IMAGE_STRING_VALUE
, 0},
8500 {":file", IMAGE_STRING_VALUE
, 0},
8501 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8502 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8503 {":relief", IMAGE_INTEGER_VALUE
, 0},
8504 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8505 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8506 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8509 /* Structure describing the image type `png'. */
8511 static struct image_type png_type
=
8521 /* Return non-zero if OBJECT is a valid PNG image specification. */
8524 png_image_p (object
)
8527 struct image_keyword fmt
[PNG_LAST
];
8528 bcopy (png_format
, fmt
, sizeof fmt
);
8530 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8533 /* Must specify either the :data or :file keyword. */
8534 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8538 /* Error and warning handlers installed when the PNG library
8542 my_png_error (png_ptr
, msg
)
8543 png_struct
*png_ptr
;
8546 xassert (png_ptr
!= NULL
);
8547 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8548 longjmp (png_ptr
->jmpbuf
, 1);
8553 my_png_warning (png_ptr
, msg
)
8554 png_struct
*png_ptr
;
8557 xassert (png_ptr
!= NULL
);
8558 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8561 /* Memory source for PNG decoding. */
8563 struct png_memory_storage
8565 unsigned char *bytes
; /* The data */
8566 size_t len
; /* How big is it? */
8567 int index
; /* Where are we? */
8571 /* Function set as reader function when reading PNG image from memory.
8572 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8573 bytes from the input to DATA. */
8576 png_read_from_memory (png_ptr
, data
, length
)
8577 png_structp png_ptr
;
8581 struct png_memory_storage
*tbr
8582 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8584 if (length
> tbr
->len
- tbr
->index
)
8585 png_error (png_ptr
, "Read error");
8587 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8588 tbr
->index
= tbr
->index
+ length
;
8591 /* Load PNG image IMG for use on frame F. Value is non-zero if
8599 Lisp_Object file
, specified_file
;
8600 Lisp_Object specified_data
;
8602 XImage
*ximg
, *mask_img
= NULL
;
8603 struct gcpro gcpro1
;
8604 png_struct
*png_ptr
= NULL
;
8605 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8606 FILE *volatile fp
= NULL
;
8608 png_byte
* volatile pixels
= NULL
;
8609 png_byte
** volatile rows
= NULL
;
8610 png_uint_32 width
, height
;
8611 int bit_depth
, color_type
, interlace_type
;
8613 png_uint_32 row_bytes
;
8616 double screen_gamma
, image_gamma
;
8618 struct png_memory_storage tbr
; /* Data to be read */
8620 /* Find out what file to load. */
8621 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8622 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8626 if (NILP (specified_data
))
8628 file
= x_find_image_file (specified_file
);
8629 if (!STRINGP (file
))
8631 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8636 /* Open the image file. */
8637 fp
= fopen (XSTRING (file
)->data
, "rb");
8640 image_error ("Cannot open image file `%s'", file
, Qnil
);
8646 /* Check PNG signature. */
8647 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8648 || !png_check_sig (sig
, sizeof sig
))
8650 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8658 /* Read from memory. */
8659 tbr
.bytes
= XSTRING (specified_data
)->data
;
8660 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8663 /* Check PNG signature. */
8664 if (tbr
.len
< sizeof sig
8665 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8667 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8672 /* Need to skip past the signature. */
8673 tbr
.bytes
+= sizeof (sig
);
8676 /* Initialize read and info structs for PNG lib. */
8677 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8678 my_png_error
, my_png_warning
);
8681 if (fp
) fclose (fp
);
8686 info_ptr
= png_create_info_struct (png_ptr
);
8689 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8690 if (fp
) fclose (fp
);
8695 end_info
= png_create_info_struct (png_ptr
);
8698 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8699 if (fp
) fclose (fp
);
8704 /* Set error jump-back. We come back here when the PNG library
8705 detects an error. */
8706 if (setjmp (png_ptr
->jmpbuf
))
8710 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8713 if (fp
) fclose (fp
);
8718 /* Read image info. */
8719 if (!NILP (specified_data
))
8720 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8722 png_init_io (png_ptr
, fp
);
8724 png_set_sig_bytes (png_ptr
, sizeof sig
);
8725 png_read_info (png_ptr
, info_ptr
);
8726 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8727 &interlace_type
, NULL
, NULL
);
8729 /* If image contains simply transparency data, we prefer to
8730 construct a clipping mask. */
8731 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8736 /* This function is easier to write if we only have to handle
8737 one data format: RGB or RGBA with 8 bits per channel. Let's
8738 transform other formats into that format. */
8740 /* Strip more than 8 bits per channel. */
8741 if (bit_depth
== 16)
8742 png_set_strip_16 (png_ptr
);
8744 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8746 png_set_expand (png_ptr
);
8748 /* Convert grayscale images to RGB. */
8749 if (color_type
== PNG_COLOR_TYPE_GRAY
8750 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8751 png_set_gray_to_rgb (png_ptr
);
8753 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8754 gamma_str
= getenv ("SCREEN_GAMMA");
8755 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8757 /* Tell the PNG lib to handle gamma correction for us. */
8759 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8760 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8761 /* There is a special chunk in the image specifying the gamma. */
8762 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8765 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8766 /* Image contains gamma information. */
8767 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8769 /* Use a default of 0.5 for the image gamma. */
8770 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8772 /* Handle alpha channel by combining the image with a background
8773 color. Do this only if a real alpha channel is supplied. For
8774 simple transparency, we prefer a clipping mask. */
8777 png_color_16
*image_background
;
8779 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8780 /* Image contains a background color with which to
8781 combine the image. */
8782 png_set_background (png_ptr
, image_background
,
8783 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8786 /* Image does not contain a background color with which
8787 to combine the image data via an alpha channel. Use
8788 the frame's background instead. */
8791 png_color_16 frame_background
;
8793 cmap
= FRAME_X_COLORMAP (f
);
8794 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8795 x_query_color (f
, &color
);
8797 bzero (&frame_background
, sizeof frame_background
);
8798 frame_background
.red
= color
.red
;
8799 frame_background
.green
= color
.green
;
8800 frame_background
.blue
= color
.blue
;
8802 png_set_background (png_ptr
, &frame_background
,
8803 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8807 /* Update info structure. */
8808 png_read_update_info (png_ptr
, info_ptr
);
8810 /* Get number of channels. Valid values are 1 for grayscale images
8811 and images with a palette, 2 for grayscale images with transparency
8812 information (alpha channel), 3 for RGB images, and 4 for RGB
8813 images with alpha channel, i.e. RGBA. If conversions above were
8814 sufficient we should only have 3 or 4 channels here. */
8815 channels
= png_get_channels (png_ptr
, info_ptr
);
8816 xassert (channels
== 3 || channels
== 4);
8818 /* Number of bytes needed for one row of the image. */
8819 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8821 /* Allocate memory for the image. */
8822 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8823 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8824 for (i
= 0; i
< height
; ++i
)
8825 rows
[i
] = pixels
+ i
* row_bytes
;
8827 /* Read the entire image. */
8828 png_read_image (png_ptr
, rows
);
8829 png_read_end (png_ptr
, info_ptr
);
8836 /* Create the X image and pixmap. */
8837 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8841 /* Create an image and pixmap serving as mask if the PNG image
8842 contains an alpha channel. */
8845 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8846 &mask_img
, &img
->mask
))
8848 x_destroy_x_image (ximg
);
8849 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8854 /* Fill the X image and mask from PNG data. */
8855 init_color_table ();
8857 for (y
= 0; y
< height
; ++y
)
8859 png_byte
*p
= rows
[y
];
8861 for (x
= 0; x
< width
; ++x
)
8868 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8870 /* An alpha channel, aka mask channel, associates variable
8871 transparency with an image. Where other image formats
8872 support binary transparency---fully transparent or fully
8873 opaque---PNG allows up to 254 levels of partial transparency.
8874 The PNG library implements partial transparency by combining
8875 the image with a specified background color.
8877 I'm not sure how to handle this here nicely: because the
8878 background on which the image is displayed may change, for
8879 real alpha channel support, it would be necessary to create
8880 a new image for each possible background.
8882 What I'm doing now is that a mask is created if we have
8883 boolean transparency information. Otherwise I'm using
8884 the frame's background color to combine the image with. */
8889 XPutPixel (mask_img
, x
, y
, *p
> 0);
8895 /* Remember colors allocated for this image. */
8896 img
->colors
= colors_in_color_table (&img
->ncolors
);
8897 free_color_table ();
8900 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8905 img
->height
= height
;
8907 /* Put the image into the pixmap, then free the X image and its buffer. */
8908 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8909 x_destroy_x_image (ximg
);
8911 /* Same for the mask. */
8914 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8915 x_destroy_x_image (mask_img
);
8922 #endif /* HAVE_PNG != 0 */
8926 /***********************************************************************
8928 ***********************************************************************/
8932 /* Work around a warning about HAVE_STDLIB_H being redefined in
8934 #ifdef HAVE_STDLIB_H
8935 #define HAVE_STDLIB_H_1
8936 #undef HAVE_STDLIB_H
8937 #endif /* HAVE_STLIB_H */
8939 #include <jpeglib.h>
8943 #ifdef HAVE_STLIB_H_1
8944 #define HAVE_STDLIB_H 1
8947 static int jpeg_image_p
P_ ((Lisp_Object object
));
8948 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8950 /* The symbol `jpeg' identifying images of this type. */
8954 /* Indices of image specification fields in gs_format, below. */
8956 enum jpeg_keyword_index
8965 JPEG_HEURISTIC_MASK
,
8970 /* Vector of image_keyword structures describing the format
8971 of valid user-defined image specifications. */
8973 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8975 {":type", IMAGE_SYMBOL_VALUE
, 1},
8976 {":data", IMAGE_STRING_VALUE
, 0},
8977 {":file", IMAGE_STRING_VALUE
, 0},
8978 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8979 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8980 {":relief", IMAGE_INTEGER_VALUE
, 0},
8981 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8982 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8983 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8986 /* Structure describing the image type `jpeg'. */
8988 static struct image_type jpeg_type
=
8998 /* Return non-zero if OBJECT is a valid JPEG image specification. */
9001 jpeg_image_p (object
)
9004 struct image_keyword fmt
[JPEG_LAST
];
9006 bcopy (jpeg_format
, fmt
, sizeof fmt
);
9008 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
9011 /* Must specify either the :data or :file keyword. */
9012 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
9016 struct my_jpeg_error_mgr
9018 struct jpeg_error_mgr pub
;
9019 jmp_buf setjmp_buffer
;
9024 my_error_exit (cinfo
)
9027 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
9028 longjmp (mgr
->setjmp_buffer
, 1);
9032 /* Init source method for JPEG data source manager. Called by
9033 jpeg_read_header() before any data is actually read. See
9034 libjpeg.doc from the JPEG lib distribution. */
9037 our_init_source (cinfo
)
9038 j_decompress_ptr cinfo
;
9043 /* Fill input buffer method for JPEG data source manager. Called
9044 whenever more data is needed. We read the whole image in one step,
9045 so this only adds a fake end of input marker at the end. */
9048 our_fill_input_buffer (cinfo
)
9049 j_decompress_ptr cinfo
;
9051 /* Insert a fake EOI marker. */
9052 struct jpeg_source_mgr
*src
= cinfo
->src
;
9053 static JOCTET buffer
[2];
9055 buffer
[0] = (JOCTET
) 0xFF;
9056 buffer
[1] = (JOCTET
) JPEG_EOI
;
9058 src
->next_input_byte
= buffer
;
9059 src
->bytes_in_buffer
= 2;
9064 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9065 is the JPEG data source manager. */
9068 our_skip_input_data (cinfo
, num_bytes
)
9069 j_decompress_ptr cinfo
;
9072 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9076 if (num_bytes
> src
->bytes_in_buffer
)
9077 ERREXIT (cinfo
, JERR_INPUT_EOF
);
9079 src
->bytes_in_buffer
-= num_bytes
;
9080 src
->next_input_byte
+= num_bytes
;
9085 /* Method to terminate data source. Called by
9086 jpeg_finish_decompress() after all data has been processed. */
9089 our_term_source (cinfo
)
9090 j_decompress_ptr cinfo
;
9095 /* Set up the JPEG lib for reading an image from DATA which contains
9096 LEN bytes. CINFO is the decompression info structure created for
9097 reading the image. */
9100 jpeg_memory_src (cinfo
, data
, len
)
9101 j_decompress_ptr cinfo
;
9105 struct jpeg_source_mgr
*src
;
9107 if (cinfo
->src
== NULL
)
9109 /* First time for this JPEG object? */
9110 cinfo
->src
= (struct jpeg_source_mgr
*)
9111 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9112 sizeof (struct jpeg_source_mgr
));
9113 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9114 src
->next_input_byte
= data
;
9117 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9118 src
->init_source
= our_init_source
;
9119 src
->fill_input_buffer
= our_fill_input_buffer
;
9120 src
->skip_input_data
= our_skip_input_data
;
9121 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9122 src
->term_source
= our_term_source
;
9123 src
->bytes_in_buffer
= len
;
9124 src
->next_input_byte
= data
;
9128 /* Load image IMG for use on frame F. Patterned after example.c
9129 from the JPEG lib. */
9136 struct jpeg_decompress_struct cinfo
;
9137 struct my_jpeg_error_mgr mgr
;
9138 Lisp_Object file
, specified_file
;
9139 Lisp_Object specified_data
;
9140 FILE * volatile fp
= NULL
;
9142 int row_stride
, x
, y
;
9143 XImage
*ximg
= NULL
;
9145 unsigned long *colors
;
9147 struct gcpro gcpro1
;
9149 /* Open the JPEG file. */
9150 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9151 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9155 if (NILP (specified_data
))
9157 file
= x_find_image_file (specified_file
);
9158 if (!STRINGP (file
))
9160 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9165 fp
= fopen (XSTRING (file
)->data
, "r");
9168 image_error ("Cannot open `%s'", file
, Qnil
);
9174 /* Customize libjpeg's error handling to call my_error_exit when an
9175 error is detected. This function will perform a longjmp. */
9176 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9177 mgr
.pub
.error_exit
= my_error_exit
;
9179 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9183 /* Called from my_error_exit. Display a JPEG error. */
9184 char buffer
[JMSG_LENGTH_MAX
];
9185 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9186 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9187 build_string (buffer
));
9190 /* Close the input file and destroy the JPEG object. */
9192 fclose ((FILE *) fp
);
9193 jpeg_destroy_decompress (&cinfo
);
9195 /* If we already have an XImage, free that. */
9196 x_destroy_x_image (ximg
);
9198 /* Free pixmap and colors. */
9199 x_clear_image (f
, img
);
9205 /* Create the JPEG decompression object. Let it read from fp.
9206 Read the JPEG image header. */
9207 jpeg_create_decompress (&cinfo
);
9209 if (NILP (specified_data
))
9210 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9212 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9213 STRING_BYTES (XSTRING (specified_data
)));
9215 jpeg_read_header (&cinfo
, TRUE
);
9217 /* Customize decompression so that color quantization will be used.
9218 Start decompression. */
9219 cinfo
.quantize_colors
= TRUE
;
9220 jpeg_start_decompress (&cinfo
);
9221 width
= img
->width
= cinfo
.output_width
;
9222 height
= img
->height
= cinfo
.output_height
;
9224 /* Create X image and pixmap. */
9225 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9226 longjmp (mgr
.setjmp_buffer
, 2);
9228 /* Allocate colors. When color quantization is used,
9229 cinfo.actual_number_of_colors has been set with the number of
9230 colors generated, and cinfo.colormap is a two-dimensional array
9231 of color indices in the range 0..cinfo.actual_number_of_colors.
9232 No more than 255 colors will be generated. */
9236 if (cinfo
.out_color_components
> 2)
9237 ir
= 0, ig
= 1, ib
= 2;
9238 else if (cinfo
.out_color_components
> 1)
9239 ir
= 0, ig
= 1, ib
= 0;
9241 ir
= 0, ig
= 0, ib
= 0;
9243 /* Use the color table mechanism because it handles colors that
9244 cannot be allocated nicely. Such colors will be replaced with
9245 a default color, and we don't have to care about which colors
9246 can be freed safely, and which can't. */
9247 init_color_table ();
9248 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9251 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9253 /* Multiply RGB values with 255 because X expects RGB values
9254 in the range 0..0xffff. */
9255 int r
= cinfo
.colormap
[ir
][i
] << 8;
9256 int g
= cinfo
.colormap
[ig
][i
] << 8;
9257 int b
= cinfo
.colormap
[ib
][i
] << 8;
9258 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9261 /* Remember those colors actually allocated. */
9262 img
->colors
= colors_in_color_table (&img
->ncolors
);
9263 free_color_table ();
9267 row_stride
= width
* cinfo
.output_components
;
9268 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9270 for (y
= 0; y
< height
; ++y
)
9272 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9273 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9274 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9278 jpeg_finish_decompress (&cinfo
);
9279 jpeg_destroy_decompress (&cinfo
);
9281 fclose ((FILE *) fp
);
9283 /* Put the image into the pixmap. */
9284 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9285 x_destroy_x_image (ximg
);
9290 #endif /* HAVE_JPEG */
9294 /***********************************************************************
9296 ***********************************************************************/
9302 static int tiff_image_p
P_ ((Lisp_Object object
));
9303 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9305 /* The symbol `tiff' identifying images of this type. */
9309 /* Indices of image specification fields in tiff_format, below. */
9311 enum tiff_keyword_index
9320 TIFF_HEURISTIC_MASK
,
9325 /* Vector of image_keyword structures describing the format
9326 of valid user-defined image specifications. */
9328 static struct image_keyword tiff_format
[TIFF_LAST
] =
9330 {":type", IMAGE_SYMBOL_VALUE
, 1},
9331 {":data", IMAGE_STRING_VALUE
, 0},
9332 {":file", IMAGE_STRING_VALUE
, 0},
9333 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9334 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9335 {":relief", IMAGE_INTEGER_VALUE
, 0},
9336 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9337 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9338 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9341 /* Structure describing the image type `tiff'. */
9343 static struct image_type tiff_type
=
9353 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9356 tiff_image_p (object
)
9359 struct image_keyword fmt
[TIFF_LAST
];
9360 bcopy (tiff_format
, fmt
, sizeof fmt
);
9362 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9365 /* Must specify either the :data or :file keyword. */
9366 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9370 /* Reading from a memory buffer for TIFF images Based on the PNG
9371 memory source, but we have to provide a lot of extra functions.
9374 We really only need to implement read and seek, but I am not
9375 convinced that the TIFF library is smart enough not to destroy
9376 itself if we only hand it the function pointers we need to
9381 unsigned char *bytes
;
9389 tiff_read_from_memory (data
, buf
, size
)
9394 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9396 if (size
> src
->len
- src
->index
)
9398 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9405 tiff_write_from_memory (data
, buf
, size
)
9415 tiff_seek_in_memory (data
, off
, whence
)
9420 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9425 case SEEK_SET
: /* Go from beginning of source. */
9429 case SEEK_END
: /* Go from end of source. */
9430 idx
= src
->len
+ off
;
9433 case SEEK_CUR
: /* Go from current position. */
9434 idx
= src
->index
+ off
;
9437 default: /* Invalid `whence'. */
9441 if (idx
> src
->len
|| idx
< 0)
9450 tiff_close_memory (data
)
9459 tiff_mmap_memory (data
, pbase
, psize
)
9464 /* It is already _IN_ memory. */
9470 tiff_unmap_memory (data
, base
, size
)
9475 /* We don't need to do this. */
9480 tiff_size_of_memory (data
)
9483 return ((tiff_memory_source
*) data
)->len
;
9487 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9495 Lisp_Object file
, specified_file
;
9496 Lisp_Object specified_data
;
9498 int width
, height
, x
, y
;
9502 struct gcpro gcpro1
;
9503 tiff_memory_source memsrc
;
9505 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9506 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9510 if (NILP (specified_data
))
9512 /* Read from a file */
9513 file
= x_find_image_file (specified_file
);
9514 if (!STRINGP (file
))
9516 image_error ("Cannot find image file `%s'", file
, Qnil
);
9521 /* Try to open the image file. */
9522 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9525 image_error ("Cannot open `%s'", file
, Qnil
);
9532 /* Memory source! */
9533 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9534 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9537 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9538 (TIFFReadWriteProc
) tiff_read_from_memory
,
9539 (TIFFReadWriteProc
) tiff_write_from_memory
,
9540 tiff_seek_in_memory
,
9542 tiff_size_of_memory
,
9548 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9554 /* Get width and height of the image, and allocate a raster buffer
9555 of width x height 32-bit values. */
9556 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9557 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9558 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9560 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9564 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9570 /* Create the X image and pixmap. */
9571 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9578 /* Initialize the color table. */
9579 init_color_table ();
9581 /* Process the pixel raster. Origin is in the lower-left corner. */
9582 for (y
= 0; y
< height
; ++y
)
9584 uint32
*row
= buf
+ y
* width
;
9586 for (x
= 0; x
< width
; ++x
)
9588 uint32 abgr
= row
[x
];
9589 int r
= TIFFGetR (abgr
) << 8;
9590 int g
= TIFFGetG (abgr
) << 8;
9591 int b
= TIFFGetB (abgr
) << 8;
9592 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9596 /* Remember the colors allocated for the image. Free the color table. */
9597 img
->colors
= colors_in_color_table (&img
->ncolors
);
9598 free_color_table ();
9600 /* Put the image into the pixmap, then free the X image and its buffer. */
9601 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9602 x_destroy_x_image (ximg
);
9606 img
->height
= height
;
9612 #endif /* HAVE_TIFF != 0 */
9616 /***********************************************************************
9618 ***********************************************************************/
9622 #include <gif_lib.h>
9624 static int gif_image_p
P_ ((Lisp_Object object
));
9625 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9627 /* The symbol `gif' identifying images of this type. */
9631 /* Indices of image specification fields in gif_format, below. */
9633 enum gif_keyword_index
9648 /* Vector of image_keyword structures describing the format
9649 of valid user-defined image specifications. */
9651 static struct image_keyword gif_format
[GIF_LAST
] =
9653 {":type", IMAGE_SYMBOL_VALUE
, 1},
9654 {":data", IMAGE_STRING_VALUE
, 0},
9655 {":file", IMAGE_STRING_VALUE
, 0},
9656 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9657 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9658 {":relief", IMAGE_INTEGER_VALUE
, 0},
9659 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9660 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9661 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9662 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9665 /* Structure describing the image type `gif'. */
9667 static struct image_type gif_type
=
9677 /* Return non-zero if OBJECT is a valid GIF image specification. */
9680 gif_image_p (object
)
9683 struct image_keyword fmt
[GIF_LAST
];
9684 bcopy (gif_format
, fmt
, sizeof fmt
);
9686 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9689 /* Must specify either the :data or :file keyword. */
9690 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9694 /* Reading a GIF image from memory
9695 Based on the PNG memory stuff to a certain extent. */
9699 unsigned char *bytes
;
9706 /* Make the current memory source available to gif_read_from_memory.
9707 It's done this way because not all versions of libungif support
9708 a UserData field in the GifFileType structure. */
9709 static gif_memory_source
*current_gif_memory_src
;
9712 gif_read_from_memory (file
, buf
, len
)
9717 gif_memory_source
*src
= current_gif_memory_src
;
9719 if (len
> src
->len
- src
->index
)
9722 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9728 /* Load GIF image IMG for use on frame F. Value is non-zero if
9736 Lisp_Object file
, specified_file
;
9737 Lisp_Object specified_data
;
9738 int rc
, width
, height
, x
, y
, i
;
9740 ColorMapObject
*gif_color_map
;
9741 unsigned long pixel_colors
[256];
9743 struct gcpro gcpro1
;
9745 int ino
, image_left
, image_top
, image_width
, image_height
;
9746 gif_memory_source memsrc
;
9747 unsigned char *raster
;
9749 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9750 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9754 if (NILP (specified_data
))
9756 file
= x_find_image_file (specified_file
);
9757 if (!STRINGP (file
))
9759 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9764 /* Open the GIF file. */
9765 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9768 image_error ("Cannot open `%s'", file
, Qnil
);
9775 /* Read from memory! */
9776 current_gif_memory_src
= &memsrc
;
9777 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9778 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9781 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9784 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9790 /* Read entire contents. */
9791 rc
= DGifSlurp (gif
);
9792 if (rc
== GIF_ERROR
)
9794 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9795 DGifCloseFile (gif
);
9800 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9801 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9802 if (ino
>= gif
->ImageCount
)
9804 image_error ("Invalid image number `%s' in image `%s'",
9806 DGifCloseFile (gif
);
9811 width
= img
->width
= max (gif
->SWidth
, gif
->Image
.Left
+ gif
->Image
.Width
);
9812 height
= img
->height
= max (gif
->SHeight
, gif
->Image
.Top
+ gif
->Image
.Height
);
9814 /* Create the X image and pixmap. */
9815 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9817 DGifCloseFile (gif
);
9822 /* Allocate colors. */
9823 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9825 gif_color_map
= gif
->SColorMap
;
9826 init_color_table ();
9827 bzero (pixel_colors
, sizeof pixel_colors
);
9829 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9831 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9832 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9833 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9834 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9837 img
->colors
= colors_in_color_table (&img
->ncolors
);
9838 free_color_table ();
9840 /* Clear the part of the screen image that are not covered by
9841 the image from the GIF file. Full animated GIF support
9842 requires more than can be done here (see the gif89 spec,
9843 disposal methods). Let's simply assume that the part
9844 not covered by a sub-image is in the frame's background color. */
9845 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9846 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9847 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9848 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9850 for (y
= 0; y
< image_top
; ++y
)
9851 for (x
= 0; x
< width
; ++x
)
9852 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9854 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9855 for (x
= 0; x
< width
; ++x
)
9856 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9858 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9860 for (x
= 0; x
< image_left
; ++x
)
9861 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9862 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9863 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9866 /* Read the GIF image into the X image. We use a local variable
9867 `raster' here because RasterBits below is a char *, and invites
9868 problems with bytes >= 0x80. */
9869 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9871 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9873 static int interlace_start
[] = {0, 4, 2, 1};
9874 static int interlace_increment
[] = {8, 8, 4, 2};
9876 int row
= interlace_start
[0];
9880 for (y
= 0; y
< image_height
; y
++)
9882 if (row
>= image_height
)
9884 row
= interlace_start
[++pass
];
9885 while (row
>= image_height
)
9886 row
= interlace_start
[++pass
];
9889 for (x
= 0; x
< image_width
; x
++)
9891 int i
= raster
[(y
* image_width
) + x
];
9892 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9896 row
+= interlace_increment
[pass
];
9901 for (y
= 0; y
< image_height
; ++y
)
9902 for (x
= 0; x
< image_width
; ++x
)
9904 int i
= raster
[y
* image_width
+ x
];
9905 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9909 DGifCloseFile (gif
);
9911 /* Put the image into the pixmap, then free the X image and its buffer. */
9912 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9913 x_destroy_x_image (ximg
);
9919 #endif /* HAVE_GIF != 0 */
9923 /***********************************************************************
9925 ***********************************************************************/
9927 static int gs_image_p
P_ ((Lisp_Object object
));
9928 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9929 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9931 /* The symbol `postscript' identifying images of this type. */
9933 Lisp_Object Qpostscript
;
9935 /* Keyword symbols. */
9937 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9939 /* Indices of image specification fields in gs_format, below. */
9941 enum gs_keyword_index
9958 /* Vector of image_keyword structures describing the format
9959 of valid user-defined image specifications. */
9961 static struct image_keyword gs_format
[GS_LAST
] =
9963 {":type", IMAGE_SYMBOL_VALUE
, 1},
9964 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9965 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9966 {":file", IMAGE_STRING_VALUE
, 1},
9967 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9968 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9969 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9970 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9971 {":relief", IMAGE_INTEGER_VALUE
, 0},
9972 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9973 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9974 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9977 /* Structure describing the image type `ghostscript'. */
9979 static struct image_type gs_type
=
9989 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9992 gs_clear_image (f
, img
)
9996 /* IMG->data.ptr_val may contain a recorded colormap. */
9997 xfree (img
->data
.ptr_val
);
9998 x_clear_image (f
, img
);
10002 /* Return non-zero if OBJECT is a valid Ghostscript image
10006 gs_image_p (object
)
10007 Lisp_Object object
;
10009 struct image_keyword fmt
[GS_LAST
];
10013 bcopy (gs_format
, fmt
, sizeof fmt
);
10015 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
10018 /* Bounding box must be a list or vector containing 4 integers. */
10019 tem
= fmt
[GS_BOUNDING_BOX
].value
;
10022 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
10023 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
10028 else if (VECTORP (tem
))
10030 if (XVECTOR (tem
)->size
!= 4)
10032 for (i
= 0; i
< 4; ++i
)
10033 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
10043 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
10052 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
10053 struct gcpro gcpro1
, gcpro2
;
10055 double in_width
, in_height
;
10056 Lisp_Object pixel_colors
= Qnil
;
10058 /* Compute pixel size of pixmap needed from the given size in the
10059 image specification. Sizes in the specification are in pt. 1 pt
10060 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10062 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
10063 in_width
= XFASTINT (pt_width
) / 72.0;
10064 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
10065 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
10066 in_height
= XFASTINT (pt_height
) / 72.0;
10067 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
10069 /* Create the pixmap. */
10070 xassert (img
->pixmap
== None
);
10071 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10072 img
->width
, img
->height
,
10073 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
10077 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
10081 /* Call the loader to fill the pixmap. It returns a process object
10082 if successful. We do not record_unwind_protect here because
10083 other places in redisplay like calling window scroll functions
10084 don't either. Let the Lisp loader use `unwind-protect' instead. */
10085 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
10087 sprintf (buffer
, "%lu %lu",
10088 (unsigned long) FRAME_X_WINDOW (f
),
10089 (unsigned long) img
->pixmap
);
10090 window_and_pixmap_id
= build_string (buffer
);
10092 sprintf (buffer
, "%lu %lu",
10093 FRAME_FOREGROUND_PIXEL (f
),
10094 FRAME_BACKGROUND_PIXEL (f
));
10095 pixel_colors
= build_string (buffer
);
10097 XSETFRAME (frame
, f
);
10098 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
10100 loader
= intern ("gs-load-image");
10102 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10103 make_number (img
->width
),
10104 make_number (img
->height
),
10105 window_and_pixmap_id
,
10108 return PROCESSP (img
->data
.lisp_val
);
10112 /* Kill the Ghostscript process that was started to fill PIXMAP on
10113 frame F. Called from XTread_socket when receiving an event
10114 telling Emacs that Ghostscript has finished drawing. */
10117 x_kill_gs_process (pixmap
, f
)
10121 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10125 /* Find the image containing PIXMAP. */
10126 for (i
= 0; i
< c
->used
; ++i
)
10127 if (c
->images
[i
]->pixmap
== pixmap
)
10130 /* Should someone in between have cleared the image cache, for
10131 instance, give up. */
10135 /* Kill the GS process. We should have found PIXMAP in the image
10136 cache and its image should contain a process object. */
10137 img
= c
->images
[i
];
10138 xassert (PROCESSP (img
->data
.lisp_val
));
10139 Fkill_process (img
->data
.lisp_val
, Qnil
);
10140 img
->data
.lisp_val
= Qnil
;
10142 /* On displays with a mutable colormap, figure out the colors
10143 allocated for the image by looking at the pixels of an XImage for
10145 class = FRAME_X_VISUAL (f
)->class;
10146 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10152 /* Try to get an XImage for img->pixmep. */
10153 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10154 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10159 /* Initialize the color table. */
10160 init_color_table ();
10162 /* For each pixel of the image, look its color up in the
10163 color table. After having done so, the color table will
10164 contain an entry for each color used by the image. */
10165 for (y
= 0; y
< img
->height
; ++y
)
10166 for (x
= 0; x
< img
->width
; ++x
)
10168 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10169 lookup_pixel_color (f
, pixel
);
10172 /* Record colors in the image. Free color table and XImage. */
10173 img
->colors
= colors_in_color_table (&img
->ncolors
);
10174 free_color_table ();
10175 XDestroyImage (ximg
);
10177 #if 0 /* This doesn't seem to be the case. If we free the colors
10178 here, we get a BadAccess later in x_clear_image when
10179 freeing the colors. */
10180 /* We have allocated colors once, but Ghostscript has also
10181 allocated colors on behalf of us. So, to get the
10182 reference counts right, free them once. */
10184 x_free_colors (f
, img
->colors
, img
->ncolors
);
10188 image_error ("Cannot get X image of `%s'; colors will not be freed",
10194 /* Now that we have the pixmap, compute mask and transform the
10195 image if requested. */
10197 postprocess_image (f
, img
);
10203 /***********************************************************************
10205 ***********************************************************************/
10207 DEFUN ("x-change-window-property", Fx_change_window_property
,
10208 Sx_change_window_property
, 2, 3, 0,
10209 "Change window property PROP to VALUE on the X window of FRAME.\n\
10210 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
10211 selected frame. Value is VALUE.")
10212 (prop
, value
, frame
)
10213 Lisp_Object frame
, prop
, value
;
10215 struct frame
*f
= check_x_frame (frame
);
10218 CHECK_STRING (prop
, 1);
10219 CHECK_STRING (value
, 2);
10222 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10223 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10224 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10225 XSTRING (value
)->data
, XSTRING (value
)->size
);
10227 /* Make sure the property is set when we return. */
10228 XFlush (FRAME_X_DISPLAY (f
));
10235 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10236 Sx_delete_window_property
, 1, 2, 0,
10237 "Remove window property PROP from X window of FRAME.\n\
10238 FRAME nil or omitted means use the selected frame. Value is PROP.")
10240 Lisp_Object prop
, frame
;
10242 struct frame
*f
= check_x_frame (frame
);
10245 CHECK_STRING (prop
, 1);
10247 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10248 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10250 /* Make sure the property is removed when we return. */
10251 XFlush (FRAME_X_DISPLAY (f
));
10258 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10260 "Value is the value of window property PROP on FRAME.\n\
10261 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10262 if FRAME hasn't a property with name PROP or if PROP has no string\n\
10265 Lisp_Object prop
, frame
;
10267 struct frame
*f
= check_x_frame (frame
);
10270 Lisp_Object prop_value
= Qnil
;
10271 char *tmp_data
= NULL
;
10274 unsigned long actual_size
, bytes_remaining
;
10276 CHECK_STRING (prop
, 1);
10278 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10279 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10280 prop_atom
, 0, 0, False
, XA_STRING
,
10281 &actual_type
, &actual_format
, &actual_size
,
10282 &bytes_remaining
, (unsigned char **) &tmp_data
);
10285 int size
= bytes_remaining
;
10290 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10291 prop_atom
, 0, bytes_remaining
,
10293 &actual_type
, &actual_format
,
10294 &actual_size
, &bytes_remaining
,
10295 (unsigned char **) &tmp_data
);
10296 if (rc
== Success
&& tmp_data
)
10297 prop_value
= make_string (tmp_data
, size
);
10308 /***********************************************************************
10310 ***********************************************************************/
10312 /* If non-null, an asynchronous timer that, when it expires, displays
10313 an hourglass cursor on all frames. */
10315 static struct atimer
*hourglass_atimer
;
10317 /* Non-zero means an hourglass cursor is currently shown. */
10319 static int hourglass_shown_p
;
10321 /* Number of seconds to wait before displaying an hourglass cursor. */
10323 static Lisp_Object Vhourglass_delay
;
10325 /* Default number of seconds to wait before displaying an hourglass
10328 #define DEFAULT_HOURGLASS_DELAY 1
10330 /* Function prototypes. */
10332 static void show_hourglass
P_ ((struct atimer
*));
10333 static void hide_hourglass
P_ ((void));
10336 /* Cancel a currently active hourglass timer, and start a new one. */
10342 int secs
, usecs
= 0;
10344 /* Don't bother for ttys. */
10345 if (NILP (Vwindow_system
))
10348 cancel_hourglass ();
10350 if (INTEGERP (Vhourglass_delay
)
10351 && XINT (Vhourglass_delay
) > 0)
10352 secs
= XFASTINT (Vhourglass_delay
);
10353 else if (FLOATP (Vhourglass_delay
)
10354 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10357 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10358 secs
= XFASTINT (tem
);
10359 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10362 secs
= DEFAULT_HOURGLASS_DELAY
;
10364 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10365 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10366 show_hourglass
, NULL
);
10370 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10374 cancel_hourglass ()
10376 if (hourglass_atimer
)
10378 cancel_atimer (hourglass_atimer
);
10379 hourglass_atimer
= NULL
;
10382 if (hourglass_shown_p
)
10387 /* Timer function of hourglass_atimer. TIMER is equal to
10390 Display an hourglass pointer on all frames by mapping the frames'
10391 hourglass_window. Set the hourglass_p flag in the frames'
10392 output_data.x structure to indicate that an hourglass cursor is
10393 shown on the frames. */
10396 show_hourglass (timer
)
10397 struct atimer
*timer
;
10399 /* The timer implementation will cancel this timer automatically
10400 after this function has run. Set hourglass_atimer to null
10401 so that we know the timer doesn't have to be canceled. */
10402 hourglass_atimer
= NULL
;
10404 if (!hourglass_shown_p
)
10406 Lisp_Object rest
, frame
;
10410 FOR_EACH_FRAME (rest
, frame
)
10412 struct frame
*f
= XFRAME (frame
);
10414 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10416 Display
*dpy
= FRAME_X_DISPLAY (f
);
10418 #ifdef USE_X_TOOLKIT
10419 if (f
->output_data
.x
->widget
)
10421 if (FRAME_OUTER_WINDOW (f
))
10424 f
->output_data
.x
->hourglass_p
= 1;
10426 if (!f
->output_data
.x
->hourglass_window
)
10428 unsigned long mask
= CWCursor
;
10429 XSetWindowAttributes attrs
;
10431 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10433 f
->output_data
.x
->hourglass_window
10434 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10435 0, 0, 32000, 32000, 0, 0,
10441 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10447 hourglass_shown_p
= 1;
10453 /* Hide the hourglass pointer on all frames, if it is currently
10459 if (hourglass_shown_p
)
10461 Lisp_Object rest
, frame
;
10464 FOR_EACH_FRAME (rest
, frame
)
10466 struct frame
*f
= XFRAME (frame
);
10469 /* Watch out for newly created frames. */
10470 && f
->output_data
.x
->hourglass_window
)
10472 XUnmapWindow (FRAME_X_DISPLAY (f
),
10473 f
->output_data
.x
->hourglass_window
);
10474 /* Sync here because XTread_socket looks at the
10475 hourglass_p flag that is reset to zero below. */
10476 XSync (FRAME_X_DISPLAY (f
), False
);
10477 f
->output_data
.x
->hourglass_p
= 0;
10481 hourglass_shown_p
= 0;
10488 /***********************************************************************
10490 ***********************************************************************/
10492 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10493 Lisp_Object
, Lisp_Object
));
10494 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10495 Lisp_Object
, int, int, int *, int *));
10497 /* The frame of a currently visible tooltip. */
10499 Lisp_Object tip_frame
;
10501 /* If non-nil, a timer started that hides the last tooltip when it
10504 Lisp_Object tip_timer
;
10507 /* If non-nil, a vector of 3 elements containing the last args
10508 with which x-show-tip was called. See there. */
10510 Lisp_Object last_show_tip_args
;
10512 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
10514 Lisp_Object Vx_max_tooltip_size
;
10518 unwind_create_tip_frame (frame
)
10521 Lisp_Object deleted
;
10523 deleted
= unwind_create_frame (frame
);
10524 if (EQ (deleted
, Qt
))
10534 /* Create a frame for a tooltip on the display described by DPYINFO.
10535 PARMS is a list of frame parameters. TEXT is the string to
10536 display in the tip frame. Value is the frame.
10538 Note that functions called here, esp. x_default_parameter can
10539 signal errors, for instance when a specified color name is
10540 undefined. We have to make sure that we're in a consistent state
10541 when this happens. */
10544 x_create_tip_frame (dpyinfo
, parms
, text
)
10545 struct x_display_info
*dpyinfo
;
10546 Lisp_Object parms
, text
;
10549 Lisp_Object frame
, tem
;
10551 long window_prompting
= 0;
10553 int count
= BINDING_STACK_SIZE ();
10554 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10556 int face_change_count_before
= face_change_count
;
10557 Lisp_Object buffer
;
10558 struct buffer
*old_buffer
;
10562 /* Use this general default value to start with until we know if
10563 this frame has a specified name. */
10564 Vx_resource_name
= Vinvocation_name
;
10566 #ifdef MULTI_KBOARD
10567 kb
= dpyinfo
->kboard
;
10569 kb
= &the_only_kboard
;
10572 /* Get the name of the frame to use for resource lookup. */
10573 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10574 if (!STRINGP (name
)
10575 && !EQ (name
, Qunbound
)
10577 error ("Invalid frame name--not a string or nil");
10578 Vx_resource_name
= name
;
10581 GCPRO3 (parms
, name
, frame
);
10582 f
= make_frame (1);
10583 XSETFRAME (frame
, f
);
10585 buffer
= Fget_buffer_create (build_string (" *tip*"));
10586 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10587 old_buffer
= current_buffer
;
10588 set_buffer_internal_1 (XBUFFER (buffer
));
10589 current_buffer
->truncate_lines
= Qnil
;
10591 Finsert (1, &text
);
10592 set_buffer_internal_1 (old_buffer
);
10594 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10595 record_unwind_protect (unwind_create_tip_frame
, frame
);
10597 /* By setting the output method, we're essentially saying that
10598 the frame is live, as per FRAME_LIVE_P. If we get a signal
10599 from this point on, x_destroy_window might screw up reference
10601 f
->output_method
= output_x_window
;
10602 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10603 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10604 f
->output_data
.x
->icon_bitmap
= -1;
10605 f
->output_data
.x
->fontset
= -1;
10606 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10607 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10608 f
->icon_name
= Qnil
;
10609 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10611 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10612 dpyinfo_refcount
= dpyinfo
->reference_count
;
10613 #endif /* GLYPH_DEBUG */
10614 #ifdef MULTI_KBOARD
10615 FRAME_KBOARD (f
) = kb
;
10617 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10618 f
->output_data
.x
->explicit_parent
= 0;
10620 /* These colors will be set anyway later, but it's important
10621 to get the color reference counts right, so initialize them! */
10624 struct gcpro gcpro1
;
10626 black
= build_string ("black");
10628 f
->output_data
.x
->foreground_pixel
10629 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10630 f
->output_data
.x
->background_pixel
10631 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10632 f
->output_data
.x
->cursor_pixel
10633 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10634 f
->output_data
.x
->cursor_foreground_pixel
10635 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10636 f
->output_data
.x
->border_pixel
10637 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10638 f
->output_data
.x
->mouse_pixel
10639 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10643 /* Set the name; the functions to which we pass f expect the name to
10645 if (EQ (name
, Qunbound
) || NILP (name
))
10647 f
->name
= build_string (dpyinfo
->x_id_name
);
10648 f
->explicit_name
= 0;
10653 f
->explicit_name
= 1;
10654 /* use the frame's title when getting resources for this frame. */
10655 specbind (Qx_resource_name
, name
);
10658 /* Extract the window parameters from the supplied values that are
10659 needed to determine window geometry. */
10663 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10666 /* First, try whatever font the caller has specified. */
10667 if (STRINGP (font
))
10669 tem
= Fquery_fontset (font
, Qnil
);
10671 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10673 font
= x_new_font (f
, XSTRING (font
)->data
);
10676 /* Try out a font which we hope has bold and italic variations. */
10677 if (!STRINGP (font
))
10678 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10679 if (!STRINGP (font
))
10680 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10681 if (! STRINGP (font
))
10682 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10683 if (! STRINGP (font
))
10684 /* This was formerly the first thing tried, but it finds too many fonts
10685 and takes too long. */
10686 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10687 /* If those didn't work, look for something which will at least work. */
10688 if (! STRINGP (font
))
10689 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10691 if (! STRINGP (font
))
10692 font
= build_string ("fixed");
10694 x_default_parameter (f
, parms
, Qfont
, font
,
10695 "font", "Font", RES_TYPE_STRING
);
10698 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10699 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10701 /* This defaults to 2 in order to match xterm. We recognize either
10702 internalBorderWidth or internalBorder (which is what xterm calls
10704 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10708 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10709 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10710 if (! EQ (value
, Qunbound
))
10711 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10715 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10716 "internalBorderWidth", "internalBorderWidth",
10719 /* Also do the stuff which must be set before the window exists. */
10720 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10721 "foreground", "Foreground", RES_TYPE_STRING
);
10722 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10723 "background", "Background", RES_TYPE_STRING
);
10724 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10725 "pointerColor", "Foreground", RES_TYPE_STRING
);
10726 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10727 "cursorColor", "Foreground", RES_TYPE_STRING
);
10728 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10729 "borderColor", "BorderColor", RES_TYPE_STRING
);
10731 /* Init faces before x_default_parameter is called for scroll-bar
10732 parameters because that function calls x_set_scroll_bar_width,
10733 which calls change_frame_size, which calls Fset_window_buffer,
10734 which runs hooks, which call Fvertical_motion. At the end, we
10735 end up in init_iterator with a null face cache, which should not
10737 init_frame_faces (f
);
10739 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10740 window_prompting
= x_figure_window_size (f
, parms
);
10742 if (window_prompting
& XNegative
)
10744 if (window_prompting
& YNegative
)
10745 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10747 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10751 if (window_prompting
& YNegative
)
10752 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10754 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10757 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10759 XSetWindowAttributes attrs
;
10760 unsigned long mask
;
10763 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10764 if (DoesSaveUnders (dpyinfo
->screen
))
10765 mask
|= CWSaveUnder
;
10767 /* Window managers look at the override-redirect flag to determine
10768 whether or net to give windows a decoration (Xlib spec, chapter
10770 attrs
.override_redirect
= True
;
10771 attrs
.save_under
= True
;
10772 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10773 /* Arrange for getting MapNotify and UnmapNotify events. */
10774 attrs
.event_mask
= StructureNotifyMask
;
10776 = FRAME_X_WINDOW (f
)
10777 = XCreateWindow (FRAME_X_DISPLAY (f
),
10778 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10779 /* x, y, width, height */
10783 CopyFromParent
, InputOutput
, CopyFromParent
,
10790 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10791 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10792 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10793 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10794 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10795 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10797 /* Dimensions, especially f->height, must be done via change_frame_size.
10798 Change will not be effected unless different from the current
10801 height
= f
->height
;
10803 SET_FRAME_WIDTH (f
, 0);
10804 change_frame_size (f
, height
, width
, 1, 0, 0);
10806 /* Set up faces after all frame parameters are known. This call
10807 also merges in face attributes specified for new frames.
10809 Frame parameters may be changed if .Xdefaults contains
10810 specifications for the default font. For example, if there is an
10811 `Emacs.default.attributeBackground: pink', the `background-color'
10812 attribute of the frame get's set, which let's the internal border
10813 of the tooltip frame appear in pink. Prevent this. */
10815 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
10817 /* Set tip_frame here, so that */
10819 call1 (Qface_set_after_frame_default
, frame
);
10821 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
10822 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
10830 /* It is now ok to make the frame official even if we get an error
10831 below. And the frame needs to be on Vframe_list or making it
10832 visible won't work. */
10833 Vframe_list
= Fcons (frame
, Vframe_list
);
10835 /* Now that the frame is official, it counts as a reference to
10837 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10839 /* Setting attributes of faces of the tooltip frame from resources
10840 and similar will increment face_change_count, which leads to the
10841 clearing of all current matrices. Since this isn't necessary
10842 here, avoid it by resetting face_change_count to the value it
10843 had before we created the tip frame. */
10844 face_change_count
= face_change_count_before
;
10846 /* Discard the unwind_protect. */
10847 return unbind_to (count
, frame
);
10851 /* Compute where to display tip frame F. PARMS is the list of frame
10852 parameters for F. DX and DY are specified offsets from the current
10853 location of the mouse. WIDTH and HEIGHT are the width and height
10854 of the tooltip. Return coordinates relative to the root window of
10855 the display in *ROOT_X, and *ROOT_Y. */
10858 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
10860 Lisp_Object parms
, dx
, dy
;
10862 int *root_x
, *root_y
;
10864 Lisp_Object left
, top
;
10866 Window root
, child
;
10869 /* User-specified position? */
10870 left
= Fcdr (Fassq (Qleft
, parms
));
10871 top
= Fcdr (Fassq (Qtop
, parms
));
10873 /* Move the tooltip window where the mouse pointer is. Resize and
10875 if (!INTEGERP (left
) && !INTEGERP (top
))
10878 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10879 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
10883 if (INTEGERP (top
))
10884 *root_y
= XINT (top
);
10885 else if (*root_y
+ XINT (dy
) - height
< 0)
10886 *root_y
-= XINT (dy
);
10890 *root_y
+= XINT (dy
);
10893 if (INTEGERP (left
))
10894 *root_x
= XINT (left
);
10895 else if (*root_x
+ XINT (dx
) + width
> FRAME_X_DISPLAY_INFO (f
)->width
)
10896 *root_x
-= width
+ XINT (dx
);
10898 *root_x
+= XINT (dx
);
10902 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10903 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10904 A tooltip window is a small X window displaying a string.\n\
10906 FRAME nil or omitted means use the selected frame.\n\
10908 PARMS is an optional list of frame parameters which can be\n\
10909 used to change the tooltip's appearance.\n\
10911 Automatically hide the tooltip after TIMEOUT seconds.\n\
10912 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10914 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10915 the tooltip is displayed at that x-position. Otherwise it is\n\
10916 displayed at the mouse position, with offset DX added (default is 5 if\n\
10917 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10918 parameter is specified, it determines the y-position of the tooltip\n\
10919 window, otherwise it is displayed at the mouse position, with offset\n\
10920 DY added (default is -10).\n\
10922 A tooltip's maximum size is specified by `x-max-tooltip-size'.\n\
10923 Text larger than the specified size is clipped.")
10924 (string
, frame
, parms
, timeout
, dx
, dy
)
10925 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10929 Lisp_Object buffer
, top
, left
, max_width
, max_height
;
10930 int root_x
, root_y
;
10931 struct buffer
*old_buffer
;
10932 struct text_pos pos
;
10933 int i
, width
, height
;
10934 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10935 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10936 int count
= BINDING_STACK_SIZE ();
10938 specbind (Qinhibit_redisplay
, Qt
);
10940 GCPRO4 (string
, parms
, frame
, timeout
);
10942 CHECK_STRING (string
, 0);
10943 f
= check_x_frame (frame
);
10944 if (NILP (timeout
))
10945 timeout
= make_number (5);
10947 CHECK_NATNUM (timeout
, 2);
10950 dx
= make_number (5);
10952 CHECK_NUMBER (dx
, 5);
10955 dy
= make_number (-10);
10957 CHECK_NUMBER (dy
, 6);
10959 if (NILP (last_show_tip_args
))
10960 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
10962 if (!NILP (tip_frame
))
10964 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
10965 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
10966 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
10968 if (EQ (frame
, last_frame
)
10969 && !NILP (Fequal (last_string
, string
))
10970 && !NILP (Fequal (last_parms
, parms
)))
10972 struct frame
*f
= XFRAME (tip_frame
);
10974 /* Only DX and DY have changed. */
10975 if (!NILP (tip_timer
))
10977 Lisp_Object timer
= tip_timer
;
10979 call1 (Qcancel_timer
, timer
);
10983 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
10984 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
10985 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10992 /* Hide a previous tip, if any. */
10995 ASET (last_show_tip_args
, 0, string
);
10996 ASET (last_show_tip_args
, 1, frame
);
10997 ASET (last_show_tip_args
, 2, parms
);
10999 /* Add default values to frame parameters. */
11000 if (NILP (Fassq (Qname
, parms
)))
11001 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
11002 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11003 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
11004 if (NILP (Fassq (Qborder_width
, parms
)))
11005 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
11006 if (NILP (Fassq (Qborder_color
, parms
)))
11007 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
11008 if (NILP (Fassq (Qbackground_color
, parms
)))
11009 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
11012 /* Create a frame for the tooltip, and record it in the global
11013 variable tip_frame. */
11014 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
, string
);
11015 f
= XFRAME (frame
);
11017 /* Set up the frame's root window. */
11018 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
11019 w
->left
= w
->top
= make_number (0);
11021 if (CONSP (Vx_max_tooltip_size
)
11022 && INTEGERP (XCAR (Vx_max_tooltip_size
))
11023 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
11024 && INTEGERP (XCDR (Vx_max_tooltip_size
))
11025 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
11027 w
->width
= XCAR (Vx_max_tooltip_size
);
11028 w
->height
= XCDR (Vx_max_tooltip_size
);
11032 w
->width
= make_number (80);
11033 w
->height
= make_number (40);
11036 f
->window_width
= XINT (w
->width
);
11038 w
->pseudo_window_p
= 1;
11040 /* Display the tooltip text in a temporary buffer. */
11041 old_buffer
= current_buffer
;
11042 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
11043 current_buffer
->truncate_lines
= Qnil
;
11044 clear_glyph_matrix (w
->desired_matrix
);
11045 clear_glyph_matrix (w
->current_matrix
);
11046 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
11047 try_window (FRAME_ROOT_WINDOW (f
), pos
);
11049 /* Compute width and height of the tooltip. */
11050 width
= height
= 0;
11051 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
11053 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
11054 struct glyph
*last
;
11057 /* Stop at the first empty row at the end. */
11058 if (!row
->enabled_p
|| !row
->displays_text_p
)
11061 /* Let the row go over the full width of the frame. */
11062 row
->full_width_p
= 1;
11064 /* There's a glyph at the end of rows that is used to place
11065 the cursor there. Don't include the width of this glyph. */
11066 if (row
->used
[TEXT_AREA
])
11068 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
11069 row_width
= row
->pixel_width
- last
->pixel_width
;
11072 row_width
= row
->pixel_width
;
11074 height
+= row
->height
;
11075 width
= max (width
, row_width
);
11078 /* Add the frame's internal border to the width and height the X
11079 window should have. */
11080 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11081 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11083 /* Move the tooltip window where the mouse pointer is. Resize and
11085 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
11088 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11089 root_x
, root_y
, width
, height
);
11090 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
11093 /* Draw into the window. */
11094 w
->must_be_updated_p
= 1;
11095 update_single_window (w
, 1);
11097 /* Restore original current buffer. */
11098 set_buffer_internal_1 (old_buffer
);
11099 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
11102 /* Let the tip disappear after timeout seconds. */
11103 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
11104 intern ("x-hide-tip"));
11107 return unbind_to (count
, Qnil
);
11111 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
11112 "Hide the current tooltip window, if there is any.\n\
11113 Value is t is tooltip was open, nil otherwise.")
11117 Lisp_Object deleted
, frame
, timer
;
11118 struct gcpro gcpro1
, gcpro2
;
11120 /* Return quickly if nothing to do. */
11121 if (NILP (tip_timer
) && NILP (tip_frame
))
11126 GCPRO2 (frame
, timer
);
11127 tip_frame
= tip_timer
= deleted
= Qnil
;
11129 count
= BINDING_STACK_SIZE ();
11130 specbind (Qinhibit_redisplay
, Qt
);
11131 specbind (Qinhibit_quit
, Qt
);
11134 call1 (Qcancel_timer
, timer
);
11136 if (FRAMEP (frame
))
11138 Fdelete_frame (frame
, Qnil
);
11142 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11143 redisplay procedure is not called when a tip frame over menu
11144 items is unmapped. Redisplay the menu manually... */
11146 struct frame
*f
= SELECTED_FRAME ();
11147 Widget w
= f
->output_data
.x
->menubar_widget
;
11148 extern void xlwmenu_redisplay
P_ ((Widget
));
11150 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
11154 xlwmenu_redisplay (w
);
11158 #endif /* USE_LUCID */
11162 return unbind_to (count
, deleted
);
11167 /***********************************************************************
11168 File selection dialog
11169 ***********************************************************************/
11173 /* Callback for "OK" and "Cancel" on file selection dialog. */
11176 file_dialog_cb (widget
, client_data
, call_data
)
11178 XtPointer call_data
, client_data
;
11180 int *result
= (int *) client_data
;
11181 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11182 *result
= cb
->reason
;
11186 /* Callback for unmapping a file selection dialog. This is used to
11187 capture the case where a dialog is closed via a window manager's
11188 closer button, for example. Using a XmNdestroyCallback didn't work
11192 file_dialog_unmap_cb (widget
, client_data
, call_data
)
11194 XtPointer call_data
, client_data
;
11196 int *result
= (int *) client_data
;
11197 *result
= XmCR_CANCEL
;
11201 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11202 "Read file name, prompting with PROMPT in directory DIR.\n\
11203 Use a file selection dialog.\n\
11204 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
11205 specified. Don't let the user enter a file name in the file\n\
11206 selection dialog's entry field, if MUSTMATCH is non-nil.")
11207 (prompt
, dir
, default_filename
, mustmatch
)
11208 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11211 struct frame
*f
= SELECTED_FRAME ();
11212 Lisp_Object file
= Qnil
;
11213 Widget dialog
, text
, list
, help
;
11216 extern XtAppContext Xt_app_con
;
11218 XmString dir_xmstring
, pattern_xmstring
;
11219 int popup_activated_flag
;
11220 int count
= specpdl_ptr
- specpdl
;
11221 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11223 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11224 CHECK_STRING (prompt
, 0);
11225 CHECK_STRING (dir
, 1);
11227 /* Prevent redisplay. */
11228 specbind (Qinhibit_redisplay
, Qt
);
11232 /* Create the dialog with PROMPT as title, using DIR as initial
11233 directory and using "*" as pattern. */
11234 dir
= Fexpand_file_name (dir
, Qnil
);
11235 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11236 pattern_xmstring
= XmStringCreateLocalized ("*");
11238 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11239 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11240 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11241 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11242 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11243 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11245 XmStringFree (dir_xmstring
);
11246 XmStringFree (pattern_xmstring
);
11248 /* Add callbacks for OK and Cancel. */
11249 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11250 (XtPointer
) &result
);
11251 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11252 (XtPointer
) &result
);
11253 XtAddCallback (dialog
, XmNunmapCallback
, file_dialog_unmap_cb
,
11254 (XtPointer
) &result
);
11256 /* Disable the help button since we can't display help. */
11257 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11258 XtSetSensitive (help
, False
);
11260 /* Mark OK button as default. */
11261 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11262 XmNshowAsDefault
, True
, NULL
);
11264 /* If MUSTMATCH is non-nil, disable the file entry field of the
11265 dialog, so that the user must select a file from the files list
11266 box. We can't remove it because we wouldn't have a way to get at
11267 the result file name, then. */
11268 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11269 if (!NILP (mustmatch
))
11272 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11273 XtSetSensitive (text
, False
);
11274 XtSetSensitive (label
, False
);
11277 /* Manage the dialog, so that list boxes get filled. */
11278 XtManageChild (dialog
);
11280 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11281 must include the path for this to work. */
11282 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11283 if (STRINGP (default_filename
))
11285 XmString default_xmstring
;
11289 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11291 if (!XmListItemExists (list
, default_xmstring
))
11293 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11294 XmListAddItem (list
, default_xmstring
, 0);
11298 item_pos
= XmListItemPos (list
, default_xmstring
);
11299 XmStringFree (default_xmstring
);
11301 /* Select the item and scroll it into view. */
11302 XmListSelectPos (list
, item_pos
, True
);
11303 XmListSetPos (list
, item_pos
);
11306 /* Process events until the user presses Cancel or OK. Block
11307 and unblock input here so that we get a chance of processing
11311 while (result
== 0)
11314 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11319 /* Get the result. */
11320 if (result
== XmCR_OK
)
11325 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11326 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11327 XmStringFree (text
);
11328 file
= build_string (data
);
11335 XtUnmanageChild (dialog
);
11336 XtDestroyWidget (dialog
);
11340 /* Make "Cancel" equivalent to C-g. */
11342 Fsignal (Qquit
, Qnil
);
11344 return unbind_to (count
, file
);
11347 #endif /* USE_MOTIF */
11351 /***********************************************************************
11353 ***********************************************************************/
11355 #ifdef HAVE_XKBGETKEYBOARD
11356 #include <X11/XKBlib.h>
11357 #include <X11/keysym.h>
11360 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11361 Sx_backspace_delete_keys_p
, 0, 1, 0,
11362 "Check if both Backspace and Delete keys are on the keyboard of FRAME.\n\
11363 FRAME nil means use the selected frame.\n\
11364 Value is t if we know that both keys are present, and are mapped to the\n\
11369 #ifdef HAVE_XKBGETKEYBOARD
11371 struct frame
*f
= check_x_frame (frame
);
11372 Display
*dpy
= FRAME_X_DISPLAY (f
);
11373 Lisp_Object have_keys
;
11374 int major
, minor
, op
, event
, error
;
11378 /* Check library version in case we're dynamically linked. */
11379 major
= XkbMajorVersion
;
11380 minor
= XkbMinorVersion
;
11381 if (!XkbLibraryVersion (&major
, &minor
))
11387 /* Check that the server supports XKB. */
11388 major
= XkbMajorVersion
;
11389 minor
= XkbMinorVersion
;
11390 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11397 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11400 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11402 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11404 for (i
= kb
->min_key_code
;
11405 (i
< kb
->max_key_code
11406 && (delete_keycode
== 0 || backspace_keycode
== 0));
11409 /* The XKB symbolic key names can be seen most easily in
11410 the PS file generated by `xkbprint -label name
11412 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11413 delete_keycode
= i
;
11414 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11415 backspace_keycode
= i
;
11418 XkbFreeNames (kb
, 0, True
);
11421 XkbFreeClientMap (kb
, 0, True
);
11424 && backspace_keycode
11425 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11426 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11431 #else /* not HAVE_XKBGETKEYBOARD */
11433 #endif /* not HAVE_XKBGETKEYBOARD */
11438 /***********************************************************************
11440 ***********************************************************************/
11445 /* This is zero if not using X windows. */
11448 /* The section below is built by the lisp expression at the top of the file,
11449 just above where these variables are declared. */
11450 /*&&& init symbols here &&&*/
11451 Qauto_raise
= intern ("auto-raise");
11452 staticpro (&Qauto_raise
);
11453 Qauto_lower
= intern ("auto-lower");
11454 staticpro (&Qauto_lower
);
11455 Qbar
= intern ("bar");
11457 Qborder_color
= intern ("border-color");
11458 staticpro (&Qborder_color
);
11459 Qborder_width
= intern ("border-width");
11460 staticpro (&Qborder_width
);
11461 Qbox
= intern ("box");
11463 Qcursor_color
= intern ("cursor-color");
11464 staticpro (&Qcursor_color
);
11465 Qcursor_type
= intern ("cursor-type");
11466 staticpro (&Qcursor_type
);
11467 Qgeometry
= intern ("geometry");
11468 staticpro (&Qgeometry
);
11469 Qicon_left
= intern ("icon-left");
11470 staticpro (&Qicon_left
);
11471 Qicon_top
= intern ("icon-top");
11472 staticpro (&Qicon_top
);
11473 Qicon_type
= intern ("icon-type");
11474 staticpro (&Qicon_type
);
11475 Qicon_name
= intern ("icon-name");
11476 staticpro (&Qicon_name
);
11477 Qinternal_border_width
= intern ("internal-border-width");
11478 staticpro (&Qinternal_border_width
);
11479 Qleft
= intern ("left");
11480 staticpro (&Qleft
);
11481 Qright
= intern ("right");
11482 staticpro (&Qright
);
11483 Qmouse_color
= intern ("mouse-color");
11484 staticpro (&Qmouse_color
);
11485 Qnone
= intern ("none");
11486 staticpro (&Qnone
);
11487 Qparent_id
= intern ("parent-id");
11488 staticpro (&Qparent_id
);
11489 Qscroll_bar_width
= intern ("scroll-bar-width");
11490 staticpro (&Qscroll_bar_width
);
11491 Qsuppress_icon
= intern ("suppress-icon");
11492 staticpro (&Qsuppress_icon
);
11493 Qundefined_color
= intern ("undefined-color");
11494 staticpro (&Qundefined_color
);
11495 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11496 staticpro (&Qvertical_scroll_bars
);
11497 Qvisibility
= intern ("visibility");
11498 staticpro (&Qvisibility
);
11499 Qwindow_id
= intern ("window-id");
11500 staticpro (&Qwindow_id
);
11501 Qouter_window_id
= intern ("outer-window-id");
11502 staticpro (&Qouter_window_id
);
11503 Qx_frame_parameter
= intern ("x-frame-parameter");
11504 staticpro (&Qx_frame_parameter
);
11505 Qx_resource_name
= intern ("x-resource-name");
11506 staticpro (&Qx_resource_name
);
11507 Quser_position
= intern ("user-position");
11508 staticpro (&Quser_position
);
11509 Quser_size
= intern ("user-size");
11510 staticpro (&Quser_size
);
11511 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11512 staticpro (&Qscroll_bar_foreground
);
11513 Qscroll_bar_background
= intern ("scroll-bar-background");
11514 staticpro (&Qscroll_bar_background
);
11515 Qscreen_gamma
= intern ("screen-gamma");
11516 staticpro (&Qscreen_gamma
);
11517 Qline_spacing
= intern ("line-spacing");
11518 staticpro (&Qline_spacing
);
11519 Qcenter
= intern ("center");
11520 staticpro (&Qcenter
);
11521 Qcompound_text
= intern ("compound-text");
11522 staticpro (&Qcompound_text
);
11523 Qcancel_timer
= intern ("cancel-timer");
11524 staticpro (&Qcancel_timer
);
11525 Qwait_for_wm
= intern ("wait-for-wm");
11526 staticpro (&Qwait_for_wm
);
11527 /* This is the end of symbol initialization. */
11529 /* Text property `display' should be nonsticky by default. */
11530 Vtext_property_default_nonsticky
11531 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11534 Qlaplace
= intern ("laplace");
11535 staticpro (&Qlaplace
);
11536 Qemboss
= intern ("emboss");
11537 staticpro (&Qemboss
);
11538 Qedge_detection
= intern ("edge-detection");
11539 staticpro (&Qedge_detection
);
11540 Qheuristic
= intern ("heuristic");
11541 staticpro (&Qheuristic
);
11542 QCmatrix
= intern (":matrix");
11543 staticpro (&QCmatrix
);
11544 QCcolor_adjustment
= intern (":color-adjustment");
11545 staticpro (&QCcolor_adjustment
);
11546 QCmask
= intern (":mask");
11547 staticpro (&QCmask
);
11549 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11550 staticpro (&Qface_set_after_frame_default
);
11552 Fput (Qundefined_color
, Qerror_conditions
,
11553 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11554 Fput (Qundefined_color
, Qerror_message
,
11555 build_string ("Undefined color"));
11557 init_x_parm_symbols ();
11559 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11560 "Non-nil means always draw a cross over disabled images.\n\
11561 Disabled images are those having an `:conversion disabled' property.\n\
11562 A cross is always drawn on black & white displays.");
11563 cross_disabled_images
= 0;
11565 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11566 "List of directories to search for bitmap files for X.");
11567 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11569 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11570 "The shape of the pointer when over text.\n\
11571 Changing the value does not affect existing frames\n\
11572 unless you set the mouse color.");
11573 Vx_pointer_shape
= Qnil
;
11575 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11576 "The name Emacs uses to look up X resources.\n\
11577 `x-get-resource' uses this as the first component of the instance name\n\
11578 when requesting resource values.\n\
11579 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
11580 was invoked, or to the value specified with the `-name' or `-rn'\n\
11581 switches, if present.\n\
11583 It may be useful to bind this variable locally around a call\n\
11584 to `x-get-resource'. See also the variable `x-resource-class'.");
11585 Vx_resource_name
= Qnil
;
11587 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11588 "The class Emacs uses to look up X resources.\n\
11589 `x-get-resource' uses this as the first component of the instance class\n\
11590 when requesting resource values.\n\
11591 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
11593 Setting this variable permanently is not a reasonable thing to do,\n\
11594 but binding this variable locally around a call to `x-get-resource'\n\
11595 is a reasonable practice. See also the variable `x-resource-name'.");
11596 Vx_resource_class
= build_string (EMACS_CLASS
);
11598 #if 0 /* This doesn't really do anything. */
11599 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11600 "The shape of the pointer when not over text.\n\
11601 This variable takes effect when you create a new frame\n\
11602 or when you set the mouse color.");
11604 Vx_nontext_pointer_shape
= Qnil
;
11606 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
11607 "The shape of the pointer when Emacs is busy.\n\
11608 This variable takes effect when you create a new frame\n\
11609 or when you set the mouse color.");
11610 Vx_hourglass_pointer_shape
= Qnil
;
11612 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
11613 "Non-zero means Emacs displays an hourglass pointer on window systems.");
11614 display_hourglass_p
= 1;
11616 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
11617 "*Seconds to wait before displaying an hourglass pointer.\n\
11618 Value must be an integer or float.");
11619 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
11621 #if 0 /* This doesn't really do anything. */
11622 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11623 "The shape of the pointer when over the mode line.\n\
11624 This variable takes effect when you create a new frame\n\
11625 or when you set the mouse color.");
11627 Vx_mode_pointer_shape
= Qnil
;
11629 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11630 &Vx_sensitive_text_pointer_shape
,
11631 "The shape of the pointer when over mouse-sensitive text.\n\
11632 This variable takes effect when you create a new frame\n\
11633 or when you set the mouse color.");
11634 Vx_sensitive_text_pointer_shape
= Qnil
;
11636 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11637 &Vx_window_horizontal_drag_shape
,
11638 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
11639 This variable takes effect when you create a new frame\n\
11640 or when you set the mouse color.");
11641 Vx_window_horizontal_drag_shape
= Qnil
;
11643 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11644 "A string indicating the foreground color of the cursor box.");
11645 Vx_cursor_fore_pixel
= Qnil
;
11647 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
11648 "Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).\n\
11649 Text larger than this is clipped.");
11650 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
11652 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11653 "Non-nil if no X window manager is in use.\n\
11654 Emacs doesn't try to figure this out; this is always nil\n\
11655 unless you set it to something else.");
11656 /* We don't have any way to find this out, so set it to nil
11657 and maybe the user would like to set it to t. */
11658 Vx_no_window_manager
= Qnil
;
11660 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11661 &Vx_pixel_size_width_font_regexp
,
11662 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11664 Since Emacs gets width of a font matching with this regexp from\n\
11665 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11666 such a font. This is especially effective for such large fonts as\n\
11667 Chinese, Japanese, and Korean.");
11668 Vx_pixel_size_width_font_regexp
= Qnil
;
11670 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11671 "Time after which cached images are removed from the cache.\n\
11672 When an image has not been displayed this many seconds, remove it\n\
11673 from the image cache. Value must be an integer or nil with nil\n\
11674 meaning don't clear the cache.");
11675 Vimage_cache_eviction_delay
= make_number (30 * 60);
11677 #ifdef USE_X_TOOLKIT
11678 Fprovide (intern ("x-toolkit"));
11681 Fprovide (intern ("motif"));
11683 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string
,
11684 "Version info for LessTif/Motif.");
11685 Vmotif_version_string
= build_string (XmVERSION_STRING
);
11686 #endif /* USE_MOTIF */
11687 #endif /* USE_X_TOOLKIT */
11689 defsubr (&Sx_get_resource
);
11691 /* X window properties. */
11692 defsubr (&Sx_change_window_property
);
11693 defsubr (&Sx_delete_window_property
);
11694 defsubr (&Sx_window_property
);
11696 defsubr (&Sxw_display_color_p
);
11697 defsubr (&Sx_display_grayscale_p
);
11698 defsubr (&Sxw_color_defined_p
);
11699 defsubr (&Sxw_color_values
);
11700 defsubr (&Sx_server_max_request_size
);
11701 defsubr (&Sx_server_vendor
);
11702 defsubr (&Sx_server_version
);
11703 defsubr (&Sx_display_pixel_width
);
11704 defsubr (&Sx_display_pixel_height
);
11705 defsubr (&Sx_display_mm_width
);
11706 defsubr (&Sx_display_mm_height
);
11707 defsubr (&Sx_display_screens
);
11708 defsubr (&Sx_display_planes
);
11709 defsubr (&Sx_display_color_cells
);
11710 defsubr (&Sx_display_visual_class
);
11711 defsubr (&Sx_display_backing_store
);
11712 defsubr (&Sx_display_save_under
);
11713 defsubr (&Sx_parse_geometry
);
11714 defsubr (&Sx_create_frame
);
11715 defsubr (&Sx_open_connection
);
11716 defsubr (&Sx_close_connection
);
11717 defsubr (&Sx_display_list
);
11718 defsubr (&Sx_synchronize
);
11719 defsubr (&Sx_focus_frame
);
11720 defsubr (&Sx_backspace_delete_keys_p
);
11722 /* Setting callback functions for fontset handler. */
11723 get_font_info_func
= x_get_font_info
;
11725 #if 0 /* This function pointer doesn't seem to be used anywhere.
11726 And the pointer assigned has the wrong type, anyway. */
11727 list_fonts_func
= x_list_fonts
;
11730 load_font_func
= x_load_font
;
11731 find_ccl_program_func
= x_find_ccl_program
;
11732 query_font_func
= x_query_font
;
11733 set_frame_fontset_func
= x_set_font
;
11734 check_window_system_func
= check_x
;
11737 Qxbm
= intern ("xbm");
11739 QCtype
= intern (":type");
11740 staticpro (&QCtype
);
11741 QCconversion
= intern (":conversion");
11742 staticpro (&QCconversion
);
11743 QCheuristic_mask
= intern (":heuristic-mask");
11744 staticpro (&QCheuristic_mask
);
11745 QCcolor_symbols
= intern (":color-symbols");
11746 staticpro (&QCcolor_symbols
);
11747 QCascent
= intern (":ascent");
11748 staticpro (&QCascent
);
11749 QCmargin
= intern (":margin");
11750 staticpro (&QCmargin
);
11751 QCrelief
= intern (":relief");
11752 staticpro (&QCrelief
);
11753 Qpostscript
= intern ("postscript");
11754 staticpro (&Qpostscript
);
11755 QCloader
= intern (":loader");
11756 staticpro (&QCloader
);
11757 QCbounding_box
= intern (":bounding-box");
11758 staticpro (&QCbounding_box
);
11759 QCpt_width
= intern (":pt-width");
11760 staticpro (&QCpt_width
);
11761 QCpt_height
= intern (":pt-height");
11762 staticpro (&QCpt_height
);
11763 QCindex
= intern (":index");
11764 staticpro (&QCindex
);
11765 Qpbm
= intern ("pbm");
11769 Qxpm
= intern ("xpm");
11774 Qjpeg
= intern ("jpeg");
11775 staticpro (&Qjpeg
);
11779 Qtiff
= intern ("tiff");
11780 staticpro (&Qtiff
);
11784 Qgif
= intern ("gif");
11789 Qpng
= intern ("png");
11793 defsubr (&Sclear_image_cache
);
11794 defsubr (&Simage_size
);
11795 defsubr (&Simage_mask_p
);
11797 hourglass_atimer
= NULL
;
11798 hourglass_shown_p
= 0;
11800 defsubr (&Sx_show_tip
);
11801 defsubr (&Sx_hide_tip
);
11803 staticpro (&tip_timer
);
11805 staticpro (&tip_frame
);
11807 last_show_tip_args
= Qnil
;
11808 staticpro (&last_show_tip_args
);
11811 defsubr (&Sx_file_dialog
);
11819 image_types
= NULL
;
11820 Vimage_types
= Qnil
;
11822 define_image_type (&xbm_type
);
11823 define_image_type (&gs_type
);
11824 define_image_type (&pbm_type
);
11827 define_image_type (&xpm_type
);
11831 define_image_type (&jpeg_type
);
11835 define_image_type (&tiff_type
);
11839 define_image_type (&gif_type
);
11843 define_image_type (&png_type
);
11847 #endif /* HAVE_X_WINDOWS */