1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999, 2000, 2001
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
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 */
125 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
127 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
130 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
131 it, and including `bitmaps/gray' more than once is a problem when
132 config.h defines `static' as an empty replacement string. */
134 int gray_bitmap_width
= gray_width
;
135 int gray_bitmap_height
= gray_height
;
136 char *gray_bitmap_bits
= gray_bits
;
138 /* The name we're using in resource queries. Most often "emacs". */
140 Lisp_Object Vx_resource_name
;
142 /* The application class we're using in resource queries.
145 Lisp_Object Vx_resource_class
;
147 /* Non-zero means we're allowed to display an hourglass cursor. */
149 int display_hourglass_p
;
151 /* The background and shape of the mouse pointer, and shape when not
152 over text or in the modeline. */
154 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
155 Lisp_Object Vx_hourglass_pointer_shape
;
157 /* The shape when over mouse-sensitive text. */
159 Lisp_Object Vx_sensitive_text_pointer_shape
;
161 /* If non-nil, the pointer shape to indicate that windows can be
162 dragged horizontally. */
164 Lisp_Object Vx_window_horizontal_drag_shape
;
166 /* Color of chars displayed in cursor box. */
168 Lisp_Object Vx_cursor_fore_pixel
;
170 /* Nonzero if using X. */
174 /* Non nil if no window manager is in use. */
176 Lisp_Object Vx_no_window_manager
;
178 /* Search path for bitmap files. */
180 Lisp_Object Vx_bitmap_file_path
;
182 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
184 Lisp_Object Vx_pixel_size_width_font_regexp
;
186 /* How to blink the cursor off. */
187 Lisp_Object Vblink_cursor_alist
;
189 Lisp_Object Qauto_raise
;
190 Lisp_Object Qauto_lower
;
191 Lisp_Object Qbar
, Qhbar
, Qbox
, Qhollow
;
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
;
225 Lisp_Object Qfullscreen
;
226 Lisp_Object Qfullwidth
;
227 Lisp_Object Qfullheight
;
228 Lisp_Object Qfullboth
;
230 /* The below are defined in frame.c. */
232 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
233 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
234 extern Lisp_Object Qtool_bar_lines
;
236 extern Lisp_Object Vwindow_system_version
;
238 Lisp_Object Qface_set_after_frame_default
;
241 int image_cache_refcount
, dpyinfo_refcount
;
246 /* Error if we are not connected to X. */
252 error ("X windows are not in use or not initialized");
255 /* Nonzero if we can use mouse menus.
256 You should not call this unless HAVE_MENUS is defined. */
264 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
265 and checking validity for X. */
268 check_x_frame (frame
)
274 frame
= selected_frame
;
275 CHECK_LIVE_FRAME (frame
);
278 error ("Non-X frame used");
282 /* Let the user specify an X display with a frame.
283 nil stands for the selected frame--or, if that is not an X frame,
284 the first X display on the list. */
286 static struct x_display_info
*
287 check_x_display_info (frame
)
290 struct x_display_info
*dpyinfo
= NULL
;
294 struct frame
*sf
= XFRAME (selected_frame
);
296 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
297 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
298 else if (x_display_list
!= 0)
299 dpyinfo
= x_display_list
;
301 error ("X windows are not in use or not initialized");
303 else if (STRINGP (frame
))
304 dpyinfo
= x_display_info_for_name (frame
);
307 FRAME_PTR f
= check_x_frame (frame
);
308 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
315 /* Return the Emacs frame-object corresponding to an X window.
316 It could be the frame's main window or an icon window. */
318 /* This function can be called during GC, so use GC_xxx type test macros. */
321 x_window_to_frame (dpyinfo
, wdesc
)
322 struct x_display_info
*dpyinfo
;
325 Lisp_Object tail
, frame
;
328 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
331 if (!GC_FRAMEP (frame
))
334 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
336 if (f
->output_data
.x
->hourglass_window
== wdesc
)
339 if ((f
->output_data
.x
->edit_widget
340 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
341 /* A tooltip frame? */
342 || (!f
->output_data
.x
->edit_widget
343 && FRAME_X_WINDOW (f
) == wdesc
)
344 || f
->output_data
.x
->icon_desc
== wdesc
)
346 #else /* not USE_X_TOOLKIT */
347 if (FRAME_X_WINDOW (f
) == wdesc
348 || f
->output_data
.x
->icon_desc
== wdesc
)
350 #endif /* not USE_X_TOOLKIT */
356 /* Like x_window_to_frame but also compares the window with the widget's
360 x_any_window_to_frame (dpyinfo
, wdesc
)
361 struct x_display_info
*dpyinfo
;
364 Lisp_Object tail
, frame
;
365 struct frame
*f
, *found
;
369 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
372 if (!GC_FRAMEP (frame
))
376 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
378 /* This frame matches if the window is any of its widgets. */
379 x
= f
->output_data
.x
;
380 if (x
->hourglass_window
== wdesc
)
384 if (wdesc
== XtWindow (x
->widget
)
385 || wdesc
== XtWindow (x
->column_widget
)
386 || wdesc
== XtWindow (x
->edit_widget
))
388 /* Match if the window is this frame's menubar. */
389 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
392 else if (FRAME_X_WINDOW (f
) == wdesc
)
393 /* A tooltip frame. */
401 /* Likewise, but exclude the menu bar widget. */
404 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
405 struct x_display_info
*dpyinfo
;
408 Lisp_Object tail
, frame
;
412 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
415 if (!GC_FRAMEP (frame
))
418 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
420 x
= f
->output_data
.x
;
421 /* This frame matches if the window is any of its widgets. */
422 if (x
->hourglass_window
== wdesc
)
426 if (wdesc
== XtWindow (x
->widget
)
427 || wdesc
== XtWindow (x
->column_widget
)
428 || wdesc
== XtWindow (x
->edit_widget
))
431 else if (FRAME_X_WINDOW (f
) == wdesc
)
432 /* A tooltip frame. */
438 /* Likewise, but consider only the menu bar widget. */
441 x_menubar_window_to_frame (dpyinfo
, wdesc
)
442 struct x_display_info
*dpyinfo
;
445 Lisp_Object tail
, frame
;
449 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
452 if (!GC_FRAMEP (frame
))
455 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
457 x
= f
->output_data
.x
;
458 /* Match if the window is this frame's menubar. */
459 if (x
->menubar_widget
460 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
466 /* Return the frame whose principal (outermost) window is WDESC.
467 If WDESC is some other (smaller) window, we return 0. */
470 x_top_window_to_frame (dpyinfo
, wdesc
)
471 struct x_display_info
*dpyinfo
;
474 Lisp_Object tail
, frame
;
478 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
481 if (!GC_FRAMEP (frame
))
484 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
486 x
= f
->output_data
.x
;
490 /* This frame matches if the window is its topmost widget. */
491 if (wdesc
== XtWindow (x
->widget
))
493 #if 0 /* I don't know why it did this,
494 but it seems logically wrong,
495 and it causes trouble for MapNotify events. */
496 /* Match if the window is this frame's menubar. */
497 if (x
->menubar_widget
498 && wdesc
== XtWindow (x
->menubar_widget
))
502 else if (FRAME_X_WINDOW (f
) == wdesc
)
508 #endif /* USE_X_TOOLKIT */
512 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
513 id, which is just an int that this section returns. Bitmaps are
514 reference counted so they can be shared among frames.
516 Bitmap indices are guaranteed to be > 0, so a negative number can
517 be used to indicate no bitmap.
519 If you use x_create_bitmap_from_data, then you must keep track of
520 the bitmaps yourself. That is, creating a bitmap from the same
521 data more than once will not be caught. */
524 /* Functions to access the contents of a bitmap, given an id. */
527 x_bitmap_height (f
, id
)
531 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
535 x_bitmap_width (f
, id
)
539 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
543 x_bitmap_pixmap (f
, id
)
547 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
551 /* Allocate a new bitmap record. Returns index of new record. */
554 x_allocate_bitmap_record (f
)
557 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
560 if (dpyinfo
->bitmaps
== NULL
)
562 dpyinfo
->bitmaps_size
= 10;
564 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
565 dpyinfo
->bitmaps_last
= 1;
569 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
570 return ++dpyinfo
->bitmaps_last
;
572 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
573 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
576 dpyinfo
->bitmaps_size
*= 2;
578 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
579 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
580 return ++dpyinfo
->bitmaps_last
;
583 /* Add one reference to the reference count of the bitmap with id ID. */
586 x_reference_bitmap (f
, id
)
590 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
593 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
596 x_create_bitmap_from_data (f
, bits
, width
, height
)
599 unsigned int width
, height
;
601 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
605 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
606 bits
, width
, height
);
611 id
= x_allocate_bitmap_record (f
);
612 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
613 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
614 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
615 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
616 dpyinfo
->bitmaps
[id
- 1].height
= height
;
617 dpyinfo
->bitmaps
[id
- 1].width
= width
;
622 /* Create bitmap from file FILE for frame F. */
625 x_create_bitmap_from_file (f
, file
)
629 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
630 unsigned int width
, height
;
632 int xhot
, yhot
, result
, id
;
637 /* Look for an existing bitmap with the same name. */
638 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
640 if (dpyinfo
->bitmaps
[id
].refcount
641 && dpyinfo
->bitmaps
[id
].file
642 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) SDATA (file
)))
644 ++dpyinfo
->bitmaps
[id
].refcount
;
649 /* Search bitmap-file-path for the file, if appropriate. */
650 fd
= openp (Vx_bitmap_file_path
, file
, Qnil
, &found
, Qnil
);
655 filename
= (char *) SDATA (found
);
657 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
658 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
659 if (result
!= BitmapSuccess
)
662 id
= x_allocate_bitmap_record (f
);
663 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
664 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
665 dpyinfo
->bitmaps
[id
- 1].file
666 = (char *) xmalloc (SBYTES (file
) + 1);
667 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
668 dpyinfo
->bitmaps
[id
- 1].height
= height
;
669 dpyinfo
->bitmaps
[id
- 1].width
= width
;
670 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, SDATA (file
));
675 /* Remove reference to bitmap with id number ID. */
678 x_destroy_bitmap (f
, id
)
682 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
686 --dpyinfo
->bitmaps
[id
- 1].refcount
;
687 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
690 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
691 if (dpyinfo
->bitmaps
[id
- 1].file
)
693 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
694 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
701 /* Free all the bitmaps for the display specified by DPYINFO. */
704 x_destroy_all_bitmaps (dpyinfo
)
705 struct x_display_info
*dpyinfo
;
708 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
709 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
711 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
712 if (dpyinfo
->bitmaps
[i
].file
)
713 xfree (dpyinfo
->bitmaps
[i
].file
);
715 dpyinfo
->bitmaps_last
= 0;
718 /* Connect the frame-parameter names for X frames
719 to the ways of passing the parameter values to the window system.
721 The name of a parameter, as a Lisp symbol,
722 has an `x-frame-parameter' property which is an integer in Lisp
723 that is an index in this table. */
725 struct x_frame_parm_table
728 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
731 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
732 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
733 static void x_change_window_heights
P_ ((Lisp_Object
, int));
734 static void x_disable_image
P_ ((struct frame
*, struct image
*));
735 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
736 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
737 static void x_set_wait_for_wm
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
738 static void x_set_fullscreen
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 static void x_set_fringe_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
751 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
756 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
759 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
760 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
761 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
762 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
764 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
766 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
771 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
772 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
774 static void init_color_table
P_ ((void));
775 static void free_color_table
P_ ((void));
776 static unsigned long *colors_in_color_table
P_ ((int *n
));
777 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
778 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
782 static struct x_frame_parm_table x_frame_parms
[] =
784 {"auto-raise", x_set_autoraise
},
785 {"auto-lower", x_set_autolower
},
786 {"background-color", x_set_background_color
},
787 {"border-color", x_set_border_color
},
788 {"border-width", x_set_border_width
},
789 {"cursor-color", x_set_cursor_color
},
790 {"cursor-type", x_set_cursor_type
},
791 {"font", x_set_font
},
792 {"foreground-color", x_set_foreground_color
},
793 {"icon-name", x_set_icon_name
},
794 {"icon-type", x_set_icon_type
},
795 {"internal-border-width", x_set_internal_border_width
},
796 {"menu-bar-lines", x_set_menu_bar_lines
},
797 {"mouse-color", x_set_mouse_color
},
798 {"name", x_explicitly_set_name
},
799 {"scroll-bar-width", x_set_scroll_bar_width
},
800 {"title", x_set_title
},
801 {"unsplittable", x_set_unsplittable
},
802 {"vertical-scroll-bars", x_set_vertical_scroll_bars
},
803 {"visibility", x_set_visibility
},
804 {"tool-bar-lines", x_set_tool_bar_lines
},
805 {"scroll-bar-foreground", x_set_scroll_bar_foreground
},
806 {"scroll-bar-background", x_set_scroll_bar_background
},
807 {"screen-gamma", x_set_screen_gamma
},
808 {"line-spacing", x_set_line_spacing
},
809 {"left-fringe", x_set_fringe_width
},
810 {"right-fringe", x_set_fringe_width
},
811 {"wait-for-wm", x_set_wait_for_wm
},
812 {"fullscreen", x_set_fullscreen
},
816 /* Attach the `x-frame-parameter' properties to
817 the Lisp symbol names of parameters relevant to X. */
820 init_x_parm_symbols ()
824 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
825 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
830 /* Really try to move where we want to be in case of fullscreen. Some WMs
831 moves the window where we tell them. Some (mwm, twm) moves the outer
832 window manager window there instead.
833 Try to compensate for those WM here. */
835 x_fullscreen_move (f
, new_top
, new_left
)
840 if (new_top
!= f
->output_data
.x
->top_pos
841 || new_left
!= f
->output_data
.x
->left_pos
)
843 int move_x
= new_left
+ f
->output_data
.x
->x_pixels_outer_diff
;
844 int move_y
= new_top
+ f
->output_data
.x
->y_pixels_outer_diff
;
846 f
->output_data
.x
->want_fullscreen
|= FULLSCREEN_MOVE_WAIT
;
847 x_set_offset (f
, move_x
, move_y
, 1);
851 /* Change the parameters of frame F as specified by ALIST.
852 If a parameter is not specially recognized, do nothing special;
853 otherwise call the `x_set_...' function for that parameter.
854 Except for certain geometry properties, always call store_frame_param
855 to store the new value in the parameter alist. */
858 x_set_frame_parameters (f
, alist
)
864 /* If both of these parameters are present, it's more efficient to
865 set them both at once. So we wait until we've looked at the
866 entire list before we set them. */
870 Lisp_Object left
, top
;
872 /* Same with these. */
873 Lisp_Object icon_left
, icon_top
;
875 /* Record in these vectors all the parms specified. */
879 int left_no_change
= 0, top_no_change
= 0;
880 int icon_left_no_change
= 0, icon_top_no_change
= 0;
881 int fullscreen_is_being_set
= 0;
883 struct gcpro gcpro1
, gcpro2
;
886 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
889 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
890 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
892 /* Extract parm names and values into those vectors. */
895 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
900 parms
[i
] = Fcar (elt
);
901 values
[i
] = Fcdr (elt
);
904 /* TAIL and ALIST are not used again below here. */
907 GCPRO2 (*parms
, *values
);
911 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
912 because their values appear in VALUES and strings are not valid. */
913 top
= left
= Qunbound
;
914 icon_left
= icon_top
= Qunbound
;
916 /* Provide default values for HEIGHT and WIDTH. */
917 if (FRAME_NEW_WIDTH (f
))
918 width
= FRAME_NEW_WIDTH (f
);
920 width
= FRAME_WIDTH (f
);
922 if (FRAME_NEW_HEIGHT (f
))
923 height
= FRAME_NEW_HEIGHT (f
);
925 height
= FRAME_HEIGHT (f
);
927 /* Process foreground_color and background_color before anything else.
928 They are independent of other properties, but other properties (e.g.,
929 cursor_color) are dependent upon them. */
930 /* Process default font as well, since fringe widths depends on it. */
931 /* Also, process fullscreen, width and height depend upon that */
932 for (p
= 0; p
< i
; p
++)
934 Lisp_Object prop
, val
;
938 if (EQ (prop
, Qforeground_color
)
939 || EQ (prop
, Qbackground_color
)
941 || EQ (prop
, Qfullscreen
))
943 register Lisp_Object param_index
, old_value
;
945 old_value
= get_frame_param (f
, prop
);
946 fullscreen_is_being_set
|= EQ (prop
, Qfullscreen
);
948 if (NILP (Fequal (val
, old_value
)))
950 store_frame_param (f
, prop
, val
);
952 param_index
= Fget (prop
, Qx_frame_parameter
);
953 if (NATNUMP (param_index
)
954 && (XFASTINT (param_index
)
955 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
956 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
961 /* Now process them in reverse of specified order. */
962 for (i
--; i
>= 0; i
--)
964 Lisp_Object prop
, val
;
969 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
970 width
= XFASTINT (val
);
971 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
972 height
= XFASTINT (val
);
973 else if (EQ (prop
, Qtop
))
975 else if (EQ (prop
, Qleft
))
977 else if (EQ (prop
, Qicon_top
))
979 else if (EQ (prop
, Qicon_left
))
981 else if (EQ (prop
, Qforeground_color
)
982 || EQ (prop
, Qbackground_color
)
984 || EQ (prop
, Qfullscreen
))
985 /* Processed above. */
989 register Lisp_Object param_index
, old_value
;
991 old_value
= get_frame_param (f
, prop
);
993 store_frame_param (f
, prop
, val
);
995 param_index
= Fget (prop
, Qx_frame_parameter
);
996 if (NATNUMP (param_index
)
997 && (XFASTINT (param_index
)
998 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
999 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
1003 /* Don't die if just one of these was set. */
1004 if (EQ (left
, Qunbound
))
1007 if (f
->output_data
.x
->left_pos
< 0)
1008 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
1010 XSETINT (left
, f
->output_data
.x
->left_pos
);
1012 if (EQ (top
, Qunbound
))
1015 if (f
->output_data
.x
->top_pos
< 0)
1016 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
1018 XSETINT (top
, f
->output_data
.x
->top_pos
);
1021 /* If one of the icon positions was not set, preserve or default it. */
1022 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
1024 icon_left_no_change
= 1;
1025 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
1026 if (NILP (icon_left
))
1027 XSETINT (icon_left
, 0);
1029 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
1031 icon_top_no_change
= 1;
1032 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
1033 if (NILP (icon_top
))
1034 XSETINT (icon_top
, 0);
1037 if (FRAME_VISIBLE_P (f
) && fullscreen_is_being_set
)
1039 /* If the frame is visible already and the fullscreen parameter is
1040 being set, it is too late to set WM manager hints to specify
1042 Here we first get the width, height and position that applies to
1043 fullscreen. We then move the frame to the appropriate
1044 position. Resize of the frame is taken care of in the code after
1045 this if-statement. */
1046 int new_left
, new_top
;
1048 x_fullscreen_adjust (f
, &width
, &height
, &new_top
, &new_left
);
1049 x_fullscreen_move (f
, new_top
, new_left
);
1052 /* Don't set these parameters unless they've been explicitly
1053 specified. The window might be mapped or resized while we're in
1054 this function, and we don't want to override that unless the lisp
1055 code has asked for it.
1057 Don't set these parameters unless they actually differ from the
1058 window's current parameters; the window may not actually exist
1063 check_frame_size (f
, &height
, &width
);
1065 XSETFRAME (frame
, f
);
1067 if (width
!= FRAME_WIDTH (f
)
1068 || height
!= FRAME_HEIGHT (f
)
1069 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1070 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1072 if ((!NILP (left
) || !NILP (top
))
1073 && ! (left_no_change
&& top_no_change
)
1074 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1075 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1080 /* Record the signs. */
1081 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1082 if (EQ (left
, Qminus
))
1083 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1084 else if (INTEGERP (left
))
1086 leftpos
= XINT (left
);
1088 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1090 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1091 && CONSP (XCDR (left
))
1092 && INTEGERP (XCAR (XCDR (left
))))
1094 leftpos
= - XINT (XCAR (XCDR (left
)));
1095 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1097 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1098 && CONSP (XCDR (left
))
1099 && INTEGERP (XCAR (XCDR (left
))))
1101 leftpos
= XINT (XCAR (XCDR (left
)));
1104 if (EQ (top
, Qminus
))
1105 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1106 else if (INTEGERP (top
))
1108 toppos
= XINT (top
);
1110 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1112 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1113 && CONSP (XCDR (top
))
1114 && INTEGERP (XCAR (XCDR (top
))))
1116 toppos
= - XINT (XCAR (XCDR (top
)));
1117 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1119 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1120 && CONSP (XCDR (top
))
1121 && INTEGERP (XCAR (XCDR (top
))))
1123 toppos
= XINT (XCAR (XCDR (top
)));
1127 /* Store the numeric value of the position. */
1128 f
->output_data
.x
->top_pos
= toppos
;
1129 f
->output_data
.x
->left_pos
= leftpos
;
1131 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1133 /* Actually set that position, and convert to absolute. */
1134 x_set_offset (f
, leftpos
, toppos
, -1);
1137 if ((!NILP (icon_left
) || !NILP (icon_top
))
1138 && ! (icon_left_no_change
&& icon_top_no_change
))
1139 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1145 /* Store the screen positions of frame F into XPTR and YPTR.
1146 These are the positions of the containing window manager window,
1147 not Emacs's own window. */
1150 x_real_positions (f
, xptr
, yptr
)
1154 int win_x
, win_y
, outer_x
, outer_y
;
1155 int real_x
= 0, real_y
= 0;
1157 Window win
= f
->output_data
.x
->parent_desc
;
1163 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1165 if (win
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1166 win
= FRAME_OUTER_WINDOW (f
);
1168 /* This loop traverses up the containment tree until we hit the root
1169 window. Window managers may intersect many windows between our window
1170 and the root window. The window we find just before the root window
1171 should be the outer WM window. */
1174 Window wm_window
, rootw
;
1175 Window
*tmp_children
;
1176 unsigned int tmp_nchildren
;
1179 success
= XQueryTree (FRAME_X_DISPLAY (f
), win
, &rootw
,
1180 &wm_window
, &tmp_children
, &tmp_nchildren
);
1182 had_errors
= x_had_errors_p (FRAME_X_DISPLAY (f
));
1184 /* Don't free tmp_children if XQueryTree failed. */
1188 XFree ((char *) tmp_children
);
1190 if (wm_window
== rootw
|| had_errors
)
1199 Window child
, rootw
;
1201 /* Get the real coordinates for the WM window upper left corner */
1202 XGetGeometry (FRAME_X_DISPLAY (f
), win
,
1203 &rootw
, &real_x
, &real_y
, &ign
, &ign
, &ign
, &ign
);
1205 /* Translate real coordinates to coordinates relative to our
1206 window. For our window, the upper left corner is 0, 0.
1207 Since the upper left corner of the WM window is outside
1208 our window, win_x and win_y will be negative:
1210 ------------------ ---> x
1212 | ----------------- v y
1215 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1217 /* From-window, to-window. */
1218 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1221 /* From-position, to-position. */
1222 real_x
, real_y
, &win_x
, &win_y
,
1227 if (FRAME_X_WINDOW (f
) == FRAME_OUTER_WINDOW (f
))
1234 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1236 /* From-window, to-window. */
1237 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1238 FRAME_OUTER_WINDOW (f
),
1240 /* From-position, to-position. */
1241 real_x
, real_y
, &outer_x
, &outer_y
,
1247 had_errors
= x_had_errors_p (FRAME_X_DISPLAY (f
));
1250 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1254 if (had_errors
) return;
1256 f
->output_data
.x
->x_pixels_diff
= -win_x
;
1257 f
->output_data
.x
->y_pixels_diff
= -win_y
;
1258 f
->output_data
.x
->x_pixels_outer_diff
= -outer_x
;
1259 f
->output_data
.x
->y_pixels_outer_diff
= -outer_y
;
1265 /* Insert a description of internally-recorded parameters of frame X
1266 into the parameter alist *ALISTPTR that is to be given to the user.
1267 Only parameters that are specific to the X window system
1268 and whose values are not correctly recorded in the frame's
1269 param_alist need to be considered here. */
1272 x_report_frame_params (f
, alistptr
)
1274 Lisp_Object
*alistptr
;
1279 /* Represent negative positions (off the top or left screen edge)
1280 in a way that Fmodify_frame_parameters will understand correctly. */
1281 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1282 if (f
->output_data
.x
->left_pos
>= 0)
1283 store_in_alist (alistptr
, Qleft
, tem
);
1285 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1287 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1288 if (f
->output_data
.x
->top_pos
>= 0)
1289 store_in_alist (alistptr
, Qtop
, tem
);
1291 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1293 store_in_alist (alistptr
, Qborder_width
,
1294 make_number (f
->output_data
.x
->border_width
));
1295 store_in_alist (alistptr
, Qinternal_border_width
,
1296 make_number (f
->output_data
.x
->internal_border_width
));
1297 store_in_alist (alistptr
, Qleft_fringe
,
1298 make_number (f
->output_data
.x
->left_fringe_width
));
1299 store_in_alist (alistptr
, Qright_fringe
,
1300 make_number (f
->output_data
.x
->right_fringe_width
));
1301 store_in_alist (alistptr
, Qscroll_bar_width
,
1302 make_number (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1303 ? FRAME_SCROLL_BAR_PIXEL_WIDTH(f
)
1305 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1306 store_in_alist (alistptr
, Qwindow_id
,
1307 build_string (buf
));
1308 #ifdef USE_X_TOOLKIT
1309 /* Tooltip frame may not have this widget. */
1310 if (f
->output_data
.x
->widget
)
1312 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1313 store_in_alist (alistptr
, Qouter_window_id
,
1314 build_string (buf
));
1315 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1316 FRAME_SAMPLE_VISIBILITY (f
);
1317 store_in_alist (alistptr
, Qvisibility
,
1318 (FRAME_VISIBLE_P (f
) ? Qt
1319 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1320 store_in_alist (alistptr
, Qdisplay
,
1321 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1323 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1326 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1327 store_in_alist (alistptr
, Qparent_id
, tem
);
1332 /* Gamma-correct COLOR on frame F. */
1335 gamma_correct (f
, color
)
1341 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1342 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1343 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1348 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1349 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1350 allocate the color. Value is zero if COLOR_NAME is invalid, or
1351 no color could be allocated. */
1354 x_defined_color (f
, color_name
, color
, alloc_p
)
1361 Display
*dpy
= FRAME_X_DISPLAY (f
);
1362 Colormap cmap
= FRAME_X_COLORMAP (f
);
1365 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1366 if (success_p
&& alloc_p
)
1367 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1374 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1375 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1376 Signal an error if color can't be allocated. */
1379 x_decode_color (f
, color_name
, mono_color
)
1381 Lisp_Object color_name
;
1386 CHECK_STRING (color_name
);
1388 #if 0 /* Don't do this. It's wrong when we're not using the default
1389 colormap, it makes freeing difficult, and it's probably not
1390 an important optimization. */
1391 if (strcmp (SDATA (color_name
), "black") == 0)
1392 return BLACK_PIX_DEFAULT (f
);
1393 else if (strcmp (SDATA (color_name
), "white") == 0)
1394 return WHITE_PIX_DEFAULT (f
);
1397 /* Return MONO_COLOR for monochrome frames. */
1398 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1401 /* x_defined_color is responsible for coping with failures
1402 by looking for a near-miss. */
1403 if (x_defined_color (f
, SDATA (color_name
), &cdef
, 1))
1406 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1407 Fcons (color_name
, Qnil
)));
1413 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1414 the previous value of that parameter, NEW_VALUE is the new value. */
1417 x_set_line_spacing (f
, new_value
, old_value
)
1419 Lisp_Object new_value
, old_value
;
1421 if (NILP (new_value
))
1422 f
->extra_line_spacing
= 0;
1423 else if (NATNUMP (new_value
))
1424 f
->extra_line_spacing
= XFASTINT (new_value
);
1426 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1427 Fcons (new_value
, Qnil
)));
1428 if (FRAME_VISIBLE_P (f
))
1433 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1434 the previous value of that parameter, NEW_VALUE is the new value.
1435 See also the comment of wait_for_wm in struct x_output. */
1438 x_set_wait_for_wm (f
, new_value
, old_value
)
1440 Lisp_Object new_value
, old_value
;
1442 f
->output_data
.x
->wait_for_wm
= !NILP (new_value
);
1446 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
1447 the previous value of that parameter, NEW_VALUE is the new value. */
1450 x_set_fullscreen (f
, new_value
, old_value
)
1452 Lisp_Object new_value
, old_value
;
1454 if (NILP (new_value
))
1455 f
->output_data
.x
->want_fullscreen
= FULLSCREEN_NONE
;
1456 else if (EQ (new_value
, Qfullboth
))
1457 f
->output_data
.x
->want_fullscreen
= FULLSCREEN_BOTH
;
1458 else if (EQ (new_value
, Qfullwidth
))
1459 f
->output_data
.x
->want_fullscreen
= FULLSCREEN_WIDTH
;
1460 else if (EQ (new_value
, Qfullheight
))
1461 f
->output_data
.x
->want_fullscreen
= FULLSCREEN_HEIGHT
;
1465 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1466 the previous value of that parameter, NEW_VALUE is the new
1470 x_set_screen_gamma (f
, new_value
, old_value
)
1472 Lisp_Object new_value
, old_value
;
1474 if (NILP (new_value
))
1476 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1477 /* The value 0.4545 is the normal viewing gamma. */
1478 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1480 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1481 Fcons (new_value
, Qnil
)));
1483 clear_face_cache (0);
1487 /* Functions called only from `x_set_frame_param'
1488 to set individual parameters.
1490 If FRAME_X_WINDOW (f) is 0,
1491 the frame is being created and its X-window does not exist yet.
1492 In that case, just record the parameter's new value
1493 in the standard place; do not attempt to change the window. */
1496 x_set_foreground_color (f
, arg
, oldval
)
1498 Lisp_Object arg
, oldval
;
1500 struct x_output
*x
= f
->output_data
.x
;
1501 unsigned long fg
, old_fg
;
1503 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1504 old_fg
= x
->foreground_pixel
;
1505 x
->foreground_pixel
= fg
;
1507 if (FRAME_X_WINDOW (f
) != 0)
1509 Display
*dpy
= FRAME_X_DISPLAY (f
);
1512 XSetForeground (dpy
, x
->normal_gc
, fg
);
1513 XSetBackground (dpy
, x
->reverse_gc
, fg
);
1515 if (x
->cursor_pixel
== old_fg
)
1517 unload_color (f
, x
->cursor_pixel
);
1518 x
->cursor_pixel
= x_copy_color (f
, fg
);
1519 XSetBackground (dpy
, x
->cursor_gc
, x
->cursor_pixel
);
1524 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1526 if (FRAME_VISIBLE_P (f
))
1530 unload_color (f
, old_fg
);
1534 x_set_background_color (f
, arg
, oldval
)
1536 Lisp_Object arg
, oldval
;
1538 struct x_output
*x
= f
->output_data
.x
;
1541 bg
= x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1542 unload_color (f
, x
->background_pixel
);
1543 x
->background_pixel
= bg
;
1545 if (FRAME_X_WINDOW (f
) != 0)
1547 Display
*dpy
= FRAME_X_DISPLAY (f
);
1550 XSetBackground (dpy
, x
->normal_gc
, bg
);
1551 XSetForeground (dpy
, x
->reverse_gc
, bg
);
1552 XSetWindowBackground (dpy
, FRAME_X_WINDOW (f
), bg
);
1553 XSetForeground (dpy
, x
->cursor_gc
, bg
);
1555 #ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1556 toolkit scroll bars. */
1559 for (bar
= FRAME_SCROLL_BARS (f
);
1561 bar
= XSCROLL_BAR (bar
)->next
)
1563 Window window
= SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
));
1564 XSetWindowBackground (dpy
, window
, bg
);
1567 #endif /* USE_TOOLKIT_SCROLL_BARS */
1570 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1572 if (FRAME_VISIBLE_P (f
))
1578 x_set_mouse_color (f
, arg
, oldval
)
1580 Lisp_Object arg
, oldval
;
1582 struct x_output
*x
= f
->output_data
.x
;
1583 Display
*dpy
= FRAME_X_DISPLAY (f
);
1584 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1585 Cursor hourglass_cursor
, horizontal_drag_cursor
;
1587 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1588 unsigned long mask_color
= x
->background_pixel
;
1590 /* Don't let pointers be invisible. */
1591 if (mask_color
== pixel
)
1593 x_free_colors (f
, &pixel
, 1);
1594 pixel
= x_copy_color (f
, x
->foreground_pixel
);
1597 unload_color (f
, x
->mouse_pixel
);
1598 x
->mouse_pixel
= pixel
;
1602 /* It's not okay to crash if the user selects a screwy cursor. */
1603 count
= x_catch_errors (dpy
);
1605 if (!NILP (Vx_pointer_shape
))
1607 CHECK_NUMBER (Vx_pointer_shape
);
1608 cursor
= XCreateFontCursor (dpy
, XINT (Vx_pointer_shape
));
1611 cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1612 x_check_errors (dpy
, "bad text pointer cursor: %s");
1614 if (!NILP (Vx_nontext_pointer_shape
))
1616 CHECK_NUMBER (Vx_nontext_pointer_shape
);
1618 = XCreateFontCursor (dpy
, XINT (Vx_nontext_pointer_shape
));
1621 nontext_cursor
= XCreateFontCursor (dpy
, XC_left_ptr
);
1622 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1624 if (!NILP (Vx_hourglass_pointer_shape
))
1626 CHECK_NUMBER (Vx_hourglass_pointer_shape
);
1628 = XCreateFontCursor (dpy
, XINT (Vx_hourglass_pointer_shape
));
1631 hourglass_cursor
= XCreateFontCursor (dpy
, XC_watch
);
1632 x_check_errors (dpy
, "bad hourglass pointer cursor: %s");
1634 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1635 if (!NILP (Vx_mode_pointer_shape
))
1637 CHECK_NUMBER (Vx_mode_pointer_shape
);
1638 mode_cursor
= XCreateFontCursor (dpy
, XINT (Vx_mode_pointer_shape
));
1641 mode_cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1642 x_check_errors (dpy
, "bad modeline pointer cursor: %s");
1644 if (!NILP (Vx_sensitive_text_pointer_shape
))
1646 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
);
1648 = XCreateFontCursor (dpy
, XINT (Vx_sensitive_text_pointer_shape
));
1651 cross_cursor
= XCreateFontCursor (dpy
, XC_hand2
);
1653 if (!NILP (Vx_window_horizontal_drag_shape
))
1655 CHECK_NUMBER (Vx_window_horizontal_drag_shape
);
1656 horizontal_drag_cursor
1657 = XCreateFontCursor (dpy
, XINT (Vx_window_horizontal_drag_shape
));
1660 horizontal_drag_cursor
1661 = XCreateFontCursor (dpy
, XC_sb_h_double_arrow
);
1663 /* Check and report errors with the above calls. */
1664 x_check_errors (dpy
, "can't set cursor shape: %s");
1665 x_uncatch_errors (dpy
, count
);
1668 XColor fore_color
, back_color
;
1670 fore_color
.pixel
= x
->mouse_pixel
;
1671 x_query_color (f
, &fore_color
);
1672 back_color
.pixel
= mask_color
;
1673 x_query_color (f
, &back_color
);
1675 XRecolorCursor (dpy
, cursor
, &fore_color
, &back_color
);
1676 XRecolorCursor (dpy
, nontext_cursor
, &fore_color
, &back_color
);
1677 XRecolorCursor (dpy
, mode_cursor
, &fore_color
, &back_color
);
1678 XRecolorCursor (dpy
, cross_cursor
, &fore_color
, &back_color
);
1679 XRecolorCursor (dpy
, hourglass_cursor
, &fore_color
, &back_color
);
1680 XRecolorCursor (dpy
, horizontal_drag_cursor
, &fore_color
, &back_color
);
1683 if (FRAME_X_WINDOW (f
) != 0)
1684 XDefineCursor (dpy
, FRAME_X_WINDOW (f
), cursor
);
1686 if (cursor
!= x
->text_cursor
1687 && x
->text_cursor
!= 0)
1688 XFreeCursor (dpy
, x
->text_cursor
);
1689 x
->text_cursor
= cursor
;
1691 if (nontext_cursor
!= x
->nontext_cursor
1692 && x
->nontext_cursor
!= 0)
1693 XFreeCursor (dpy
, x
->nontext_cursor
);
1694 x
->nontext_cursor
= nontext_cursor
;
1696 if (hourglass_cursor
!= x
->hourglass_cursor
1697 && x
->hourglass_cursor
!= 0)
1698 XFreeCursor (dpy
, x
->hourglass_cursor
);
1699 x
->hourglass_cursor
= hourglass_cursor
;
1701 if (mode_cursor
!= x
->modeline_cursor
1702 && x
->modeline_cursor
!= 0)
1703 XFreeCursor (dpy
, f
->output_data
.x
->modeline_cursor
);
1704 x
->modeline_cursor
= mode_cursor
;
1706 if (cross_cursor
!= x
->cross_cursor
1707 && x
->cross_cursor
!= 0)
1708 XFreeCursor (dpy
, x
->cross_cursor
);
1709 x
->cross_cursor
= cross_cursor
;
1711 if (horizontal_drag_cursor
!= x
->horizontal_drag_cursor
1712 && x
->horizontal_drag_cursor
!= 0)
1713 XFreeCursor (dpy
, x
->horizontal_drag_cursor
);
1714 x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1719 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1723 x_set_cursor_color (f
, arg
, oldval
)
1725 Lisp_Object arg
, oldval
;
1727 unsigned long fore_pixel
, pixel
;
1728 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1729 struct x_output
*x
= f
->output_data
.x
;
1731 if (!NILP (Vx_cursor_fore_pixel
))
1733 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1734 WHITE_PIX_DEFAULT (f
));
1735 fore_pixel_allocated_p
= 1;
1738 fore_pixel
= x
->background_pixel
;
1740 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1741 pixel_allocated_p
= 1;
1743 /* Make sure that the cursor color differs from the background color. */
1744 if (pixel
== x
->background_pixel
)
1746 if (pixel_allocated_p
)
1748 x_free_colors (f
, &pixel
, 1);
1749 pixel_allocated_p
= 0;
1752 pixel
= x
->mouse_pixel
;
1753 if (pixel
== fore_pixel
)
1755 if (fore_pixel_allocated_p
)
1757 x_free_colors (f
, &fore_pixel
, 1);
1758 fore_pixel_allocated_p
= 0;
1760 fore_pixel
= x
->background_pixel
;
1764 unload_color (f
, x
->cursor_foreground_pixel
);
1765 if (!fore_pixel_allocated_p
)
1766 fore_pixel
= x_copy_color (f
, fore_pixel
);
1767 x
->cursor_foreground_pixel
= fore_pixel
;
1769 unload_color (f
, x
->cursor_pixel
);
1770 if (!pixel_allocated_p
)
1771 pixel
= x_copy_color (f
, pixel
);
1772 x
->cursor_pixel
= pixel
;
1774 if (FRAME_X_WINDOW (f
) != 0)
1777 XSetBackground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, x
->cursor_pixel
);
1778 XSetForeground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, fore_pixel
);
1781 if (FRAME_VISIBLE_P (f
))
1783 x_update_cursor (f
, 0);
1784 x_update_cursor (f
, 1);
1788 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1791 /* Set the border-color of frame F to value described by ARG.
1792 ARG can be a string naming a color.
1793 The border-color is used for the border that is drawn by the X server.
1794 Note that this does not fully take effect if done before
1795 F has an x-window; it must be redone when the window is created.
1797 Note: this is done in two routines because of the way X10 works.
1799 Note: under X11, this is normally the province of the window manager,
1800 and so emacs' border colors may be overridden. */
1803 x_set_border_color (f
, arg
, oldval
)
1805 Lisp_Object arg
, oldval
;
1810 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1811 x_set_border_pixel (f
, pix
);
1812 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1815 /* Set the border-color of frame F to pixel value PIX.
1816 Note that this does not fully take effect if done before
1817 F has an x-window. */
1820 x_set_border_pixel (f
, pix
)
1824 unload_color (f
, f
->output_data
.x
->border_pixel
);
1825 f
->output_data
.x
->border_pixel
= pix
;
1827 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1830 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1831 (unsigned long)pix
);
1834 if (FRAME_VISIBLE_P (f
))
1840 /* Value is the internal representation of the specified cursor type
1841 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1842 of the bar cursor. */
1844 enum text_cursor_kinds
1845 x_specified_cursor_type (arg
, width
)
1849 enum text_cursor_kinds type
;
1856 else if (CONSP (arg
)
1857 && EQ (XCAR (arg
), Qbar
)
1858 && INTEGERP (XCDR (arg
))
1859 && XINT (XCDR (arg
)) >= 0)
1862 *width
= XINT (XCDR (arg
));
1864 else if (EQ (arg
, Qhbar
))
1869 else if (CONSP (arg
)
1870 && EQ (XCAR (arg
), Qhbar
)
1871 && INTEGERP (XCDR (arg
))
1872 && XINT (XCDR (arg
)) >= 0)
1875 *width
= XINT (XCDR (arg
));
1877 else if (NILP (arg
))
1879 else if (EQ (arg
, Qbox
))
1880 type
= FILLED_BOX_CURSOR
;
1882 /* Treat anything unknown as "hollow box cursor".
1883 It was bad to signal an error; people have trouble fixing
1884 .Xdefaults with Emacs, when it has something bad in it. */
1885 type
= HOLLOW_BOX_CURSOR
;
1891 x_set_cursor_type (f
, arg
, oldval
)
1893 Lisp_Object arg
, oldval
;
1898 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1899 f
->output_data
.x
->cursor_width
= width
;
1901 /* Make sure the cursor gets redrawn. */
1902 cursor_type_changed
= 1;
1904 /* By default, set up the blink-off state depending on the on-state. */
1906 if (FRAME_DESIRED_CURSOR (f
) == FILLED_BOX_CURSOR
)
1907 FRAME_BLINK_OFF_CURSOR (f
) = HOLLOW_BOX_CURSOR
;
1908 else if (FRAME_DESIRED_CURSOR (f
) == BAR_CURSOR
&& FRAME_CURSOR_WIDTH (f
) > 1)
1910 FRAME_BLINK_OFF_CURSOR (f
) = BAR_CURSOR
;
1911 FRAME_BLINK_OFF_CURSOR_WIDTH (f
) = 1;
1914 FRAME_BLINK_OFF_CURSOR (f
) = NO_CURSOR
;
1916 tem
= Fassoc (arg
, Vblink_cursor_alist
);
1919 FRAME_BLINK_OFF_CURSOR (f
)
1920 = x_specified_cursor_type (XCDR (tem
), &width
);
1921 f
->output_data
.x
->blink_off_cursor_width
= width
;
1926 x_set_icon_type (f
, arg
, oldval
)
1928 Lisp_Object arg
, oldval
;
1934 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1937 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1942 result
= x_text_icon (f
,
1943 (char *) SDATA ((!NILP (f
->icon_name
)
1947 result
= x_bitmap_icon (f
, arg
);
1952 error ("No icon window available");
1955 XFlush (FRAME_X_DISPLAY (f
));
1959 /* Return non-nil if frame F wants a bitmap icon. */
1967 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1975 x_set_icon_name (f
, arg
, oldval
)
1977 Lisp_Object arg
, oldval
;
1983 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1986 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1991 if (f
->output_data
.x
->icon_bitmap
!= 0)
1996 result
= x_text_icon (f
,
1997 (char *) SDATA ((!NILP (f
->icon_name
)
2006 error ("No icon window available");
2009 XFlush (FRAME_X_DISPLAY (f
));
2014 x_set_font (f
, arg
, oldval
)
2016 Lisp_Object arg
, oldval
;
2019 Lisp_Object fontset_name
;
2021 int old_fontset
= f
->output_data
.x
->fontset
;
2025 fontset_name
= Fquery_fontset (arg
, Qnil
);
2028 result
= (STRINGP (fontset_name
)
2029 ? x_new_fontset (f
, SDATA (fontset_name
))
2030 : x_new_font (f
, SDATA (arg
)));
2033 if (EQ (result
, Qnil
))
2034 error ("Font `%s' is not defined", SDATA (arg
));
2035 else if (EQ (result
, Qt
))
2036 error ("The characters of the given font have varying widths");
2037 else if (STRINGP (result
))
2039 if (STRINGP (fontset_name
))
2041 /* Fontset names are built from ASCII font names, so the
2042 names may be equal despite there was a change. */
2043 if (old_fontset
== f
->output_data
.x
->fontset
)
2046 else if (!NILP (Fequal (result
, oldval
)))
2049 store_frame_param (f
, Qfont
, result
);
2050 recompute_basic_faces (f
);
2055 do_pending_window_change (0);
2057 /* Don't call `face-set-after-frame-default' when faces haven't been
2058 initialized yet. This is the case when called from
2059 Fx_create_frame. In that case, the X widget or window doesn't
2060 exist either, and we can end up in x_report_frame_params with a
2061 null widget which gives a segfault. */
2062 if (FRAME_FACE_CACHE (f
))
2064 XSETFRAME (frame
, f
);
2065 call1 (Qface_set_after_frame_default
, frame
);
2070 x_set_fringe_width (f
, new_value
, old_value
)
2072 Lisp_Object new_value
, old_value
;
2074 x_compute_fringe_widths (f
, 1);
2078 x_set_border_width (f
, arg
, oldval
)
2080 Lisp_Object arg
, oldval
;
2084 if (XINT (arg
) == f
->output_data
.x
->border_width
)
2087 if (FRAME_X_WINDOW (f
) != 0)
2088 error ("Cannot change the border width of a window");
2090 f
->output_data
.x
->border_width
= XINT (arg
);
2094 x_set_internal_border_width (f
, arg
, oldval
)
2096 Lisp_Object arg
, oldval
;
2098 int old
= f
->output_data
.x
->internal_border_width
;
2101 f
->output_data
.x
->internal_border_width
= XINT (arg
);
2102 if (f
->output_data
.x
->internal_border_width
< 0)
2103 f
->output_data
.x
->internal_border_width
= 0;
2105 #ifdef USE_X_TOOLKIT
2106 if (f
->output_data
.x
->edit_widget
)
2107 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
2110 if (f
->output_data
.x
->internal_border_width
== old
)
2113 if (FRAME_X_WINDOW (f
) != 0)
2115 x_set_window_size (f
, 0, f
->width
, f
->height
);
2116 SET_FRAME_GARBAGED (f
);
2117 do_pending_window_change (0);
2120 SET_FRAME_GARBAGED (f
);
2124 x_set_visibility (f
, value
, oldval
)
2126 Lisp_Object value
, oldval
;
2129 XSETFRAME (frame
, f
);
2132 Fmake_frame_invisible (frame
, Qt
);
2133 else if (EQ (value
, Qicon
))
2134 Ficonify_frame (frame
);
2136 Fmake_frame_visible (frame
);
2140 /* Change window heights in windows rooted in WINDOW by N lines. */
2143 x_change_window_heights (window
, n
)
2147 struct window
*w
= XWINDOW (window
);
2149 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
2150 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
2152 if (INTEGERP (w
->orig_top
))
2153 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
2154 if (INTEGERP (w
->orig_height
))
2155 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
2157 /* Handle just the top child in a vertical split. */
2158 if (!NILP (w
->vchild
))
2159 x_change_window_heights (w
->vchild
, n
);
2161 /* Adjust all children in a horizontal split. */
2162 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
2164 w
= XWINDOW (window
);
2165 x_change_window_heights (window
, n
);
2170 x_set_menu_bar_lines (f
, value
, oldval
)
2172 Lisp_Object value
, oldval
;
2175 #ifndef USE_X_TOOLKIT
2176 int olines
= FRAME_MENU_BAR_LINES (f
);
2179 /* Right now, menu bars don't work properly in minibuf-only frames;
2180 most of the commands try to apply themselves to the minibuffer
2181 frame itself, and get an error because you can't switch buffers
2182 in or split the minibuffer window. */
2183 if (FRAME_MINIBUF_ONLY_P (f
))
2186 if (INTEGERP (value
))
2187 nlines
= XINT (value
);
2191 /* Make sure we redisplay all windows in this frame. */
2192 windows_or_buffers_changed
++;
2194 #ifdef USE_X_TOOLKIT
2195 FRAME_MENU_BAR_LINES (f
) = 0;
2198 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2199 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
2200 /* Make sure next redisplay shows the menu bar. */
2201 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2205 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2206 free_frame_menubar (f
);
2207 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2209 f
->output_data
.x
->menubar_widget
= 0;
2211 #else /* not USE_X_TOOLKIT */
2212 FRAME_MENU_BAR_LINES (f
) = nlines
;
2213 x_change_window_heights (f
->root_window
, nlines
- olines
);
2214 #endif /* not USE_X_TOOLKIT */
2219 /* Set the number of lines used for the tool bar of frame F to VALUE.
2220 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2221 is the old number of tool bar lines. This function changes the
2222 height of all windows on frame F to match the new tool bar height.
2223 The frame's height doesn't change. */
2226 x_set_tool_bar_lines (f
, value
, oldval
)
2228 Lisp_Object value
, oldval
;
2230 int delta
, nlines
, root_height
;
2231 Lisp_Object root_window
;
2233 /* Treat tool bars like menu bars. */
2234 if (FRAME_MINIBUF_ONLY_P (f
))
2237 /* Use VALUE only if an integer >= 0. */
2238 if (INTEGERP (value
) && XINT (value
) >= 0)
2239 nlines
= XFASTINT (value
);
2243 /* Make sure we redisplay all windows in this frame. */
2244 ++windows_or_buffers_changed
;
2246 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2248 /* Don't resize the tool-bar to more than we have room for. */
2249 root_window
= FRAME_ROOT_WINDOW (f
);
2250 root_height
= XINT (XWINDOW (root_window
)->height
);
2251 if (root_height
- delta
< 1)
2253 delta
= root_height
- 1;
2254 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2257 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2258 x_change_window_heights (root_window
, delta
);
2261 /* We also have to make sure that the internal border at the top of
2262 the frame, below the menu bar or tool bar, is redrawn when the
2263 tool bar disappears. This is so because the internal border is
2264 below the tool bar if one is displayed, but is below the menu bar
2265 if there isn't a tool bar. The tool bar draws into the area
2266 below the menu bar. */
2267 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2271 clear_current_matrices (f
);
2272 updating_frame
= NULL
;
2275 /* If the tool bar gets smaller, the internal border below it
2276 has to be cleared. It was formerly part of the display
2277 of the larger tool bar, and updating windows won't clear it. */
2280 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2281 int width
= PIXEL_WIDTH (f
);
2282 int y
= nlines
* CANON_Y_UNIT (f
);
2285 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2286 0, y
, width
, height
, False
);
2289 if (WINDOWP (f
->tool_bar_window
))
2290 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2295 /* Set the foreground color for scroll bars on frame F to VALUE.
2296 VALUE should be a string, a color name. If it isn't a string or
2297 isn't a valid color name, do nothing. OLDVAL is the old value of
2298 the frame parameter. */
2301 x_set_scroll_bar_foreground (f
, value
, oldval
)
2303 Lisp_Object value
, oldval
;
2305 unsigned long pixel
;
2307 if (STRINGP (value
))
2308 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2312 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2313 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2315 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2316 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2318 /* Remove all scroll bars because they have wrong colors. */
2319 if (condemn_scroll_bars_hook
)
2320 (*condemn_scroll_bars_hook
) (f
);
2321 if (judge_scroll_bars_hook
)
2322 (*judge_scroll_bars_hook
) (f
);
2324 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2330 /* Set the background color for scroll bars on frame F to VALUE VALUE
2331 should be a string, a color name. If it isn't a string or isn't a
2332 valid color name, do nothing. OLDVAL is the old value of the frame
2336 x_set_scroll_bar_background (f
, value
, oldval
)
2338 Lisp_Object value
, oldval
;
2340 unsigned long pixel
;
2342 if (STRINGP (value
))
2343 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2347 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2348 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2350 #ifdef USE_TOOLKIT_SCROLL_BARS
2351 /* Scrollbar shadow colors. */
2352 if (f
->output_data
.x
->scroll_bar_top_shadow_pixel
!= -1)
2354 unload_color (f
, f
->output_data
.x
->scroll_bar_top_shadow_pixel
);
2355 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
2357 if (f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
!= -1)
2359 unload_color (f
, f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
);
2360 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
2362 #endif /* USE_TOOLKIT_SCROLL_BARS */
2364 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2365 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2367 /* Remove all scroll bars because they have wrong colors. */
2368 if (condemn_scroll_bars_hook
)
2369 (*condemn_scroll_bars_hook
) (f
);
2370 if (judge_scroll_bars_hook
)
2371 (*judge_scroll_bars_hook
) (f
);
2373 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2379 /* Encode Lisp string STRING as a text in a format appropriate for
2380 XICCC (X Inter Client Communication Conventions).
2382 If STRING contains only ASCII characters, do no conversion and
2383 return the string data of STRING. Otherwise, encode the text by
2384 CODING_SYSTEM, and return a newly allocated memory area which
2385 should be freed by `xfree' by a caller.
2387 SELECTIONP non-zero means the string is being encoded for an X
2388 selection, so it is safe to run pre-write conversions (which
2391 Store the byte length of resulting text in *TEXT_BYTES.
2393 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2394 which means that the `encoding' of the result can be `STRING'.
2395 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2396 the result should be `COMPOUND_TEXT'. */
2399 x_encode_text (string
, coding_system
, selectionp
, text_bytes
, stringp
)
2400 Lisp_Object string
, coding_system
;
2401 int *text_bytes
, *stringp
;
2404 unsigned char *str
= SDATA (string
);
2405 int chars
= SCHARS (string
);
2406 int bytes
= SBYTES (string
);
2410 struct coding_system coding
;
2411 extern Lisp_Object Qcompound_text_with_extensions
;
2413 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2414 if (charset_info
== 0)
2416 /* No multibyte character in OBJ. We need not encode it. */
2417 *text_bytes
= bytes
;
2422 setup_coding_system (coding_system
, &coding
);
2424 && SYMBOLP (coding
.pre_write_conversion
)
2425 && !NILP (Ffboundp (coding
.pre_write_conversion
)))
2427 string
= run_pre_post_conversion_on_str (string
, &coding
, 1);
2428 str
= SDATA (string
);
2429 chars
= SCHARS (string
);
2430 bytes
= SBYTES (string
);
2432 coding
.src_multibyte
= 1;
2433 coding
.dst_multibyte
= 0;
2434 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2435 if (coding
.type
== coding_type_iso2022
)
2436 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2437 /* We suppress producing escape sequences for composition. */
2438 coding
.composing
= COMPOSITION_DISABLED
;
2439 bufsize
= encoding_buffer_size (&coding
, bytes
);
2440 buf
= (unsigned char *) xmalloc (bufsize
);
2441 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2442 *text_bytes
= coding
.produced
;
2443 *stringp
= (charset_info
== 1
2444 || (!EQ (coding_system
, Qcompound_text
)
2445 && !EQ (coding_system
, Qcompound_text_with_extensions
)));
2450 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2453 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2454 name; if NAME is a string, set F's name to NAME and set
2455 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2457 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2458 suggesting a new name, which lisp code should override; if
2459 F->explicit_name is set, ignore the new name; otherwise, set it. */
2462 x_set_name (f
, name
, explicit)
2467 /* Make sure that requests from lisp code override requests from
2468 Emacs redisplay code. */
2471 /* If we're switching from explicit to implicit, we had better
2472 update the mode lines and thereby update the title. */
2473 if (f
->explicit_name
&& NILP (name
))
2474 update_mode_lines
= 1;
2476 f
->explicit_name
= ! NILP (name
);
2478 else if (f
->explicit_name
)
2481 /* If NAME is nil, set the name to the x_id_name. */
2484 /* Check for no change needed in this very common case
2485 before we do any consing. */
2486 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2489 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2492 CHECK_STRING (name
);
2494 /* Don't change the name if it's already NAME. */
2495 if (! NILP (Fstring_equal (name
, f
->name
)))
2500 /* For setting the frame title, the title parameter should override
2501 the name parameter. */
2502 if (! NILP (f
->title
))
2505 if (FRAME_X_WINDOW (f
))
2510 XTextProperty text
, icon
;
2512 Lisp_Object coding_system
;
2514 coding_system
= Vlocale_coding_system
;
2515 if (NILP (coding_system
))
2516 coding_system
= Qcompound_text
;
2517 text
.value
= x_encode_text (name
, coding_system
, 0, &bytes
, &stringp
);
2518 text
.encoding
= (stringp
? XA_STRING
2519 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2521 text
.nitems
= bytes
;
2523 if (NILP (f
->icon_name
))
2529 icon
.value
= x_encode_text (f
->icon_name
, coding_system
, 0,
2531 icon
.encoding
= (stringp
? XA_STRING
2532 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2534 icon
.nitems
= bytes
;
2536 #ifdef USE_X_TOOLKIT
2537 XSetWMName (FRAME_X_DISPLAY (f
),
2538 XtWindow (f
->output_data
.x
->widget
), &text
);
2539 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2541 #else /* not USE_X_TOOLKIT */
2542 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2543 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2544 #endif /* not USE_X_TOOLKIT */
2545 if (!NILP (f
->icon_name
)
2546 && icon
.value
!= SDATA (f
->icon_name
))
2548 if (text
.value
!= SDATA (name
))
2551 #else /* not HAVE_X11R4 */
2552 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2554 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2556 #endif /* not HAVE_X11R4 */
2561 /* This function should be called when the user's lisp code has
2562 specified a name for the frame; the name will override any set by the
2565 x_explicitly_set_name (f
, arg
, oldval
)
2567 Lisp_Object arg
, oldval
;
2569 x_set_name (f
, arg
, 1);
2572 /* This function should be called by Emacs redisplay code to set the
2573 name; names set this way will never override names set by the user's
2576 x_implicitly_set_name (f
, arg
, oldval
)
2578 Lisp_Object arg
, oldval
;
2580 x_set_name (f
, arg
, 0);
2583 /* Change the title of frame F to NAME.
2584 If NAME is nil, use the frame name as the title.
2586 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2587 name; if NAME is a string, set F's name to NAME and set
2588 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2590 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2591 suggesting a new name, which lisp code should override; if
2592 F->explicit_name is set, ignore the new name; otherwise, set it. */
2595 x_set_title (f
, name
, old_name
)
2597 Lisp_Object name
, old_name
;
2599 /* Don't change the title if it's already NAME. */
2600 if (EQ (name
, f
->title
))
2603 update_mode_lines
= 1;
2610 CHECK_STRING (name
);
2612 if (FRAME_X_WINDOW (f
))
2617 XTextProperty text
, icon
;
2619 Lisp_Object coding_system
;
2621 coding_system
= Vlocale_coding_system
;
2622 if (NILP (coding_system
))
2623 coding_system
= Qcompound_text
;
2624 text
.value
= x_encode_text (name
, coding_system
, 0, &bytes
, &stringp
);
2625 text
.encoding
= (stringp
? XA_STRING
2626 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2628 text
.nitems
= bytes
;
2630 if (NILP (f
->icon_name
))
2636 icon
.value
= x_encode_text (f
->icon_name
, coding_system
, 0,
2638 icon
.encoding
= (stringp
? XA_STRING
2639 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2641 icon
.nitems
= bytes
;
2643 #ifdef USE_X_TOOLKIT
2644 XSetWMName (FRAME_X_DISPLAY (f
),
2645 XtWindow (f
->output_data
.x
->widget
), &text
);
2646 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2648 #else /* not USE_X_TOOLKIT */
2649 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2650 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2651 #endif /* not USE_X_TOOLKIT */
2652 if (!NILP (f
->icon_name
)
2653 && icon
.value
!= SDATA (f
->icon_name
))
2655 if (text
.value
!= SDATA (name
))
2658 #else /* not HAVE_X11R4 */
2659 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2661 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2663 #endif /* not HAVE_X11R4 */
2669 x_set_autoraise (f
, arg
, oldval
)
2671 Lisp_Object arg
, oldval
;
2673 f
->auto_raise
= !EQ (Qnil
, arg
);
2677 x_set_autolower (f
, arg
, oldval
)
2679 Lisp_Object arg
, oldval
;
2681 f
->auto_lower
= !EQ (Qnil
, arg
);
2685 x_set_unsplittable (f
, arg
, oldval
)
2687 Lisp_Object arg
, oldval
;
2689 f
->no_split
= !NILP (arg
);
2693 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2695 Lisp_Object arg
, oldval
;
2697 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2698 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2699 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2700 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2702 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2704 ? vertical_scroll_bar_none
2706 ? vertical_scroll_bar_right
2707 : vertical_scroll_bar_left
);
2709 /* We set this parameter before creating the X window for the
2710 frame, so we can get the geometry right from the start.
2711 However, if the window hasn't been created yet, we shouldn't
2712 call x_set_window_size. */
2713 if (FRAME_X_WINDOW (f
))
2714 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2715 do_pending_window_change (0);
2720 x_set_scroll_bar_width (f
, arg
, oldval
)
2722 Lisp_Object arg
, oldval
;
2724 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2728 #ifdef USE_TOOLKIT_SCROLL_BARS
2729 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2730 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2731 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2732 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2734 /* Make the actual width at least 14 pixels and a multiple of a
2736 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2738 /* Use all of that space (aside from required margins) for the
2740 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2743 if (FRAME_X_WINDOW (f
))
2744 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2745 do_pending_window_change (0);
2747 else if (INTEGERP (arg
) && XINT (arg
) > 0
2748 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2750 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2751 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2753 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2754 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2755 if (FRAME_X_WINDOW (f
))
2756 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2759 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2760 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2761 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2766 /* Subroutines of creating an X frame. */
2768 /* Make sure that Vx_resource_name is set to a reasonable value.
2769 Fix it up, or set it to `emacs' if it is too hopeless. */
2772 validate_x_resource_name ()
2775 /* Number of valid characters in the resource name. */
2777 /* Number of invalid characters in the resource name. */
2782 if (!STRINGP (Vx_resource_class
))
2783 Vx_resource_class
= build_string (EMACS_CLASS
);
2785 if (STRINGP (Vx_resource_name
))
2787 unsigned char *p
= SDATA (Vx_resource_name
);
2790 len
= SBYTES (Vx_resource_name
);
2792 /* Only letters, digits, - and _ are valid in resource names.
2793 Count the valid characters and count the invalid ones. */
2794 for (i
= 0; i
< len
; i
++)
2797 if (! ((c
>= 'a' && c
<= 'z')
2798 || (c
>= 'A' && c
<= 'Z')
2799 || (c
>= '0' && c
<= '9')
2800 || c
== '-' || c
== '_'))
2807 /* Not a string => completely invalid. */
2808 bad_count
= 5, good_count
= 0;
2810 /* If name is valid already, return. */
2814 /* If name is entirely invalid, or nearly so, use `emacs'. */
2816 || (good_count
== 1 && bad_count
> 0))
2818 Vx_resource_name
= build_string ("emacs");
2822 /* Name is partly valid. Copy it and replace the invalid characters
2823 with underscores. */
2825 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2827 for (i
= 0; i
< len
; i
++)
2829 int c
= SREF (new, i
);
2830 if (! ((c
>= 'a' && c
<= 'z')
2831 || (c
>= 'A' && c
<= 'Z')
2832 || (c
>= '0' && c
<= '9')
2833 || c
== '-' || c
== '_'))
2839 extern char *x_get_string_resource ();
2841 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2842 doc
: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
2843 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
2844 class, where INSTANCE is the name under which Emacs was invoked, or
2845 the name specified by the `-name' or `-rn' command-line arguments.
2847 The optional arguments COMPONENT and SUBCLASS add to the key and the
2848 class, respectively. You must specify both of them or neither.
2849 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
2850 and the class is `Emacs.CLASS.SUBCLASS'. */)
2851 (attribute
, class, component
, subclass
)
2852 Lisp_Object attribute
, class, component
, subclass
;
2854 register char *value
;
2860 CHECK_STRING (attribute
);
2861 CHECK_STRING (class);
2863 if (!NILP (component
))
2864 CHECK_STRING (component
);
2865 if (!NILP (subclass
))
2866 CHECK_STRING (subclass
);
2867 if (NILP (component
) != NILP (subclass
))
2868 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2870 validate_x_resource_name ();
2872 /* Allocate space for the components, the dots which separate them,
2873 and the final '\0'. Make them big enough for the worst case. */
2874 name_key
= (char *) alloca (SBYTES (Vx_resource_name
)
2875 + (STRINGP (component
)
2876 ? SBYTES (component
) : 0)
2877 + SBYTES (attribute
)
2880 class_key
= (char *) alloca (SBYTES (Vx_resource_class
)
2882 + (STRINGP (subclass
)
2883 ? SBYTES (subclass
) : 0)
2886 /* Start with emacs.FRAMENAME for the name (the specific one)
2887 and with `Emacs' for the class key (the general one). */
2888 strcpy (name_key
, SDATA (Vx_resource_name
));
2889 strcpy (class_key
, SDATA (Vx_resource_class
));
2891 strcat (class_key
, ".");
2892 strcat (class_key
, SDATA (class));
2894 if (!NILP (component
))
2896 strcat (class_key
, ".");
2897 strcat (class_key
, SDATA (subclass
));
2899 strcat (name_key
, ".");
2900 strcat (name_key
, SDATA (component
));
2903 strcat (name_key
, ".");
2904 strcat (name_key
, SDATA (attribute
));
2906 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2907 name_key
, class_key
);
2909 if (value
!= (char *) 0)
2910 return build_string (value
);
2915 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2918 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2919 struct x_display_info
*dpyinfo
;
2920 Lisp_Object attribute
, class, component
, subclass
;
2922 register char *value
;
2926 CHECK_STRING (attribute
);
2927 CHECK_STRING (class);
2929 if (!NILP (component
))
2930 CHECK_STRING (component
);
2931 if (!NILP (subclass
))
2932 CHECK_STRING (subclass
);
2933 if (NILP (component
) != NILP (subclass
))
2934 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2936 validate_x_resource_name ();
2938 /* Allocate space for the components, the dots which separate them,
2939 and the final '\0'. Make them big enough for the worst case. */
2940 name_key
= (char *) alloca (SBYTES (Vx_resource_name
)
2941 + (STRINGP (component
)
2942 ? SBYTES (component
) : 0)
2943 + SBYTES (attribute
)
2946 class_key
= (char *) alloca (SBYTES (Vx_resource_class
)
2948 + (STRINGP (subclass
)
2949 ? SBYTES (subclass
) : 0)
2952 /* Start with emacs.FRAMENAME for the name (the specific one)
2953 and with `Emacs' for the class key (the general one). */
2954 strcpy (name_key
, SDATA (Vx_resource_name
));
2955 strcpy (class_key
, SDATA (Vx_resource_class
));
2957 strcat (class_key
, ".");
2958 strcat (class_key
, SDATA (class));
2960 if (!NILP (component
))
2962 strcat (class_key
, ".");
2963 strcat (class_key
, SDATA (subclass
));
2965 strcat (name_key
, ".");
2966 strcat (name_key
, SDATA (component
));
2969 strcat (name_key
, ".");
2970 strcat (name_key
, SDATA (attribute
));
2972 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2974 if (value
!= (char *) 0)
2975 return build_string (value
);
2980 /* Used when C code wants a resource value. */
2983 x_get_resource_string (attribute
, class)
2984 char *attribute
, *class;
2988 struct frame
*sf
= SELECTED_FRAME ();
2990 /* Allocate space for the components, the dots which separate them,
2991 and the final '\0'. */
2992 name_key
= (char *) alloca (SBYTES (Vinvocation_name
)
2993 + strlen (attribute
) + 2);
2994 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2995 + strlen (class) + 2);
2997 sprintf (name_key
, "%s.%s",
2998 SDATA (Vinvocation_name
),
3000 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
3002 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
3003 name_key
, class_key
);
3006 /* Types we might convert a resource string into. */
3016 /* Return the value of parameter PARAM.
3018 First search ALIST, then Vdefault_frame_alist, then the X defaults
3019 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3021 Convert the resource to the type specified by desired_type.
3023 If no default is specified, return Qunbound. If you call
3024 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3025 and don't let it get stored in any Lisp-visible variables! */
3028 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
3029 struct x_display_info
*dpyinfo
;
3030 Lisp_Object alist
, param
;
3033 enum resource_types type
;
3035 register Lisp_Object tem
;
3037 tem
= Fassq (param
, alist
);
3039 tem
= Fassq (param
, Vdefault_frame_alist
);
3045 tem
= display_x_get_resource (dpyinfo
,
3046 build_string (attribute
),
3047 build_string (class),
3055 case RES_TYPE_NUMBER
:
3056 return make_number (atoi (SDATA (tem
)));
3058 case RES_TYPE_FLOAT
:
3059 return make_float (atof (SDATA (tem
)));
3061 case RES_TYPE_BOOLEAN
:
3062 tem
= Fdowncase (tem
);
3063 if (!strcmp (SDATA (tem
), "on")
3064 || !strcmp (SDATA (tem
), "true"))
3069 case RES_TYPE_STRING
:
3072 case RES_TYPE_SYMBOL
:
3073 /* As a special case, we map the values `true' and `on'
3074 to Qt, and `false' and `off' to Qnil. */
3077 lower
= Fdowncase (tem
);
3078 if (!strcmp (SDATA (lower
), "on")
3079 || !strcmp (SDATA (lower
), "true"))
3081 else if (!strcmp (SDATA (lower
), "off")
3082 || !strcmp (SDATA (lower
), "false"))
3085 return Fintern (tem
, Qnil
);
3098 /* Like x_get_arg, but also record the value in f->param_alist. */
3101 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
3103 Lisp_Object alist
, param
;
3106 enum resource_types type
;
3110 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
3111 attribute
, class, type
);
3113 store_frame_param (f
, param
, value
);
3118 /* Record in frame F the specified or default value according to ALIST
3119 of the parameter named PROP (a Lisp symbol).
3120 If no value is specified for PROP, look for an X default for XPROP
3121 on the frame named NAME.
3122 If that is not found either, use the value DEFLT. */
3125 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
3132 enum resource_types type
;
3136 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
3137 if (EQ (tem
, Qunbound
))
3139 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3144 /* Record in frame F the specified or default value according to ALIST
3145 of the parameter named PROP (a Lisp symbol). If no value is
3146 specified for PROP, look for an X default for XPROP on the frame
3147 named NAME. If that is not found either, use the value DEFLT. */
3150 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
3159 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3162 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
3163 if (EQ (tem
, Qunbound
))
3165 #ifdef USE_TOOLKIT_SCROLL_BARS
3167 /* See if an X resource for the scroll bar color has been
3169 tem
= display_x_get_resource (dpyinfo
,
3170 build_string (foreground_p
3174 build_string ("verticalScrollBar"),
3178 /* If nothing has been specified, scroll bars will use a
3179 toolkit-dependent default. Because these defaults are
3180 difficult to get at without actually creating a scroll
3181 bar, use nil to indicate that no color has been
3186 #else /* not USE_TOOLKIT_SCROLL_BARS */
3190 #endif /* not USE_TOOLKIT_SCROLL_BARS */
3193 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3199 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3200 doc
: /* Parse an X-style geometry string STRING.
3201 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3202 The properties returned may include `top', `left', `height', and `width'.
3203 The value of `left' or `top' may be an integer,
3204 or a list (+ N) meaning N pixels relative to top/left corner,
3205 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3210 unsigned int width
, height
;
3213 CHECK_STRING (string
);
3215 geometry
= XParseGeometry ((char *) SDATA (string
),
3216 &x
, &y
, &width
, &height
);
3219 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
3220 error ("Must specify both x and y position, or neither");
3224 if (geometry
& XValue
)
3226 Lisp_Object element
;
3228 if (x
>= 0 && (geometry
& XNegative
))
3229 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3230 else if (x
< 0 && ! (geometry
& XNegative
))
3231 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3233 element
= Fcons (Qleft
, make_number (x
));
3234 result
= Fcons (element
, result
);
3237 if (geometry
& YValue
)
3239 Lisp_Object element
;
3241 if (y
>= 0 && (geometry
& YNegative
))
3242 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3243 else if (y
< 0 && ! (geometry
& YNegative
))
3244 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3246 element
= Fcons (Qtop
, make_number (y
));
3247 result
= Fcons (element
, result
);
3250 if (geometry
& WidthValue
)
3251 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3252 if (geometry
& HeightValue
)
3253 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3258 /* Calculate the desired size and position of this window,
3259 and return the flags saying which aspects were specified.
3261 This function does not make the coordinates positive. */
3263 #define DEFAULT_ROWS 40
3264 #define DEFAULT_COLS 80
3267 x_figure_window_size (f
, parms
)
3271 register Lisp_Object tem0
, tem1
, tem2
;
3272 long window_prompting
= 0;
3273 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3275 /* Default values if we fall through.
3276 Actually, if that happens we should get
3277 window manager prompting. */
3278 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3279 f
->height
= DEFAULT_ROWS
;
3280 /* Window managers expect that if program-specified
3281 positions are not (0,0), they're intentional, not defaults. */
3282 f
->output_data
.x
->top_pos
= 0;
3283 f
->output_data
.x
->left_pos
= 0;
3285 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3286 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3287 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3288 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3290 if (!EQ (tem0
, Qunbound
))
3292 CHECK_NUMBER (tem0
);
3293 f
->height
= XINT (tem0
);
3295 if (!EQ (tem1
, Qunbound
))
3297 CHECK_NUMBER (tem1
);
3298 SET_FRAME_WIDTH (f
, XINT (tem1
));
3300 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3301 window_prompting
|= USSize
;
3303 window_prompting
|= PSize
;
3306 f
->output_data
.x
->vertical_scroll_bar_extra
3307 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3309 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3311 x_compute_fringe_widths (f
, 0);
3313 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3314 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3316 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3317 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3318 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3319 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3321 if (EQ (tem0
, Qminus
))
3323 f
->output_data
.x
->top_pos
= 0;
3324 window_prompting
|= YNegative
;
3326 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3327 && CONSP (XCDR (tem0
))
3328 && INTEGERP (XCAR (XCDR (tem0
))))
3330 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3331 window_prompting
|= YNegative
;
3333 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3334 && CONSP (XCDR (tem0
))
3335 && INTEGERP (XCAR (XCDR (tem0
))))
3337 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3339 else if (EQ (tem0
, Qunbound
))
3340 f
->output_data
.x
->top_pos
= 0;
3343 CHECK_NUMBER (tem0
);
3344 f
->output_data
.x
->top_pos
= XINT (tem0
);
3345 if (f
->output_data
.x
->top_pos
< 0)
3346 window_prompting
|= YNegative
;
3349 if (EQ (tem1
, Qminus
))
3351 f
->output_data
.x
->left_pos
= 0;
3352 window_prompting
|= XNegative
;
3354 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3355 && CONSP (XCDR (tem1
))
3356 && INTEGERP (XCAR (XCDR (tem1
))))
3358 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3359 window_prompting
|= XNegative
;
3361 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3362 && CONSP (XCDR (tem1
))
3363 && INTEGERP (XCAR (XCDR (tem1
))))
3365 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3367 else if (EQ (tem1
, Qunbound
))
3368 f
->output_data
.x
->left_pos
= 0;
3371 CHECK_NUMBER (tem1
);
3372 f
->output_data
.x
->left_pos
= XINT (tem1
);
3373 if (f
->output_data
.x
->left_pos
< 0)
3374 window_prompting
|= XNegative
;
3377 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3378 window_prompting
|= USPosition
;
3380 window_prompting
|= PPosition
;
3383 if (f
->output_data
.x
->want_fullscreen
!= FULLSCREEN_NONE
)
3388 /* It takes both for some WM:s to place it where we want */
3389 window_prompting
= USPosition
| PPosition
;
3390 x_fullscreen_adjust (f
, &width
, &height
, &top
, &left
);
3393 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3394 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3395 f
->output_data
.x
->left_pos
= left
;
3396 f
->output_data
.x
->top_pos
= top
;
3399 return window_prompting
;
3402 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3405 XSetWMProtocols (dpy
, w
, protocols
, count
)
3412 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3413 if (prop
== None
) return False
;
3414 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3415 (unsigned char *) protocols
, count
);
3418 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3420 #ifdef USE_X_TOOLKIT
3422 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3423 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3424 already be present because of the toolkit (Motif adds some of them,
3425 for example, but Xt doesn't). */
3428 hack_wm_protocols (f
, widget
)
3432 Display
*dpy
= XtDisplay (widget
);
3433 Window w
= XtWindow (widget
);
3434 int need_delete
= 1;
3440 Atom type
, *atoms
= 0;
3442 unsigned long nitems
= 0;
3443 unsigned long bytes_after
;
3445 if ((XGetWindowProperty (dpy
, w
,
3446 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3447 (long)0, (long)100, False
, XA_ATOM
,
3448 &type
, &format
, &nitems
, &bytes_after
,
3449 (unsigned char **) &atoms
)
3451 && format
== 32 && type
== XA_ATOM
)
3455 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3457 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3459 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3462 if (atoms
) XFree ((char *) atoms
);
3468 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3470 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3472 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3474 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3475 XA_ATOM
, 32, PropModeAppend
,
3476 (unsigned char *) props
, count
);
3484 /* Support routines for XIC (X Input Context). */
3488 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3489 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3492 /* Supported XIM styles, ordered by preferenc. */
3494 static XIMStyle supported_xim_styles
[] =
3496 XIMPreeditPosition
| XIMStatusArea
,
3497 XIMPreeditPosition
| XIMStatusNothing
,
3498 XIMPreeditPosition
| XIMStatusNone
,
3499 XIMPreeditNothing
| XIMStatusArea
,
3500 XIMPreeditNothing
| XIMStatusNothing
,
3501 XIMPreeditNothing
| XIMStatusNone
,
3502 XIMPreeditNone
| XIMStatusArea
,
3503 XIMPreeditNone
| XIMStatusNothing
,
3504 XIMPreeditNone
| XIMStatusNone
,
3509 /* Create an X fontset on frame F with base font name
3513 xic_create_xfontset (f
, base_fontname
)
3515 char *base_fontname
;
3518 char **missing_list
;
3522 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3523 base_fontname
, &missing_list
,
3524 &missing_count
, &def_string
);
3526 XFreeStringList (missing_list
);
3528 /* No need to free def_string. */
3533 /* Value is the best input style, given user preferences USER (already
3534 checked to be supported by Emacs), and styles supported by the
3535 input method XIM. */
3538 best_xim_style (user
, xim
)
3544 for (i
= 0; i
< user
->count_styles
; ++i
)
3545 for (j
= 0; j
< xim
->count_styles
; ++j
)
3546 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3547 return user
->supported_styles
[i
];
3549 /* Return the default style. */
3550 return XIMPreeditNothing
| XIMStatusNothing
;
3553 /* Create XIC for frame F. */
3555 static XIMStyle xic_style
;
3558 create_frame_xic (f
)
3563 XFontSet xfs
= NULL
;
3568 xim
= FRAME_X_XIM (f
);
3573 XVaNestedList preedit_attr
;
3574 XVaNestedList status_attr
;
3575 char *base_fontname
;
3578 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3579 spot
.x
= 0; spot
.y
= 1;
3580 /* Create X fontset. */
3581 fontset
= FRAME_FONTSET (f
);
3583 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3586 /* Determine the base fontname from the ASCII font name of
3588 char *ascii_font
= (char *) SDATA (fontset_ascii (fontset
));
3589 char *p
= ascii_font
;
3592 for (i
= 0; *p
; p
++)
3595 /* As the font name doesn't conform to XLFD, we can't
3596 modify it to get a suitable base fontname for the
3598 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3601 int len
= strlen (ascii_font
) + 1;
3604 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3613 base_fontname
= (char *) alloca (len
);
3614 bzero (base_fontname
, len
);
3615 strcpy (base_fontname
, "-*-*-");
3616 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3617 strcat (base_fontname
, "*-*-*-*-*-*-*");
3620 xfs
= xic_create_xfontset (f
, base_fontname
);
3622 /* Determine XIC style. */
3625 XIMStyles supported_list
;
3626 supported_list
.count_styles
= (sizeof supported_xim_styles
3627 / sizeof supported_xim_styles
[0]);
3628 supported_list
.supported_styles
= supported_xim_styles
;
3629 xic_style
= best_xim_style (&supported_list
,
3630 FRAME_X_XIM_STYLES (f
));
3633 preedit_attr
= XVaCreateNestedList (0,
3636 FRAME_FOREGROUND_PIXEL (f
),
3638 FRAME_BACKGROUND_PIXEL (f
),
3639 (xic_style
& XIMPreeditPosition
3644 status_attr
= XVaCreateNestedList (0,
3650 FRAME_FOREGROUND_PIXEL (f
),
3652 FRAME_BACKGROUND_PIXEL (f
),
3655 xic
= XCreateIC (xim
,
3656 XNInputStyle
, xic_style
,
3657 XNClientWindow
, FRAME_X_WINDOW(f
),
3658 XNFocusWindow
, FRAME_X_WINDOW(f
),
3659 XNStatusAttributes
, status_attr
,
3660 XNPreeditAttributes
, preedit_attr
,
3662 XFree (preedit_attr
);
3663 XFree (status_attr
);
3666 FRAME_XIC (f
) = xic
;
3667 FRAME_XIC_STYLE (f
) = xic_style
;
3668 FRAME_XIC_FONTSET (f
) = xfs
;
3672 /* Destroy XIC and free XIC fontset of frame F, if any. */
3678 if (FRAME_XIC (f
) == NULL
)
3681 XDestroyIC (FRAME_XIC (f
));
3682 if (FRAME_XIC_FONTSET (f
))
3683 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3685 FRAME_XIC (f
) = NULL
;
3686 FRAME_XIC_FONTSET (f
) = NULL
;
3690 /* Place preedit area for XIC of window W's frame to specified
3691 pixel position X/Y. X and Y are relative to window W. */
3694 xic_set_preeditarea (w
, x
, y
)
3698 struct frame
*f
= XFRAME (w
->frame
);
3702 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3703 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3704 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3705 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3710 /* Place status area for XIC in bottom right corner of frame F.. */
3713 xic_set_statusarea (f
)
3716 XIC xic
= FRAME_XIC (f
);
3721 /* Negotiate geometry of status area. If input method has existing
3722 status area, use its current size. */
3723 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3724 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3725 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3728 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3729 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3732 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3734 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3735 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3739 area
.width
= needed
->width
;
3740 area
.height
= needed
->height
;
3741 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3742 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3743 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3746 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3747 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3752 /* Set X fontset for XIC of frame F, using base font name
3753 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3756 xic_set_xfontset (f
, base_fontname
)
3758 char *base_fontname
;
3763 xfs
= xic_create_xfontset (f
, base_fontname
);
3765 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3766 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3767 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3768 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3769 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3772 if (FRAME_XIC_FONTSET (f
))
3773 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3774 FRAME_XIC_FONTSET (f
) = xfs
;
3777 #endif /* HAVE_X_I18N */
3781 #ifdef USE_X_TOOLKIT
3783 /* Create and set up the X widget for frame F. */
3786 x_window (f
, window_prompting
, minibuffer_only
)
3788 long window_prompting
;
3789 int minibuffer_only
;
3791 XClassHint class_hints
;
3792 XSetWindowAttributes attributes
;
3793 unsigned long attribute_mask
;
3794 Widget shell_widget
;
3796 Widget frame_widget
;
3802 /* Use the resource name as the top-level widget name
3803 for looking up resources. Make a non-Lisp copy
3804 for the window manager, so GC relocation won't bother it.
3806 Elsewhere we specify the window name for the window manager. */
3809 char *str
= (char *) SDATA (Vx_resource_name
);
3810 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3811 strcpy (f
->namebuf
, str
);
3815 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3816 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3817 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3818 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3819 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3820 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3821 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3822 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3823 applicationShellWidgetClass
,
3824 FRAME_X_DISPLAY (f
), al
, ac
);
3826 f
->output_data
.x
->widget
= shell_widget
;
3827 /* maybe_set_screen_title_format (shell_widget); */
3829 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3830 (widget_value
*) NULL
,
3831 shell_widget
, False
,
3835 (lw_callback
) NULL
);
3838 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3839 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3840 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3841 XtSetValues (pane_widget
, al
, ac
);
3842 f
->output_data
.x
->column_widget
= pane_widget
;
3844 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3845 the emacs screen when changing menubar. This reduces flickering. */
3848 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3849 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3850 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3851 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3852 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3853 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3854 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3855 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3856 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3859 f
->output_data
.x
->edit_widget
= frame_widget
;
3861 XtManageChild (frame_widget
);
3863 /* Do some needed geometry management. */
3866 char *tem
, shell_position
[32];
3869 int extra_borders
= 0;
3871 = (f
->output_data
.x
->menubar_widget
3872 ? (f
->output_data
.x
->menubar_widget
->core
.height
3873 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3876 #if 0 /* Experimentally, we now get the right results
3877 for -geometry -0-0 without this. 24 Aug 96, rms. */
3878 if (FRAME_EXTERNAL_MENU_BAR (f
))
3881 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3882 menubar_size
+= ibw
;
3886 f
->output_data
.x
->menubar_height
= menubar_size
;
3889 /* Motif seems to need this amount added to the sizes
3890 specified for the shell widget. The Athena/Lucid widgets don't.
3891 Both conclusions reached experimentally. -- rms. */
3892 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3893 &extra_borders
, NULL
);
3897 /* Convert our geometry parameters into a geometry string
3899 Note that we do not specify here whether the position
3900 is a user-specified or program-specified one.
3901 We pass that information later, in x_wm_set_size_hints. */
3903 int left
= f
->output_data
.x
->left_pos
;
3904 int xneg
= window_prompting
& XNegative
;
3905 int top
= f
->output_data
.x
->top_pos
;
3906 int yneg
= window_prompting
& YNegative
;
3912 if (window_prompting
& USPosition
)
3913 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3914 PIXEL_WIDTH (f
) + extra_borders
,
3915 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3916 (xneg
? '-' : '+'), left
,
3917 (yneg
? '-' : '+'), top
);
3919 sprintf (shell_position
, "=%dx%d",
3920 PIXEL_WIDTH (f
) + extra_borders
,
3921 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3924 len
= strlen (shell_position
) + 1;
3925 /* We don't free this because we don't know whether
3926 it is safe to free it while the frame exists.
3927 It isn't worth the trouble of arranging to free it
3928 when the frame is deleted. */
3929 tem
= (char *) xmalloc (len
);
3930 strncpy (tem
, shell_position
, len
);
3931 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3932 XtSetValues (shell_widget
, al
, ac
);
3935 XtManageChild (pane_widget
);
3936 XtRealizeWidget (shell_widget
);
3938 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3940 validate_x_resource_name ();
3942 class_hints
.res_name
= (char *) SDATA (Vx_resource_name
);
3943 class_hints
.res_class
= (char *) SDATA (Vx_resource_class
);
3944 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3947 FRAME_XIC (f
) = NULL
;
3949 create_frame_xic (f
);
3953 f
->output_data
.x
->wm_hints
.input
= True
;
3954 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3955 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3956 &f
->output_data
.x
->wm_hints
);
3958 hack_wm_protocols (f
, shell_widget
);
3961 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3964 /* Do a stupid property change to force the server to generate a
3965 PropertyNotify event so that the event_stream server timestamp will
3966 be initialized to something relevant to the time we created the window.
3968 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3969 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3970 XA_ATOM
, 32, PropModeAppend
,
3971 (unsigned char*) NULL
, 0);
3973 /* Make all the standard events reach the Emacs frame. */
3974 attributes
.event_mask
= STANDARD_EVENT_SET
;
3979 /* XIM server might require some X events. */
3980 unsigned long fevent
= NoEventMask
;
3981 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3982 attributes
.event_mask
|= fevent
;
3984 #endif /* HAVE_X_I18N */
3986 attribute_mask
= CWEventMask
;
3987 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3988 attribute_mask
, &attributes
);
3990 XtMapWidget (frame_widget
);
3992 /* x_set_name normally ignores requests to set the name if the
3993 requested name is the same as the current name. This is the one
3994 place where that assumption isn't correct; f->name is set, but
3995 the X server hasn't been told. */
3998 int explicit = f
->explicit_name
;
4000 f
->explicit_name
= 0;
4003 x_set_name (f
, name
, explicit);
4006 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4007 f
->output_data
.x
->text_cursor
);
4011 /* This is a no-op, except under Motif. Make sure main areas are
4012 set to something reasonable, in case we get an error later. */
4013 lw_set_main_areas (pane_widget
, 0, frame_widget
);
4016 #else /* not USE_X_TOOLKIT */
4018 /* Create and set up the X window for frame F. */
4025 XClassHint class_hints
;
4026 XSetWindowAttributes attributes
;
4027 unsigned long attribute_mask
;
4029 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
4030 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
4031 attributes
.bit_gravity
= StaticGravity
;
4032 attributes
.backing_store
= NotUseful
;
4033 attributes
.save_under
= True
;
4034 attributes
.event_mask
= STANDARD_EVENT_SET
;
4035 attributes
.colormap
= FRAME_X_COLORMAP (f
);
4036 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
4041 = XCreateWindow (FRAME_X_DISPLAY (f
),
4042 f
->output_data
.x
->parent_desc
,
4043 f
->output_data
.x
->left_pos
,
4044 f
->output_data
.x
->top_pos
,
4045 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
4046 f
->output_data
.x
->border_width
,
4047 CopyFromParent
, /* depth */
4048 InputOutput
, /* class */
4050 attribute_mask
, &attributes
);
4054 create_frame_xic (f
);
4057 /* XIM server might require some X events. */
4058 unsigned long fevent
= NoEventMask
;
4059 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
4060 attributes
.event_mask
|= fevent
;
4061 attribute_mask
= CWEventMask
;
4062 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4063 attribute_mask
, &attributes
);
4066 #endif /* HAVE_X_I18N */
4068 validate_x_resource_name ();
4070 class_hints
.res_name
= (char *) SDATA (Vx_resource_name
);
4071 class_hints
.res_class
= (char *) SDATA (Vx_resource_class
);
4072 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
4074 /* The menubar is part of the ordinary display;
4075 it does not count in addition to the height of the window. */
4076 f
->output_data
.x
->menubar_height
= 0;
4078 /* This indicates that we use the "Passive Input" input model.
4079 Unless we do this, we don't get the Focus{In,Out} events that we
4080 need to draw the cursor correctly. Accursed bureaucrats.
4081 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
4083 f
->output_data
.x
->wm_hints
.input
= True
;
4084 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
4085 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4086 &f
->output_data
.x
->wm_hints
);
4087 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
4089 /* Request "save yourself" and "delete window" commands from wm. */
4092 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
4093 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
4094 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
4097 /* x_set_name normally ignores requests to set the name if the
4098 requested name is the same as the current name. This is the one
4099 place where that assumption isn't correct; f->name is set, but
4100 the X server hasn't been told. */
4103 int explicit = f
->explicit_name
;
4105 f
->explicit_name
= 0;
4108 x_set_name (f
, name
, explicit);
4111 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4112 f
->output_data
.x
->text_cursor
);
4116 if (FRAME_X_WINDOW (f
) == 0)
4117 error ("Unable to create window");
4120 #endif /* not USE_X_TOOLKIT */
4122 /* Handle the icon stuff for this window. Perhaps later we might
4123 want an x_set_icon_position which can be called interactively as
4131 Lisp_Object icon_x
, icon_y
;
4132 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4134 /* Set the position of the icon. Note that twm groups all
4135 icons in an icon window. */
4136 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
4137 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
4138 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
4140 CHECK_NUMBER (icon_x
);
4141 CHECK_NUMBER (icon_y
);
4143 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
4144 error ("Both left and top icon corners of icon must be specified");
4148 if (! EQ (icon_x
, Qunbound
))
4149 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
4151 /* Start up iconic or window? */
4152 x_wm_set_window_state
4153 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
4158 x_text_icon (f
, (char *) SDATA ((!NILP (f
->icon_name
)
4165 /* Make the GCs needed for this window, setting the
4166 background, border and mouse colors; also create the
4167 mouse cursor and the gray border tile. */
4169 static char cursor_bits
[] =
4171 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4172 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4173 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4174 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
4181 XGCValues gc_values
;
4185 /* Create the GCs of this frame.
4186 Note that many default values are used. */
4189 gc_values
.font
= f
->output_data
.x
->font
->fid
;
4190 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
4191 gc_values
.background
= f
->output_data
.x
->background_pixel
;
4192 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
4193 f
->output_data
.x
->normal_gc
4194 = XCreateGC (FRAME_X_DISPLAY (f
),
4196 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
4199 /* Reverse video style. */
4200 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4201 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
4202 f
->output_data
.x
->reverse_gc
4203 = XCreateGC (FRAME_X_DISPLAY (f
),
4205 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
4208 /* Cursor has cursor-color background, background-color foreground. */
4209 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4210 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
4211 gc_values
.fill_style
= FillOpaqueStippled
;
4213 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
4214 FRAME_X_DISPLAY_INFO (f
)->root_window
,
4215 cursor_bits
, 16, 16);
4216 f
->output_data
.x
->cursor_gc
4217 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4218 (GCFont
| GCForeground
| GCBackground
4219 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
4223 f
->output_data
.x
->white_relief
.gc
= 0;
4224 f
->output_data
.x
->black_relief
.gc
= 0;
4226 /* Create the gray border tile used when the pointer is not in
4227 the frame. Since this depends on the frame's pixel values,
4228 this must be done on a per-frame basis. */
4229 f
->output_data
.x
->border_tile
4230 = (XCreatePixmapFromBitmapData
4231 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
4232 gray_bits
, gray_width
, gray_height
,
4233 f
->output_data
.x
->foreground_pixel
,
4234 f
->output_data
.x
->background_pixel
,
4235 DefaultDepth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
))));
4241 /* Free what was was allocated in x_make_gc. */
4247 Display
*dpy
= FRAME_X_DISPLAY (f
);
4251 if (f
->output_data
.x
->normal_gc
)
4253 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
4254 f
->output_data
.x
->normal_gc
= 0;
4257 if (f
->output_data
.x
->reverse_gc
)
4259 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4260 f
->output_data
.x
->reverse_gc
= 0;
4263 if (f
->output_data
.x
->cursor_gc
)
4265 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4266 f
->output_data
.x
->cursor_gc
= 0;
4269 if (f
->output_data
.x
->border_tile
)
4271 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4272 f
->output_data
.x
->border_tile
= 0;
4279 /* Handler for signals raised during x_create_frame and
4280 x_create_top_frame. FRAME is the frame which is partially
4284 unwind_create_frame (frame
)
4287 struct frame
*f
= XFRAME (frame
);
4289 /* If frame is ``official'', nothing to do. */
4290 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4293 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4296 x_free_frame_resources (f
);
4298 /* Check that reference counts are indeed correct. */
4299 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4300 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4308 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4310 doc
: /* Make a new X window, which is called a "frame" in Emacs terms.
4311 Returns an Emacs frame object.
4312 ALIST is an alist of frame parameters.
4313 If the parameters specify that the frame should not have a minibuffer,
4314 and do not specify a specific minibuffer window to use,
4315 then `default-minibuffer-frame' must be a frame whose minibuffer can
4316 be shared by the new frame.
4318 This function is an internal primitive--use `make-frame' instead. */)
4323 Lisp_Object frame
, tem
;
4325 int minibuffer_only
= 0;
4326 long window_prompting
= 0;
4328 int count
= SPECPDL_INDEX ();
4329 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4330 Lisp_Object display
;
4331 struct x_display_info
*dpyinfo
= NULL
;
4337 /* Use this general default value to start with
4338 until we know if this frame has a specified name. */
4339 Vx_resource_name
= Vinvocation_name
;
4341 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4342 if (EQ (display
, Qunbound
))
4344 dpyinfo
= check_x_display_info (display
);
4346 kb
= dpyinfo
->kboard
;
4348 kb
= &the_only_kboard
;
4351 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4353 && ! EQ (name
, Qunbound
)
4355 error ("Invalid frame name--not a string or nil");
4358 Vx_resource_name
= name
;
4360 /* See if parent window is specified. */
4361 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4362 if (EQ (parent
, Qunbound
))
4364 if (! NILP (parent
))
4365 CHECK_NUMBER (parent
);
4367 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4368 /* No need to protect DISPLAY because that's not used after passing
4369 it to make_frame_without_minibuffer. */
4371 GCPRO4 (parms
, parent
, name
, frame
);
4372 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4374 if (EQ (tem
, Qnone
) || NILP (tem
))
4375 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4376 else if (EQ (tem
, Qonly
))
4378 f
= make_minibuffer_frame ();
4379 minibuffer_only
= 1;
4381 else if (WINDOWP (tem
))
4382 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4386 XSETFRAME (frame
, f
);
4388 /* Note that X Windows does support scroll bars. */
4389 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4391 f
->output_method
= output_x_window
;
4392 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4393 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4394 f
->output_data
.x
->icon_bitmap
= -1;
4395 f
->output_data
.x
->fontset
= -1;
4396 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4397 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4398 #ifdef USE_TOOLKIT_SCROLL_BARS
4399 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
4400 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
4401 #endif /* USE_TOOLKIT_SCROLL_BARS */
4402 record_unwind_protect (unwind_create_frame
, frame
);
4405 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4407 if (! STRINGP (f
->icon_name
))
4408 f
->icon_name
= Qnil
;
4410 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4412 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4413 dpyinfo_refcount
= dpyinfo
->reference_count
;
4414 #endif /* GLYPH_DEBUG */
4416 FRAME_KBOARD (f
) = kb
;
4419 /* These colors will be set anyway later, but it's important
4420 to get the color reference counts right, so initialize them! */
4423 struct gcpro gcpro1
;
4425 /* Function x_decode_color can signal an error. Make
4426 sure to initialize color slots so that we won't try
4427 to free colors we haven't allocated. */
4428 f
->output_data
.x
->foreground_pixel
= -1;
4429 f
->output_data
.x
->background_pixel
= -1;
4430 f
->output_data
.x
->cursor_pixel
= -1;
4431 f
->output_data
.x
->cursor_foreground_pixel
= -1;
4432 f
->output_data
.x
->border_pixel
= -1;
4433 f
->output_data
.x
->mouse_pixel
= -1;
4435 black
= build_string ("black");
4437 f
->output_data
.x
->foreground_pixel
4438 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4439 f
->output_data
.x
->background_pixel
4440 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4441 f
->output_data
.x
->cursor_pixel
4442 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4443 f
->output_data
.x
->cursor_foreground_pixel
4444 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4445 f
->output_data
.x
->border_pixel
4446 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4447 f
->output_data
.x
->mouse_pixel
4448 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4452 /* Specify the parent under which to make this X window. */
4456 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4457 f
->output_data
.x
->explicit_parent
= 1;
4461 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4462 f
->output_data
.x
->explicit_parent
= 0;
4465 /* Set the name; the functions to which we pass f expect the name to
4467 if (EQ (name
, Qunbound
) || NILP (name
))
4469 f
->name
= build_string (dpyinfo
->x_id_name
);
4470 f
->explicit_name
= 0;
4475 f
->explicit_name
= 1;
4476 /* use the frame's title when getting resources for this frame. */
4477 specbind (Qx_resource_name
, name
);
4480 /* Extract the window parameters from the supplied values
4481 that are needed to determine window geometry. */
4485 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4488 /* First, try whatever font the caller has specified. */
4491 tem
= Fquery_fontset (font
, Qnil
);
4493 font
= x_new_fontset (f
, SDATA (tem
));
4495 font
= x_new_font (f
, SDATA (font
));
4498 /* Try out a font which we hope has bold and italic variations. */
4499 if (!STRINGP (font
))
4500 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4501 if (!STRINGP (font
))
4502 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4503 if (! STRINGP (font
))
4504 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4505 if (! STRINGP (font
))
4506 /* This was formerly the first thing tried, but it finds too many fonts
4507 and takes too long. */
4508 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4509 /* If those didn't work, look for something which will at least work. */
4510 if (! STRINGP (font
))
4511 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4513 if (! STRINGP (font
))
4514 font
= build_string ("fixed");
4516 x_default_parameter (f
, parms
, Qfont
, font
,
4517 "font", "Font", RES_TYPE_STRING
);
4521 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4522 whereby it fails to get any font. */
4523 xlwmenu_default_font
= f
->output_data
.x
->font
;
4526 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4527 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4529 /* This defaults to 1 in order to match xterm. We recognize either
4530 internalBorderWidth or internalBorder (which is what xterm calls
4532 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4536 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4537 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4538 if (! EQ (value
, Qunbound
))
4539 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4542 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4543 "internalBorderWidth", "internalBorderWidth",
4545 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4546 "verticalScrollBars", "ScrollBars",
4549 /* Also do the stuff which must be set before the window exists. */
4550 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4551 "foreground", "Foreground", RES_TYPE_STRING
);
4552 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4553 "background", "Background", RES_TYPE_STRING
);
4554 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4555 "pointerColor", "Foreground", RES_TYPE_STRING
);
4556 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4557 "cursorColor", "Foreground", RES_TYPE_STRING
);
4558 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4559 "borderColor", "BorderColor", RES_TYPE_STRING
);
4560 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4561 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4562 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4563 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4564 x_default_parameter (f
, parms
, Qleft_fringe
, Qnil
,
4565 "leftFringe", "LeftFringe", RES_TYPE_NUMBER
);
4566 x_default_parameter (f
, parms
, Qright_fringe
, Qnil
,
4567 "rightFringe", "RightFringe", RES_TYPE_NUMBER
);
4569 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4570 "scrollBarForeground",
4571 "ScrollBarForeground", 1);
4572 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4573 "scrollBarBackground",
4574 "ScrollBarBackground", 0);
4576 /* Init faces before x_default_parameter is called for scroll-bar
4577 parameters because that function calls x_set_scroll_bar_width,
4578 which calls change_frame_size, which calls Fset_window_buffer,
4579 which runs hooks, which call Fvertical_motion. At the end, we
4580 end up in init_iterator with a null face cache, which should not
4582 init_frame_faces (f
);
4584 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4585 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4586 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4587 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4588 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4589 "bufferPredicate", "BufferPredicate",
4591 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4592 "title", "Title", RES_TYPE_STRING
);
4593 x_default_parameter (f
, parms
, Qwait_for_wm
, Qt
,
4594 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN
);
4595 x_default_parameter (f
, parms
, Qfullscreen
, Qnil
,
4596 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL
);
4598 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4600 /* Add the tool-bar height to the initial frame height so that the
4601 user gets a text display area of the size he specified with -g or
4602 via .Xdefaults. Later changes of the tool-bar height don't
4603 change the frame size. This is done so that users can create
4604 tall Emacs frames without having to guess how tall the tool-bar
4606 if (FRAME_TOOL_BAR_LINES (f
))
4608 int margin
, relief
, bar_height
;
4610 relief
= (tool_bar_button_relief
>= 0
4611 ? tool_bar_button_relief
4612 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4614 if (INTEGERP (Vtool_bar_button_margin
)
4615 && XINT (Vtool_bar_button_margin
) > 0)
4616 margin
= XFASTINT (Vtool_bar_button_margin
);
4617 else if (CONSP (Vtool_bar_button_margin
)
4618 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4619 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4620 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4624 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4625 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4628 /* Compute the size of the X window. */
4629 window_prompting
= x_figure_window_size (f
, parms
);
4631 if (window_prompting
& XNegative
)
4633 if (window_prompting
& YNegative
)
4634 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4636 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4640 if (window_prompting
& YNegative
)
4641 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4643 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4646 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4648 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4649 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4651 /* Create the X widget or window. */
4652 #ifdef USE_X_TOOLKIT
4653 x_window (f
, window_prompting
, minibuffer_only
);
4661 /* Now consider the frame official. */
4662 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4663 Vframe_list
= Fcons (frame
, Vframe_list
);
4665 /* We need to do this after creating the X window, so that the
4666 icon-creation functions can say whose icon they're describing. */
4667 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4668 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4670 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4671 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4672 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4673 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4674 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4675 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4676 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4677 "scrollBarWidth", "ScrollBarWidth",
4680 /* Dimensions, especially f->height, must be done via change_frame_size.
4681 Change will not be effected unless different from the current
4687 SET_FRAME_WIDTH (f
, 0);
4688 change_frame_size (f
, height
, width
, 1, 0, 0);
4690 /* Set up faces after all frame parameters are known. This call
4691 also merges in face attributes specified for new frames. If we
4692 don't do this, the `menu' face for instance won't have the right
4693 colors, and the menu bar won't appear in the specified colors for
4695 call1 (Qface_set_after_frame_default
, frame
);
4697 #ifdef USE_X_TOOLKIT
4698 /* Create the menu bar. */
4699 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4701 /* If this signals an error, we haven't set size hints for the
4702 frame and we didn't make it visible. */
4703 initialize_frame_menubar (f
);
4705 /* This is a no-op, except under Motif where it arranges the
4706 main window for the widgets on it. */
4707 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4708 f
->output_data
.x
->menubar_widget
,
4709 f
->output_data
.x
->edit_widget
);
4711 #endif /* USE_X_TOOLKIT */
4713 /* Tell the server what size and position, etc, we want, and how
4714 badly we want them. This should be done after we have the menu
4715 bar so that its size can be taken into account. */
4717 x_wm_set_size_hint (f
, window_prompting
, 0);
4720 /* Make the window appear on the frame and enable display, unless
4721 the caller says not to. However, with explicit parent, Emacs
4722 cannot control visibility, so don't try. */
4723 if (! f
->output_data
.x
->explicit_parent
)
4725 Lisp_Object visibility
;
4727 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4729 if (EQ (visibility
, Qunbound
))
4732 if (EQ (visibility
, Qicon
))
4733 x_iconify_frame (f
);
4734 else if (! NILP (visibility
))
4735 x_make_frame_visible (f
);
4737 /* Must have been Qnil. */
4743 /* Make sure windows on this frame appear in calls to next-window
4744 and similar functions. */
4745 Vwindow_list
= Qnil
;
4747 return unbind_to (count
, frame
);
4751 /* FRAME is used only to get a handle on the X display. We don't pass the
4752 display info directly because we're called from frame.c, which doesn't
4753 know about that structure. */
4756 x_get_focus_frame (frame
)
4757 struct frame
*frame
;
4759 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4761 if (! dpyinfo
->x_focus_frame
)
4764 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4769 /* In certain situations, when the window manager follows a
4770 click-to-focus policy, there seems to be no way around calling
4771 XSetInputFocus to give another frame the input focus .
4773 In an ideal world, XSetInputFocus should generally be avoided so
4774 that applications don't interfere with the window manager's focus
4775 policy. But I think it's okay to use when it's clearly done
4776 following a user-command. */
4778 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4779 doc
: /* Set the input focus to FRAME.
4780 FRAME nil means use the selected frame. */)
4784 struct frame
*f
= check_x_frame (frame
);
4785 Display
*dpy
= FRAME_X_DISPLAY (f
);
4789 count
= x_catch_errors (dpy
);
4790 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4791 RevertToParent
, CurrentTime
);
4792 x_uncatch_errors (dpy
, count
);
4799 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4800 doc
: /* Internal function called by `color-defined-p', which see. */)
4802 Lisp_Object color
, frame
;
4805 FRAME_PTR f
= check_x_frame (frame
);
4807 CHECK_STRING (color
);
4809 if (x_defined_color (f
, SDATA (color
), &foo
, 0))
4815 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4816 doc
: /* Internal function called by `color-values', which see. */)
4818 Lisp_Object color
, frame
;
4821 FRAME_PTR f
= check_x_frame (frame
);
4823 CHECK_STRING (color
);
4825 if (x_defined_color (f
, SDATA (color
), &foo
, 0))
4829 rgb
[0] = make_number (foo
.red
);
4830 rgb
[1] = make_number (foo
.green
);
4831 rgb
[2] = make_number (foo
.blue
);
4832 return Flist (3, rgb
);
4838 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4839 doc
: /* Internal function called by `display-color-p', which see. */)
4841 Lisp_Object display
;
4843 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4845 if (dpyinfo
->n_planes
<= 2)
4848 switch (dpyinfo
->visual
->class)
4861 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4863 doc
: /* Return t if the X display supports shades of gray.
4864 Note that color displays do support shades of gray.
4865 The optional argument DISPLAY specifies which display to ask about.
4866 DISPLAY should be either a frame or a display name (a string).
4867 If omitted or nil, that stands for the selected frame's display. */)
4869 Lisp_Object display
;
4871 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4873 if (dpyinfo
->n_planes
<= 1)
4876 switch (dpyinfo
->visual
->class)
4891 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4893 doc
: /* Returns the width in pixels of the X display DISPLAY.
4894 The optional argument DISPLAY specifies which display to ask about.
4895 DISPLAY should be either a frame or a display name (a string).
4896 If omitted or nil, that stands for the selected frame's display. */)
4898 Lisp_Object display
;
4900 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4902 return make_number (dpyinfo
->width
);
4905 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4906 Sx_display_pixel_height
, 0, 1, 0,
4907 doc
: /* Returns the height in pixels of the X display DISPLAY.
4908 The optional argument DISPLAY specifies which display to ask about.
4909 DISPLAY should be either a frame or a display name (a string).
4910 If omitted or nil, that stands for the selected frame's display. */)
4912 Lisp_Object display
;
4914 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4916 return make_number (dpyinfo
->height
);
4919 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4921 doc
: /* Returns the number of bitplanes of the X display DISPLAY.
4922 The optional argument DISPLAY specifies which display to ask about.
4923 DISPLAY should be either a frame or a display name (a string).
4924 If omitted or nil, that stands for the selected frame's display. */)
4926 Lisp_Object display
;
4928 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4930 return make_number (dpyinfo
->n_planes
);
4933 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4935 doc
: /* Returns the number of color cells of the X display DISPLAY.
4936 The optional argument DISPLAY specifies which display to ask about.
4937 DISPLAY should be either a frame or a display name (a string).
4938 If omitted or nil, that stands for the selected frame's display. */)
4940 Lisp_Object display
;
4942 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4944 return make_number (DisplayCells (dpyinfo
->display
,
4945 XScreenNumberOfScreen (dpyinfo
->screen
)));
4948 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4949 Sx_server_max_request_size
,
4951 doc
: /* Returns the maximum request size of the X server of display DISPLAY.
4952 The optional argument DISPLAY specifies which display to ask about.
4953 DISPLAY should be either a frame or a display name (a string).
4954 If omitted or nil, that stands for the selected frame's display. */)
4956 Lisp_Object display
;
4958 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4960 return make_number (MAXREQUEST (dpyinfo
->display
));
4963 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4964 doc
: /* Returns the vendor ID string of the X server of display DISPLAY.
4965 The optional argument DISPLAY specifies which display to ask about.
4966 DISPLAY should be either a frame or a display name (a string).
4967 If omitted or nil, that stands for the selected frame's display. */)
4969 Lisp_Object display
;
4971 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4972 char *vendor
= ServerVendor (dpyinfo
->display
);
4974 if (! vendor
) vendor
= "";
4975 return build_string (vendor
);
4978 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4979 doc
: /* Returns the version numbers of the X server of display DISPLAY.
4980 The value is a list of three integers: the major and minor
4981 version numbers of the X Protocol in use, and the vendor-specific release
4982 number. See also the function `x-server-vendor'.
4984 The optional argument DISPLAY specifies which display to ask about.
4985 DISPLAY should be either a frame or a display name (a string).
4986 If omitted or nil, that stands for the selected frame's display. */)
4988 Lisp_Object display
;
4990 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4991 Display
*dpy
= dpyinfo
->display
;
4993 return Fcons (make_number (ProtocolVersion (dpy
)),
4994 Fcons (make_number (ProtocolRevision (dpy
)),
4995 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4998 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4999 doc
: /* Return the number of screens on the X server of display DISPLAY.
5000 The optional argument DISPLAY specifies which display to ask about.
5001 DISPLAY should be either a frame or a display name (a string).
5002 If omitted or nil, that stands for the selected frame's display. */)
5004 Lisp_Object display
;
5006 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5008 return make_number (ScreenCount (dpyinfo
->display
));
5011 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
5012 doc
: /* Return the height in millimeters of the X display DISPLAY.
5013 The optional argument DISPLAY specifies which display to ask about.
5014 DISPLAY should be either a frame or a display name (a string).
5015 If omitted or nil, that stands for the selected frame's display. */)
5017 Lisp_Object display
;
5019 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5021 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
5024 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
5025 doc
: /* Return the width in millimeters of the X display DISPLAY.
5026 The optional argument DISPLAY specifies which display to ask about.
5027 DISPLAY should be either a frame or a display name (a string).
5028 If omitted or nil, that stands for the selected frame's display. */)
5030 Lisp_Object display
;
5032 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5034 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
5037 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
5038 Sx_display_backing_store
, 0, 1, 0,
5039 doc
: /* Returns an indication of whether X display DISPLAY does backing store.
5040 The value may be `always', `when-mapped', or `not-useful'.
5041 The optional argument DISPLAY specifies which display to ask about.
5042 DISPLAY should be either a frame or a display name (a string).
5043 If omitted or nil, that stands for the selected frame's display. */)
5045 Lisp_Object display
;
5047 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5050 switch (DoesBackingStore (dpyinfo
->screen
))
5053 result
= intern ("always");
5057 result
= intern ("when-mapped");
5061 result
= intern ("not-useful");
5065 error ("Strange value for BackingStore parameter of screen");
5072 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
5073 Sx_display_visual_class
, 0, 1, 0,
5074 doc
: /* Return the visual class of the X display DISPLAY.
5075 The value is one of the symbols `static-gray', `gray-scale',
5076 `static-color', `pseudo-color', `true-color', or `direct-color'.
5078 The optional argument DISPLAY specifies which display to ask about.
5079 DISPLAY should be either a frame or a display name (a string).
5080 If omitted or nil, that stands for the selected frame's display. */)
5082 Lisp_Object display
;
5084 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5087 switch (dpyinfo
->visual
->class)
5090 result
= intern ("static-gray");
5093 result
= intern ("gray-scale");
5096 result
= intern ("static-color");
5099 result
= intern ("pseudo-color");
5102 result
= intern ("true-color");
5105 result
= intern ("direct-color");
5108 error ("Display has an unknown visual class");
5115 DEFUN ("x-display-save-under", Fx_display_save_under
,
5116 Sx_display_save_under
, 0, 1, 0,
5117 doc
: /* Returns t if the X display DISPLAY supports the save-under feature.
5118 The optional argument DISPLAY specifies which display to ask about.
5119 DISPLAY should be either a frame or a display name (a string).
5120 If omitted or nil, that stands for the selected frame's display. */)
5122 Lisp_Object display
;
5124 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5126 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
5134 register struct frame
*f
;
5136 return PIXEL_WIDTH (f
);
5141 register struct frame
*f
;
5143 return PIXEL_HEIGHT (f
);
5148 register struct frame
*f
;
5150 return FONT_WIDTH (f
->output_data
.x
->font
);
5155 register struct frame
*f
;
5157 return f
->output_data
.x
->line_height
;
5162 register struct frame
*f
;
5164 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
5169 /************************************************************************
5171 ************************************************************************/
5174 /* Mapping visual names to visuals. */
5176 static struct visual_class
5183 {"StaticGray", StaticGray
},
5184 {"GrayScale", GrayScale
},
5185 {"StaticColor", StaticColor
},
5186 {"PseudoColor", PseudoColor
},
5187 {"TrueColor", TrueColor
},
5188 {"DirectColor", DirectColor
},
5193 #ifndef HAVE_XSCREENNUMBEROFSCREEN
5195 /* Value is the screen number of screen SCR. This is a substitute for
5196 the X function with the same name when that doesn't exist. */
5199 XScreenNumberOfScreen (scr
)
5200 register Screen
*scr
;
5202 Display
*dpy
= scr
->display
;
5205 for (i
= 0; i
< dpy
->nscreens
; ++i
)
5206 if (scr
== dpy
->screens
+ i
)
5212 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5215 /* Select the visual that should be used on display DPYINFO. Set
5216 members of DPYINFO appropriately. Called from x_term_init. */
5219 select_visual (dpyinfo
)
5220 struct x_display_info
*dpyinfo
;
5222 Display
*dpy
= dpyinfo
->display
;
5223 Screen
*screen
= dpyinfo
->screen
;
5226 /* See if a visual is specified. */
5227 value
= display_x_get_resource (dpyinfo
,
5228 build_string ("visualClass"),
5229 build_string ("VisualClass"),
5231 if (STRINGP (value
))
5233 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
5234 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
5235 depth, a decimal number. NAME is compared with case ignored. */
5236 char *s
= (char *) alloca (SBYTES (value
) + 1);
5241 strcpy (s
, SDATA (value
));
5242 dash
= index (s
, '-');
5245 dpyinfo
->n_planes
= atoi (dash
+ 1);
5249 /* We won't find a matching visual with depth 0, so that
5250 an error will be printed below. */
5251 dpyinfo
->n_planes
= 0;
5253 /* Determine the visual class. */
5254 for (i
= 0; visual_classes
[i
].name
; ++i
)
5255 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
5257 class = visual_classes
[i
].class;
5261 /* Look up a matching visual for the specified class. */
5263 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
5264 dpyinfo
->n_planes
, class, &vinfo
))
5265 fatal ("Invalid visual specification `%s'", SDATA (value
));
5267 dpyinfo
->visual
= vinfo
.visual
;
5272 XVisualInfo
*vinfo
, vinfo_template
;
5274 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
5277 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
5279 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
5281 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5282 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
5283 &vinfo_template
, &n_visuals
);
5285 fatal ("Can't get proper X visual info");
5287 dpyinfo
->n_planes
= vinfo
->depth
;
5288 XFree ((char *) vinfo
);
5293 /* Return the X display structure for the display named NAME.
5294 Open a new connection if necessary. */
5296 struct x_display_info
*
5297 x_display_info_for_name (name
)
5301 struct x_display_info
*dpyinfo
;
5303 CHECK_STRING (name
);
5305 if (! EQ (Vwindow_system
, intern ("x")))
5306 error ("Not using X Windows");
5308 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5310 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5313 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5318 /* Use this general default value to start with. */
5319 Vx_resource_name
= Vinvocation_name
;
5321 validate_x_resource_name ();
5323 dpyinfo
= x_term_init (name
, (char *)0,
5324 (char *) SDATA (Vx_resource_name
));
5327 error ("Cannot connect to X server %s", SDATA (name
));
5330 XSETFASTINT (Vwindow_system_version
, 11);
5336 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5338 doc
: /* Open a connection to an X server.
5339 DISPLAY is the name of the display to connect to.
5340 Optional second arg XRM-STRING is a string of resources in xrdb format.
5341 If the optional third arg MUST-SUCCEED is non-nil,
5342 terminate Emacs if we can't open the connection. */)
5343 (display
, xrm_string
, must_succeed
)
5344 Lisp_Object display
, xrm_string
, must_succeed
;
5346 unsigned char *xrm_option
;
5347 struct x_display_info
*dpyinfo
;
5349 CHECK_STRING (display
);
5350 if (! NILP (xrm_string
))
5351 CHECK_STRING (xrm_string
);
5353 if (! EQ (Vwindow_system
, intern ("x")))
5354 error ("Not using X Windows");
5356 if (! NILP (xrm_string
))
5357 xrm_option
= (unsigned char *) SDATA (xrm_string
);
5359 xrm_option
= (unsigned char *) 0;
5361 validate_x_resource_name ();
5363 /* This is what opens the connection and sets x_current_display.
5364 This also initializes many symbols, such as those used for input. */
5365 dpyinfo
= x_term_init (display
, xrm_option
,
5366 (char *) SDATA (Vx_resource_name
));
5370 if (!NILP (must_succeed
))
5371 fatal ("Cannot connect to X server %s.\n\
5372 Check the DISPLAY environment variable or use `-d'.\n\
5373 Also use the `xauth' program to verify that you have the proper
5374 authoritization information needed to connect the X server.\n\
5375 An insecure way to solve the problem may be to use `xhost'.\n",
5378 error ("Cannot connect to X server %s", SDATA (display
));
5383 XSETFASTINT (Vwindow_system_version
, 11);
5387 DEFUN ("x-close-connection", Fx_close_connection
,
5388 Sx_close_connection
, 1, 1, 0,
5389 doc
: /* Close the connection to DISPLAY's X server.
5390 For DISPLAY, specify either a frame or a display name (a string).
5391 If DISPLAY is nil, that stands for the selected frame's display. */)
5393 Lisp_Object display
;
5395 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5398 if (dpyinfo
->reference_count
> 0)
5399 error ("Display still has frames on it");
5402 /* Free the fonts in the font table. */
5403 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5404 if (dpyinfo
->font_table
[i
].name
)
5406 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5407 xfree (dpyinfo
->font_table
[i
].full_name
);
5408 xfree (dpyinfo
->font_table
[i
].name
);
5409 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5412 x_destroy_all_bitmaps (dpyinfo
);
5413 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5415 #ifdef USE_X_TOOLKIT
5416 XtCloseDisplay (dpyinfo
->display
);
5418 XCloseDisplay (dpyinfo
->display
);
5421 x_delete_display (dpyinfo
);
5427 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5428 doc
: /* Return the list of display names that Emacs has connections to. */)
5431 Lisp_Object tail
, result
;
5434 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5435 result
= Fcons (XCAR (XCAR (tail
)), result
);
5440 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5441 doc
: /* If ON is non-nil, report X errors as soon as the erring request is made.
5442 If ON is nil, allow buffering of requests.
5443 Turning on synchronization prohibits the Xlib routines from buffering
5444 requests and seriously degrades performance, but makes debugging much
5446 The optional second argument DISPLAY specifies which display to act on.
5447 DISPLAY should be either a frame or a display name (a string).
5448 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
5450 Lisp_Object display
, on
;
5452 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5454 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5459 /* Wait for responses to all X commands issued so far for frame F. */
5466 XSync (FRAME_X_DISPLAY (f
), False
);
5471 /***********************************************************************
5473 ***********************************************************************/
5475 /* Value is the number of elements of vector VECTOR. */
5477 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5479 /* List of supported image types. Use define_image_type to add new
5480 types. Use lookup_image_type to find a type for a given symbol. */
5482 static struct image_type
*image_types
;
5484 /* The symbol `image' which is the car of the lists used to represent
5487 extern Lisp_Object Qimage
;
5489 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5495 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5496 extern Lisp_Object QCdata
, QCtype
;
5497 Lisp_Object QCascent
, QCmargin
, QCrelief
;
5498 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5499 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5501 /* Other symbols. */
5503 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5505 /* Time in seconds after which images should be removed from the cache
5506 if not displayed. */
5508 Lisp_Object Vimage_cache_eviction_delay
;
5510 /* Function prototypes. */
5512 static void define_image_type
P_ ((struct image_type
*type
));
5513 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5514 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5515 static void x_laplace
P_ ((struct frame
*, struct image
*));
5516 static void x_emboss
P_ ((struct frame
*, struct image
*));
5517 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5521 /* Define a new image type from TYPE. This adds a copy of TYPE to
5522 image_types and adds the symbol *TYPE->type to Vimage_types. */
5525 define_image_type (type
)
5526 struct image_type
*type
;
5528 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5529 The initialized data segment is read-only. */
5530 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5531 bcopy (type
, p
, sizeof *p
);
5532 p
->next
= image_types
;
5534 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5538 /* Look up image type SYMBOL, and return a pointer to its image_type
5539 structure. Value is null if SYMBOL is not a known image type. */
5541 static INLINE
struct image_type
*
5542 lookup_image_type (symbol
)
5545 struct image_type
*type
;
5547 for (type
= image_types
; type
; type
= type
->next
)
5548 if (EQ (symbol
, *type
->type
))
5555 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5556 valid image specification is a list whose car is the symbol
5557 `image', and whose rest is a property list. The property list must
5558 contain a value for key `:type'. That value must be the name of a
5559 supported image type. The rest of the property list depends on the
5563 valid_image_p (object
)
5568 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5572 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
5573 if (EQ (XCAR (tem
), QCtype
))
5576 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
5578 struct image_type
*type
;
5579 type
= lookup_image_type (XCAR (tem
));
5581 valid_p
= type
->valid_p (object
);
5592 /* Log error message with format string FORMAT and argument ARG.
5593 Signaling an error, e.g. when an image cannot be loaded, is not a
5594 good idea because this would interrupt redisplay, and the error
5595 message display would lead to another redisplay. This function
5596 therefore simply displays a message. */
5599 image_error (format
, arg1
, arg2
)
5601 Lisp_Object arg1
, arg2
;
5603 add_to_log (format
, arg1
, arg2
);
5608 /***********************************************************************
5609 Image specifications
5610 ***********************************************************************/
5612 enum image_value_type
5614 IMAGE_DONT_CHECK_VALUE_TYPE
,
5616 IMAGE_STRING_OR_NIL_VALUE
,
5618 IMAGE_POSITIVE_INTEGER_VALUE
,
5619 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5620 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5622 IMAGE_INTEGER_VALUE
,
5623 IMAGE_FUNCTION_VALUE
,
5628 /* Structure used when parsing image specifications. */
5630 struct image_keyword
5632 /* Name of keyword. */
5635 /* The type of value allowed. */
5636 enum image_value_type type
;
5638 /* Non-zero means key must be present. */
5641 /* Used to recognize duplicate keywords in a property list. */
5644 /* The value that was found. */
5649 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5651 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5654 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5655 has the format (image KEYWORD VALUE ...). One of the keyword/
5656 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5657 image_keywords structures of size NKEYWORDS describing other
5658 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5661 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5663 struct image_keyword
*keywords
;
5670 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5673 plist
= XCDR (spec
);
5674 while (CONSP (plist
))
5676 Lisp_Object key
, value
;
5678 /* First element of a pair must be a symbol. */
5680 plist
= XCDR (plist
);
5684 /* There must follow a value. */
5687 value
= XCAR (plist
);
5688 plist
= XCDR (plist
);
5690 /* Find key in KEYWORDS. Error if not found. */
5691 for (i
= 0; i
< nkeywords
; ++i
)
5692 if (strcmp (keywords
[i
].name
, SDATA (SYMBOL_NAME (key
))) == 0)
5698 /* Record that we recognized the keyword. If a keywords
5699 was found more than once, it's an error. */
5700 keywords
[i
].value
= value
;
5701 ++keywords
[i
].count
;
5703 if (keywords
[i
].count
> 1)
5706 /* Check type of value against allowed type. */
5707 switch (keywords
[i
].type
)
5709 case IMAGE_STRING_VALUE
:
5710 if (!STRINGP (value
))
5714 case IMAGE_STRING_OR_NIL_VALUE
:
5715 if (!STRINGP (value
) && !NILP (value
))
5719 case IMAGE_SYMBOL_VALUE
:
5720 if (!SYMBOLP (value
))
5724 case IMAGE_POSITIVE_INTEGER_VALUE
:
5725 if (!INTEGERP (value
) || XINT (value
) <= 0)
5729 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5730 if (INTEGERP (value
) && XINT (value
) >= 0)
5733 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5734 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5738 case IMAGE_ASCENT_VALUE
:
5739 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5741 else if (INTEGERP (value
)
5742 && XINT (value
) >= 0
5743 && XINT (value
) <= 100)
5747 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5748 if (!INTEGERP (value
) || XINT (value
) < 0)
5752 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5755 case IMAGE_FUNCTION_VALUE
:
5756 value
= indirect_function (value
);
5758 || COMPILEDP (value
)
5759 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5763 case IMAGE_NUMBER_VALUE
:
5764 if (!INTEGERP (value
) && !FLOATP (value
))
5768 case IMAGE_INTEGER_VALUE
:
5769 if (!INTEGERP (value
))
5773 case IMAGE_BOOL_VALUE
:
5774 if (!NILP (value
) && !EQ (value
, Qt
))
5783 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5787 /* Check that all mandatory fields are present. */
5788 for (i
= 0; i
< nkeywords
; ++i
)
5789 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5792 return NILP (plist
);
5796 /* Return the value of KEY in image specification SPEC. Value is nil
5797 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5798 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5801 image_spec_value (spec
, key
, found
)
5802 Lisp_Object spec
, key
;
5807 xassert (valid_image_p (spec
));
5809 for (tail
= XCDR (spec
);
5810 CONSP (tail
) && CONSP (XCDR (tail
));
5811 tail
= XCDR (XCDR (tail
)))
5813 if (EQ (XCAR (tail
), key
))
5817 return XCAR (XCDR (tail
));
5827 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5828 doc
: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
5829 PIXELS non-nil means return the size in pixels, otherwise return the
5830 size in canonical character units.
5831 FRAME is the frame on which the image will be displayed. FRAME nil
5832 or omitted means use the selected frame. */)
5833 (spec
, pixels
, frame
)
5834 Lisp_Object spec
, pixels
, frame
;
5839 if (valid_image_p (spec
))
5841 struct frame
*f
= check_x_frame (frame
);
5842 int id
= lookup_image (f
, spec
);
5843 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5844 int width
= img
->width
+ 2 * img
->hmargin
;
5845 int height
= img
->height
+ 2 * img
->vmargin
;
5848 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5849 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5851 size
= Fcons (make_number (width
), make_number (height
));
5854 error ("Invalid image specification");
5860 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5861 doc
: /* Return t if image SPEC has a mask bitmap.
5862 FRAME is the frame on which the image will be displayed. FRAME nil
5863 or omitted means use the selected frame. */)
5865 Lisp_Object spec
, frame
;
5870 if (valid_image_p (spec
))
5872 struct frame
*f
= check_x_frame (frame
);
5873 int id
= lookup_image (f
, spec
);
5874 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5879 error ("Invalid image specification");
5886 /***********************************************************************
5887 Image type independent image structures
5888 ***********************************************************************/
5890 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5891 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5894 /* Allocate and return a new image structure for image specification
5895 SPEC. SPEC has a hash value of HASH. */
5897 static struct image
*
5898 make_image (spec
, hash
)
5902 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5904 xassert (valid_image_p (spec
));
5905 bzero (img
, sizeof *img
);
5906 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5907 xassert (img
->type
!= NULL
);
5909 img
->data
.lisp_val
= Qnil
;
5910 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5916 /* Free image IMG which was used on frame F, including its resources. */
5925 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5927 /* Remove IMG from the hash table of its cache. */
5929 img
->prev
->next
= img
->next
;
5931 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5934 img
->next
->prev
= img
->prev
;
5936 c
->images
[img
->id
] = NULL
;
5938 /* Free resources, then free IMG. */
5939 img
->type
->free (f
, img
);
5945 /* Prepare image IMG for display on frame F. Must be called before
5946 drawing an image. */
5949 prepare_image_for_display (f
, img
)
5955 /* We're about to display IMG, so set its timestamp to `now'. */
5957 img
->timestamp
= EMACS_SECS (t
);
5959 /* If IMG doesn't have a pixmap yet, load it now, using the image
5960 type dependent loader function. */
5961 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5962 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5966 /* Value is the number of pixels for the ascent of image IMG when
5967 drawn in face FACE. */
5970 image_ascent (img
, face
)
5974 int height
= img
->height
+ img
->vmargin
;
5977 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5980 /* This expression is arranged so that if the image can't be
5981 exactly centered, it will be moved slightly up. This is
5982 because a typical font is `top-heavy' (due to the presence
5983 uppercase letters), so the image placement should err towards
5984 being top-heavy too. It also just generally looks better. */
5985 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5987 ascent
= height
/ 2;
5990 ascent
= height
* img
->ascent
/ 100.0;
5996 /* Image background colors. */
5998 static unsigned long
5999 four_corners_best (ximg
, width
, height
)
6001 unsigned long width
, height
;
6003 unsigned long corners
[4], best
;
6006 /* Get the colors at the corners of ximg. */
6007 corners
[0] = XGetPixel (ximg
, 0, 0);
6008 corners
[1] = XGetPixel (ximg
, width
- 1, 0);
6009 corners
[2] = XGetPixel (ximg
, width
- 1, height
- 1);
6010 corners
[3] = XGetPixel (ximg
, 0, height
- 1);
6012 /* Choose the most frequently found color as background. */
6013 for (i
= best_count
= 0; i
< 4; ++i
)
6017 for (j
= n
= 0; j
< 4; ++j
)
6018 if (corners
[i
] == corners
[j
])
6022 best
= corners
[i
], best_count
= n
;
6028 /* Return the `background' field of IMG. If IMG doesn't have one yet,
6029 it is guessed heuristically. If non-zero, XIMG is an existing XImage
6030 object to use for the heuristic. */
6033 image_background (img
, f
, ximg
)
6038 if (! img
->background_valid
)
6039 /* IMG doesn't have a background yet, try to guess a reasonable value. */
6041 int free_ximg
= !ximg
;
6044 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
6045 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
6047 img
->background
= four_corners_best (ximg
, img
->width
, img
->height
);
6050 XDestroyImage (ximg
);
6052 img
->background_valid
= 1;
6055 return img
->background
;
6058 /* Return the `background_transparent' field of IMG. If IMG doesn't
6059 have one yet, it is guessed heuristically. If non-zero, MASK is an
6060 existing XImage object to use for the heuristic. */
6063 image_background_transparent (img
, f
, mask
)
6068 if (! img
->background_transparent_valid
)
6069 /* IMG doesn't have a background yet, try to guess a reasonable value. */
6073 int free_mask
= !mask
;
6076 mask
= XGetImage (FRAME_X_DISPLAY (f
), img
->mask
,
6077 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
6079 img
->background_transparent
6080 = !four_corners_best (mask
, img
->width
, img
->height
);
6083 XDestroyImage (mask
);
6086 img
->background_transparent
= 0;
6088 img
->background_transparent_valid
= 1;
6091 return img
->background_transparent
;
6095 /***********************************************************************
6096 Helper functions for X image types
6097 ***********************************************************************/
6099 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
6101 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
6102 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
6104 Lisp_Object color_name
,
6105 unsigned long dflt
));
6108 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
6109 free the pixmap if any. MASK_P non-zero means clear the mask
6110 pixmap if any. COLORS_P non-zero means free colors allocated for
6111 the image, if any. */
6114 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
6117 int pixmap_p
, mask_p
, colors_p
;
6119 if (pixmap_p
&& img
->pixmap
)
6121 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
6123 img
->background_valid
= 0;
6126 if (mask_p
&& img
->mask
)
6128 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6130 img
->background_transparent_valid
= 0;
6133 if (colors_p
&& img
->ncolors
)
6135 x_free_colors (f
, img
->colors
, img
->ncolors
);
6136 xfree (img
->colors
);
6142 /* Free X resources of image IMG which is used on frame F. */
6145 x_clear_image (f
, img
)
6150 x_clear_image_1 (f
, img
, 1, 1, 1);
6155 /* Allocate color COLOR_NAME for image IMG on frame F. If color
6156 cannot be allocated, use DFLT. Add a newly allocated color to
6157 IMG->colors, so that it can be freed again. Value is the pixel
6160 static unsigned long
6161 x_alloc_image_color (f
, img
, color_name
, dflt
)
6164 Lisp_Object color_name
;
6168 unsigned long result
;
6170 xassert (STRINGP (color_name
));
6172 if (x_defined_color (f
, SDATA (color_name
), &color
, 1))
6174 /* This isn't called frequently so we get away with simply
6175 reallocating the color vector to the needed size, here. */
6178 (unsigned long *) xrealloc (img
->colors
,
6179 img
->ncolors
* sizeof *img
->colors
);
6180 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
6181 result
= color
.pixel
;
6191 /***********************************************************************
6193 ***********************************************************************/
6195 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
6196 static void postprocess_image
P_ ((struct frame
*, struct image
*));
6199 /* Return a new, initialized image cache that is allocated from the
6200 heap. Call free_image_cache to free an image cache. */
6202 struct image_cache
*
6205 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
6208 bzero (c
, sizeof *c
);
6210 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
6211 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
6212 c
->buckets
= (struct image
**) xmalloc (size
);
6213 bzero (c
->buckets
, size
);
6218 /* Free image cache of frame F. Be aware that X frames share images
6222 free_image_cache (f
)
6225 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6230 /* Cache should not be referenced by any frame when freed. */
6231 xassert (c
->refcount
== 0);
6233 for (i
= 0; i
< c
->used
; ++i
)
6234 free_image (f
, c
->images
[i
]);
6238 FRAME_X_IMAGE_CACHE (f
) = NULL
;
6243 /* Clear image cache of frame F. FORCE_P non-zero means free all
6244 images. FORCE_P zero means clear only images that haven't been
6245 displayed for some time. Should be called from time to time to
6246 reduce the number of loaded images. If image-eviction-seconds is
6247 non-nil, this frees images in the cache which weren't displayed for
6248 at least that many seconds. */
6251 clear_image_cache (f
, force_p
)
6255 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6257 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
6264 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
6266 /* Block input so that we won't be interrupted by a SIGIO
6267 while being in an inconsistent state. */
6270 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
6272 struct image
*img
= c
->images
[i
];
6274 && (force_p
|| img
->timestamp
< old
))
6276 free_image (f
, img
);
6281 /* We may be clearing the image cache because, for example,
6282 Emacs was iconified for a longer period of time. In that
6283 case, current matrices may still contain references to
6284 images freed above. So, clear these matrices. */
6287 Lisp_Object tail
, frame
;
6289 FOR_EACH_FRAME (tail
, frame
)
6291 struct frame
*f
= XFRAME (frame
);
6293 && FRAME_X_IMAGE_CACHE (f
) == c
)
6294 clear_current_matrices (f
);
6297 ++windows_or_buffers_changed
;
6305 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
6307 doc
: /* Clear the image cache of FRAME.
6308 FRAME nil or omitted means use the selected frame.
6309 FRAME t means clear the image caches of all frames. */)
6317 FOR_EACH_FRAME (tail
, frame
)
6318 if (FRAME_X_P (XFRAME (frame
)))
6319 clear_image_cache (XFRAME (frame
), 1);
6322 clear_image_cache (check_x_frame (frame
), 1);
6328 /* Compute masks and transform image IMG on frame F, as specified
6329 by the image's specification, */
6332 postprocess_image (f
, img
)
6336 /* Manipulation of the image's mask. */
6339 Lisp_Object conversion
, spec
;
6344 /* `:heuristic-mask t'
6346 means build a mask heuristically.
6347 `:heuristic-mask (R G B)'
6348 `:mask (heuristic (R G B))'
6349 means build a mask from color (R G B) in the
6352 means remove a mask, if any. */
6354 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6356 x_build_heuristic_mask (f
, img
, mask
);
6361 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6363 if (EQ (mask
, Qheuristic
))
6364 x_build_heuristic_mask (f
, img
, Qt
);
6365 else if (CONSP (mask
)
6366 && EQ (XCAR (mask
), Qheuristic
))
6368 if (CONSP (XCDR (mask
)))
6369 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6371 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6373 else if (NILP (mask
) && found_p
&& img
->mask
)
6375 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6381 /* Should we apply an image transformation algorithm? */
6382 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6383 if (EQ (conversion
, Qdisabled
))
6384 x_disable_image (f
, img
);
6385 else if (EQ (conversion
, Qlaplace
))
6387 else if (EQ (conversion
, Qemboss
))
6389 else if (CONSP (conversion
)
6390 && EQ (XCAR (conversion
), Qedge_detection
))
6393 tem
= XCDR (conversion
);
6395 x_edge_detection (f
, img
,
6396 Fplist_get (tem
, QCmatrix
),
6397 Fplist_get (tem
, QCcolor_adjustment
));
6403 /* Return the id of image with Lisp specification SPEC on frame F.
6404 SPEC must be a valid Lisp image specification (see valid_image_p). */
6407 lookup_image (f
, spec
)
6411 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6415 struct gcpro gcpro1
;
6418 /* F must be a window-system frame, and SPEC must be a valid image
6420 xassert (FRAME_WINDOW_P (f
));
6421 xassert (valid_image_p (spec
));
6425 /* Look up SPEC in the hash table of the image cache. */
6426 hash
= sxhash (spec
, 0);
6427 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6429 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6430 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6433 /* If not found, create a new image and cache it. */
6436 extern Lisp_Object Qpostscript
;
6439 img
= make_image (spec
, hash
);
6440 cache_image (f
, img
);
6441 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6443 /* If we can't load the image, and we don't have a width and
6444 height, use some arbitrary width and height so that we can
6445 draw a rectangle for it. */
6446 if (img
->load_failed_p
)
6450 value
= image_spec_value (spec
, QCwidth
, NULL
);
6451 img
->width
= (INTEGERP (value
)
6452 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6453 value
= image_spec_value (spec
, QCheight
, NULL
);
6454 img
->height
= (INTEGERP (value
)
6455 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6459 /* Handle image type independent image attributes
6460 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
6461 `:background COLOR'. */
6462 Lisp_Object ascent
, margin
, relief
, bg
;
6464 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6465 if (INTEGERP (ascent
))
6466 img
->ascent
= XFASTINT (ascent
);
6467 else if (EQ (ascent
, Qcenter
))
6468 img
->ascent
= CENTERED_IMAGE_ASCENT
;
6470 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6471 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6472 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
6473 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
6474 && INTEGERP (XCDR (margin
)))
6476 if (XINT (XCAR (margin
)) > 0)
6477 img
->hmargin
= XFASTINT (XCAR (margin
));
6478 if (XINT (XCDR (margin
)) > 0)
6479 img
->vmargin
= XFASTINT (XCDR (margin
));
6482 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6483 if (INTEGERP (relief
))
6485 img
->relief
= XINT (relief
);
6486 img
->hmargin
+= abs (img
->relief
);
6487 img
->vmargin
+= abs (img
->relief
);
6490 if (! img
->background_valid
)
6492 bg
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6496 = x_alloc_image_color (f
, img
, bg
,
6497 FRAME_BACKGROUND_PIXEL (f
));
6498 img
->background_valid
= 1;
6502 /* Do image transformations and compute masks, unless we
6503 don't have the image yet. */
6504 if (!EQ (*img
->type
->type
, Qpostscript
))
6505 postprocess_image (f
, img
);
6509 xassert (!interrupt_input_blocked
);
6512 /* We're using IMG, so set its timestamp to `now'. */
6513 EMACS_GET_TIME (now
);
6514 img
->timestamp
= EMACS_SECS (now
);
6518 /* Value is the image id. */
6523 /* Cache image IMG in the image cache of frame F. */
6526 cache_image (f
, img
)
6530 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6533 /* Find a free slot in c->images. */
6534 for (i
= 0; i
< c
->used
; ++i
)
6535 if (c
->images
[i
] == NULL
)
6538 /* If no free slot found, maybe enlarge c->images. */
6539 if (i
== c
->used
&& c
->used
== c
->size
)
6542 c
->images
= (struct image
**) xrealloc (c
->images
,
6543 c
->size
* sizeof *c
->images
);
6546 /* Add IMG to c->images, and assign IMG an id. */
6552 /* Add IMG to the cache's hash table. */
6553 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6554 img
->next
= c
->buckets
[i
];
6556 img
->next
->prev
= img
;
6558 c
->buckets
[i
] = img
;
6562 /* Call FN on every image in the image cache of frame F. Used to mark
6563 Lisp Objects in the image cache. */
6566 forall_images_in_image_cache (f
, fn
)
6568 void (*fn
) P_ ((struct image
*img
));
6570 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6572 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6576 for (i
= 0; i
< c
->used
; ++i
)
6585 /***********************************************************************
6587 ***********************************************************************/
6589 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6590 XImage
**, Pixmap
*));
6591 static void x_destroy_x_image
P_ ((XImage
*));
6592 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6595 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6596 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6597 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6598 via xmalloc. Print error messages via image_error if an error
6599 occurs. Value is non-zero if successful. */
6602 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6604 int width
, height
, depth
;
6608 Display
*display
= FRAME_X_DISPLAY (f
);
6609 Screen
*screen
= FRAME_X_SCREEN (f
);
6610 Window window
= FRAME_X_WINDOW (f
);
6612 xassert (interrupt_input_blocked
);
6615 depth
= DefaultDepthOfScreen (screen
);
6616 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6617 depth
, ZPixmap
, 0, NULL
, width
, height
,
6618 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6621 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6625 /* Allocate image raster. */
6626 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6628 /* Allocate a pixmap of the same size. */
6629 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6630 if (*pixmap
== None
)
6632 x_destroy_x_image (*ximg
);
6634 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6642 /* Destroy XImage XIMG. Free XIMG->data. */
6645 x_destroy_x_image (ximg
)
6648 xassert (interrupt_input_blocked
);
6653 XDestroyImage (ximg
);
6658 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6659 are width and height of both the image and pixmap. */
6662 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6669 xassert (interrupt_input_blocked
);
6670 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6671 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6672 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6677 /***********************************************************************
6679 ***********************************************************************/
6681 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6682 static char *slurp_file
P_ ((char *, int *));
6685 /* Find image file FILE. Look in data-directory, then
6686 x-bitmap-file-path. Value is the full name of the file found, or
6687 nil if not found. */
6690 x_find_image_file (file
)
6693 Lisp_Object file_found
, search_path
;
6694 struct gcpro gcpro1
, gcpro2
;
6698 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6699 GCPRO2 (file_found
, search_path
);
6701 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6702 fd
= openp (search_path
, file
, Qnil
, &file_found
, Qnil
);
6714 /* Read FILE into memory. Value is a pointer to a buffer allocated
6715 with xmalloc holding FILE's contents. Value is null if an error
6716 occurred. *SIZE is set to the size of the file. */
6719 slurp_file (file
, size
)
6727 if (stat (file
, &st
) == 0
6728 && (fp
= fopen (file
, "r")) != NULL
6729 && (buf
= (char *) xmalloc (st
.st_size
),
6730 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6751 /***********************************************************************
6753 ***********************************************************************/
6755 static int xbm_scan
P_ ((char **, char *, char *, int *));
6756 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6757 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6759 static int xbm_image_p
P_ ((Lisp_Object object
));
6760 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6762 static int xbm_file_p
P_ ((Lisp_Object
));
6765 /* Indices of image specification fields in xbm_format, below. */
6767 enum xbm_keyword_index
6785 /* Vector of image_keyword structures describing the format
6786 of valid XBM image specifications. */
6788 static struct image_keyword xbm_format
[XBM_LAST
] =
6790 {":type", IMAGE_SYMBOL_VALUE
, 1},
6791 {":file", IMAGE_STRING_VALUE
, 0},
6792 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6793 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6794 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6795 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
6796 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
6797 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6798 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6799 {":relief", IMAGE_INTEGER_VALUE
, 0},
6800 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6801 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6802 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6805 /* Structure describing the image type XBM. */
6807 static struct image_type xbm_type
=
6816 /* Tokens returned from xbm_scan. */
6825 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6826 A valid specification is a list starting with the symbol `image'
6827 The rest of the list is a property list which must contain an
6830 If the specification specifies a file to load, it must contain
6831 an entry `:file FILENAME' where FILENAME is a string.
6833 If the specification is for a bitmap loaded from memory it must
6834 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6835 WIDTH and HEIGHT are integers > 0. DATA may be:
6837 1. a string large enough to hold the bitmap data, i.e. it must
6838 have a size >= (WIDTH + 7) / 8 * HEIGHT
6840 2. a bool-vector of size >= WIDTH * HEIGHT
6842 3. a vector of strings or bool-vectors, one for each line of the
6845 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6846 may not be specified in this case because they are defined in the
6849 Both the file and data forms may contain the additional entries
6850 `:background COLOR' and `:foreground COLOR'. If not present,
6851 foreground and background of the frame on which the image is
6852 displayed is used. */
6855 xbm_image_p (object
)
6858 struct image_keyword kw
[XBM_LAST
];
6860 bcopy (xbm_format
, kw
, sizeof kw
);
6861 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6864 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6866 if (kw
[XBM_FILE
].count
)
6868 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6871 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6873 /* In-memory XBM file. */
6874 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6882 /* Entries for `:width', `:height' and `:data' must be present. */
6883 if (!kw
[XBM_WIDTH
].count
6884 || !kw
[XBM_HEIGHT
].count
6885 || !kw
[XBM_DATA
].count
)
6888 data
= kw
[XBM_DATA
].value
;
6889 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6890 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6892 /* Check type of data, and width and height against contents of
6898 /* Number of elements of the vector must be >= height. */
6899 if (XVECTOR (data
)->size
< height
)
6902 /* Each string or bool-vector in data must be large enough
6903 for one line of the image. */
6904 for (i
= 0; i
< height
; ++i
)
6906 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6911 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6914 else if (BOOL_VECTOR_P (elt
))
6916 if (XBOOL_VECTOR (elt
)->size
< width
)
6923 else if (STRINGP (data
))
6926 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6929 else if (BOOL_VECTOR_P (data
))
6931 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6942 /* Scan a bitmap file. FP is the stream to read from. Value is
6943 either an enumerator from enum xbm_token, or a character for a
6944 single-character token, or 0 at end of file. If scanning an
6945 identifier, store the lexeme of the identifier in SVAL. If
6946 scanning a number, store its value in *IVAL. */
6949 xbm_scan (s
, end
, sval
, ival
)
6958 /* Skip white space. */
6959 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6964 else if (isdigit (c
))
6966 int value
= 0, digit
;
6968 if (c
== '0' && *s
< end
)
6971 if (c
== 'x' || c
== 'X')
6978 else if (c
>= 'a' && c
<= 'f')
6979 digit
= c
- 'a' + 10;
6980 else if (c
>= 'A' && c
<= 'F')
6981 digit
= c
- 'A' + 10;
6984 value
= 16 * value
+ digit
;
6987 else if (isdigit (c
))
6991 && (c
= *(*s
)++, isdigit (c
)))
6992 value
= 8 * value
+ c
- '0';
6999 && (c
= *(*s
)++, isdigit (c
)))
7000 value
= 10 * value
+ c
- '0';
7008 else if (isalpha (c
) || c
== '_')
7012 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
7019 else if (c
== '/' && **s
== '*')
7021 /* C-style comment. */
7023 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
7036 /* Replacement for XReadBitmapFileData which isn't available under old
7037 X versions. CONTENTS is a pointer to a buffer to parse; END is the
7038 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
7039 the image. Return in *DATA the bitmap data allocated with xmalloc.
7040 Value is non-zero if successful. DATA null means just test if
7041 CONTENTS looks like an in-memory XBM file. */
7044 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
7045 char *contents
, *end
;
7046 int *width
, *height
;
7047 unsigned char **data
;
7050 char buffer
[BUFSIZ
];
7053 int bytes_per_line
, i
, nbytes
;
7059 LA1 = xbm_scan (&s, end, buffer, &value)
7061 #define expect(TOKEN) \
7062 if (LA1 != (TOKEN)) \
7067 #define expect_ident(IDENT) \
7068 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
7073 *width
= *height
= -1;
7076 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
7078 /* Parse defines for width, height and hot-spots. */
7082 expect_ident ("define");
7083 expect (XBM_TK_IDENT
);
7085 if (LA1
== XBM_TK_NUMBER
);
7087 char *p
= strrchr (buffer
, '_');
7088 p
= p
? p
+ 1 : buffer
;
7089 if (strcmp (p
, "width") == 0)
7091 else if (strcmp (p
, "height") == 0)
7094 expect (XBM_TK_NUMBER
);
7097 if (*width
< 0 || *height
< 0)
7099 else if (data
== NULL
)
7102 /* Parse bits. Must start with `static'. */
7103 expect_ident ("static");
7104 if (LA1
== XBM_TK_IDENT
)
7106 if (strcmp (buffer
, "unsigned") == 0)
7109 expect_ident ("char");
7111 else if (strcmp (buffer
, "short") == 0)
7115 if (*width
% 16 && *width
% 16 < 9)
7118 else if (strcmp (buffer
, "char") == 0)
7126 expect (XBM_TK_IDENT
);
7132 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
7133 nbytes
= bytes_per_line
* *height
;
7134 p
= *data
= (char *) xmalloc (nbytes
);
7138 for (i
= 0; i
< nbytes
; i
+= 2)
7141 expect (XBM_TK_NUMBER
);
7144 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
7147 if (LA1
== ',' || LA1
== '}')
7155 for (i
= 0; i
< nbytes
; ++i
)
7158 expect (XBM_TK_NUMBER
);
7162 if (LA1
== ',' || LA1
== '}')
7187 /* Load XBM image IMG which will be displayed on frame F from buffer
7188 CONTENTS. END is the end of the buffer. Value is non-zero if
7192 xbm_load_image (f
, img
, contents
, end
)
7195 char *contents
, *end
;
7198 unsigned char *data
;
7201 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
7204 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7205 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7206 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7209 xassert (img
->width
> 0 && img
->height
> 0);
7211 /* Get foreground and background colors, maybe allocate colors. */
7212 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
7214 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
7215 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
7218 background
= x_alloc_image_color (f
, img
, value
, background
);
7219 img
->background
= background
;
7220 img
->background_valid
= 1;
7224 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7227 img
->width
, img
->height
,
7228 foreground
, background
,
7232 if (img
->pixmap
== None
)
7234 x_clear_image (f
, img
);
7235 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
7241 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7247 /* Value is non-zero if DATA looks like an in-memory XBM file. */
7254 return (STRINGP (data
)
7255 && xbm_read_bitmap_data (SDATA (data
),
7262 /* Fill image IMG which is used on frame F with pixmap data. Value is
7263 non-zero if successful. */
7271 Lisp_Object file_name
;
7273 xassert (xbm_image_p (img
->spec
));
7275 /* If IMG->spec specifies a file name, create a non-file spec from it. */
7276 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
7277 if (STRINGP (file_name
))
7282 struct gcpro gcpro1
;
7284 file
= x_find_image_file (file_name
);
7286 if (!STRINGP (file
))
7288 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
7293 contents
= slurp_file (SDATA (file
), &size
);
7294 if (contents
== NULL
)
7296 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7301 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
7306 struct image_keyword fmt
[XBM_LAST
];
7309 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7310 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7313 int in_memory_file_p
= 0;
7315 /* See if data looks like an in-memory XBM file. */
7316 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7317 in_memory_file_p
= xbm_file_p (data
);
7319 /* Parse the image specification. */
7320 bcopy (xbm_format
, fmt
, sizeof fmt
);
7321 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
7324 /* Get specified width, and height. */
7325 if (!in_memory_file_p
)
7327 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
7328 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
7329 xassert (img
->width
> 0 && img
->height
> 0);
7332 /* Get foreground and background colors, maybe allocate colors. */
7333 if (fmt
[XBM_FOREGROUND
].count
7334 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
7335 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
7337 if (fmt
[XBM_BACKGROUND
].count
7338 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
7339 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
7342 if (in_memory_file_p
)
7343 success_p
= xbm_load_image (f
, img
, SDATA (data
),
7352 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
7354 p
= bits
= (char *) alloca (nbytes
* img
->height
);
7355 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
7357 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
7359 bcopy (SDATA (line
), p
, nbytes
);
7361 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
7364 else if (STRINGP (data
))
7365 bits
= SDATA (data
);
7367 bits
= XBOOL_VECTOR (data
)->data
;
7369 /* Create the pixmap. */
7370 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7372 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7375 img
->width
, img
->height
,
7376 foreground
, background
,
7382 image_error ("Unable to create pixmap for XBM image `%s'",
7384 x_clear_image (f
, img
);
7394 /***********************************************************************
7396 ***********************************************************************/
7400 static int xpm_image_p
P_ ((Lisp_Object object
));
7401 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
7402 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
7404 #include "X11/xpm.h"
7406 /* The symbol `xpm' identifying XPM-format images. */
7410 /* Indices of image specification fields in xpm_format, below. */
7412 enum xpm_keyword_index
7428 /* Vector of image_keyword structures describing the format
7429 of valid XPM image specifications. */
7431 static struct image_keyword xpm_format
[XPM_LAST
] =
7433 {":type", IMAGE_SYMBOL_VALUE
, 1},
7434 {":file", IMAGE_STRING_VALUE
, 0},
7435 {":data", IMAGE_STRING_VALUE
, 0},
7436 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7437 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7438 {":relief", IMAGE_INTEGER_VALUE
, 0},
7439 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7440 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7441 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7442 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7443 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
7446 /* Structure describing the image type XBM. */
7448 static struct image_type xpm_type
=
7458 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7459 functions for allocating image colors. Our own functions handle
7460 color allocation failures more gracefully than the ones on the XPM
7463 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7464 #define ALLOC_XPM_COLORS
7467 #ifdef ALLOC_XPM_COLORS
7469 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7470 static void xpm_free_color_cache
P_ ((void));
7471 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7472 static int xpm_color_bucket
P_ ((char *));
7473 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7476 /* An entry in a hash table used to cache color definitions of named
7477 colors. This cache is necessary to speed up XPM image loading in
7478 case we do color allocations ourselves. Without it, we would need
7479 a call to XParseColor per pixel in the image. */
7481 struct xpm_cached_color
7483 /* Next in collision chain. */
7484 struct xpm_cached_color
*next
;
7486 /* Color definition (RGB and pixel color). */
7493 /* The hash table used for the color cache, and its bucket vector
7496 #define XPM_COLOR_CACHE_BUCKETS 1001
7497 struct xpm_cached_color
**xpm_color_cache
;
7499 /* Initialize the color cache. */
7502 xpm_init_color_cache (f
, attrs
)
7504 XpmAttributes
*attrs
;
7506 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7507 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7508 memset (xpm_color_cache
, 0, nbytes
);
7509 init_color_table ();
7511 if (attrs
->valuemask
& XpmColorSymbols
)
7516 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7517 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7518 attrs
->colorsymbols
[i
].value
, &color
))
7520 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7522 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7528 /* Free the color cache. */
7531 xpm_free_color_cache ()
7533 struct xpm_cached_color
*p
, *next
;
7536 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7537 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7543 xfree (xpm_color_cache
);
7544 xpm_color_cache
= NULL
;
7545 free_color_table ();
7549 /* Return the bucket index for color named COLOR_NAME in the color
7553 xpm_color_bucket (color_name
)
7559 for (s
= color_name
; *s
; ++s
)
7561 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7565 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7566 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7569 static struct xpm_cached_color
*
7570 xpm_cache_color (f
, color_name
, color
, bucket
)
7577 struct xpm_cached_color
*p
;
7580 bucket
= xpm_color_bucket (color_name
);
7582 nbytes
= sizeof *p
+ strlen (color_name
);
7583 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7584 strcpy (p
->name
, color_name
);
7586 p
->next
= xpm_color_cache
[bucket
];
7587 xpm_color_cache
[bucket
] = p
;
7592 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7593 return the cached definition in *COLOR. Otherwise, make a new
7594 entry in the cache and allocate the color. Value is zero if color
7595 allocation failed. */
7598 xpm_lookup_color (f
, color_name
, color
)
7603 struct xpm_cached_color
*p
;
7604 int h
= xpm_color_bucket (color_name
);
7606 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7607 if (strcmp (p
->name
, color_name
) == 0)
7612 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7615 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7617 p
= xpm_cache_color (f
, color_name
, color
, h
);
7624 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7625 CLOSURE is a pointer to the frame on which we allocate the
7626 color. Return in *COLOR the allocated color. Value is non-zero
7630 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7637 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7641 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7642 is a pointer to the frame on which we allocate the color. Value is
7643 non-zero if successful. */
7646 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7656 #endif /* ALLOC_XPM_COLORS */
7659 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7660 for XPM images. Such a list must consist of conses whose car and
7664 xpm_valid_color_symbols_p (color_symbols
)
7665 Lisp_Object color_symbols
;
7667 while (CONSP (color_symbols
))
7669 Lisp_Object sym
= XCAR (color_symbols
);
7671 || !STRINGP (XCAR (sym
))
7672 || !STRINGP (XCDR (sym
)))
7674 color_symbols
= XCDR (color_symbols
);
7677 return NILP (color_symbols
);
7681 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7684 xpm_image_p (object
)
7687 struct image_keyword fmt
[XPM_LAST
];
7688 bcopy (xpm_format
, fmt
, sizeof fmt
);
7689 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7690 /* Either `:file' or `:data' must be present. */
7691 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7692 /* Either no `:color-symbols' or it's a list of conses
7693 whose car and cdr are strings. */
7694 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7695 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7699 /* Load image IMG which will be displayed on frame F. Value is
7700 non-zero if successful. */
7708 XpmAttributes attrs
;
7709 Lisp_Object specified_file
, color_symbols
;
7711 /* Configure the XPM lib. Use the visual of frame F. Allocate
7712 close colors. Return colors allocated. */
7713 bzero (&attrs
, sizeof attrs
);
7714 attrs
.visual
= FRAME_X_VISUAL (f
);
7715 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7716 attrs
.valuemask
|= XpmVisual
;
7717 attrs
.valuemask
|= XpmColormap
;
7719 #ifdef ALLOC_XPM_COLORS
7720 /* Allocate colors with our own functions which handle
7721 failing color allocation more gracefully. */
7722 attrs
.color_closure
= f
;
7723 attrs
.alloc_color
= xpm_alloc_color
;
7724 attrs
.free_colors
= xpm_free_colors
;
7725 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7726 #else /* not ALLOC_XPM_COLORS */
7727 /* Let the XPM lib allocate colors. */
7728 attrs
.valuemask
|= XpmReturnAllocPixels
;
7729 #ifdef XpmAllocCloseColors
7730 attrs
.alloc_close_colors
= 1;
7731 attrs
.valuemask
|= XpmAllocCloseColors
;
7732 #else /* not XpmAllocCloseColors */
7733 attrs
.closeness
= 600;
7734 attrs
.valuemask
|= XpmCloseness
;
7735 #endif /* not XpmAllocCloseColors */
7736 #endif /* ALLOC_XPM_COLORS */
7738 /* If image specification contains symbolic color definitions, add
7739 these to `attrs'. */
7740 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7741 if (CONSP (color_symbols
))
7744 XpmColorSymbol
*xpm_syms
;
7747 attrs
.valuemask
|= XpmColorSymbols
;
7749 /* Count number of symbols. */
7750 attrs
.numsymbols
= 0;
7751 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7754 /* Allocate an XpmColorSymbol array. */
7755 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7756 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7757 bzero (xpm_syms
, size
);
7758 attrs
.colorsymbols
= xpm_syms
;
7760 /* Fill the color symbol array. */
7761 for (tail
= color_symbols
, i
= 0;
7763 ++i
, tail
= XCDR (tail
))
7765 Lisp_Object name
= XCAR (XCAR (tail
));
7766 Lisp_Object color
= XCDR (XCAR (tail
));
7767 xpm_syms
[i
].name
= (char *) alloca (SCHARS (name
) + 1);
7768 strcpy (xpm_syms
[i
].name
, SDATA (name
));
7769 xpm_syms
[i
].value
= (char *) alloca (SCHARS (color
) + 1);
7770 strcpy (xpm_syms
[i
].value
, SDATA (color
));
7774 /* Create a pixmap for the image, either from a file, or from a
7775 string buffer containing data in the same format as an XPM file. */
7776 #ifdef ALLOC_XPM_COLORS
7777 xpm_init_color_cache (f
, &attrs
);
7780 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7781 if (STRINGP (specified_file
))
7783 Lisp_Object file
= x_find_image_file (specified_file
);
7784 if (!STRINGP (file
))
7786 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7790 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7791 SDATA (file
), &img
->pixmap
, &img
->mask
,
7796 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7797 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7799 &img
->pixmap
, &img
->mask
,
7803 if (rc
== XpmSuccess
)
7805 #ifdef ALLOC_XPM_COLORS
7806 img
->colors
= colors_in_color_table (&img
->ncolors
);
7807 #else /* not ALLOC_XPM_COLORS */
7810 img
->ncolors
= attrs
.nalloc_pixels
;
7811 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7812 * sizeof *img
->colors
);
7813 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7815 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7816 #ifdef DEBUG_X_COLORS
7817 register_color (img
->colors
[i
]);
7820 #endif /* not ALLOC_XPM_COLORS */
7822 img
->width
= attrs
.width
;
7823 img
->height
= attrs
.height
;
7824 xassert (img
->width
> 0 && img
->height
> 0);
7826 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7827 XpmFreeAttributes (&attrs
);
7834 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7837 case XpmFileInvalid
:
7838 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7842 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7845 case XpmColorFailed
:
7846 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7850 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7855 #ifdef ALLOC_XPM_COLORS
7856 xpm_free_color_cache ();
7858 return rc
== XpmSuccess
;
7861 #endif /* HAVE_XPM != 0 */
7864 /***********************************************************************
7866 ***********************************************************************/
7868 /* An entry in the color table mapping an RGB color to a pixel color. */
7873 unsigned long pixel
;
7875 /* Next in color table collision list. */
7876 struct ct_color
*next
;
7879 /* The bucket vector size to use. Must be prime. */
7883 /* Value is a hash of the RGB color given by R, G, and B. */
7885 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7887 /* The color hash table. */
7889 struct ct_color
**ct_table
;
7891 /* Number of entries in the color table. */
7893 int ct_colors_allocated
;
7895 /* Initialize the color table. */
7900 int size
= CT_SIZE
* sizeof (*ct_table
);
7901 ct_table
= (struct ct_color
**) xmalloc (size
);
7902 bzero (ct_table
, size
);
7903 ct_colors_allocated
= 0;
7907 /* Free memory associated with the color table. */
7913 struct ct_color
*p
, *next
;
7915 for (i
= 0; i
< CT_SIZE
; ++i
)
7916 for (p
= ct_table
[i
]; p
; p
= next
)
7927 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7928 entry for that color already is in the color table, return the
7929 pixel color of that entry. Otherwise, allocate a new color for R,
7930 G, B, and make an entry in the color table. */
7932 static unsigned long
7933 lookup_rgb_color (f
, r
, g
, b
)
7937 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7938 int i
= hash
% CT_SIZE
;
7941 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7942 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7955 cmap
= FRAME_X_COLORMAP (f
);
7956 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7960 ++ct_colors_allocated
;
7962 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7966 p
->pixel
= color
.pixel
;
7967 p
->next
= ct_table
[i
];
7971 return FRAME_FOREGROUND_PIXEL (f
);
7978 /* Look up pixel color PIXEL which is used on frame F in the color
7979 table. If not already present, allocate it. Value is PIXEL. */
7981 static unsigned long
7982 lookup_pixel_color (f
, pixel
)
7984 unsigned long pixel
;
7986 int i
= pixel
% CT_SIZE
;
7989 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7990 if (p
->pixel
== pixel
)
7999 cmap
= FRAME_X_COLORMAP (f
);
8000 color
.pixel
= pixel
;
8001 x_query_color (f
, &color
);
8002 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
8006 ++ct_colors_allocated
;
8008 p
= (struct ct_color
*) xmalloc (sizeof *p
);
8013 p
->next
= ct_table
[i
];
8017 return FRAME_FOREGROUND_PIXEL (f
);
8024 /* Value is a vector of all pixel colors contained in the color table,
8025 allocated via xmalloc. Set *N to the number of colors. */
8027 static unsigned long *
8028 colors_in_color_table (n
)
8033 unsigned long *colors
;
8035 if (ct_colors_allocated
== 0)
8042 colors
= (unsigned long *) xmalloc (ct_colors_allocated
8044 *n
= ct_colors_allocated
;
8046 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
8047 for (p
= ct_table
[i
]; p
; p
= p
->next
)
8048 colors
[j
++] = p
->pixel
;
8056 /***********************************************************************
8058 ***********************************************************************/
8060 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
8061 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
8062 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
8064 /* Non-zero means draw a cross on images having `:conversion
8067 int cross_disabled_images
;
8069 /* Edge detection matrices for different edge-detection
8072 static int emboss_matrix
[9] = {
8074 2, -1, 0, /* y - 1 */
8076 0, 1, -2 /* y + 1 */
8079 static int laplace_matrix
[9] = {
8081 1, 0, 0, /* y - 1 */
8083 0, 0, -1 /* y + 1 */
8086 /* Value is the intensity of the color whose red/green/blue values
8089 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
8092 /* On frame F, return an array of XColor structures describing image
8093 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
8094 non-zero means also fill the red/green/blue members of the XColor
8095 structures. Value is a pointer to the array of XColors structures,
8096 allocated with xmalloc; it must be freed by the caller. */
8099 x_to_xcolors (f
, img
, rgb_p
)
8108 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
8110 /* Get the X image IMG->pixmap. */
8111 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
8112 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
8114 /* Fill the `pixel' members of the XColor array. I wished there
8115 were an easy and portable way to circumvent XGetPixel. */
8117 for (y
= 0; y
< img
->height
; ++y
)
8121 for (x
= 0; x
< img
->width
; ++x
, ++p
)
8122 p
->pixel
= XGetPixel (ximg
, x
, y
);
8125 x_query_colors (f
, row
, img
->width
);
8128 XDestroyImage (ximg
);
8133 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
8134 RGB members are set. F is the frame on which this all happens.
8135 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
8138 x_from_xcolors (f
, img
, colors
)
8148 init_color_table ();
8150 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
8153 for (y
= 0; y
< img
->height
; ++y
)
8154 for (x
= 0; x
< img
->width
; ++x
, ++p
)
8156 unsigned long pixel
;
8157 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
8158 XPutPixel (oimg
, x
, y
, pixel
);
8162 x_clear_image_1 (f
, img
, 1, 0, 1);
8164 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
8165 x_destroy_x_image (oimg
);
8166 img
->pixmap
= pixmap
;
8167 img
->colors
= colors_in_color_table (&img
->ncolors
);
8168 free_color_table ();
8172 /* On frame F, perform edge-detection on image IMG.
8174 MATRIX is a nine-element array specifying the transformation
8175 matrix. See emboss_matrix for an example.
8177 COLOR_ADJUST is a color adjustment added to each pixel of the
8181 x_detect_edges (f
, img
, matrix
, color_adjust
)
8184 int matrix
[9], color_adjust
;
8186 XColor
*colors
= x_to_xcolors (f
, img
, 1);
8190 for (i
= sum
= 0; i
< 9; ++i
)
8191 sum
+= abs (matrix
[i
]);
8193 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
8195 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
8197 for (y
= 0; y
< img
->height
; ++y
)
8199 p
= COLOR (new, 0, y
);
8200 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8201 p
= COLOR (new, img
->width
- 1, y
);
8202 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8205 for (x
= 1; x
< img
->width
- 1; ++x
)
8207 p
= COLOR (new, x
, 0);
8208 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8209 p
= COLOR (new, x
, img
->height
- 1);
8210 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8213 for (y
= 1; y
< img
->height
- 1; ++y
)
8215 p
= COLOR (new, 1, y
);
8217 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
8219 int r
, g
, b
, y1
, x1
;
8222 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
8223 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
8226 XColor
*t
= COLOR (colors
, x1
, y1
);
8227 r
+= matrix
[i
] * t
->red
;
8228 g
+= matrix
[i
] * t
->green
;
8229 b
+= matrix
[i
] * t
->blue
;
8232 r
= (r
/ sum
+ color_adjust
) & 0xffff;
8233 g
= (g
/ sum
+ color_adjust
) & 0xffff;
8234 b
= (b
/ sum
+ color_adjust
) & 0xffff;
8235 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
8240 x_from_xcolors (f
, img
, new);
8246 /* Perform the pre-defined `emboss' edge-detection on image IMG
8254 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
8258 /* Perform the pre-defined `laplace' edge-detection on image IMG
8266 x_detect_edges (f
, img
, laplace_matrix
, 45000);
8270 /* Perform edge-detection on image IMG on frame F, with specified
8271 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
8273 MATRIX must be either
8275 - a list of at least 9 numbers in row-major form
8276 - a vector of at least 9 numbers
8278 COLOR_ADJUST nil means use a default; otherwise it must be a
8282 x_edge_detection (f
, img
, matrix
, color_adjust
)
8285 Lisp_Object matrix
, color_adjust
;
8293 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
8294 ++i
, matrix
= XCDR (matrix
))
8295 trans
[i
] = XFLOATINT (XCAR (matrix
));
8297 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
8299 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
8300 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
8303 if (NILP (color_adjust
))
8304 color_adjust
= make_number (0xffff / 2);
8306 if (i
== 9 && NUMBERP (color_adjust
))
8307 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
8311 /* Transform image IMG on frame F so that it looks disabled. */
8314 x_disable_image (f
, img
)
8318 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
8320 if (dpyinfo
->n_planes
>= 2)
8322 /* Color (or grayscale). Convert to gray, and equalize. Just
8323 drawing such images with a stipple can look very odd, so
8324 we're using this method instead. */
8325 XColor
*colors
= x_to_xcolors (f
, img
, 1);
8327 const int h
= 15000;
8328 const int l
= 30000;
8330 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
8334 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
8335 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
8336 p
->red
= p
->green
= p
->blue
= i2
;
8339 x_from_xcolors (f
, img
, colors
);
8342 /* Draw a cross over the disabled image, if we must or if we
8344 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
8346 Display
*dpy
= FRAME_X_DISPLAY (f
);
8349 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
8350 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
8351 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
8352 img
->width
- 1, img
->height
- 1);
8353 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
8359 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
8360 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
8361 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
8362 img
->width
- 1, img
->height
- 1);
8363 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
8371 /* Build a mask for image IMG which is used on frame F. FILE is the
8372 name of an image file, for error messages. HOW determines how to
8373 determine the background color of IMG. If it is a list '(R G B)',
8374 with R, G, and B being integers >= 0, take that as the color of the
8375 background. Otherwise, determine the background color of IMG
8376 heuristically. Value is non-zero if successful. */
8379 x_build_heuristic_mask (f
, img
, how
)
8384 Display
*dpy
= FRAME_X_DISPLAY (f
);
8385 XImage
*ximg
, *mask_img
;
8386 int x
, y
, rc
, use_img_background
;
8387 unsigned long bg
= 0;
8391 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8393 img
->background_transparent_valid
= 0;
8396 /* Create an image and pixmap serving as mask. */
8397 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
8398 &mask_img
, &img
->mask
);
8402 /* Get the X image of IMG->pixmap. */
8403 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
8406 /* Determine the background color of ximg. If HOW is `(R G B)'
8407 take that as color. Otherwise, use the image's background color. */
8408 use_img_background
= 1;
8414 for (i
= 0; i
< 3 && CONSP (how
) && NATNUMP (XCAR (how
)); ++i
)
8416 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
8420 if (i
== 3 && NILP (how
))
8422 char color_name
[30];
8423 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
8424 bg
= x_alloc_image_color (f
, img
, build_string (color_name
), 0);
8425 use_img_background
= 0;
8429 if (use_img_background
)
8430 bg
= four_corners_best (ximg
, img
->width
, img
->height
);
8432 /* Set all bits in mask_img to 1 whose color in ximg is different
8433 from the background color bg. */
8434 for (y
= 0; y
< img
->height
; ++y
)
8435 for (x
= 0; x
< img
->width
; ++x
)
8436 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8438 /* Fill in the background_transparent field while we have the mask handy. */
8439 image_background_transparent (img
, f
, mask_img
);
8441 /* Put mask_img into img->mask. */
8442 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8443 x_destroy_x_image (mask_img
);
8444 XDestroyImage (ximg
);
8451 /***********************************************************************
8452 PBM (mono, gray, color)
8453 ***********************************************************************/
8455 static int pbm_image_p
P_ ((Lisp_Object object
));
8456 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8457 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8459 /* The symbol `pbm' identifying images of this type. */
8463 /* Indices of image specification fields in gs_format, below. */
8465 enum pbm_keyword_index
8481 /* Vector of image_keyword structures describing the format
8482 of valid user-defined image specifications. */
8484 static struct image_keyword pbm_format
[PBM_LAST
] =
8486 {":type", IMAGE_SYMBOL_VALUE
, 1},
8487 {":file", IMAGE_STRING_VALUE
, 0},
8488 {":data", IMAGE_STRING_VALUE
, 0},
8489 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8490 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8491 {":relief", IMAGE_INTEGER_VALUE
, 0},
8492 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8493 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8494 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8495 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8496 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8499 /* Structure describing the image type `pbm'. */
8501 static struct image_type pbm_type
=
8511 /* Return non-zero if OBJECT is a valid PBM image specification. */
8514 pbm_image_p (object
)
8517 struct image_keyword fmt
[PBM_LAST
];
8519 bcopy (pbm_format
, fmt
, sizeof fmt
);
8521 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8524 /* Must specify either :data or :file. */
8525 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8529 /* Scan a decimal number from *S and return it. Advance *S while
8530 reading the number. END is the end of the string. Value is -1 at
8534 pbm_scan_number (s
, end
)
8535 unsigned char **s
, *end
;
8537 int c
= 0, val
= -1;
8541 /* Skip white-space. */
8542 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8547 /* Skip comment to end of line. */
8548 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8551 else if (isdigit (c
))
8553 /* Read decimal number. */
8555 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8556 val
= 10 * val
+ c
- '0';
8567 /* Load PBM image IMG for use on frame F. */
8575 int width
, height
, max_color_idx
= 0;
8577 Lisp_Object file
, specified_file
;
8578 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8579 struct gcpro gcpro1
;
8580 unsigned char *contents
= NULL
;
8581 unsigned char *end
, *p
;
8584 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8588 if (STRINGP (specified_file
))
8590 file
= x_find_image_file (specified_file
);
8591 if (!STRINGP (file
))
8593 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8598 contents
= slurp_file (SDATA (file
), &size
);
8599 if (contents
== NULL
)
8601 image_error ("Error reading `%s'", file
, Qnil
);
8607 end
= contents
+ size
;
8612 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8614 end
= p
+ SBYTES (data
);
8617 /* Check magic number. */
8618 if (end
- p
< 2 || *p
++ != 'P')
8620 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8630 raw_p
= 0, type
= PBM_MONO
;
8634 raw_p
= 0, type
= PBM_GRAY
;
8638 raw_p
= 0, type
= PBM_COLOR
;
8642 raw_p
= 1, type
= PBM_MONO
;
8646 raw_p
= 1, type
= PBM_GRAY
;
8650 raw_p
= 1, type
= PBM_COLOR
;
8654 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8658 /* Read width, height, maximum color-component. Characters
8659 starting with `#' up to the end of a line are ignored. */
8660 width
= pbm_scan_number (&p
, end
);
8661 height
= pbm_scan_number (&p
, end
);
8663 if (type
!= PBM_MONO
)
8665 max_color_idx
= pbm_scan_number (&p
, end
);
8666 if (raw_p
&& max_color_idx
> 255)
8667 max_color_idx
= 255;
8672 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8675 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8676 &ximg
, &img
->pixmap
))
8679 /* Initialize the color hash table. */
8680 init_color_table ();
8682 if (type
== PBM_MONO
)
8685 struct image_keyword fmt
[PBM_LAST
];
8686 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8687 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8689 /* Parse the image specification. */
8690 bcopy (pbm_format
, fmt
, sizeof fmt
);
8691 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8693 /* Get foreground and background colors, maybe allocate colors. */
8694 if (fmt
[PBM_FOREGROUND
].count
8695 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
8696 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8697 if (fmt
[PBM_BACKGROUND
].count
8698 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
8700 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8701 img
->background
= bg
;
8702 img
->background_valid
= 1;
8705 for (y
= 0; y
< height
; ++y
)
8706 for (x
= 0; x
< width
; ++x
)
8716 g
= pbm_scan_number (&p
, end
);
8718 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8723 for (y
= 0; y
< height
; ++y
)
8724 for (x
= 0; x
< width
; ++x
)
8728 if (type
== PBM_GRAY
)
8729 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8738 r
= pbm_scan_number (&p
, end
);
8739 g
= pbm_scan_number (&p
, end
);
8740 b
= pbm_scan_number (&p
, end
);
8743 if (r
< 0 || g
< 0 || b
< 0)
8747 XDestroyImage (ximg
);
8748 image_error ("Invalid pixel value in image `%s'",
8753 /* RGB values are now in the range 0..max_color_idx.
8754 Scale this to the range 0..0xffff supported by X. */
8755 r
= (double) r
* 65535 / max_color_idx
;
8756 g
= (double) g
* 65535 / max_color_idx
;
8757 b
= (double) b
* 65535 / max_color_idx
;
8758 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8762 /* Store in IMG->colors the colors allocated for the image, and
8763 free the color table. */
8764 img
->colors
= colors_in_color_table (&img
->ncolors
);
8765 free_color_table ();
8767 /* Maybe fill in the background field while we have ximg handy. */
8768 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
8769 IMAGE_BACKGROUND (img
, f
, ximg
);
8771 /* Put the image into a pixmap. */
8772 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8773 x_destroy_x_image (ximg
);
8776 img
->height
= height
;
8785 /***********************************************************************
8787 ***********************************************************************/
8793 /* Function prototypes. */
8795 static int png_image_p
P_ ((Lisp_Object object
));
8796 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8798 /* The symbol `png' identifying images of this type. */
8802 /* Indices of image specification fields in png_format, below. */
8804 enum png_keyword_index
8819 /* Vector of image_keyword structures describing the format
8820 of valid user-defined image specifications. */
8822 static struct image_keyword png_format
[PNG_LAST
] =
8824 {":type", IMAGE_SYMBOL_VALUE
, 1},
8825 {":data", IMAGE_STRING_VALUE
, 0},
8826 {":file", IMAGE_STRING_VALUE
, 0},
8827 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8828 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8829 {":relief", IMAGE_INTEGER_VALUE
, 0},
8830 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8831 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8832 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8833 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8836 /* Structure describing the image type `png'. */
8838 static struct image_type png_type
=
8848 /* Return non-zero if OBJECT is a valid PNG image specification. */
8851 png_image_p (object
)
8854 struct image_keyword fmt
[PNG_LAST
];
8855 bcopy (png_format
, fmt
, sizeof fmt
);
8857 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8860 /* Must specify either the :data or :file keyword. */
8861 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8865 /* Error and warning handlers installed when the PNG library
8869 my_png_error (png_ptr
, msg
)
8870 png_struct
*png_ptr
;
8873 xassert (png_ptr
!= NULL
);
8874 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8875 longjmp (png_ptr
->jmpbuf
, 1);
8880 my_png_warning (png_ptr
, msg
)
8881 png_struct
*png_ptr
;
8884 xassert (png_ptr
!= NULL
);
8885 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8888 /* Memory source for PNG decoding. */
8890 struct png_memory_storage
8892 unsigned char *bytes
; /* The data */
8893 size_t len
; /* How big is it? */
8894 int index
; /* Where are we? */
8898 /* Function set as reader function when reading PNG image from memory.
8899 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8900 bytes from the input to DATA. */
8903 png_read_from_memory (png_ptr
, data
, length
)
8904 png_structp png_ptr
;
8908 struct png_memory_storage
*tbr
8909 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8911 if (length
> tbr
->len
- tbr
->index
)
8912 png_error (png_ptr
, "Read error");
8914 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8915 tbr
->index
= tbr
->index
+ length
;
8918 /* Load PNG image IMG for use on frame F. Value is non-zero if
8926 Lisp_Object file
, specified_file
;
8927 Lisp_Object specified_data
;
8929 XImage
*ximg
, *mask_img
= NULL
;
8930 struct gcpro gcpro1
;
8931 png_struct
*png_ptr
= NULL
;
8932 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8933 FILE *volatile fp
= NULL
;
8935 png_byte
* volatile pixels
= NULL
;
8936 png_byte
** volatile rows
= NULL
;
8937 png_uint_32 width
, height
;
8938 int bit_depth
, color_type
, interlace_type
;
8940 png_uint_32 row_bytes
;
8942 double screen_gamma
, image_gamma
;
8944 struct png_memory_storage tbr
; /* Data to be read */
8946 /* Find out what file to load. */
8947 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8948 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8952 if (NILP (specified_data
))
8954 file
= x_find_image_file (specified_file
);
8955 if (!STRINGP (file
))
8957 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8962 /* Open the image file. */
8963 fp
= fopen (SDATA (file
), "rb");
8966 image_error ("Cannot open image file `%s'", file
, Qnil
);
8972 /* Check PNG signature. */
8973 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8974 || !png_check_sig (sig
, sizeof sig
))
8976 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8984 /* Read from memory. */
8985 tbr
.bytes
= SDATA (specified_data
);
8986 tbr
.len
= SBYTES (specified_data
);
8989 /* Check PNG signature. */
8990 if (tbr
.len
< sizeof sig
8991 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8993 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8998 /* Need to skip past the signature. */
8999 tbr
.bytes
+= sizeof (sig
);
9002 /* Initialize read and info structs for PNG lib. */
9003 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
9004 my_png_error
, my_png_warning
);
9007 if (fp
) fclose (fp
);
9012 info_ptr
= png_create_info_struct (png_ptr
);
9015 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
9016 if (fp
) fclose (fp
);
9021 end_info
= png_create_info_struct (png_ptr
);
9024 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
9025 if (fp
) fclose (fp
);
9030 /* Set error jump-back. We come back here when the PNG library
9031 detects an error. */
9032 if (setjmp (png_ptr
->jmpbuf
))
9036 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
9039 if (fp
) fclose (fp
);
9044 /* Read image info. */
9045 if (!NILP (specified_data
))
9046 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
9048 png_init_io (png_ptr
, fp
);
9050 png_set_sig_bytes (png_ptr
, sizeof sig
);
9051 png_read_info (png_ptr
, info_ptr
);
9052 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
9053 &interlace_type
, NULL
, NULL
);
9055 /* If image contains simply transparency data, we prefer to
9056 construct a clipping mask. */
9057 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
9062 /* This function is easier to write if we only have to handle
9063 one data format: RGB or RGBA with 8 bits per channel. Let's
9064 transform other formats into that format. */
9066 /* Strip more than 8 bits per channel. */
9067 if (bit_depth
== 16)
9068 png_set_strip_16 (png_ptr
);
9070 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
9072 png_set_expand (png_ptr
);
9074 /* Convert grayscale images to RGB. */
9075 if (color_type
== PNG_COLOR_TYPE_GRAY
9076 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
9077 png_set_gray_to_rgb (png_ptr
);
9079 screen_gamma
= (f
->gamma
? 1 / f
->gamma
/ 0.45455 : 2.2);
9081 /* Tell the PNG lib to handle gamma correction for us. */
9083 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
9084 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
9085 /* The libpng documentation says this is right in this case. */
9086 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
9089 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
9090 /* Image contains gamma information. */
9091 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
9093 /* Use the standard default for the image gamma. */
9094 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
9096 /* Handle alpha channel by combining the image with a background
9097 color. Do this only if a real alpha channel is supplied. For
9098 simple transparency, we prefer a clipping mask. */
9101 png_color_16
*image_bg
;
9102 Lisp_Object specified_bg
9103 = image_spec_value (img
->spec
, QCbackground
, NULL
);
9105 if (STRINGP (specified_bg
))
9106 /* The user specified `:background', use that. */
9109 if (x_defined_color (f
, SDATA (specified_bg
), &color
, 0))
9111 png_color_16 user_bg
;
9113 bzero (&user_bg
, sizeof user_bg
);
9114 user_bg
.red
= color
.red
;
9115 user_bg
.green
= color
.green
;
9116 user_bg
.blue
= color
.blue
;
9118 png_set_background (png_ptr
, &user_bg
,
9119 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
9122 else if (png_get_bKGD (png_ptr
, info_ptr
, &image_bg
))
9123 /* Image contains a background color with which to
9124 combine the image. */
9125 png_set_background (png_ptr
, image_bg
,
9126 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
9129 /* Image does not contain a background color with which
9130 to combine the image data via an alpha channel. Use
9131 the frame's background instead. */
9134 png_color_16 frame_background
;
9136 cmap
= FRAME_X_COLORMAP (f
);
9137 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
9138 x_query_color (f
, &color
);
9140 bzero (&frame_background
, sizeof frame_background
);
9141 frame_background
.red
= color
.red
;
9142 frame_background
.green
= color
.green
;
9143 frame_background
.blue
= color
.blue
;
9145 png_set_background (png_ptr
, &frame_background
,
9146 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
9150 /* Update info structure. */
9151 png_read_update_info (png_ptr
, info_ptr
);
9153 /* Get number of channels. Valid values are 1 for grayscale images
9154 and images with a palette, 2 for grayscale images with transparency
9155 information (alpha channel), 3 for RGB images, and 4 for RGB
9156 images with alpha channel, i.e. RGBA. If conversions above were
9157 sufficient we should only have 3 or 4 channels here. */
9158 channels
= png_get_channels (png_ptr
, info_ptr
);
9159 xassert (channels
== 3 || channels
== 4);
9161 /* Number of bytes needed for one row of the image. */
9162 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
9164 /* Allocate memory for the image. */
9165 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
9166 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
9167 for (i
= 0; i
< height
; ++i
)
9168 rows
[i
] = pixels
+ i
* row_bytes
;
9170 /* Read the entire image. */
9171 png_read_image (png_ptr
, rows
);
9172 png_read_end (png_ptr
, info_ptr
);
9179 /* Create the X image and pixmap. */
9180 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
9184 /* Create an image and pixmap serving as mask if the PNG image
9185 contains an alpha channel. */
9188 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
9189 &mask_img
, &img
->mask
))
9191 x_destroy_x_image (ximg
);
9192 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
9197 /* Fill the X image and mask from PNG data. */
9198 init_color_table ();
9200 for (y
= 0; y
< height
; ++y
)
9202 png_byte
*p
= rows
[y
];
9204 for (x
= 0; x
< width
; ++x
)
9211 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
9213 /* An alpha channel, aka mask channel, associates variable
9214 transparency with an image. Where other image formats
9215 support binary transparency---fully transparent or fully
9216 opaque---PNG allows up to 254 levels of partial transparency.
9217 The PNG library implements partial transparency by combining
9218 the image with a specified background color.
9220 I'm not sure how to handle this here nicely: because the
9221 background on which the image is displayed may change, for
9222 real alpha channel support, it would be necessary to create
9223 a new image for each possible background.
9225 What I'm doing now is that a mask is created if we have
9226 boolean transparency information. Otherwise I'm using
9227 the frame's background color to combine the image with. */
9232 XPutPixel (mask_img
, x
, y
, *p
> 0);
9238 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9239 /* Set IMG's background color from the PNG image, unless the user
9243 if (png_get_bKGD (png_ptr
, info_ptr
, &bg
))
9245 img
->background
= lookup_rgb_color (f
, bg
->red
, bg
->green
, bg
->blue
);
9246 img
->background_valid
= 1;
9250 /* Remember colors allocated for this image. */
9251 img
->colors
= colors_in_color_table (&img
->ncolors
);
9252 free_color_table ();
9255 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
9260 img
->height
= height
;
9262 /* Maybe fill in the background field while we have ximg handy. */
9263 IMAGE_BACKGROUND (img
, f
, ximg
);
9265 /* Put the image into the pixmap, then free the X image and its buffer. */
9266 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9267 x_destroy_x_image (ximg
);
9269 /* Same for the mask. */
9272 /* Fill in the background_transparent field while we have the mask
9274 image_background_transparent (img
, f
, mask_img
);
9276 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
9277 x_destroy_x_image (mask_img
);
9284 #endif /* HAVE_PNG != 0 */
9288 /***********************************************************************
9290 ***********************************************************************/
9294 /* Work around a warning about HAVE_STDLIB_H being redefined in
9296 #ifdef HAVE_STDLIB_H
9297 #define HAVE_STDLIB_H_1
9298 #undef HAVE_STDLIB_H
9299 #endif /* HAVE_STLIB_H */
9301 #include <jpeglib.h>
9305 #ifdef HAVE_STLIB_H_1
9306 #define HAVE_STDLIB_H 1
9309 static int jpeg_image_p
P_ ((Lisp_Object object
));
9310 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
9312 /* The symbol `jpeg' identifying images of this type. */
9316 /* Indices of image specification fields in gs_format, below. */
9318 enum jpeg_keyword_index
9327 JPEG_HEURISTIC_MASK
,
9333 /* Vector of image_keyword structures describing the format
9334 of valid user-defined image specifications. */
9336 static struct image_keyword jpeg_format
[JPEG_LAST
] =
9338 {":type", IMAGE_SYMBOL_VALUE
, 1},
9339 {":data", IMAGE_STRING_VALUE
, 0},
9340 {":file", IMAGE_STRING_VALUE
, 0},
9341 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9342 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9343 {":relief", IMAGE_INTEGER_VALUE
, 0},
9344 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9345 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9346 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9347 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9350 /* Structure describing the image type `jpeg'. */
9352 static struct image_type jpeg_type
=
9362 /* Return non-zero if OBJECT is a valid JPEG image specification. */
9365 jpeg_image_p (object
)
9368 struct image_keyword fmt
[JPEG_LAST
];
9370 bcopy (jpeg_format
, fmt
, sizeof fmt
);
9372 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
9375 /* Must specify either the :data or :file keyword. */
9376 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
9380 struct my_jpeg_error_mgr
9382 struct jpeg_error_mgr pub
;
9383 jmp_buf setjmp_buffer
;
9388 my_error_exit (cinfo
)
9391 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
9392 longjmp (mgr
->setjmp_buffer
, 1);
9396 /* Init source method for JPEG data source manager. Called by
9397 jpeg_read_header() before any data is actually read. See
9398 libjpeg.doc from the JPEG lib distribution. */
9401 our_init_source (cinfo
)
9402 j_decompress_ptr cinfo
;
9407 /* Fill input buffer method for JPEG data source manager. Called
9408 whenever more data is needed. We read the whole image in one step,
9409 so this only adds a fake end of input marker at the end. */
9412 our_fill_input_buffer (cinfo
)
9413 j_decompress_ptr cinfo
;
9415 /* Insert a fake EOI marker. */
9416 struct jpeg_source_mgr
*src
= cinfo
->src
;
9417 static JOCTET buffer
[2];
9419 buffer
[0] = (JOCTET
) 0xFF;
9420 buffer
[1] = (JOCTET
) JPEG_EOI
;
9422 src
->next_input_byte
= buffer
;
9423 src
->bytes_in_buffer
= 2;
9428 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9429 is the JPEG data source manager. */
9432 our_skip_input_data (cinfo
, num_bytes
)
9433 j_decompress_ptr cinfo
;
9436 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9440 if (num_bytes
> src
->bytes_in_buffer
)
9441 ERREXIT (cinfo
, JERR_INPUT_EOF
);
9443 src
->bytes_in_buffer
-= num_bytes
;
9444 src
->next_input_byte
+= num_bytes
;
9449 /* Method to terminate data source. Called by
9450 jpeg_finish_decompress() after all data has been processed. */
9453 our_term_source (cinfo
)
9454 j_decompress_ptr cinfo
;
9459 /* Set up the JPEG lib for reading an image from DATA which contains
9460 LEN bytes. CINFO is the decompression info structure created for
9461 reading the image. */
9464 jpeg_memory_src (cinfo
, data
, len
)
9465 j_decompress_ptr cinfo
;
9469 struct jpeg_source_mgr
*src
;
9471 if (cinfo
->src
== NULL
)
9473 /* First time for this JPEG object? */
9474 cinfo
->src
= (struct jpeg_source_mgr
*)
9475 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9476 sizeof (struct jpeg_source_mgr
));
9477 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9478 src
->next_input_byte
= data
;
9481 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9482 src
->init_source
= our_init_source
;
9483 src
->fill_input_buffer
= our_fill_input_buffer
;
9484 src
->skip_input_data
= our_skip_input_data
;
9485 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9486 src
->term_source
= our_term_source
;
9487 src
->bytes_in_buffer
= len
;
9488 src
->next_input_byte
= data
;
9492 /* Load image IMG for use on frame F. Patterned after example.c
9493 from the JPEG lib. */
9500 struct jpeg_decompress_struct cinfo
;
9501 struct my_jpeg_error_mgr mgr
;
9502 Lisp_Object file
, specified_file
;
9503 Lisp_Object specified_data
;
9504 FILE * volatile fp
= NULL
;
9506 int row_stride
, x
, y
;
9507 XImage
*ximg
= NULL
;
9509 unsigned long *colors
;
9511 struct gcpro gcpro1
;
9513 /* Open the JPEG file. */
9514 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9515 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9519 if (NILP (specified_data
))
9521 file
= x_find_image_file (specified_file
);
9522 if (!STRINGP (file
))
9524 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9529 fp
= fopen (SDATA (file
), "r");
9532 image_error ("Cannot open `%s'", file
, Qnil
);
9538 /* Customize libjpeg's error handling to call my_error_exit when an
9539 error is detected. This function will perform a longjmp. */
9540 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9541 mgr
.pub
.error_exit
= my_error_exit
;
9543 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9547 /* Called from my_error_exit. Display a JPEG error. */
9548 char buffer
[JMSG_LENGTH_MAX
];
9549 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9550 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9551 build_string (buffer
));
9554 /* Close the input file and destroy the JPEG object. */
9556 fclose ((FILE *) fp
);
9557 jpeg_destroy_decompress (&cinfo
);
9559 /* If we already have an XImage, free that. */
9560 x_destroy_x_image (ximg
);
9562 /* Free pixmap and colors. */
9563 x_clear_image (f
, img
);
9569 /* Create the JPEG decompression object. Let it read from fp.
9570 Read the JPEG image header. */
9571 jpeg_create_decompress (&cinfo
);
9573 if (NILP (specified_data
))
9574 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9576 jpeg_memory_src (&cinfo
, SDATA (specified_data
),
9577 SBYTES (specified_data
));
9579 jpeg_read_header (&cinfo
, TRUE
);
9581 /* Customize decompression so that color quantization will be used.
9582 Start decompression. */
9583 cinfo
.quantize_colors
= TRUE
;
9584 jpeg_start_decompress (&cinfo
);
9585 width
= img
->width
= cinfo
.output_width
;
9586 height
= img
->height
= cinfo
.output_height
;
9588 /* Create X image and pixmap. */
9589 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9590 longjmp (mgr
.setjmp_buffer
, 2);
9592 /* Allocate colors. When color quantization is used,
9593 cinfo.actual_number_of_colors has been set with the number of
9594 colors generated, and cinfo.colormap is a two-dimensional array
9595 of color indices in the range 0..cinfo.actual_number_of_colors.
9596 No more than 255 colors will be generated. */
9600 if (cinfo
.out_color_components
> 2)
9601 ir
= 0, ig
= 1, ib
= 2;
9602 else if (cinfo
.out_color_components
> 1)
9603 ir
= 0, ig
= 1, ib
= 0;
9605 ir
= 0, ig
= 0, ib
= 0;
9607 /* Use the color table mechanism because it handles colors that
9608 cannot be allocated nicely. Such colors will be replaced with
9609 a default color, and we don't have to care about which colors
9610 can be freed safely, and which can't. */
9611 init_color_table ();
9612 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9615 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9617 /* Multiply RGB values with 255 because X expects RGB values
9618 in the range 0..0xffff. */
9619 int r
= cinfo
.colormap
[ir
][i
] << 8;
9620 int g
= cinfo
.colormap
[ig
][i
] << 8;
9621 int b
= cinfo
.colormap
[ib
][i
] << 8;
9622 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9625 /* Remember those colors actually allocated. */
9626 img
->colors
= colors_in_color_table (&img
->ncolors
);
9627 free_color_table ();
9631 row_stride
= width
* cinfo
.output_components
;
9632 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9634 for (y
= 0; y
< height
; ++y
)
9636 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9637 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9638 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9642 jpeg_finish_decompress (&cinfo
);
9643 jpeg_destroy_decompress (&cinfo
);
9645 fclose ((FILE *) fp
);
9647 /* Maybe fill in the background field while we have ximg handy. */
9648 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9649 IMAGE_BACKGROUND (img
, f
, ximg
);
9651 /* Put the image into the pixmap. */
9652 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9653 x_destroy_x_image (ximg
);
9658 #endif /* HAVE_JPEG */
9662 /***********************************************************************
9664 ***********************************************************************/
9670 static int tiff_image_p
P_ ((Lisp_Object object
));
9671 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9673 /* The symbol `tiff' identifying images of this type. */
9677 /* Indices of image specification fields in tiff_format, below. */
9679 enum tiff_keyword_index
9688 TIFF_HEURISTIC_MASK
,
9694 /* Vector of image_keyword structures describing the format
9695 of valid user-defined image specifications. */
9697 static struct image_keyword tiff_format
[TIFF_LAST
] =
9699 {":type", IMAGE_SYMBOL_VALUE
, 1},
9700 {":data", IMAGE_STRING_VALUE
, 0},
9701 {":file", IMAGE_STRING_VALUE
, 0},
9702 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9703 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9704 {":relief", IMAGE_INTEGER_VALUE
, 0},
9705 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9706 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9707 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9708 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9711 /* Structure describing the image type `tiff'. */
9713 static struct image_type tiff_type
=
9723 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9726 tiff_image_p (object
)
9729 struct image_keyword fmt
[TIFF_LAST
];
9730 bcopy (tiff_format
, fmt
, sizeof fmt
);
9732 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9735 /* Must specify either the :data or :file keyword. */
9736 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9740 /* Reading from a memory buffer for TIFF images Based on the PNG
9741 memory source, but we have to provide a lot of extra functions.
9744 We really only need to implement read and seek, but I am not
9745 convinced that the TIFF library is smart enough not to destroy
9746 itself if we only hand it the function pointers we need to
9751 unsigned char *bytes
;
9759 tiff_read_from_memory (data
, buf
, size
)
9764 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9766 if (size
> src
->len
- src
->index
)
9768 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9775 tiff_write_from_memory (data
, buf
, size
)
9785 tiff_seek_in_memory (data
, off
, whence
)
9790 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9795 case SEEK_SET
: /* Go from beginning of source. */
9799 case SEEK_END
: /* Go from end of source. */
9800 idx
= src
->len
+ off
;
9803 case SEEK_CUR
: /* Go from current position. */
9804 idx
= src
->index
+ off
;
9807 default: /* Invalid `whence'. */
9811 if (idx
> src
->len
|| idx
< 0)
9820 tiff_close_memory (data
)
9829 tiff_mmap_memory (data
, pbase
, psize
)
9834 /* It is already _IN_ memory. */
9840 tiff_unmap_memory (data
, base
, size
)
9845 /* We don't need to do this. */
9850 tiff_size_of_memory (data
)
9853 return ((tiff_memory_source
*) data
)->len
;
9858 tiff_error_handler (title
, format
, ap
)
9859 const char *title
, *format
;
9865 len
= sprintf (buf
, "TIFF error: %s ", title
);
9866 vsprintf (buf
+ len
, format
, ap
);
9867 add_to_log (buf
, Qnil
, Qnil
);
9872 tiff_warning_handler (title
, format
, ap
)
9873 const char *title
, *format
;
9879 len
= sprintf (buf
, "TIFF warning: %s ", title
);
9880 vsprintf (buf
+ len
, format
, ap
);
9881 add_to_log (buf
, Qnil
, Qnil
);
9885 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9893 Lisp_Object file
, specified_file
;
9894 Lisp_Object specified_data
;
9896 int width
, height
, x
, y
;
9900 struct gcpro gcpro1
;
9901 tiff_memory_source memsrc
;
9903 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9904 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9908 TIFFSetErrorHandler (tiff_error_handler
);
9909 TIFFSetWarningHandler (tiff_warning_handler
);
9911 if (NILP (specified_data
))
9913 /* Read from a file */
9914 file
= x_find_image_file (specified_file
);
9915 if (!STRINGP (file
))
9917 image_error ("Cannot find image file `%s'", file
, Qnil
);
9922 /* Try to open the image file. */
9923 tiff
= TIFFOpen (SDATA (file
), "r");
9926 image_error ("Cannot open `%s'", file
, Qnil
);
9933 /* Memory source! */
9934 memsrc
.bytes
= SDATA (specified_data
);
9935 memsrc
.len
= SBYTES (specified_data
);
9938 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9939 (TIFFReadWriteProc
) tiff_read_from_memory
,
9940 (TIFFReadWriteProc
) tiff_write_from_memory
,
9941 tiff_seek_in_memory
,
9943 tiff_size_of_memory
,
9949 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9955 /* Get width and height of the image, and allocate a raster buffer
9956 of width x height 32-bit values. */
9957 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9958 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9959 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9961 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9965 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9971 /* Create the X image and pixmap. */
9972 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9979 /* Initialize the color table. */
9980 init_color_table ();
9982 /* Process the pixel raster. Origin is in the lower-left corner. */
9983 for (y
= 0; y
< height
; ++y
)
9985 uint32
*row
= buf
+ y
* width
;
9987 for (x
= 0; x
< width
; ++x
)
9989 uint32 abgr
= row
[x
];
9990 int r
= TIFFGetR (abgr
) << 8;
9991 int g
= TIFFGetG (abgr
) << 8;
9992 int b
= TIFFGetB (abgr
) << 8;
9993 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9997 /* Remember the colors allocated for the image. Free the color table. */
9998 img
->colors
= colors_in_color_table (&img
->ncolors
);
9999 free_color_table ();
10001 img
->width
= width
;
10002 img
->height
= height
;
10004 /* Maybe fill in the background field while we have ximg handy. */
10005 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10006 IMAGE_BACKGROUND (img
, f
, ximg
);
10008 /* Put the image into the pixmap, then free the X image and its buffer. */
10009 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10010 x_destroy_x_image (ximg
);
10017 #endif /* HAVE_TIFF != 0 */
10021 /***********************************************************************
10023 ***********************************************************************/
10027 #include <gif_lib.h>
10029 static int gif_image_p
P_ ((Lisp_Object object
));
10030 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
10032 /* The symbol `gif' identifying images of this type. */
10036 /* Indices of image specification fields in gif_format, below. */
10038 enum gif_keyword_index
10047 GIF_HEURISTIC_MASK
,
10054 /* Vector of image_keyword structures describing the format
10055 of valid user-defined image specifications. */
10057 static struct image_keyword gif_format
[GIF_LAST
] =
10059 {":type", IMAGE_SYMBOL_VALUE
, 1},
10060 {":data", IMAGE_STRING_VALUE
, 0},
10061 {":file", IMAGE_STRING_VALUE
, 0},
10062 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10063 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10064 {":relief", IMAGE_INTEGER_VALUE
, 0},
10065 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10066 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10067 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10068 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
10069 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10072 /* Structure describing the image type `gif'. */
10074 static struct image_type gif_type
=
10084 /* Return non-zero if OBJECT is a valid GIF image specification. */
10087 gif_image_p (object
)
10088 Lisp_Object object
;
10090 struct image_keyword fmt
[GIF_LAST
];
10091 bcopy (gif_format
, fmt
, sizeof fmt
);
10093 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
10096 /* Must specify either the :data or :file keyword. */
10097 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
10101 /* Reading a GIF image from memory
10102 Based on the PNG memory stuff to a certain extent. */
10106 unsigned char *bytes
;
10113 /* Make the current memory source available to gif_read_from_memory.
10114 It's done this way because not all versions of libungif support
10115 a UserData field in the GifFileType structure. */
10116 static gif_memory_source
*current_gif_memory_src
;
10119 gif_read_from_memory (file
, buf
, len
)
10124 gif_memory_source
*src
= current_gif_memory_src
;
10126 if (len
> src
->len
- src
->index
)
10129 bcopy (src
->bytes
+ src
->index
, buf
, len
);
10135 /* Load GIF image IMG for use on frame F. Value is non-zero if
10143 Lisp_Object file
, specified_file
;
10144 Lisp_Object specified_data
;
10145 int rc
, width
, height
, x
, y
, i
;
10147 ColorMapObject
*gif_color_map
;
10148 unsigned long pixel_colors
[256];
10150 struct gcpro gcpro1
;
10152 int ino
, image_left
, image_top
, image_width
, image_height
;
10153 gif_memory_source memsrc
;
10154 unsigned char *raster
;
10156 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10157 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10161 if (NILP (specified_data
))
10163 file
= x_find_image_file (specified_file
);
10164 if (!STRINGP (file
))
10166 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10171 /* Open the GIF file. */
10172 gif
= DGifOpenFileName (SDATA (file
));
10175 image_error ("Cannot open `%s'", file
, Qnil
);
10182 /* Read from memory! */
10183 current_gif_memory_src
= &memsrc
;
10184 memsrc
.bytes
= SDATA (specified_data
);
10185 memsrc
.len
= SBYTES (specified_data
);
10188 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
10191 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
10197 /* Read entire contents. */
10198 rc
= DGifSlurp (gif
);
10199 if (rc
== GIF_ERROR
)
10201 image_error ("Error reading `%s'", img
->spec
, Qnil
);
10202 DGifCloseFile (gif
);
10207 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
10208 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
10209 if (ino
>= gif
->ImageCount
)
10211 image_error ("Invalid image number `%s' in image `%s'",
10213 DGifCloseFile (gif
);
10218 width
= img
->width
= max (gif
->SWidth
, gif
->Image
.Left
+ gif
->Image
.Width
);
10219 height
= img
->height
= max (gif
->SHeight
, gif
->Image
.Top
+ gif
->Image
.Height
);
10221 /* Create the X image and pixmap. */
10222 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
10224 DGifCloseFile (gif
);
10229 /* Allocate colors. */
10230 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
10231 if (!gif_color_map
)
10232 gif_color_map
= gif
->SColorMap
;
10233 init_color_table ();
10234 bzero (pixel_colors
, sizeof pixel_colors
);
10236 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
10238 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
10239 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
10240 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
10241 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
10244 img
->colors
= colors_in_color_table (&img
->ncolors
);
10245 free_color_table ();
10247 /* Clear the part of the screen image that are not covered by
10248 the image from the GIF file. Full animated GIF support
10249 requires more than can be done here (see the gif89 spec,
10250 disposal methods). Let's simply assume that the part
10251 not covered by a sub-image is in the frame's background color. */
10252 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
10253 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
10254 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
10255 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
10257 for (y
= 0; y
< image_top
; ++y
)
10258 for (x
= 0; x
< width
; ++x
)
10259 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10261 for (y
= image_top
+ image_height
; y
< height
; ++y
)
10262 for (x
= 0; x
< width
; ++x
)
10263 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10265 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
10267 for (x
= 0; x
< image_left
; ++x
)
10268 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10269 for (x
= image_left
+ image_width
; x
< width
; ++x
)
10270 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10273 /* Read the GIF image into the X image. We use a local variable
10274 `raster' here because RasterBits below is a char *, and invites
10275 problems with bytes >= 0x80. */
10276 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
10278 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
10280 static int interlace_start
[] = {0, 4, 2, 1};
10281 static int interlace_increment
[] = {8, 8, 4, 2};
10283 int row
= interlace_start
[0];
10287 for (y
= 0; y
< image_height
; y
++)
10289 if (row
>= image_height
)
10291 row
= interlace_start
[++pass
];
10292 while (row
>= image_height
)
10293 row
= interlace_start
[++pass
];
10296 for (x
= 0; x
< image_width
; x
++)
10298 int i
= raster
[(y
* image_width
) + x
];
10299 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
10303 row
+= interlace_increment
[pass
];
10308 for (y
= 0; y
< image_height
; ++y
)
10309 for (x
= 0; x
< image_width
; ++x
)
10311 int i
= raster
[y
* image_width
+ x
];
10312 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
10316 DGifCloseFile (gif
);
10318 /* Maybe fill in the background field while we have ximg handy. */
10319 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10320 IMAGE_BACKGROUND (img
, f
, ximg
);
10322 /* Put the image into the pixmap, then free the X image and its buffer. */
10323 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10324 x_destroy_x_image (ximg
);
10330 #endif /* HAVE_GIF != 0 */
10334 /***********************************************************************
10336 ***********************************************************************/
10338 static int gs_image_p
P_ ((Lisp_Object object
));
10339 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
10340 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
10342 /* The symbol `postscript' identifying images of this type. */
10344 Lisp_Object Qpostscript
;
10346 /* Keyword symbols. */
10348 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
10350 /* Indices of image specification fields in gs_format, below. */
10352 enum gs_keyword_index
10370 /* Vector of image_keyword structures describing the format
10371 of valid user-defined image specifications. */
10373 static struct image_keyword gs_format
[GS_LAST
] =
10375 {":type", IMAGE_SYMBOL_VALUE
, 1},
10376 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10377 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10378 {":file", IMAGE_STRING_VALUE
, 1},
10379 {":loader", IMAGE_FUNCTION_VALUE
, 0},
10380 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
10381 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10382 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10383 {":relief", IMAGE_INTEGER_VALUE
, 0},
10384 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10385 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10386 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10387 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10390 /* Structure describing the image type `ghostscript'. */
10392 static struct image_type gs_type
=
10402 /* Free X resources of Ghostscript image IMG which is used on frame F. */
10405 gs_clear_image (f
, img
)
10409 /* IMG->data.ptr_val may contain a recorded colormap. */
10410 xfree (img
->data
.ptr_val
);
10411 x_clear_image (f
, img
);
10415 /* Return non-zero if OBJECT is a valid Ghostscript image
10419 gs_image_p (object
)
10420 Lisp_Object object
;
10422 struct image_keyword fmt
[GS_LAST
];
10426 bcopy (gs_format
, fmt
, sizeof fmt
);
10428 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
10431 /* Bounding box must be a list or vector containing 4 integers. */
10432 tem
= fmt
[GS_BOUNDING_BOX
].value
;
10435 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
10436 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
10441 else if (VECTORP (tem
))
10443 if (XVECTOR (tem
)->size
!= 4)
10445 for (i
= 0; i
< 4; ++i
)
10446 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
10456 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
10465 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
10466 struct gcpro gcpro1
, gcpro2
;
10468 double in_width
, in_height
;
10469 Lisp_Object pixel_colors
= Qnil
;
10471 /* Compute pixel size of pixmap needed from the given size in the
10472 image specification. Sizes in the specification are in pt. 1 pt
10473 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10475 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
10476 in_width
= XFASTINT (pt_width
) / 72.0;
10477 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
10478 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
10479 in_height
= XFASTINT (pt_height
) / 72.0;
10480 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
10482 /* Create the pixmap. */
10483 xassert (img
->pixmap
== None
);
10484 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10485 img
->width
, img
->height
,
10486 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
10490 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
10494 /* Call the loader to fill the pixmap. It returns a process object
10495 if successful. We do not record_unwind_protect here because
10496 other places in redisplay like calling window scroll functions
10497 don't either. Let the Lisp loader use `unwind-protect' instead. */
10498 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
10500 sprintf (buffer
, "%lu %lu",
10501 (unsigned long) FRAME_X_WINDOW (f
),
10502 (unsigned long) img
->pixmap
);
10503 window_and_pixmap_id
= build_string (buffer
);
10505 sprintf (buffer
, "%lu %lu",
10506 FRAME_FOREGROUND_PIXEL (f
),
10507 FRAME_BACKGROUND_PIXEL (f
));
10508 pixel_colors
= build_string (buffer
);
10510 XSETFRAME (frame
, f
);
10511 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
10513 loader
= intern ("gs-load-image");
10515 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10516 make_number (img
->width
),
10517 make_number (img
->height
),
10518 window_and_pixmap_id
,
10521 return PROCESSP (img
->data
.lisp_val
);
10525 /* Kill the Ghostscript process that was started to fill PIXMAP on
10526 frame F. Called from XTread_socket when receiving an event
10527 telling Emacs that Ghostscript has finished drawing. */
10530 x_kill_gs_process (pixmap
, f
)
10534 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10538 /* Find the image containing PIXMAP. */
10539 for (i
= 0; i
< c
->used
; ++i
)
10540 if (c
->images
[i
]->pixmap
== pixmap
)
10543 /* Should someone in between have cleared the image cache, for
10544 instance, give up. */
10548 /* Kill the GS process. We should have found PIXMAP in the image
10549 cache and its image should contain a process object. */
10550 img
= c
->images
[i
];
10551 xassert (PROCESSP (img
->data
.lisp_val
));
10552 Fkill_process (img
->data
.lisp_val
, Qnil
);
10553 img
->data
.lisp_val
= Qnil
;
10555 /* On displays with a mutable colormap, figure out the colors
10556 allocated for the image by looking at the pixels of an XImage for
10558 class = FRAME_X_VISUAL (f
)->class;
10559 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10565 /* Try to get an XImage for img->pixmep. */
10566 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10567 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10572 /* Initialize the color table. */
10573 init_color_table ();
10575 /* For each pixel of the image, look its color up in the
10576 color table. After having done so, the color table will
10577 contain an entry for each color used by the image. */
10578 for (y
= 0; y
< img
->height
; ++y
)
10579 for (x
= 0; x
< img
->width
; ++x
)
10581 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10582 lookup_pixel_color (f
, pixel
);
10585 /* Record colors in the image. Free color table and XImage. */
10586 img
->colors
= colors_in_color_table (&img
->ncolors
);
10587 free_color_table ();
10588 XDestroyImage (ximg
);
10590 #if 0 /* This doesn't seem to be the case. If we free the colors
10591 here, we get a BadAccess later in x_clear_image when
10592 freeing the colors. */
10593 /* We have allocated colors once, but Ghostscript has also
10594 allocated colors on behalf of us. So, to get the
10595 reference counts right, free them once. */
10597 x_free_colors (f
, img
->colors
, img
->ncolors
);
10601 image_error ("Cannot get X image of `%s'; colors will not be freed",
10607 /* Now that we have the pixmap, compute mask and transform the
10608 image if requested. */
10610 postprocess_image (f
, img
);
10616 /***********************************************************************
10618 ***********************************************************************/
10620 DEFUN ("x-change-window-property", Fx_change_window_property
,
10621 Sx_change_window_property
, 2, 3, 0,
10622 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
10623 PROP and VALUE must be strings. FRAME nil or omitted means use the
10624 selected frame. Value is VALUE. */)
10625 (prop
, value
, frame
)
10626 Lisp_Object frame
, prop
, value
;
10628 struct frame
*f
= check_x_frame (frame
);
10631 CHECK_STRING (prop
);
10632 CHECK_STRING (value
);
10635 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SDATA (prop
), False
);
10636 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10637 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10638 SDATA (value
), SCHARS (value
));
10640 /* Make sure the property is set when we return. */
10641 XFlush (FRAME_X_DISPLAY (f
));
10648 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10649 Sx_delete_window_property
, 1, 2, 0,
10650 doc
: /* Remove window property PROP from X window of FRAME.
10651 FRAME nil or omitted means use the selected frame. Value is PROP. */)
10653 Lisp_Object prop
, frame
;
10655 struct frame
*f
= check_x_frame (frame
);
10658 CHECK_STRING (prop
);
10660 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SDATA (prop
), False
);
10661 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10663 /* Make sure the property is removed when we return. */
10664 XFlush (FRAME_X_DISPLAY (f
));
10671 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10673 doc
: /* Value is the value of window property PROP on FRAME.
10674 If FRAME is nil or omitted, use the selected frame. Value is nil
10675 if FRAME hasn't a property with name PROP or if PROP has no string
10678 Lisp_Object prop
, frame
;
10680 struct frame
*f
= check_x_frame (frame
);
10683 Lisp_Object prop_value
= Qnil
;
10684 char *tmp_data
= NULL
;
10687 unsigned long actual_size
, bytes_remaining
;
10689 CHECK_STRING (prop
);
10691 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SDATA (prop
), False
);
10692 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10693 prop_atom
, 0, 0, False
, XA_STRING
,
10694 &actual_type
, &actual_format
, &actual_size
,
10695 &bytes_remaining
, (unsigned char **) &tmp_data
);
10698 int size
= bytes_remaining
;
10703 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10704 prop_atom
, 0, bytes_remaining
,
10706 &actual_type
, &actual_format
,
10707 &actual_size
, &bytes_remaining
,
10708 (unsigned char **) &tmp_data
);
10709 if (rc
== Success
&& tmp_data
)
10710 prop_value
= make_string (tmp_data
, size
);
10721 /***********************************************************************
10723 ***********************************************************************/
10725 /* If non-null, an asynchronous timer that, when it expires, displays
10726 an hourglass cursor on all frames. */
10728 static struct atimer
*hourglass_atimer
;
10730 /* Non-zero means an hourglass cursor is currently shown. */
10732 static int hourglass_shown_p
;
10734 /* Number of seconds to wait before displaying an hourglass cursor. */
10736 static Lisp_Object Vhourglass_delay
;
10738 /* Default number of seconds to wait before displaying an hourglass
10741 #define DEFAULT_HOURGLASS_DELAY 1
10743 /* Function prototypes. */
10745 static void show_hourglass
P_ ((struct atimer
*));
10746 static void hide_hourglass
P_ ((void));
10749 /* Cancel a currently active hourglass timer, and start a new one. */
10755 int secs
, usecs
= 0;
10757 cancel_hourglass ();
10759 if (INTEGERP (Vhourglass_delay
)
10760 && XINT (Vhourglass_delay
) > 0)
10761 secs
= XFASTINT (Vhourglass_delay
);
10762 else if (FLOATP (Vhourglass_delay
)
10763 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10766 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10767 secs
= XFASTINT (tem
);
10768 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10771 secs
= DEFAULT_HOURGLASS_DELAY
;
10773 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10774 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10775 show_hourglass
, NULL
);
10779 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10783 cancel_hourglass ()
10785 if (hourglass_atimer
)
10787 cancel_atimer (hourglass_atimer
);
10788 hourglass_atimer
= NULL
;
10791 if (hourglass_shown_p
)
10796 /* Timer function of hourglass_atimer. TIMER is equal to
10799 Display an hourglass pointer on all frames by mapping the frames'
10800 hourglass_window. Set the hourglass_p flag in the frames'
10801 output_data.x structure to indicate that an hourglass cursor is
10802 shown on the frames. */
10805 show_hourglass (timer
)
10806 struct atimer
*timer
;
10808 /* The timer implementation will cancel this timer automatically
10809 after this function has run. Set hourglass_atimer to null
10810 so that we know the timer doesn't have to be canceled. */
10811 hourglass_atimer
= NULL
;
10813 if (!hourglass_shown_p
)
10815 Lisp_Object rest
, frame
;
10819 FOR_EACH_FRAME (rest
, frame
)
10821 struct frame
*f
= XFRAME (frame
);
10823 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10825 Display
*dpy
= FRAME_X_DISPLAY (f
);
10827 #ifdef USE_X_TOOLKIT
10828 if (f
->output_data
.x
->widget
)
10830 if (FRAME_OUTER_WINDOW (f
))
10833 f
->output_data
.x
->hourglass_p
= 1;
10835 if (!f
->output_data
.x
->hourglass_window
)
10837 unsigned long mask
= CWCursor
;
10838 XSetWindowAttributes attrs
;
10840 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10842 f
->output_data
.x
->hourglass_window
10843 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10844 0, 0, 32000, 32000, 0, 0,
10850 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10856 hourglass_shown_p
= 1;
10862 /* Hide the hourglass pointer on all frames, if it is currently
10868 if (hourglass_shown_p
)
10870 Lisp_Object rest
, frame
;
10873 FOR_EACH_FRAME (rest
, frame
)
10875 struct frame
*f
= XFRAME (frame
);
10878 /* Watch out for newly created frames. */
10879 && f
->output_data
.x
->hourglass_window
)
10881 XUnmapWindow (FRAME_X_DISPLAY (f
),
10882 f
->output_data
.x
->hourglass_window
);
10883 /* Sync here because XTread_socket looks at the
10884 hourglass_p flag that is reset to zero below. */
10885 XSync (FRAME_X_DISPLAY (f
), False
);
10886 f
->output_data
.x
->hourglass_p
= 0;
10890 hourglass_shown_p
= 0;
10897 /***********************************************************************
10899 ***********************************************************************/
10901 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10902 Lisp_Object
, Lisp_Object
));
10903 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10904 Lisp_Object
, int, int, int *, int *));
10906 /* The frame of a currently visible tooltip. */
10908 Lisp_Object tip_frame
;
10910 /* If non-nil, a timer started that hides the last tooltip when it
10913 Lisp_Object tip_timer
;
10916 /* If non-nil, a vector of 3 elements containing the last args
10917 with which x-show-tip was called. See there. */
10919 Lisp_Object last_show_tip_args
;
10921 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
10923 Lisp_Object Vx_max_tooltip_size
;
10927 unwind_create_tip_frame (frame
)
10930 Lisp_Object deleted
;
10932 deleted
= unwind_create_frame (frame
);
10933 if (EQ (deleted
, Qt
))
10943 /* Create a frame for a tooltip on the display described by DPYINFO.
10944 PARMS is a list of frame parameters. TEXT is the string to
10945 display in the tip frame. Value is the frame.
10947 Note that functions called here, esp. x_default_parameter can
10948 signal errors, for instance when a specified color name is
10949 undefined. We have to make sure that we're in a consistent state
10950 when this happens. */
10953 x_create_tip_frame (dpyinfo
, parms
, text
)
10954 struct x_display_info
*dpyinfo
;
10955 Lisp_Object parms
, text
;
10958 Lisp_Object frame
, tem
;
10960 long window_prompting
= 0;
10962 int count
= SPECPDL_INDEX ();
10963 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10965 int face_change_count_before
= face_change_count
;
10966 Lisp_Object buffer
;
10967 struct buffer
*old_buffer
;
10971 /* Use this general default value to start with until we know if
10972 this frame has a specified name. */
10973 Vx_resource_name
= Vinvocation_name
;
10975 #ifdef MULTI_KBOARD
10976 kb
= dpyinfo
->kboard
;
10978 kb
= &the_only_kboard
;
10981 /* Get the name of the frame to use for resource lookup. */
10982 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10983 if (!STRINGP (name
)
10984 && !EQ (name
, Qunbound
)
10986 error ("Invalid frame name--not a string or nil");
10987 Vx_resource_name
= name
;
10990 GCPRO3 (parms
, name
, frame
);
10991 f
= make_frame (1);
10992 XSETFRAME (frame
, f
);
10994 buffer
= Fget_buffer_create (build_string (" *tip*"));
10995 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10996 old_buffer
= current_buffer
;
10997 set_buffer_internal_1 (XBUFFER (buffer
));
10998 current_buffer
->truncate_lines
= Qnil
;
11000 Finsert (1, &text
);
11001 set_buffer_internal_1 (old_buffer
);
11003 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
11004 record_unwind_protect (unwind_create_tip_frame
, frame
);
11006 /* By setting the output method, we're essentially saying that
11007 the frame is live, as per FRAME_LIVE_P. If we get a signal
11008 from this point on, x_destroy_window might screw up reference
11010 f
->output_method
= output_x_window
;
11011 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
11012 bzero (f
->output_data
.x
, sizeof (struct x_output
));
11013 f
->output_data
.x
->icon_bitmap
= -1;
11014 f
->output_data
.x
->fontset
= -1;
11015 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
11016 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
11017 #ifdef USE_TOOLKIT_SCROLL_BARS
11018 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
11019 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
11020 #endif /* USE_TOOLKIT_SCROLL_BARS */
11021 f
->icon_name
= Qnil
;
11022 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
11024 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
11025 dpyinfo_refcount
= dpyinfo
->reference_count
;
11026 #endif /* GLYPH_DEBUG */
11027 #ifdef MULTI_KBOARD
11028 FRAME_KBOARD (f
) = kb
;
11030 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
11031 f
->output_data
.x
->explicit_parent
= 0;
11033 /* These colors will be set anyway later, but it's important
11034 to get the color reference counts right, so initialize them! */
11037 struct gcpro gcpro1
;
11039 black
= build_string ("black");
11041 f
->output_data
.x
->foreground_pixel
11042 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11043 f
->output_data
.x
->background_pixel
11044 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11045 f
->output_data
.x
->cursor_pixel
11046 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11047 f
->output_data
.x
->cursor_foreground_pixel
11048 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11049 f
->output_data
.x
->border_pixel
11050 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11051 f
->output_data
.x
->mouse_pixel
11052 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11056 /* Set the name; the functions to which we pass f expect the name to
11058 if (EQ (name
, Qunbound
) || NILP (name
))
11060 f
->name
= build_string (dpyinfo
->x_id_name
);
11061 f
->explicit_name
= 0;
11066 f
->explicit_name
= 1;
11067 /* use the frame's title when getting resources for this frame. */
11068 specbind (Qx_resource_name
, name
);
11071 /* Extract the window parameters from the supplied values that are
11072 needed to determine window geometry. */
11076 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
11079 /* First, try whatever font the caller has specified. */
11080 if (STRINGP (font
))
11082 tem
= Fquery_fontset (font
, Qnil
);
11084 font
= x_new_fontset (f
, SDATA (tem
));
11086 font
= x_new_font (f
, SDATA (font
));
11089 /* Try out a font which we hope has bold and italic variations. */
11090 if (!STRINGP (font
))
11091 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
11092 if (!STRINGP (font
))
11093 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11094 if (! STRINGP (font
))
11095 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11096 if (! STRINGP (font
))
11097 /* This was formerly the first thing tried, but it finds too many fonts
11098 and takes too long. */
11099 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
11100 /* If those didn't work, look for something which will at least work. */
11101 if (! STRINGP (font
))
11102 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
11104 if (! STRINGP (font
))
11105 font
= build_string ("fixed");
11107 x_default_parameter (f
, parms
, Qfont
, font
,
11108 "font", "Font", RES_TYPE_STRING
);
11111 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
11112 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
11114 /* This defaults to 2 in order to match xterm. We recognize either
11115 internalBorderWidth or internalBorder (which is what xterm calls
11117 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11121 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
11122 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
11123 if (! EQ (value
, Qunbound
))
11124 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
11128 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
11129 "internalBorderWidth", "internalBorderWidth",
11132 /* Also do the stuff which must be set before the window exists. */
11133 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
11134 "foreground", "Foreground", RES_TYPE_STRING
);
11135 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
11136 "background", "Background", RES_TYPE_STRING
);
11137 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
11138 "pointerColor", "Foreground", RES_TYPE_STRING
);
11139 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
11140 "cursorColor", "Foreground", RES_TYPE_STRING
);
11141 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
11142 "borderColor", "BorderColor", RES_TYPE_STRING
);
11144 /* Init faces before x_default_parameter is called for scroll-bar
11145 parameters because that function calls x_set_scroll_bar_width,
11146 which calls change_frame_size, which calls Fset_window_buffer,
11147 which runs hooks, which call Fvertical_motion. At the end, we
11148 end up in init_iterator with a null face cache, which should not
11150 init_frame_faces (f
);
11152 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
11153 window_prompting
= x_figure_window_size (f
, parms
);
11155 if (window_prompting
& XNegative
)
11157 if (window_prompting
& YNegative
)
11158 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
11160 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
11164 if (window_prompting
& YNegative
)
11165 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
11167 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
11170 f
->output_data
.x
->size_hint_flags
= window_prompting
;
11172 XSetWindowAttributes attrs
;
11173 unsigned long mask
;
11176 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
11177 if (DoesSaveUnders (dpyinfo
->screen
))
11178 mask
|= CWSaveUnder
;
11180 /* Window managers look at the override-redirect flag to determine
11181 whether or net to give windows a decoration (Xlib spec, chapter
11183 attrs
.override_redirect
= True
;
11184 attrs
.save_under
= True
;
11185 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
11186 /* Arrange for getting MapNotify and UnmapNotify events. */
11187 attrs
.event_mask
= StructureNotifyMask
;
11189 = FRAME_X_WINDOW (f
)
11190 = XCreateWindow (FRAME_X_DISPLAY (f
),
11191 FRAME_X_DISPLAY_INFO (f
)->root_window
,
11192 /* x, y, width, height */
11196 CopyFromParent
, InputOutput
, CopyFromParent
,
11203 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
11204 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
11205 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
11206 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
11207 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
11208 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
11210 /* Dimensions, especially f->height, must be done via change_frame_size.
11211 Change will not be effected unless different from the current
11214 height
= f
->height
;
11216 SET_FRAME_WIDTH (f
, 0);
11217 change_frame_size (f
, height
, width
, 1, 0, 0);
11219 /* Set up faces after all frame parameters are known. This call
11220 also merges in face attributes specified for new frames.
11222 Frame parameters may be changed if .Xdefaults contains
11223 specifications for the default font. For example, if there is an
11224 `Emacs.default.attributeBackground: pink', the `background-color'
11225 attribute of the frame get's set, which let's the internal border
11226 of the tooltip frame appear in pink. Prevent this. */
11228 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
11230 /* Set tip_frame here, so that */
11232 call1 (Qface_set_after_frame_default
, frame
);
11234 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
11235 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
11243 /* It is now ok to make the frame official even if we get an error
11244 below. And the frame needs to be on Vframe_list or making it
11245 visible won't work. */
11246 Vframe_list
= Fcons (frame
, Vframe_list
);
11248 /* Now that the frame is official, it counts as a reference to
11250 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
11252 /* Setting attributes of faces of the tooltip frame from resources
11253 and similar will increment face_change_count, which leads to the
11254 clearing of all current matrices. Since this isn't necessary
11255 here, avoid it by resetting face_change_count to the value it
11256 had before we created the tip frame. */
11257 face_change_count
= face_change_count_before
;
11259 /* Discard the unwind_protect. */
11260 return unbind_to (count
, frame
);
11264 /* Compute where to display tip frame F. PARMS is the list of frame
11265 parameters for F. DX and DY are specified offsets from the current
11266 location of the mouse. WIDTH and HEIGHT are the width and height
11267 of the tooltip. Return coordinates relative to the root window of
11268 the display in *ROOT_X, and *ROOT_Y. */
11271 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
11273 Lisp_Object parms
, dx
, dy
;
11275 int *root_x
, *root_y
;
11277 Lisp_Object left
, top
;
11279 Window root
, child
;
11282 /* User-specified position? */
11283 left
= Fcdr (Fassq (Qleft
, parms
));
11284 top
= Fcdr (Fassq (Qtop
, parms
));
11286 /* Move the tooltip window where the mouse pointer is. Resize and
11288 if (!INTEGERP (left
) || !INTEGERP (top
))
11291 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
11292 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
11296 if (INTEGERP (top
))
11297 *root_y
= XINT (top
);
11298 else if (*root_y
+ XINT (dy
) - height
< 0)
11299 *root_y
-= XINT (dy
);
11303 *root_y
+= XINT (dy
);
11306 if (INTEGERP (left
))
11307 *root_x
= XINT (left
);
11308 else if (*root_x
+ XINT (dx
) + width
<= FRAME_X_DISPLAY_INFO (f
)->width
)
11309 /* It fits to the right of the pointer. */
11310 *root_x
+= XINT (dx
);
11311 else if (width
+ XINT (dx
) <= *root_x
)
11312 /* It fits to the left of the pointer. */
11313 *root_x
-= width
+ XINT (dx
);
11315 /* Put it left-justified on the screen--it ought to fit that way. */
11320 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
11321 doc
: /* Show STRING in a "tooltip" window on frame FRAME.
11322 A tooltip window is a small X window displaying a string.
11324 FRAME nil or omitted means use the selected frame.
11326 PARMS is an optional list of frame parameters which can be used to
11327 change the tooltip's appearance.
11329 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
11330 means use the default timeout of 5 seconds.
11332 If the list of frame parameters PARAMS contains a `left' parameters,
11333 the tooltip is displayed at that x-position. Otherwise it is
11334 displayed at the mouse position, with offset DX added (default is 5 if
11335 DX isn't specified). Likewise for the y-position; if a `top' frame
11336 parameter is specified, it determines the y-position of the tooltip
11337 window, otherwise it is displayed at the mouse position, with offset
11338 DY added (default is -10).
11340 A tooltip's maximum size is specified by `x-max-tooltip-size'.
11341 Text larger than the specified size is clipped. */)
11342 (string
, frame
, parms
, timeout
, dx
, dy
)
11343 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
11347 int root_x
, root_y
;
11348 struct buffer
*old_buffer
;
11349 struct text_pos pos
;
11350 int i
, width
, height
;
11351 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
11352 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
11353 int count
= SPECPDL_INDEX ();
11355 specbind (Qinhibit_redisplay
, Qt
);
11357 GCPRO4 (string
, parms
, frame
, timeout
);
11359 CHECK_STRING (string
);
11360 f
= check_x_frame (frame
);
11361 if (NILP (timeout
))
11362 timeout
= make_number (5);
11364 CHECK_NATNUM (timeout
);
11367 dx
= make_number (5);
11372 dy
= make_number (-10);
11376 if (NILP (last_show_tip_args
))
11377 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
11379 if (!NILP (tip_frame
))
11381 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
11382 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
11383 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
11385 if (EQ (frame
, last_frame
)
11386 && !NILP (Fequal (last_string
, string
))
11387 && !NILP (Fequal (last_parms
, parms
)))
11389 struct frame
*f
= XFRAME (tip_frame
);
11391 /* Only DX and DY have changed. */
11392 if (!NILP (tip_timer
))
11394 Lisp_Object timer
= tip_timer
;
11396 call1 (Qcancel_timer
, timer
);
11400 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
11401 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
11402 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11409 /* Hide a previous tip, if any. */
11412 ASET (last_show_tip_args
, 0, string
);
11413 ASET (last_show_tip_args
, 1, frame
);
11414 ASET (last_show_tip_args
, 2, parms
);
11416 /* Add default values to frame parameters. */
11417 if (NILP (Fassq (Qname
, parms
)))
11418 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
11419 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11420 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
11421 if (NILP (Fassq (Qborder_width
, parms
)))
11422 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
11423 if (NILP (Fassq (Qborder_color
, parms
)))
11424 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
11425 if (NILP (Fassq (Qbackground_color
, parms
)))
11426 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
11429 /* Create a frame for the tooltip, and record it in the global
11430 variable tip_frame. */
11431 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
, string
);
11432 f
= XFRAME (frame
);
11434 /* Set up the frame's root window. */
11435 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
11436 w
->left
= w
->top
= make_number (0);
11438 if (CONSP (Vx_max_tooltip_size
)
11439 && INTEGERP (XCAR (Vx_max_tooltip_size
))
11440 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
11441 && INTEGERP (XCDR (Vx_max_tooltip_size
))
11442 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
11444 w
->width
= XCAR (Vx_max_tooltip_size
);
11445 w
->height
= XCDR (Vx_max_tooltip_size
);
11449 w
->width
= make_number (80);
11450 w
->height
= make_number (40);
11453 f
->window_width
= XINT (w
->width
);
11455 w
->pseudo_window_p
= 1;
11457 /* Display the tooltip text in a temporary buffer. */
11458 old_buffer
= current_buffer
;
11459 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
11460 current_buffer
->truncate_lines
= Qnil
;
11461 clear_glyph_matrix (w
->desired_matrix
);
11462 clear_glyph_matrix (w
->current_matrix
);
11463 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
11464 try_window (FRAME_ROOT_WINDOW (f
), pos
);
11466 /* Compute width and height of the tooltip. */
11467 width
= height
= 0;
11468 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
11470 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
11471 struct glyph
*last
;
11474 /* Stop at the first empty row at the end. */
11475 if (!row
->enabled_p
|| !row
->displays_text_p
)
11478 /* Let the row go over the full width of the frame. */
11479 row
->full_width_p
= 1;
11481 /* There's a glyph at the end of rows that is used to place
11482 the cursor there. Don't include the width of this glyph. */
11483 if (row
->used
[TEXT_AREA
])
11485 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
11486 row_width
= row
->pixel_width
- last
->pixel_width
;
11489 row_width
= row
->pixel_width
;
11491 height
+= row
->height
;
11492 width
= max (width
, row_width
);
11495 /* Add the frame's internal border to the width and height the X
11496 window should have. */
11497 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11498 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11500 /* Move the tooltip window where the mouse pointer is. Resize and
11502 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
11505 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11506 root_x
, root_y
, width
, height
);
11507 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
11510 /* Draw into the window. */
11511 w
->must_be_updated_p
= 1;
11512 update_single_window (w
, 1);
11514 /* Restore original current buffer. */
11515 set_buffer_internal_1 (old_buffer
);
11516 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
11519 /* Let the tip disappear after timeout seconds. */
11520 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
11521 intern ("x-hide-tip"));
11524 return unbind_to (count
, Qnil
);
11528 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
11529 doc
: /* Hide the current tooltip window, if there is any.
11530 Value is t if tooltip was open, nil otherwise. */)
11534 Lisp_Object deleted
, frame
, timer
;
11535 struct gcpro gcpro1
, gcpro2
;
11537 /* Return quickly if nothing to do. */
11538 if (NILP (tip_timer
) && NILP (tip_frame
))
11543 GCPRO2 (frame
, timer
);
11544 tip_frame
= tip_timer
= deleted
= Qnil
;
11546 count
= SPECPDL_INDEX ();
11547 specbind (Qinhibit_redisplay
, Qt
);
11548 specbind (Qinhibit_quit
, Qt
);
11551 call1 (Qcancel_timer
, timer
);
11553 if (FRAMEP (frame
))
11555 Fdelete_frame (frame
, Qnil
);
11559 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11560 redisplay procedure is not called when a tip frame over menu
11561 items is unmapped. Redisplay the menu manually... */
11563 struct frame
*f
= SELECTED_FRAME ();
11564 Widget w
= f
->output_data
.x
->menubar_widget
;
11565 extern void xlwmenu_redisplay
P_ ((Widget
));
11567 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
11571 xlwmenu_redisplay (w
);
11575 #endif /* USE_LUCID */
11579 return unbind_to (count
, deleted
);
11584 /***********************************************************************
11585 File selection dialog
11586 ***********************************************************************/
11590 /* Callback for "OK" and "Cancel" on file selection dialog. */
11593 file_dialog_cb (widget
, client_data
, call_data
)
11595 XtPointer call_data
, client_data
;
11597 int *result
= (int *) client_data
;
11598 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11599 *result
= cb
->reason
;
11603 /* Callback for unmapping a file selection dialog. This is used to
11604 capture the case where a dialog is closed via a window manager's
11605 closer button, for example. Using a XmNdestroyCallback didn't work
11609 file_dialog_unmap_cb (widget
, client_data
, call_data
)
11611 XtPointer call_data
, client_data
;
11613 int *result
= (int *) client_data
;
11614 *result
= XmCR_CANCEL
;
11618 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11619 doc
: /* Read file name, prompting with PROMPT in directory DIR.
11620 Use a file selection dialog.
11621 Select DEFAULT-FILENAME in the dialog's file selection box, if
11622 specified. Don't let the user enter a file name in the file
11623 selection dialog's entry field, if MUSTMATCH is non-nil. */)
11624 (prompt
, dir
, default_filename
, mustmatch
)
11625 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11628 struct frame
*f
= SELECTED_FRAME ();
11629 Lisp_Object file
= Qnil
;
11630 Widget dialog
, text
, list
, help
;
11633 extern XtAppContext Xt_app_con
;
11634 XmString dir_xmstring
, pattern_xmstring
;
11635 int count
= SPECPDL_INDEX ();
11636 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11638 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11639 CHECK_STRING (prompt
);
11640 CHECK_STRING (dir
);
11642 /* Prevent redisplay. */
11643 specbind (Qinhibit_redisplay
, Qt
);
11647 /* Create the dialog with PROMPT as title, using DIR as initial
11648 directory and using "*" as pattern. */
11649 dir
= Fexpand_file_name (dir
, Qnil
);
11650 dir_xmstring
= XmStringCreateLocalized (SDATA (dir
));
11651 pattern_xmstring
= XmStringCreateLocalized ("*");
11653 XtSetArg (al
[ac
], XmNtitle
, SDATA (prompt
)); ++ac
;
11654 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11655 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11656 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11657 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11658 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11660 XmStringFree (dir_xmstring
);
11661 XmStringFree (pattern_xmstring
);
11663 /* Add callbacks for OK and Cancel. */
11664 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11665 (XtPointer
) &result
);
11666 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11667 (XtPointer
) &result
);
11668 XtAddCallback (dialog
, XmNunmapCallback
, file_dialog_unmap_cb
,
11669 (XtPointer
) &result
);
11671 /* Disable the help button since we can't display help. */
11672 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11673 XtSetSensitive (help
, False
);
11675 /* Mark OK button as default. */
11676 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11677 XmNshowAsDefault
, True
, NULL
);
11679 /* If MUSTMATCH is non-nil, disable the file entry field of the
11680 dialog, so that the user must select a file from the files list
11681 box. We can't remove it because we wouldn't have a way to get at
11682 the result file name, then. */
11683 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11684 if (!NILP (mustmatch
))
11687 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11688 XtSetSensitive (text
, False
);
11689 XtSetSensitive (label
, False
);
11692 /* Manage the dialog, so that list boxes get filled. */
11693 XtManageChild (dialog
);
11695 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11696 must include the path for this to work. */
11697 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11698 if (STRINGP (default_filename
))
11700 XmString default_xmstring
;
11704 = XmStringCreateLocalized (SDATA (default_filename
));
11706 if (!XmListItemExists (list
, default_xmstring
))
11708 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11709 XmListAddItem (list
, default_xmstring
, 0);
11713 item_pos
= XmListItemPos (list
, default_xmstring
);
11714 XmStringFree (default_xmstring
);
11716 /* Select the item and scroll it into view. */
11717 XmListSelectPos (list
, item_pos
, True
);
11718 XmListSetPos (list
, item_pos
);
11721 /* Process events until the user presses Cancel or OK. Block
11722 and unblock input here so that we get a chance of processing
11726 while (result
== 0)
11729 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11734 /* Get the result. */
11735 if (result
== XmCR_OK
)
11740 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11741 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11742 XmStringFree (text
);
11743 file
= build_string (data
);
11750 XtUnmanageChild (dialog
);
11751 XtDestroyWidget (dialog
);
11755 /* Make "Cancel" equivalent to C-g. */
11757 Fsignal (Qquit
, Qnil
);
11759 return unbind_to (count
, file
);
11762 #endif /* USE_MOTIF */
11766 /***********************************************************************
11768 ***********************************************************************/
11770 #ifdef HAVE_XKBGETKEYBOARD
11771 #include <X11/XKBlib.h>
11772 #include <X11/keysym.h>
11775 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11776 Sx_backspace_delete_keys_p
, 0, 1, 0,
11777 doc
: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
11778 FRAME nil means use the selected frame.
11779 Value is t if we know that both keys are present, and are mapped to the
11780 usual X keysyms. */)
11784 #ifdef HAVE_XKBGETKEYBOARD
11786 struct frame
*f
= check_x_frame (frame
);
11787 Display
*dpy
= FRAME_X_DISPLAY (f
);
11788 Lisp_Object have_keys
;
11789 int major
, minor
, op
, event
, error
;
11793 /* Check library version in case we're dynamically linked. */
11794 major
= XkbMajorVersion
;
11795 minor
= XkbMinorVersion
;
11796 if (!XkbLibraryVersion (&major
, &minor
))
11802 /* Check that the server supports XKB. */
11803 major
= XkbMajorVersion
;
11804 minor
= XkbMinorVersion
;
11805 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11812 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11815 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11817 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11819 for (i
= kb
->min_key_code
;
11820 (i
< kb
->max_key_code
11821 && (delete_keycode
== 0 || backspace_keycode
== 0));
11824 /* The XKB symbolic key names can be seen most easily in
11825 the PS file generated by `xkbprint -label name
11827 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11828 delete_keycode
= i
;
11829 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11830 backspace_keycode
= i
;
11833 XkbFreeNames (kb
, 0, True
);
11836 XkbFreeClientMap (kb
, 0, True
);
11839 && backspace_keycode
11840 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11841 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11846 #else /* not HAVE_XKBGETKEYBOARD */
11848 #endif /* not HAVE_XKBGETKEYBOARD */
11853 /***********************************************************************
11855 ***********************************************************************/
11860 /* This is zero if not using X windows. */
11863 /* The section below is built by the lisp expression at the top of the file,
11864 just above where these variables are declared. */
11865 /*&&& init symbols here &&&*/
11866 Qauto_raise
= intern ("auto-raise");
11867 staticpro (&Qauto_raise
);
11868 Qauto_lower
= intern ("auto-lower");
11869 staticpro (&Qauto_lower
);
11870 Qbar
= intern ("bar");
11872 Qhbar
= intern ("hbar");
11873 staticpro (&Qhbar
);
11874 Qbox
= intern ("box");
11876 Qhollow
= intern ("hollow");
11877 staticpro (&Qhollow
);
11878 Qborder_color
= intern ("border-color");
11879 staticpro (&Qborder_color
);
11880 Qborder_width
= intern ("border-width");
11881 staticpro (&Qborder_width
);
11882 Qbox
= intern ("box");
11884 Qcursor_color
= intern ("cursor-color");
11885 staticpro (&Qcursor_color
);
11886 Qcursor_type
= intern ("cursor-type");
11887 staticpro (&Qcursor_type
);
11888 Qgeometry
= intern ("geometry");
11889 staticpro (&Qgeometry
);
11890 Qicon_left
= intern ("icon-left");
11891 staticpro (&Qicon_left
);
11892 Qicon_top
= intern ("icon-top");
11893 staticpro (&Qicon_top
);
11894 Qicon_type
= intern ("icon-type");
11895 staticpro (&Qicon_type
);
11896 Qicon_name
= intern ("icon-name");
11897 staticpro (&Qicon_name
);
11898 Qinternal_border_width
= intern ("internal-border-width");
11899 staticpro (&Qinternal_border_width
);
11900 Qleft
= intern ("left");
11901 staticpro (&Qleft
);
11902 Qright
= intern ("right");
11903 staticpro (&Qright
);
11904 Qmouse_color
= intern ("mouse-color");
11905 staticpro (&Qmouse_color
);
11906 Qnone
= intern ("none");
11907 staticpro (&Qnone
);
11908 Qparent_id
= intern ("parent-id");
11909 staticpro (&Qparent_id
);
11910 Qscroll_bar_width
= intern ("scroll-bar-width");
11911 staticpro (&Qscroll_bar_width
);
11912 Qsuppress_icon
= intern ("suppress-icon");
11913 staticpro (&Qsuppress_icon
);
11914 Qundefined_color
= intern ("undefined-color");
11915 staticpro (&Qundefined_color
);
11916 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11917 staticpro (&Qvertical_scroll_bars
);
11918 Qvisibility
= intern ("visibility");
11919 staticpro (&Qvisibility
);
11920 Qwindow_id
= intern ("window-id");
11921 staticpro (&Qwindow_id
);
11922 Qouter_window_id
= intern ("outer-window-id");
11923 staticpro (&Qouter_window_id
);
11924 Qx_frame_parameter
= intern ("x-frame-parameter");
11925 staticpro (&Qx_frame_parameter
);
11926 Qx_resource_name
= intern ("x-resource-name");
11927 staticpro (&Qx_resource_name
);
11928 Quser_position
= intern ("user-position");
11929 staticpro (&Quser_position
);
11930 Quser_size
= intern ("user-size");
11931 staticpro (&Quser_size
);
11932 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11933 staticpro (&Qscroll_bar_foreground
);
11934 Qscroll_bar_background
= intern ("scroll-bar-background");
11935 staticpro (&Qscroll_bar_background
);
11936 Qscreen_gamma
= intern ("screen-gamma");
11937 staticpro (&Qscreen_gamma
);
11938 Qline_spacing
= intern ("line-spacing");
11939 staticpro (&Qline_spacing
);
11940 Qcenter
= intern ("center");
11941 staticpro (&Qcenter
);
11942 Qcompound_text
= intern ("compound-text");
11943 staticpro (&Qcompound_text
);
11944 Qcancel_timer
= intern ("cancel-timer");
11945 staticpro (&Qcancel_timer
);
11946 Qwait_for_wm
= intern ("wait-for-wm");
11947 staticpro (&Qwait_for_wm
);
11948 Qfullscreen
= intern ("fullscreen");
11949 staticpro (&Qfullscreen
);
11950 Qfullwidth
= intern ("fullwidth");
11951 staticpro (&Qfullwidth
);
11952 Qfullheight
= intern ("fullheight");
11953 staticpro (&Qfullheight
);
11954 Qfullboth
= intern ("fullboth");
11955 staticpro (&Qfullboth
);
11956 /* This is the end of symbol initialization. */
11958 /* Text property `display' should be nonsticky by default. */
11959 Vtext_property_default_nonsticky
11960 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11963 Qlaplace
= intern ("laplace");
11964 staticpro (&Qlaplace
);
11965 Qemboss
= intern ("emboss");
11966 staticpro (&Qemboss
);
11967 Qedge_detection
= intern ("edge-detection");
11968 staticpro (&Qedge_detection
);
11969 Qheuristic
= intern ("heuristic");
11970 staticpro (&Qheuristic
);
11971 QCmatrix
= intern (":matrix");
11972 staticpro (&QCmatrix
);
11973 QCcolor_adjustment
= intern (":color-adjustment");
11974 staticpro (&QCcolor_adjustment
);
11975 QCmask
= intern (":mask");
11976 staticpro (&QCmask
);
11978 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11979 staticpro (&Qface_set_after_frame_default
);
11981 Fput (Qundefined_color
, Qerror_conditions
,
11982 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11983 Fput (Qundefined_color
, Qerror_message
,
11984 build_string ("Undefined color"));
11986 init_x_parm_symbols ();
11988 DEFVAR_LISP ("blink-cursor-alist", &Vblink_cursor_alist
,
11989 doc
: /* Alist specifying how to blink the cursor off.
11990 Each element has the form (ON-STATE . OFF-STATE). Whenever the
11991 `cursor-type' frame-parameter or variable equals ON-STATE,
11992 comparing using `equal', Emacs uses OFF-STATE to specify
11993 how to blink it off. */);
11994 Vblink_cursor_alist
= Qnil
;
11996 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11997 doc
: /* Non-nil means always draw a cross over disabled images.
11998 Disabled images are those having an `:conversion disabled' property.
11999 A cross is always drawn on black & white displays. */);
12000 cross_disabled_images
= 0;
12002 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
12003 doc
: /* List of directories to search for bitmap files for X. */);
12004 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
12006 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
12007 doc
: /* The shape of the pointer when over text.
12008 Changing the value does not affect existing frames
12009 unless you set the mouse color. */);
12010 Vx_pointer_shape
= Qnil
;
12012 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
12013 doc
: /* The name Emacs uses to look up X resources.
12014 `x-get-resource' uses this as the first component of the instance name
12015 when requesting resource values.
12016 Emacs initially sets `x-resource-name' to the name under which Emacs
12017 was invoked, or to the value specified with the `-name' or `-rn'
12018 switches, if present.
12020 It may be useful to bind this variable locally around a call
12021 to `x-get-resource'. See also the variable `x-resource-class'. */);
12022 Vx_resource_name
= Qnil
;
12024 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
12025 doc
: /* The class Emacs uses to look up X resources.
12026 `x-get-resource' uses this as the first component of the instance class
12027 when requesting resource values.
12029 Emacs initially sets `x-resource-class' to "Emacs".
12031 Setting this variable permanently is not a reasonable thing to do,
12032 but binding this variable locally around a call to `x-get-resource'
12033 is a reasonable practice. See also the variable `x-resource-name'. */);
12034 Vx_resource_class
= build_string (EMACS_CLASS
);
12036 #if 0 /* This doesn't really do anything. */
12037 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
12038 doc
: /* The shape of the pointer when not over text.
12039 This variable takes effect when you create a new frame
12040 or when you set the mouse color. */);
12042 Vx_nontext_pointer_shape
= Qnil
;
12044 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
12045 doc
: /* The shape of the pointer when Emacs is busy.
12046 This variable takes effect when you create a new frame
12047 or when you set the mouse color. */);
12048 Vx_hourglass_pointer_shape
= Qnil
;
12050 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
12051 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
12052 display_hourglass_p
= 1;
12054 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
12055 doc
: /* *Seconds to wait before displaying an hourglass pointer.
12056 Value must be an integer or float. */);
12057 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
12059 #if 0 /* This doesn't really do anything. */
12060 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
12061 doc
: /* The shape of the pointer when over the mode line.
12062 This variable takes effect when you create a new frame
12063 or when you set the mouse color. */);
12065 Vx_mode_pointer_shape
= Qnil
;
12067 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
12068 &Vx_sensitive_text_pointer_shape
,
12069 doc
: /* The shape of the pointer when over mouse-sensitive text.
12070 This variable takes effect when you create a new frame
12071 or when you set the mouse color. */);
12072 Vx_sensitive_text_pointer_shape
= Qnil
;
12074 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
12075 &Vx_window_horizontal_drag_shape
,
12076 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
12077 This variable takes effect when you create a new frame
12078 or when you set the mouse color. */);
12079 Vx_window_horizontal_drag_shape
= Qnil
;
12081 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
12082 doc
: /* A string indicating the foreground color of the cursor box. */);
12083 Vx_cursor_fore_pixel
= Qnil
;
12085 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
12086 doc
: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
12087 Text larger than this is clipped. */);
12088 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
12090 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
12091 doc
: /* Non-nil if no X window manager is in use.
12092 Emacs doesn't try to figure this out; this is always nil
12093 unless you set it to something else. */);
12094 /* We don't have any way to find this out, so set it to nil
12095 and maybe the user would like to set it to t. */
12096 Vx_no_window_manager
= Qnil
;
12098 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
12099 &Vx_pixel_size_width_font_regexp
,
12100 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
12102 Since Emacs gets width of a font matching with this regexp from
12103 PIXEL_SIZE field of the name, font finding mechanism gets faster for
12104 such a font. This is especially effective for such large fonts as
12105 Chinese, Japanese, and Korean. */);
12106 Vx_pixel_size_width_font_regexp
= Qnil
;
12108 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
12109 doc
: /* Time after which cached images are removed from the cache.
12110 When an image has not been displayed this many seconds, remove it
12111 from the image cache. Value must be an integer or nil with nil
12112 meaning don't clear the cache. */);
12113 Vimage_cache_eviction_delay
= make_number (30 * 60);
12115 #ifdef USE_X_TOOLKIT
12116 Fprovide (intern ("x-toolkit"), Qnil
);
12118 Fprovide (intern ("motif"), Qnil
);
12120 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string
,
12121 doc
: /* Version info for LessTif/Motif. */);
12122 Vmotif_version_string
= build_string (XmVERSION_STRING
);
12123 #endif /* USE_MOTIF */
12124 #endif /* USE_X_TOOLKIT */
12126 defsubr (&Sx_get_resource
);
12128 /* X window properties. */
12129 defsubr (&Sx_change_window_property
);
12130 defsubr (&Sx_delete_window_property
);
12131 defsubr (&Sx_window_property
);
12133 defsubr (&Sxw_display_color_p
);
12134 defsubr (&Sx_display_grayscale_p
);
12135 defsubr (&Sxw_color_defined_p
);
12136 defsubr (&Sxw_color_values
);
12137 defsubr (&Sx_server_max_request_size
);
12138 defsubr (&Sx_server_vendor
);
12139 defsubr (&Sx_server_version
);
12140 defsubr (&Sx_display_pixel_width
);
12141 defsubr (&Sx_display_pixel_height
);
12142 defsubr (&Sx_display_mm_width
);
12143 defsubr (&Sx_display_mm_height
);
12144 defsubr (&Sx_display_screens
);
12145 defsubr (&Sx_display_planes
);
12146 defsubr (&Sx_display_color_cells
);
12147 defsubr (&Sx_display_visual_class
);
12148 defsubr (&Sx_display_backing_store
);
12149 defsubr (&Sx_display_save_under
);
12150 defsubr (&Sx_parse_geometry
);
12151 defsubr (&Sx_create_frame
);
12152 defsubr (&Sx_open_connection
);
12153 defsubr (&Sx_close_connection
);
12154 defsubr (&Sx_display_list
);
12155 defsubr (&Sx_synchronize
);
12156 defsubr (&Sx_focus_frame
);
12157 defsubr (&Sx_backspace_delete_keys_p
);
12159 /* Setting callback functions for fontset handler. */
12160 get_font_info_func
= x_get_font_info
;
12162 #if 0 /* This function pointer doesn't seem to be used anywhere.
12163 And the pointer assigned has the wrong type, anyway. */
12164 list_fonts_func
= x_list_fonts
;
12167 load_font_func
= x_load_font
;
12168 find_ccl_program_func
= x_find_ccl_program
;
12169 query_font_func
= x_query_font
;
12170 set_frame_fontset_func
= x_set_font
;
12171 check_window_system_func
= check_x
;
12174 Qxbm
= intern ("xbm");
12176 QCconversion
= intern (":conversion");
12177 staticpro (&QCconversion
);
12178 QCheuristic_mask
= intern (":heuristic-mask");
12179 staticpro (&QCheuristic_mask
);
12180 QCcolor_symbols
= intern (":color-symbols");
12181 staticpro (&QCcolor_symbols
);
12182 QCascent
= intern (":ascent");
12183 staticpro (&QCascent
);
12184 QCmargin
= intern (":margin");
12185 staticpro (&QCmargin
);
12186 QCrelief
= intern (":relief");
12187 staticpro (&QCrelief
);
12188 Qpostscript
= intern ("postscript");
12189 staticpro (&Qpostscript
);
12190 QCloader
= intern (":loader");
12191 staticpro (&QCloader
);
12192 QCbounding_box
= intern (":bounding-box");
12193 staticpro (&QCbounding_box
);
12194 QCpt_width
= intern (":pt-width");
12195 staticpro (&QCpt_width
);
12196 QCpt_height
= intern (":pt-height");
12197 staticpro (&QCpt_height
);
12198 QCindex
= intern (":index");
12199 staticpro (&QCindex
);
12200 Qpbm
= intern ("pbm");
12204 Qxpm
= intern ("xpm");
12209 Qjpeg
= intern ("jpeg");
12210 staticpro (&Qjpeg
);
12214 Qtiff
= intern ("tiff");
12215 staticpro (&Qtiff
);
12219 Qgif
= intern ("gif");
12224 Qpng
= intern ("png");
12228 defsubr (&Sclear_image_cache
);
12229 defsubr (&Simage_size
);
12230 defsubr (&Simage_mask_p
);
12232 hourglass_atimer
= NULL
;
12233 hourglass_shown_p
= 0;
12235 defsubr (&Sx_show_tip
);
12236 defsubr (&Sx_hide_tip
);
12238 staticpro (&tip_timer
);
12240 staticpro (&tip_frame
);
12242 last_show_tip_args
= Qnil
;
12243 staticpro (&last_show_tip_args
);
12246 defsubr (&Sx_file_dialog
);
12254 image_types
= NULL
;
12255 Vimage_types
= Qnil
;
12257 define_image_type (&xbm_type
);
12258 define_image_type (&gs_type
);
12259 define_image_type (&pbm_type
);
12262 define_image_type (&xpm_type
);
12266 define_image_type (&jpeg_type
);
12270 define_image_type (&tiff_type
);
12274 define_image_type (&gif_type
);
12278 define_image_type (&png_type
);
12282 #endif /* HAVE_X_WINDOWS */