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 Lisp_Object Qauto_raise
;
187 Lisp_Object Qauto_lower
;
189 Lisp_Object Qborder_color
;
190 Lisp_Object Qborder_width
;
192 Lisp_Object Qcursor_color
;
193 Lisp_Object Qcursor_type
;
194 Lisp_Object Qgeometry
;
195 Lisp_Object Qicon_left
;
196 Lisp_Object Qicon_top
;
197 Lisp_Object Qicon_type
;
198 Lisp_Object Qicon_name
;
199 Lisp_Object Qinternal_border_width
;
202 Lisp_Object Qmouse_color
;
204 Lisp_Object Qouter_window_id
;
205 Lisp_Object Qparent_id
;
206 Lisp_Object Qscroll_bar_width
;
207 Lisp_Object Qsuppress_icon
;
208 extern Lisp_Object Qtop
;
209 Lisp_Object Qundefined_color
;
210 Lisp_Object Qvertical_scroll_bars
;
211 Lisp_Object Qvisibility
;
212 Lisp_Object Qwindow_id
;
213 Lisp_Object Qx_frame_parameter
;
214 Lisp_Object Qx_resource_name
;
215 Lisp_Object Quser_position
;
216 Lisp_Object Quser_size
;
217 extern Lisp_Object Qdisplay
;
218 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
219 Lisp_Object Qscreen_gamma
, Qline_spacing
, Qcenter
;
220 Lisp_Object Qcompound_text
, Qcancel_timer
;
221 Lisp_Object Qwait_for_wm
;
222 Lisp_Object Qfullscreen
;
223 Lisp_Object Qfullwidth
;
224 Lisp_Object Qfullheight
;
225 Lisp_Object Qfullboth
;
227 /* The below are defined in frame.c. */
229 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
230 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
231 extern Lisp_Object Qtool_bar_lines
;
233 extern Lisp_Object Vwindow_system_version
;
235 Lisp_Object Qface_set_after_frame_default
;
238 int image_cache_refcount
, dpyinfo_refcount
;
243 /* Error if we are not connected to X. */
249 error ("X windows are not in use or not initialized");
252 /* Nonzero if we can use mouse menus.
253 You should not call this unless HAVE_MENUS is defined. */
261 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
262 and checking validity for X. */
265 check_x_frame (frame
)
271 frame
= selected_frame
;
272 CHECK_LIVE_FRAME (frame
);
275 error ("Non-X frame used");
279 /* Let the user specify an X display with a frame.
280 nil stands for the selected frame--or, if that is not an X frame,
281 the first X display on the list. */
283 static struct x_display_info
*
284 check_x_display_info (frame
)
287 struct x_display_info
*dpyinfo
= NULL
;
291 struct frame
*sf
= XFRAME (selected_frame
);
293 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
294 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
295 else if (x_display_list
!= 0)
296 dpyinfo
= x_display_list
;
298 error ("X windows are not in use or not initialized");
300 else if (STRINGP (frame
))
301 dpyinfo
= x_display_info_for_name (frame
);
306 CHECK_LIVE_FRAME (frame
);
309 error ("Non-X frame used");
310 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
317 /* Return the Emacs frame-object corresponding to an X window.
318 It could be the frame's main window or an icon window. */
320 /* This function can be called during GC, so use GC_xxx type test macros. */
323 x_window_to_frame (dpyinfo
, wdesc
)
324 struct x_display_info
*dpyinfo
;
327 Lisp_Object tail
, frame
;
330 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
333 if (!GC_FRAMEP (frame
))
336 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
338 if (f
->output_data
.x
->hourglass_window
== wdesc
)
341 if ((f
->output_data
.x
->edit_widget
342 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
343 /* A tooltip frame? */
344 || (!f
->output_data
.x
->edit_widget
345 && FRAME_X_WINDOW (f
) == wdesc
)
346 || f
->output_data
.x
->icon_desc
== wdesc
)
348 #else /* not USE_X_TOOLKIT */
349 if (FRAME_X_WINDOW (f
) == wdesc
350 || f
->output_data
.x
->icon_desc
== wdesc
)
352 #endif /* not USE_X_TOOLKIT */
358 /* Like x_window_to_frame but also compares the window with the widget's
362 x_any_window_to_frame (dpyinfo
, wdesc
)
363 struct x_display_info
*dpyinfo
;
366 Lisp_Object tail
, frame
;
367 struct frame
*f
, *found
;
371 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
374 if (!GC_FRAMEP (frame
))
378 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
380 /* This frame matches if the window is any of its widgets. */
381 x
= f
->output_data
.x
;
382 if (x
->hourglass_window
== wdesc
)
386 if (wdesc
== XtWindow (x
->widget
)
387 || wdesc
== XtWindow (x
->column_widget
)
388 || wdesc
== XtWindow (x
->edit_widget
))
390 /* Match if the window is this frame's menubar. */
391 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
394 else if (FRAME_X_WINDOW (f
) == wdesc
)
395 /* A tooltip frame. */
403 /* Likewise, but exclude the menu bar widget. */
406 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
407 struct x_display_info
*dpyinfo
;
410 Lisp_Object tail
, frame
;
414 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
417 if (!GC_FRAMEP (frame
))
420 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
422 x
= f
->output_data
.x
;
423 /* This frame matches if the window is any of its widgets. */
424 if (x
->hourglass_window
== wdesc
)
428 if (wdesc
== XtWindow (x
->widget
)
429 || wdesc
== XtWindow (x
->column_widget
)
430 || wdesc
== XtWindow (x
->edit_widget
))
433 else if (FRAME_X_WINDOW (f
) == wdesc
)
434 /* A tooltip frame. */
440 /* Likewise, but consider only the menu bar widget. */
443 x_menubar_window_to_frame (dpyinfo
, wdesc
)
444 struct x_display_info
*dpyinfo
;
447 Lisp_Object tail
, frame
;
451 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
454 if (!GC_FRAMEP (frame
))
457 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
459 x
= f
->output_data
.x
;
460 /* Match if the window is this frame's menubar. */
461 if (x
->menubar_widget
462 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
468 /* Return the frame whose principal (outermost) window is WDESC.
469 If WDESC is some other (smaller) window, we return 0. */
472 x_top_window_to_frame (dpyinfo
, wdesc
)
473 struct x_display_info
*dpyinfo
;
476 Lisp_Object tail
, frame
;
480 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
483 if (!GC_FRAMEP (frame
))
486 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
488 x
= f
->output_data
.x
;
492 /* This frame matches if the window is its topmost widget. */
493 if (wdesc
== XtWindow (x
->widget
))
495 #if 0 /* I don't know why it did this,
496 but it seems logically wrong,
497 and it causes trouble for MapNotify events. */
498 /* Match if the window is this frame's menubar. */
499 if (x
->menubar_widget
500 && wdesc
== XtWindow (x
->menubar_widget
))
504 else if (FRAME_X_WINDOW (f
) == wdesc
)
510 #endif /* USE_X_TOOLKIT */
514 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
515 id, which is just an int that this section returns. Bitmaps are
516 reference counted so they can be shared among frames.
518 Bitmap indices are guaranteed to be > 0, so a negative number can
519 be used to indicate no bitmap.
521 If you use x_create_bitmap_from_data, then you must keep track of
522 the bitmaps yourself. That is, creating a bitmap from the same
523 data more than once will not be caught. */
526 /* Functions to access the contents of a bitmap, given an id. */
529 x_bitmap_height (f
, id
)
533 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
537 x_bitmap_width (f
, id
)
541 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
545 x_bitmap_pixmap (f
, id
)
549 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
553 /* Allocate a new bitmap record. Returns index of new record. */
556 x_allocate_bitmap_record (f
)
559 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
562 if (dpyinfo
->bitmaps
== NULL
)
564 dpyinfo
->bitmaps_size
= 10;
566 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
567 dpyinfo
->bitmaps_last
= 1;
571 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
572 return ++dpyinfo
->bitmaps_last
;
574 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
575 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
578 dpyinfo
->bitmaps_size
*= 2;
580 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
581 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
582 return ++dpyinfo
->bitmaps_last
;
585 /* Add one reference to the reference count of the bitmap with id ID. */
588 x_reference_bitmap (f
, id
)
592 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
595 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
598 x_create_bitmap_from_data (f
, bits
, width
, height
)
601 unsigned int width
, height
;
603 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
607 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
608 bits
, width
, height
);
613 id
= x_allocate_bitmap_record (f
);
614 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
615 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
616 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
617 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
618 dpyinfo
->bitmaps
[id
- 1].height
= height
;
619 dpyinfo
->bitmaps
[id
- 1].width
= width
;
624 /* Create bitmap from file FILE for frame F. */
627 x_create_bitmap_from_file (f
, file
)
631 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
632 unsigned int width
, height
;
634 int xhot
, yhot
, result
, id
;
639 /* Look for an existing bitmap with the same name. */
640 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
642 if (dpyinfo
->bitmaps
[id
].refcount
643 && dpyinfo
->bitmaps
[id
].file
644 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
646 ++dpyinfo
->bitmaps
[id
].refcount
;
651 /* Search bitmap-file-path for the file, if appropriate. */
652 fd
= openp (Vx_bitmap_file_path
, file
, Qnil
, &found
, 0);
657 filename
= (char *) XSTRING (found
)->data
;
659 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
660 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
661 if (result
!= BitmapSuccess
)
664 id
= x_allocate_bitmap_record (f
);
665 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
666 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
667 dpyinfo
->bitmaps
[id
- 1].file
668 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
669 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
670 dpyinfo
->bitmaps
[id
- 1].height
= height
;
671 dpyinfo
->bitmaps
[id
- 1].width
= width
;
672 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
677 /* Remove reference to bitmap with id number ID. */
680 x_destroy_bitmap (f
, id
)
684 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
688 --dpyinfo
->bitmaps
[id
- 1].refcount
;
689 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
692 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
693 if (dpyinfo
->bitmaps
[id
- 1].file
)
695 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
696 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
703 /* Free all the bitmaps for the display specified by DPYINFO. */
706 x_destroy_all_bitmaps (dpyinfo
)
707 struct x_display_info
*dpyinfo
;
710 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
711 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
713 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
714 if (dpyinfo
->bitmaps
[i
].file
)
715 xfree (dpyinfo
->bitmaps
[i
].file
);
717 dpyinfo
->bitmaps_last
= 0;
720 /* Connect the frame-parameter names for X frames
721 to the ways of passing the parameter values to the window system.
723 The name of a parameter, as a Lisp symbol,
724 has an `x-frame-parameter' property which is an integer in Lisp
725 that is an index in this table. */
727 struct x_frame_parm_table
730 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
733 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
734 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
735 static void x_change_window_heights
P_ ((Lisp_Object
, int));
736 static void x_disable_image
P_ ((struct frame
*, struct image
*));
737 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
738 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
739 static void x_set_wait_for_wm
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
740 static void x_set_fullscreen
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
741 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
742 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
743 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
744 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
745 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
746 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 static void x_set_fringe_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
750 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
753 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
755 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
758 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
759 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
760 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
761 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
762 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
763 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
764 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
766 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
768 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
773 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
774 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
776 static void init_color_table
P_ ((void));
777 static void free_color_table
P_ ((void));
778 static unsigned long *colors_in_color_table
P_ ((int *n
));
779 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
780 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
784 static struct x_frame_parm_table x_frame_parms
[] =
786 {"auto-raise", x_set_autoraise
},
787 {"auto-lower", x_set_autolower
},
788 {"background-color", x_set_background_color
},
789 {"border-color", x_set_border_color
},
790 {"border-width", x_set_border_width
},
791 {"cursor-color", x_set_cursor_color
},
792 {"cursor-type", x_set_cursor_type
},
793 {"font", x_set_font
},
794 {"foreground-color", x_set_foreground_color
},
795 {"icon-name", x_set_icon_name
},
796 {"icon-type", x_set_icon_type
},
797 {"internal-border-width", x_set_internal_border_width
},
798 {"menu-bar-lines", x_set_menu_bar_lines
},
799 {"mouse-color", x_set_mouse_color
},
800 {"name", x_explicitly_set_name
},
801 {"scroll-bar-width", x_set_scroll_bar_width
},
802 {"title", x_set_title
},
803 {"unsplittable", x_set_unsplittable
},
804 {"vertical-scroll-bars", x_set_vertical_scroll_bars
},
805 {"visibility", x_set_visibility
},
806 {"tool-bar-lines", x_set_tool_bar_lines
},
807 {"scroll-bar-foreground", x_set_scroll_bar_foreground
},
808 {"scroll-bar-background", x_set_scroll_bar_background
},
809 {"screen-gamma", x_set_screen_gamma
},
810 {"line-spacing", x_set_line_spacing
},
811 {"left-fringe", x_set_fringe_width
},
812 {"right-fringe", x_set_fringe_width
},
813 {"wait-for-wm", x_set_wait_for_wm
},
814 {"fullscreen", x_set_fullscreen
},
818 /* Attach the `x-frame-parameter' properties to
819 the Lisp symbol names of parameters relevant to X. */
822 init_x_parm_symbols ()
826 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
827 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
832 /* Really try to move where we want to be in case of fullscreen. Some WMs
833 moves the window where we tell them. Some (mwm, twm) moves the outer
834 window manager window there instead.
835 Try to compensate for those WM here. */
837 x_fullscreen_move (f
, new_top
, new_left
)
842 if (new_top
!= f
->output_data
.x
->top_pos
843 || new_left
!= f
->output_data
.x
->left_pos
)
845 int move_x
= new_left
+ f
->output_data
.x
->x_pixels_outer_diff
;
846 int move_y
= new_top
+ f
->output_data
.x
->y_pixels_outer_diff
;
848 f
->output_data
.x
->want_fullscreen
|= FULLSCREEN_MOVE_WAIT
;
849 x_set_offset (f
, move_x
, move_y
, 1);
853 /* Change the parameters of frame F as specified by ALIST.
854 If a parameter is not specially recognized, do nothing special;
855 otherwise call the `x_set_...' function for that parameter.
856 Except for certain geometry properties, always call store_frame_param
857 to store the new value in the parameter alist. */
860 x_set_frame_parameters (f
, alist
)
866 /* If both of these parameters are present, it's more efficient to
867 set them both at once. So we wait until we've looked at the
868 entire list before we set them. */
872 Lisp_Object left
, top
;
874 /* Same with these. */
875 Lisp_Object icon_left
, icon_top
;
877 /* Record in these vectors all the parms specified. */
881 int left_no_change
= 0, top_no_change
= 0;
882 int icon_left_no_change
= 0, icon_top_no_change
= 0;
883 int fullscreen_is_being_set
= 0;
885 struct gcpro gcpro1
, gcpro2
;
888 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
891 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
892 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
894 /* Extract parm names and values into those vectors. */
897 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
902 parms
[i
] = Fcar (elt
);
903 values
[i
] = Fcdr (elt
);
906 /* TAIL and ALIST are not used again below here. */
909 GCPRO2 (*parms
, *values
);
913 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
914 because their values appear in VALUES and strings are not valid. */
915 top
= left
= Qunbound
;
916 icon_left
= icon_top
= Qunbound
;
918 /* Provide default values for HEIGHT and WIDTH. */
919 if (FRAME_NEW_WIDTH (f
))
920 width
= FRAME_NEW_WIDTH (f
);
922 width
= FRAME_WIDTH (f
);
924 if (FRAME_NEW_HEIGHT (f
))
925 height
= FRAME_NEW_HEIGHT (f
);
927 height
= FRAME_HEIGHT (f
);
929 /* Process foreground_color and background_color before anything else.
930 They are independent of other properties, but other properties (e.g.,
931 cursor_color) are dependent upon them. */
932 /* Process default font as well, since fringe widths depends on it. */
933 /* Also, process fullscreen, width and height depend upon that */
934 for (p
= 0; p
< i
; p
++)
936 Lisp_Object prop
, val
;
940 if (EQ (prop
, Qforeground_color
)
941 || EQ (prop
, Qbackground_color
)
943 || EQ (prop
, Qfullscreen
))
945 register Lisp_Object param_index
, old_value
;
947 old_value
= get_frame_param (f
, prop
);
948 fullscreen_is_being_set
|= EQ (prop
, Qfullscreen
);
950 if (NILP (Fequal (val
, old_value
)))
952 store_frame_param (f
, prop
, val
);
954 param_index
= Fget (prop
, Qx_frame_parameter
);
955 if (NATNUMP (param_index
)
956 && (XFASTINT (param_index
)
957 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
958 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
963 /* Now process them in reverse of specified order. */
964 for (i
--; i
>= 0; i
--)
966 Lisp_Object prop
, val
;
971 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
972 width
= XFASTINT (val
);
973 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
974 height
= XFASTINT (val
);
975 else if (EQ (prop
, Qtop
))
977 else if (EQ (prop
, Qleft
))
979 else if (EQ (prop
, Qicon_top
))
981 else if (EQ (prop
, Qicon_left
))
983 else if (EQ (prop
, Qforeground_color
)
984 || EQ (prop
, Qbackground_color
)
986 || EQ (prop
, Qfullscreen
))
987 /* Processed above. */
991 register Lisp_Object param_index
, old_value
;
993 old_value
= get_frame_param (f
, prop
);
995 store_frame_param (f
, prop
, val
);
997 param_index
= Fget (prop
, Qx_frame_parameter
);
998 if (NATNUMP (param_index
)
999 && (XFASTINT (param_index
)
1000 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
1001 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
1005 /* Don't die if just one of these was set. */
1006 if (EQ (left
, Qunbound
))
1009 if (f
->output_data
.x
->left_pos
< 0)
1010 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
1012 XSETINT (left
, f
->output_data
.x
->left_pos
);
1014 if (EQ (top
, Qunbound
))
1017 if (f
->output_data
.x
->top_pos
< 0)
1018 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
1020 XSETINT (top
, f
->output_data
.x
->top_pos
);
1023 /* If one of the icon positions was not set, preserve or default it. */
1024 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
1026 icon_left_no_change
= 1;
1027 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
1028 if (NILP (icon_left
))
1029 XSETINT (icon_left
, 0);
1031 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
1033 icon_top_no_change
= 1;
1034 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
1035 if (NILP (icon_top
))
1036 XSETINT (icon_top
, 0);
1039 if (FRAME_VISIBLE_P (f
) && fullscreen_is_being_set
)
1041 /* If the frame is visible already and the fullscreen parameter is
1042 being set, it is too late to set WM manager hints to specify
1044 Here we first get the width, height and position that applies to
1045 fullscreen. We then move the frame to the appropriate
1046 position. Resize of the frame is taken care of in the code after
1047 this if-statement. */
1048 int new_left
, new_top
;
1050 x_fullscreen_adjust (f
, &width
, &height
, &new_top
, &new_left
);
1051 x_fullscreen_move (f
, new_top
, new_left
);
1054 /* Don't set these parameters unless they've been explicitly
1055 specified. The window might be mapped or resized while we're in
1056 this function, and we don't want to override that unless the lisp
1057 code has asked for it.
1059 Don't set these parameters unless they actually differ from the
1060 window's current parameters; the window may not actually exist
1065 check_frame_size (f
, &height
, &width
);
1067 XSETFRAME (frame
, f
);
1069 if (width
!= FRAME_WIDTH (f
)
1070 || height
!= FRAME_HEIGHT (f
)
1071 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1072 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1074 if ((!NILP (left
) || !NILP (top
))
1075 && ! (left_no_change
&& top_no_change
)
1076 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1077 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1082 /* Record the signs. */
1083 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1084 if (EQ (left
, Qminus
))
1085 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1086 else if (INTEGERP (left
))
1088 leftpos
= XINT (left
);
1090 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1092 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1093 && CONSP (XCDR (left
))
1094 && INTEGERP (XCAR (XCDR (left
))))
1096 leftpos
= - XINT (XCAR (XCDR (left
)));
1097 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1099 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1100 && CONSP (XCDR (left
))
1101 && INTEGERP (XCAR (XCDR (left
))))
1103 leftpos
= XINT (XCAR (XCDR (left
)));
1106 if (EQ (top
, Qminus
))
1107 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1108 else if (INTEGERP (top
))
1110 toppos
= XINT (top
);
1112 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1114 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1115 && CONSP (XCDR (top
))
1116 && INTEGERP (XCAR (XCDR (top
))))
1118 toppos
= - XINT (XCAR (XCDR (top
)));
1119 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1121 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1122 && CONSP (XCDR (top
))
1123 && INTEGERP (XCAR (XCDR (top
))))
1125 toppos
= XINT (XCAR (XCDR (top
)));
1129 /* Store the numeric value of the position. */
1130 f
->output_data
.x
->top_pos
= toppos
;
1131 f
->output_data
.x
->left_pos
= leftpos
;
1133 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1135 /* Actually set that position, and convert to absolute. */
1136 x_set_offset (f
, leftpos
, toppos
, -1);
1139 if ((!NILP (icon_left
) || !NILP (icon_top
))
1140 && ! (icon_left_no_change
&& icon_top_no_change
))
1141 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1147 /* Store the screen positions of frame F into XPTR and YPTR.
1148 These are the positions of the containing window manager window,
1149 not Emacs's own window. */
1152 x_real_positions (f
, xptr
, yptr
)
1156 int win_x
, win_y
, outer_x
, outer_y
;
1157 int real_x
= 0, real_y
= 0;
1159 Window win
= f
->output_data
.x
->parent_desc
;
1165 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1167 if (win
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1168 win
= FRAME_OUTER_WINDOW (f
);
1170 /* This loop traverses up the containment tree until we hit the root
1171 window. Window managers may intersect many windows between our window
1172 and the root window. The window we find just before the root window
1173 should be the outer WM window. */
1176 Window wm_window
, rootw
;
1177 Window
*tmp_children
;
1178 unsigned int tmp_nchildren
;
1181 success
= XQueryTree (FRAME_X_DISPLAY (f
), win
, &rootw
,
1182 &wm_window
, &tmp_children
, &tmp_nchildren
);
1184 had_errors
= x_had_errors_p (FRAME_X_DISPLAY (f
));
1186 /* Don't free tmp_children if XQueryTree failed. */
1190 XFree ((char *) tmp_children
);
1192 if (wm_window
== rootw
|| had_errors
)
1201 Window child
, rootw
;
1203 /* Get the real coordinates for the WM window upper left corner */
1204 XGetGeometry (FRAME_X_DISPLAY (f
), win
,
1205 &rootw
, &real_x
, &real_y
, &ign
, &ign
, &ign
, &ign
);
1207 /* Translate real coordinates to coordinates relative to our
1208 window. For our window, the upper left corner is 0, 0.
1209 Since the upper left corner of the WM window is outside
1210 our window, win_x and win_y will be negative:
1212 ------------------ ---> x
1214 | ----------------- v y
1217 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1219 /* From-window, to-window. */
1220 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1223 /* From-position, to-position. */
1224 real_x
, real_y
, &win_x
, &win_y
,
1229 if (FRAME_X_WINDOW (f
) == FRAME_OUTER_WINDOW (f
))
1236 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1238 /* From-window, to-window. */
1239 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1240 FRAME_OUTER_WINDOW (f
),
1242 /* From-position, to-position. */
1243 real_x
, real_y
, &outer_x
, &outer_y
,
1249 had_errors
= x_had_errors_p (FRAME_X_DISPLAY (f
));
1252 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1256 if (had_errors
) return;
1258 f
->output_data
.x
->x_pixels_diff
= -win_x
;
1259 f
->output_data
.x
->y_pixels_diff
= -win_y
;
1260 f
->output_data
.x
->x_pixels_outer_diff
= -outer_x
;
1261 f
->output_data
.x
->y_pixels_outer_diff
= -outer_y
;
1267 /* Insert a description of internally-recorded parameters of frame X
1268 into the parameter alist *ALISTPTR that is to be given to the user.
1269 Only parameters that are specific to the X window system
1270 and whose values are not correctly recorded in the frame's
1271 param_alist need to be considered here. */
1274 x_report_frame_params (f
, alistptr
)
1276 Lisp_Object
*alistptr
;
1281 /* Represent negative positions (off the top or left screen edge)
1282 in a way that Fmodify_frame_parameters will understand correctly. */
1283 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1284 if (f
->output_data
.x
->left_pos
>= 0)
1285 store_in_alist (alistptr
, Qleft
, tem
);
1287 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1289 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1290 if (f
->output_data
.x
->top_pos
>= 0)
1291 store_in_alist (alistptr
, Qtop
, tem
);
1293 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1295 store_in_alist (alistptr
, Qborder_width
,
1296 make_number (f
->output_data
.x
->border_width
));
1297 store_in_alist (alistptr
, Qinternal_border_width
,
1298 make_number (f
->output_data
.x
->internal_border_width
));
1299 store_in_alist (alistptr
, Qleft_fringe
,
1300 make_number (f
->output_data
.x
->left_fringe_width
));
1301 store_in_alist (alistptr
, Qright_fringe
,
1302 make_number (f
->output_data
.x
->right_fringe_width
));
1303 store_in_alist (alistptr
, Qscroll_bar_width
,
1304 make_number (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1305 ? FRAME_SCROLL_BAR_PIXEL_WIDTH(f
)
1307 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1308 store_in_alist (alistptr
, Qwindow_id
,
1309 build_string (buf
));
1310 #ifdef USE_X_TOOLKIT
1311 /* Tooltip frame may not have this widget. */
1312 if (f
->output_data
.x
->widget
)
1314 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1315 store_in_alist (alistptr
, Qouter_window_id
,
1316 build_string (buf
));
1317 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1318 FRAME_SAMPLE_VISIBILITY (f
);
1319 store_in_alist (alistptr
, Qvisibility
,
1320 (FRAME_VISIBLE_P (f
) ? Qt
1321 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1322 store_in_alist (alistptr
, Qdisplay
,
1323 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1325 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1328 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1329 store_in_alist (alistptr
, Qparent_id
, tem
);
1334 /* Gamma-correct COLOR on frame F. */
1337 gamma_correct (f
, color
)
1343 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1344 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1345 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1350 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1351 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1352 allocate the color. Value is zero if COLOR_NAME is invalid, or
1353 no color could be allocated. */
1356 x_defined_color (f
, color_name
, color
, alloc_p
)
1363 Display
*dpy
= FRAME_X_DISPLAY (f
);
1364 Colormap cmap
= FRAME_X_COLORMAP (f
);
1367 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1368 if (success_p
&& alloc_p
)
1369 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1376 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1377 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1378 Signal an error if color can't be allocated. */
1381 x_decode_color (f
, color_name
, mono_color
)
1383 Lisp_Object color_name
;
1388 CHECK_STRING (color_name
);
1390 #if 0 /* Don't do this. It's wrong when we're not using the default
1391 colormap, it makes freeing difficult, and it's probably not
1392 an important optimization. */
1393 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1394 return BLACK_PIX_DEFAULT (f
);
1395 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1396 return WHITE_PIX_DEFAULT (f
);
1399 /* Return MONO_COLOR for monochrome frames. */
1400 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1403 /* x_defined_color is responsible for coping with failures
1404 by looking for a near-miss. */
1405 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1408 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1409 Fcons (color_name
, Qnil
)));
1415 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1416 the previous value of that parameter, NEW_VALUE is the new value. */
1419 x_set_line_spacing (f
, new_value
, old_value
)
1421 Lisp_Object new_value
, old_value
;
1423 if (NILP (new_value
))
1424 f
->extra_line_spacing
= 0;
1425 else if (NATNUMP (new_value
))
1426 f
->extra_line_spacing
= XFASTINT (new_value
);
1428 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1429 Fcons (new_value
, Qnil
)));
1430 if (FRAME_VISIBLE_P (f
))
1435 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1436 the previous value of that parameter, NEW_VALUE is the new value.
1437 See also the comment of wait_for_wm in struct x_output. */
1440 x_set_wait_for_wm (f
, new_value
, old_value
)
1442 Lisp_Object new_value
, old_value
;
1444 f
->output_data
.x
->wait_for_wm
= !NILP (new_value
);
1448 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
1449 the previous value of that parameter, NEW_VALUE is the new value. */
1452 x_set_fullscreen (f
, new_value
, old_value
)
1454 Lisp_Object new_value
, old_value
;
1456 if (NILP (new_value
))
1457 f
->output_data
.x
->want_fullscreen
= FULLSCREEN_NONE
;
1458 else if (EQ (new_value
, Qfullboth
))
1459 f
->output_data
.x
->want_fullscreen
= FULLSCREEN_BOTH
;
1460 else if (EQ (new_value
, Qfullwidth
))
1461 f
->output_data
.x
->want_fullscreen
= FULLSCREEN_WIDTH
;
1462 else if (EQ (new_value
, Qfullheight
))
1463 f
->output_data
.x
->want_fullscreen
= FULLSCREEN_HEIGHT
;
1467 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1468 the previous value of that parameter, NEW_VALUE is the new
1472 x_set_screen_gamma (f
, new_value
, old_value
)
1474 Lisp_Object new_value
, old_value
;
1476 if (NILP (new_value
))
1478 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1479 /* The value 0.4545 is the normal viewing gamma. */
1480 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1482 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1483 Fcons (new_value
, Qnil
)));
1485 clear_face_cache (0);
1489 /* Functions called only from `x_set_frame_param'
1490 to set individual parameters.
1492 If FRAME_X_WINDOW (f) is 0,
1493 the frame is being created and its X-window does not exist yet.
1494 In that case, just record the parameter's new value
1495 in the standard place; do not attempt to change the window. */
1498 x_set_foreground_color (f
, arg
, oldval
)
1500 Lisp_Object arg
, oldval
;
1502 struct x_output
*x
= f
->output_data
.x
;
1503 unsigned long fg
, old_fg
;
1505 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1506 old_fg
= x
->foreground_pixel
;
1507 x
->foreground_pixel
= fg
;
1509 if (FRAME_X_WINDOW (f
) != 0)
1511 Display
*dpy
= FRAME_X_DISPLAY (f
);
1514 XSetForeground (dpy
, x
->normal_gc
, fg
);
1515 XSetBackground (dpy
, x
->reverse_gc
, fg
);
1517 if (x
->cursor_pixel
== old_fg
)
1519 unload_color (f
, x
->cursor_pixel
);
1520 x
->cursor_pixel
= x_copy_color (f
, fg
);
1521 XSetBackground (dpy
, x
->cursor_gc
, x
->cursor_pixel
);
1526 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1528 if (FRAME_VISIBLE_P (f
))
1532 unload_color (f
, old_fg
);
1536 x_set_background_color (f
, arg
, oldval
)
1538 Lisp_Object arg
, oldval
;
1540 struct x_output
*x
= f
->output_data
.x
;
1543 bg
= x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1544 unload_color (f
, x
->background_pixel
);
1545 x
->background_pixel
= bg
;
1547 if (FRAME_X_WINDOW (f
) != 0)
1549 Display
*dpy
= FRAME_X_DISPLAY (f
);
1552 XSetBackground (dpy
, x
->normal_gc
, bg
);
1553 XSetForeground (dpy
, x
->reverse_gc
, bg
);
1554 XSetWindowBackground (dpy
, FRAME_X_WINDOW (f
), bg
);
1555 XSetForeground (dpy
, x
->cursor_gc
, bg
);
1557 #ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1558 toolkit scroll bars. */
1561 for (bar
= FRAME_SCROLL_BARS (f
);
1563 bar
= XSCROLL_BAR (bar
)->next
)
1565 Window window
= SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
));
1566 XSetWindowBackground (dpy
, window
, bg
);
1569 #endif /* USE_TOOLKIT_SCROLL_BARS */
1572 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1574 if (FRAME_VISIBLE_P (f
))
1580 x_set_mouse_color (f
, arg
, oldval
)
1582 Lisp_Object arg
, oldval
;
1584 struct x_output
*x
= f
->output_data
.x
;
1585 Display
*dpy
= FRAME_X_DISPLAY (f
);
1586 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1587 Cursor hourglass_cursor
, horizontal_drag_cursor
;
1589 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1590 unsigned long mask_color
= x
->background_pixel
;
1592 /* Don't let pointers be invisible. */
1593 if (mask_color
== pixel
)
1595 x_free_colors (f
, &pixel
, 1);
1596 pixel
= x_copy_color (f
, x
->foreground_pixel
);
1599 unload_color (f
, x
->mouse_pixel
);
1600 x
->mouse_pixel
= pixel
;
1604 /* It's not okay to crash if the user selects a screwy cursor. */
1605 count
= x_catch_errors (dpy
);
1607 if (!NILP (Vx_pointer_shape
))
1609 CHECK_NUMBER (Vx_pointer_shape
);
1610 cursor
= XCreateFontCursor (dpy
, XINT (Vx_pointer_shape
));
1613 cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1614 x_check_errors (dpy
, "bad text pointer cursor: %s");
1616 if (!NILP (Vx_nontext_pointer_shape
))
1618 CHECK_NUMBER (Vx_nontext_pointer_shape
);
1620 = XCreateFontCursor (dpy
, XINT (Vx_nontext_pointer_shape
));
1623 nontext_cursor
= XCreateFontCursor (dpy
, XC_left_ptr
);
1624 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1626 if (!NILP (Vx_hourglass_pointer_shape
))
1628 CHECK_NUMBER (Vx_hourglass_pointer_shape
);
1630 = XCreateFontCursor (dpy
, XINT (Vx_hourglass_pointer_shape
));
1633 hourglass_cursor
= XCreateFontCursor (dpy
, XC_watch
);
1634 x_check_errors (dpy
, "bad hourglass pointer cursor: %s");
1636 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1637 if (!NILP (Vx_mode_pointer_shape
))
1639 CHECK_NUMBER (Vx_mode_pointer_shape
);
1640 mode_cursor
= XCreateFontCursor (dpy
, XINT (Vx_mode_pointer_shape
));
1643 mode_cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1644 x_check_errors (dpy
, "bad modeline pointer cursor: %s");
1646 if (!NILP (Vx_sensitive_text_pointer_shape
))
1648 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
);
1650 = XCreateFontCursor (dpy
, XINT (Vx_sensitive_text_pointer_shape
));
1653 cross_cursor
= XCreateFontCursor (dpy
, XC_crosshair
);
1655 if (!NILP (Vx_window_horizontal_drag_shape
))
1657 CHECK_NUMBER (Vx_window_horizontal_drag_shape
);
1658 horizontal_drag_cursor
1659 = XCreateFontCursor (dpy
, XINT (Vx_window_horizontal_drag_shape
));
1662 horizontal_drag_cursor
1663 = XCreateFontCursor (dpy
, XC_sb_h_double_arrow
);
1665 /* Check and report errors with the above calls. */
1666 x_check_errors (dpy
, "can't set cursor shape: %s");
1667 x_uncatch_errors (dpy
, count
);
1670 XColor fore_color
, back_color
;
1672 fore_color
.pixel
= x
->mouse_pixel
;
1673 x_query_color (f
, &fore_color
);
1674 back_color
.pixel
= mask_color
;
1675 x_query_color (f
, &back_color
);
1677 XRecolorCursor (dpy
, cursor
, &fore_color
, &back_color
);
1678 XRecolorCursor (dpy
, nontext_cursor
, &fore_color
, &back_color
);
1679 XRecolorCursor (dpy
, mode_cursor
, &fore_color
, &back_color
);
1680 XRecolorCursor (dpy
, cross_cursor
, &fore_color
, &back_color
);
1681 XRecolorCursor (dpy
, hourglass_cursor
, &fore_color
, &back_color
);
1682 XRecolorCursor (dpy
, horizontal_drag_cursor
, &fore_color
, &back_color
);
1685 if (FRAME_X_WINDOW (f
) != 0)
1686 XDefineCursor (dpy
, FRAME_X_WINDOW (f
), cursor
);
1688 if (cursor
!= x
->text_cursor
1689 && x
->text_cursor
!= 0)
1690 XFreeCursor (dpy
, x
->text_cursor
);
1691 x
->text_cursor
= cursor
;
1693 if (nontext_cursor
!= x
->nontext_cursor
1694 && x
->nontext_cursor
!= 0)
1695 XFreeCursor (dpy
, x
->nontext_cursor
);
1696 x
->nontext_cursor
= nontext_cursor
;
1698 if (hourglass_cursor
!= x
->hourglass_cursor
1699 && x
->hourglass_cursor
!= 0)
1700 XFreeCursor (dpy
, x
->hourglass_cursor
);
1701 x
->hourglass_cursor
= hourglass_cursor
;
1703 if (mode_cursor
!= x
->modeline_cursor
1704 && x
->modeline_cursor
!= 0)
1705 XFreeCursor (dpy
, f
->output_data
.x
->modeline_cursor
);
1706 x
->modeline_cursor
= mode_cursor
;
1708 if (cross_cursor
!= x
->cross_cursor
1709 && x
->cross_cursor
!= 0)
1710 XFreeCursor (dpy
, x
->cross_cursor
);
1711 x
->cross_cursor
= cross_cursor
;
1713 if (horizontal_drag_cursor
!= x
->horizontal_drag_cursor
1714 && x
->horizontal_drag_cursor
!= 0)
1715 XFreeCursor (dpy
, x
->horizontal_drag_cursor
);
1716 x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1721 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1725 x_set_cursor_color (f
, arg
, oldval
)
1727 Lisp_Object arg
, oldval
;
1729 unsigned long fore_pixel
, pixel
;
1730 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1731 struct x_output
*x
= f
->output_data
.x
;
1733 if (!NILP (Vx_cursor_fore_pixel
))
1735 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1736 WHITE_PIX_DEFAULT (f
));
1737 fore_pixel_allocated_p
= 1;
1740 fore_pixel
= x
->background_pixel
;
1742 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1743 pixel_allocated_p
= 1;
1745 /* Make sure that the cursor color differs from the background color. */
1746 if (pixel
== x
->background_pixel
)
1748 if (pixel_allocated_p
)
1750 x_free_colors (f
, &pixel
, 1);
1751 pixel_allocated_p
= 0;
1754 pixel
= x
->mouse_pixel
;
1755 if (pixel
== fore_pixel
)
1757 if (fore_pixel_allocated_p
)
1759 x_free_colors (f
, &fore_pixel
, 1);
1760 fore_pixel_allocated_p
= 0;
1762 fore_pixel
= x
->background_pixel
;
1766 unload_color (f
, x
->cursor_foreground_pixel
);
1767 if (!fore_pixel_allocated_p
)
1768 fore_pixel
= x_copy_color (f
, fore_pixel
);
1769 x
->cursor_foreground_pixel
= fore_pixel
;
1771 unload_color (f
, x
->cursor_pixel
);
1772 if (!pixel_allocated_p
)
1773 pixel
= x_copy_color (f
, pixel
);
1774 x
->cursor_pixel
= pixel
;
1776 if (FRAME_X_WINDOW (f
) != 0)
1779 XSetBackground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, x
->cursor_pixel
);
1780 XSetForeground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, fore_pixel
);
1783 if (FRAME_VISIBLE_P (f
))
1785 x_update_cursor (f
, 0);
1786 x_update_cursor (f
, 1);
1790 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1793 /* Set the border-color of frame F to value described by ARG.
1794 ARG can be a string naming a color.
1795 The border-color is used for the border that is drawn by the X server.
1796 Note that this does not fully take effect if done before
1797 F has an x-window; it must be redone when the window is created.
1799 Note: this is done in two routines because of the way X10 works.
1801 Note: under X11, this is normally the province of the window manager,
1802 and so emacs' border colors may be overridden. */
1805 x_set_border_color (f
, arg
, oldval
)
1807 Lisp_Object arg
, oldval
;
1812 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1813 x_set_border_pixel (f
, pix
);
1814 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1817 /* Set the border-color of frame F to pixel value PIX.
1818 Note that this does not fully take effect if done before
1819 F has an x-window. */
1822 x_set_border_pixel (f
, pix
)
1826 unload_color (f
, f
->output_data
.x
->border_pixel
);
1827 f
->output_data
.x
->border_pixel
= pix
;
1829 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1832 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1833 (unsigned long)pix
);
1836 if (FRAME_VISIBLE_P (f
))
1842 /* Value is the internal representation of the specified cursor type
1843 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1844 of the bar cursor. */
1846 enum text_cursor_kinds
1847 x_specified_cursor_type (arg
, width
)
1851 enum text_cursor_kinds type
;
1858 else if (CONSP (arg
)
1859 && EQ (XCAR (arg
), Qbar
)
1860 && INTEGERP (XCDR (arg
))
1861 && XINT (XCDR (arg
)) >= 0)
1864 *width
= XINT (XCDR (arg
));
1866 else if (NILP (arg
))
1869 /* Treat anything unknown as "box cursor".
1870 It was bad to signal an error; people have trouble fixing
1871 .Xdefaults with Emacs, when it has something bad in it. */
1872 type
= FILLED_BOX_CURSOR
;
1878 x_set_cursor_type (f
, arg
, oldval
)
1880 Lisp_Object arg
, oldval
;
1884 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1885 f
->output_data
.x
->cursor_width
= width
;
1887 /* Make sure the cursor gets redrawn. This is overkill, but how
1888 often do people change cursor types? */
1889 update_mode_lines
++;
1893 x_set_icon_type (f
, arg
, oldval
)
1895 Lisp_Object arg
, oldval
;
1901 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1904 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1909 result
= x_text_icon (f
,
1910 (char *) XSTRING ((!NILP (f
->icon_name
)
1914 result
= x_bitmap_icon (f
, arg
);
1919 error ("No icon window available");
1922 XFlush (FRAME_X_DISPLAY (f
));
1926 /* Return non-nil if frame F wants a bitmap icon. */
1934 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1942 x_set_icon_name (f
, arg
, oldval
)
1944 Lisp_Object arg
, oldval
;
1950 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1953 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1958 if (f
->output_data
.x
->icon_bitmap
!= 0)
1963 result
= x_text_icon (f
,
1964 (char *) XSTRING ((!NILP (f
->icon_name
)
1973 error ("No icon window available");
1976 XFlush (FRAME_X_DISPLAY (f
));
1981 x_set_font (f
, arg
, oldval
)
1983 Lisp_Object arg
, oldval
;
1986 Lisp_Object fontset_name
;
1988 int old_fontset
= f
->output_data
.x
->fontset
;
1992 fontset_name
= Fquery_fontset (arg
, Qnil
);
1995 result
= (STRINGP (fontset_name
)
1996 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1997 : x_new_font (f
, XSTRING (arg
)->data
));
2000 if (EQ (result
, Qnil
))
2001 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
2002 else if (EQ (result
, Qt
))
2003 error ("The characters of the given font have varying widths");
2004 else if (STRINGP (result
))
2006 if (STRINGP (fontset_name
))
2008 /* Fontset names are built from ASCII font names, so the
2009 names may be equal despite there was a change. */
2010 if (old_fontset
== f
->output_data
.x
->fontset
)
2013 else if (!NILP (Fequal (result
, oldval
)))
2016 store_frame_param (f
, Qfont
, result
);
2017 recompute_basic_faces (f
);
2022 do_pending_window_change (0);
2024 /* Don't call `face-set-after-frame-default' when faces haven't been
2025 initialized yet. This is the case when called from
2026 Fx_create_frame. In that case, the X widget or window doesn't
2027 exist either, and we can end up in x_report_frame_params with a
2028 null widget which gives a segfault. */
2029 if (FRAME_FACE_CACHE (f
))
2031 XSETFRAME (frame
, f
);
2032 call1 (Qface_set_after_frame_default
, frame
);
2037 x_set_fringe_width (f
, new_value
, old_value
)
2039 Lisp_Object new_value
, old_value
;
2041 x_compute_fringe_widths (f
, 1);
2045 x_set_border_width (f
, arg
, oldval
)
2047 Lisp_Object arg
, oldval
;
2051 if (XINT (arg
) == f
->output_data
.x
->border_width
)
2054 if (FRAME_X_WINDOW (f
) != 0)
2055 error ("Cannot change the border width of a window");
2057 f
->output_data
.x
->border_width
= XINT (arg
);
2061 x_set_internal_border_width (f
, arg
, oldval
)
2063 Lisp_Object arg
, oldval
;
2065 int old
= f
->output_data
.x
->internal_border_width
;
2068 f
->output_data
.x
->internal_border_width
= XINT (arg
);
2069 if (f
->output_data
.x
->internal_border_width
< 0)
2070 f
->output_data
.x
->internal_border_width
= 0;
2072 #ifdef USE_X_TOOLKIT
2073 if (f
->output_data
.x
->edit_widget
)
2074 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
2077 if (f
->output_data
.x
->internal_border_width
== old
)
2080 if (FRAME_X_WINDOW (f
) != 0)
2082 x_set_window_size (f
, 0, f
->width
, f
->height
);
2083 SET_FRAME_GARBAGED (f
);
2084 do_pending_window_change (0);
2087 SET_FRAME_GARBAGED (f
);
2091 x_set_visibility (f
, value
, oldval
)
2093 Lisp_Object value
, oldval
;
2096 XSETFRAME (frame
, f
);
2099 Fmake_frame_invisible (frame
, Qt
);
2100 else if (EQ (value
, Qicon
))
2101 Ficonify_frame (frame
);
2103 Fmake_frame_visible (frame
);
2107 /* Change window heights in windows rooted in WINDOW by N lines. */
2110 x_change_window_heights (window
, n
)
2114 struct window
*w
= XWINDOW (window
);
2116 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
2117 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
2119 if (INTEGERP (w
->orig_top
))
2120 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
2121 if (INTEGERP (w
->orig_height
))
2122 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
2124 /* Handle just the top child in a vertical split. */
2125 if (!NILP (w
->vchild
))
2126 x_change_window_heights (w
->vchild
, n
);
2128 /* Adjust all children in a horizontal split. */
2129 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
2131 w
= XWINDOW (window
);
2132 x_change_window_heights (window
, n
);
2137 x_set_menu_bar_lines (f
, value
, oldval
)
2139 Lisp_Object value
, oldval
;
2142 #ifndef USE_X_TOOLKIT
2143 int olines
= FRAME_MENU_BAR_LINES (f
);
2146 /* Right now, menu bars don't work properly in minibuf-only frames;
2147 most of the commands try to apply themselves to the minibuffer
2148 frame itself, and get an error because you can't switch buffers
2149 in or split the minibuffer window. */
2150 if (FRAME_MINIBUF_ONLY_P (f
))
2153 if (INTEGERP (value
))
2154 nlines
= XINT (value
);
2158 /* Make sure we redisplay all windows in this frame. */
2159 windows_or_buffers_changed
++;
2161 #ifdef USE_X_TOOLKIT
2162 FRAME_MENU_BAR_LINES (f
) = 0;
2165 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2166 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
2167 /* Make sure next redisplay shows the menu bar. */
2168 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2172 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2173 free_frame_menubar (f
);
2174 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2176 f
->output_data
.x
->menubar_widget
= 0;
2178 #else /* not USE_X_TOOLKIT */
2179 FRAME_MENU_BAR_LINES (f
) = nlines
;
2180 x_change_window_heights (f
->root_window
, nlines
- olines
);
2181 #endif /* not USE_X_TOOLKIT */
2186 /* Set the number of lines used for the tool bar of frame F to VALUE.
2187 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2188 is the old number of tool bar lines. This function changes the
2189 height of all windows on frame F to match the new tool bar height.
2190 The frame's height doesn't change. */
2193 x_set_tool_bar_lines (f
, value
, oldval
)
2195 Lisp_Object value
, oldval
;
2197 int delta
, nlines
, root_height
;
2198 Lisp_Object root_window
;
2200 /* Treat tool bars like menu bars. */
2201 if (FRAME_MINIBUF_ONLY_P (f
))
2204 /* Use VALUE only if an integer >= 0. */
2205 if (INTEGERP (value
) && XINT (value
) >= 0)
2206 nlines
= XFASTINT (value
);
2210 /* Make sure we redisplay all windows in this frame. */
2211 ++windows_or_buffers_changed
;
2213 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2215 /* Don't resize the tool-bar to more than we have room for. */
2216 root_window
= FRAME_ROOT_WINDOW (f
);
2217 root_height
= XINT (XWINDOW (root_window
)->height
);
2218 if (root_height
- delta
< 1)
2220 delta
= root_height
- 1;
2221 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2224 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2225 x_change_window_heights (root_window
, delta
);
2228 /* We also have to make sure that the internal border at the top of
2229 the frame, below the menu bar or tool bar, is redrawn when the
2230 tool bar disappears. This is so because the internal border is
2231 below the tool bar if one is displayed, but is below the menu bar
2232 if there isn't a tool bar. The tool bar draws into the area
2233 below the menu bar. */
2234 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2238 clear_current_matrices (f
);
2239 updating_frame
= NULL
;
2242 /* If the tool bar gets smaller, the internal border below it
2243 has to be cleared. It was formerly part of the display
2244 of the larger tool bar, and updating windows won't clear it. */
2247 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2248 int width
= PIXEL_WIDTH (f
);
2249 int y
= nlines
* CANON_Y_UNIT (f
);
2252 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2253 0, y
, width
, height
, False
);
2256 if (WINDOWP (f
->tool_bar_window
))
2257 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2262 /* Set the foreground color for scroll bars on frame F to VALUE.
2263 VALUE should be a string, a color name. If it isn't a string or
2264 isn't a valid color name, do nothing. OLDVAL is the old value of
2265 the frame parameter. */
2268 x_set_scroll_bar_foreground (f
, value
, oldval
)
2270 Lisp_Object value
, oldval
;
2272 unsigned long pixel
;
2274 if (STRINGP (value
))
2275 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2279 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2280 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2282 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2283 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2285 /* Remove all scroll bars because they have wrong colors. */
2286 if (condemn_scroll_bars_hook
)
2287 (*condemn_scroll_bars_hook
) (f
);
2288 if (judge_scroll_bars_hook
)
2289 (*judge_scroll_bars_hook
) (f
);
2291 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2297 /* Set the background color for scroll bars on frame F to VALUE VALUE
2298 should be a string, a color name. If it isn't a string or isn't a
2299 valid color name, do nothing. OLDVAL is the old value of the frame
2303 x_set_scroll_bar_background (f
, value
, oldval
)
2305 Lisp_Object value
, oldval
;
2307 unsigned long pixel
;
2309 if (STRINGP (value
))
2310 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2314 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2315 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2317 #ifdef USE_TOOLKIT_SCROLL_BARS
2318 /* Scrollbar shadow colors. */
2319 if (f
->output_data
.x
->scroll_bar_top_shadow_pixel
!= -1)
2321 unload_color (f
, f
->output_data
.x
->scroll_bar_top_shadow_pixel
);
2322 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
2324 if (f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
!= -1)
2326 unload_color (f
, f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
);
2327 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
2329 #endif /* USE_TOOLKIT_SCROLL_BARS */
2331 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2332 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2334 /* Remove all scroll bars because they have wrong colors. */
2335 if (condemn_scroll_bars_hook
)
2336 (*condemn_scroll_bars_hook
) (f
);
2337 if (judge_scroll_bars_hook
)
2338 (*judge_scroll_bars_hook
) (f
);
2340 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2346 /* Encode Lisp string STRING as a text in a format appropriate for
2347 XICCC (X Inter Client Communication Conventions).
2349 If STRING contains only ASCII characters, do no conversion and
2350 return the string data of STRING. Otherwise, encode the text by
2351 CODING_SYSTEM, and return a newly allocated memory area which
2352 should be freed by `xfree' by a caller.
2354 SELECTIONP non-zero means the string is being encoded for an X
2355 selection, so it is safe to run pre-write conversions (which
2358 Store the byte length of resulting text in *TEXT_BYTES.
2360 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2361 which means that the `encoding' of the result can be `STRING'.
2362 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2363 the result should be `COMPOUND_TEXT'. */
2366 x_encode_text (string
, coding_system
, selectionp
, text_bytes
, stringp
)
2367 Lisp_Object string
, coding_system
;
2368 int *text_bytes
, *stringp
;
2371 unsigned char *str
= XSTRING (string
)->data
;
2372 int chars
= XSTRING (string
)->size
;
2373 int bytes
= STRING_BYTES (XSTRING (string
));
2377 struct coding_system coding
;
2379 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2380 if (charset_info
== 0)
2382 /* No multibyte character in OBJ. We need not encode it. */
2383 *text_bytes
= bytes
;
2388 setup_coding_system (coding_system
, &coding
);
2390 && SYMBOLP (coding
.pre_write_conversion
)
2391 && !NILP (Ffboundp (coding
.pre_write_conversion
)))
2393 string
= run_pre_post_conversion_on_str (string
, &coding
, 1);
2394 str
= XSTRING (string
)->data
;
2395 chars
= XSTRING (string
)->size
;
2396 bytes
= STRING_BYTES (XSTRING (string
));
2398 coding
.src_multibyte
= 1;
2399 coding
.dst_multibyte
= 0;
2400 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2401 if (coding
.type
== coding_type_iso2022
)
2402 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2403 /* We suppress producing escape sequences for composition. */
2404 coding
.composing
= COMPOSITION_DISABLED
;
2405 bufsize
= encoding_buffer_size (&coding
, bytes
);
2406 buf
= (unsigned char *) xmalloc (bufsize
);
2407 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2408 *text_bytes
= coding
.produced
;
2409 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2414 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2417 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2418 name; if NAME is a string, set F's name to NAME and set
2419 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2421 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2422 suggesting a new name, which lisp code should override; if
2423 F->explicit_name is set, ignore the new name; otherwise, set it. */
2426 x_set_name (f
, name
, explicit)
2431 /* Make sure that requests from lisp code override requests from
2432 Emacs redisplay code. */
2435 /* If we're switching from explicit to implicit, we had better
2436 update the mode lines and thereby update the title. */
2437 if (f
->explicit_name
&& NILP (name
))
2438 update_mode_lines
= 1;
2440 f
->explicit_name
= ! NILP (name
);
2442 else if (f
->explicit_name
)
2445 /* If NAME is nil, set the name to the x_id_name. */
2448 /* Check for no change needed in this very common case
2449 before we do any consing. */
2450 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2451 XSTRING (f
->name
)->data
))
2453 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2456 CHECK_STRING (name
);
2458 /* Don't change the name if it's already NAME. */
2459 if (! NILP (Fstring_equal (name
, f
->name
)))
2464 /* For setting the frame title, the title parameter should override
2465 the name parameter. */
2466 if (! NILP (f
->title
))
2469 if (FRAME_X_WINDOW (f
))
2474 XTextProperty text
, icon
;
2476 Lisp_Object coding_system
;
2478 coding_system
= Vlocale_coding_system
;
2479 if (NILP (coding_system
))
2480 coding_system
= Qcompound_text
;
2481 text
.value
= x_encode_text (name
, coding_system
, 0, &bytes
, &stringp
);
2482 text
.encoding
= (stringp
? XA_STRING
2483 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2485 text
.nitems
= bytes
;
2487 if (NILP (f
->icon_name
))
2493 icon
.value
= x_encode_text (f
->icon_name
, coding_system
, 0,
2495 icon
.encoding
= (stringp
? XA_STRING
2496 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2498 icon
.nitems
= bytes
;
2500 #ifdef USE_X_TOOLKIT
2501 XSetWMName (FRAME_X_DISPLAY (f
),
2502 XtWindow (f
->output_data
.x
->widget
), &text
);
2503 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2505 #else /* not USE_X_TOOLKIT */
2506 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2507 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2508 #endif /* not USE_X_TOOLKIT */
2509 if (!NILP (f
->icon_name
)
2510 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2512 if (text
.value
!= XSTRING (name
)->data
)
2515 #else /* not HAVE_X11R4 */
2516 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2517 XSTRING (name
)->data
);
2518 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2519 XSTRING (name
)->data
);
2520 #endif /* not HAVE_X11R4 */
2525 /* This function should be called when the user's lisp code has
2526 specified a name for the frame; the name will override any set by the
2529 x_explicitly_set_name (f
, arg
, oldval
)
2531 Lisp_Object arg
, oldval
;
2533 x_set_name (f
, arg
, 1);
2536 /* This function should be called by Emacs redisplay code to set the
2537 name; names set this way will never override names set by the user's
2540 x_implicitly_set_name (f
, arg
, oldval
)
2542 Lisp_Object arg
, oldval
;
2544 x_set_name (f
, arg
, 0);
2547 /* Change the title of frame F to NAME.
2548 If NAME is nil, use the frame name as the title.
2550 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2551 name; if NAME is a string, set F's name to NAME and set
2552 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2554 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2555 suggesting a new name, which lisp code should override; if
2556 F->explicit_name is set, ignore the new name; otherwise, set it. */
2559 x_set_title (f
, name
, old_name
)
2561 Lisp_Object name
, old_name
;
2563 /* Don't change the title if it's already NAME. */
2564 if (EQ (name
, f
->title
))
2567 update_mode_lines
= 1;
2574 CHECK_STRING (name
);
2576 if (FRAME_X_WINDOW (f
))
2581 XTextProperty text
, icon
;
2583 Lisp_Object coding_system
;
2585 coding_system
= Vlocale_coding_system
;
2586 if (NILP (coding_system
))
2587 coding_system
= Qcompound_text
;
2588 text
.value
= x_encode_text (name
, coding_system
, 0, &bytes
, &stringp
);
2589 text
.encoding
= (stringp
? XA_STRING
2590 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2592 text
.nitems
= bytes
;
2594 if (NILP (f
->icon_name
))
2600 icon
.value
= x_encode_text (f
->icon_name
, coding_system
, 0,
2602 icon
.encoding
= (stringp
? XA_STRING
2603 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2605 icon
.nitems
= bytes
;
2607 #ifdef USE_X_TOOLKIT
2608 XSetWMName (FRAME_X_DISPLAY (f
),
2609 XtWindow (f
->output_data
.x
->widget
), &text
);
2610 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2612 #else /* not USE_X_TOOLKIT */
2613 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2614 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2615 #endif /* not USE_X_TOOLKIT */
2616 if (!NILP (f
->icon_name
)
2617 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2619 if (text
.value
!= XSTRING (name
)->data
)
2622 #else /* not HAVE_X11R4 */
2623 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2624 XSTRING (name
)->data
);
2625 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2626 XSTRING (name
)->data
);
2627 #endif /* not HAVE_X11R4 */
2633 x_set_autoraise (f
, arg
, oldval
)
2635 Lisp_Object arg
, oldval
;
2637 f
->auto_raise
= !EQ (Qnil
, arg
);
2641 x_set_autolower (f
, arg
, oldval
)
2643 Lisp_Object arg
, oldval
;
2645 f
->auto_lower
= !EQ (Qnil
, arg
);
2649 x_set_unsplittable (f
, arg
, oldval
)
2651 Lisp_Object arg
, oldval
;
2653 f
->no_split
= !NILP (arg
);
2657 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2659 Lisp_Object arg
, oldval
;
2661 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2662 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2663 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2664 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2666 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2668 ? vertical_scroll_bar_none
2670 ? vertical_scroll_bar_right
2671 : vertical_scroll_bar_left
);
2673 /* We set this parameter before creating the X window for the
2674 frame, so we can get the geometry right from the start.
2675 However, if the window hasn't been created yet, we shouldn't
2676 call x_set_window_size. */
2677 if (FRAME_X_WINDOW (f
))
2678 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2679 do_pending_window_change (0);
2684 x_set_scroll_bar_width (f
, arg
, oldval
)
2686 Lisp_Object arg
, oldval
;
2688 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2692 #ifdef USE_TOOLKIT_SCROLL_BARS
2693 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2694 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2695 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2696 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2698 /* Make the actual width at least 14 pixels and a multiple of a
2700 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2702 /* Use all of that space (aside from required margins) for the
2704 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2707 if (FRAME_X_WINDOW (f
))
2708 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2709 do_pending_window_change (0);
2711 else if (INTEGERP (arg
) && XINT (arg
) > 0
2712 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2714 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2715 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2717 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2718 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2719 if (FRAME_X_WINDOW (f
))
2720 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2723 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2724 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2725 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2730 /* Subroutines of creating an X frame. */
2732 /* Make sure that Vx_resource_name is set to a reasonable value.
2733 Fix it up, or set it to `emacs' if it is too hopeless. */
2736 validate_x_resource_name ()
2739 /* Number of valid characters in the resource name. */
2741 /* Number of invalid characters in the resource name. */
2746 if (!STRINGP (Vx_resource_class
))
2747 Vx_resource_class
= build_string (EMACS_CLASS
);
2749 if (STRINGP (Vx_resource_name
))
2751 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2754 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2756 /* Only letters, digits, - and _ are valid in resource names.
2757 Count the valid characters and count the invalid ones. */
2758 for (i
= 0; i
< len
; i
++)
2761 if (! ((c
>= 'a' && c
<= 'z')
2762 || (c
>= 'A' && c
<= 'Z')
2763 || (c
>= '0' && c
<= '9')
2764 || c
== '-' || c
== '_'))
2771 /* Not a string => completely invalid. */
2772 bad_count
= 5, good_count
= 0;
2774 /* If name is valid already, return. */
2778 /* If name is entirely invalid, or nearly so, use `emacs'. */
2780 || (good_count
== 1 && bad_count
> 0))
2782 Vx_resource_name
= build_string ("emacs");
2786 /* Name is partly valid. Copy it and replace the invalid characters
2787 with underscores. */
2789 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2791 for (i
= 0; i
< len
; i
++)
2793 int c
= XSTRING (new)->data
[i
];
2794 if (! ((c
>= 'a' && c
<= 'z')
2795 || (c
>= 'A' && c
<= 'Z')
2796 || (c
>= '0' && c
<= '9')
2797 || c
== '-' || c
== '_'))
2798 XSTRING (new)->data
[i
] = '_';
2803 extern char *x_get_string_resource ();
2805 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2806 doc
: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
2807 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
2808 class, where INSTANCE is the name under which Emacs was invoked, or
2809 the name specified by the `-name' or `-rn' command-line arguments.
2811 The optional arguments COMPONENT and SUBCLASS add to the key and the
2812 class, respectively. You must specify both of them or neither.
2813 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
2814 and the class is `Emacs.CLASS.SUBCLASS'. */)
2815 (attribute
, class, component
, subclass
)
2816 Lisp_Object attribute
, class, component
, subclass
;
2818 register char *value
;
2824 CHECK_STRING (attribute
);
2825 CHECK_STRING (class);
2827 if (!NILP (component
))
2828 CHECK_STRING (component
);
2829 if (!NILP (subclass
))
2830 CHECK_STRING (subclass
);
2831 if (NILP (component
) != NILP (subclass
))
2832 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2834 validate_x_resource_name ();
2836 /* Allocate space for the components, the dots which separate them,
2837 and the final '\0'. Make them big enough for the worst case. */
2838 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2839 + (STRINGP (component
)
2840 ? STRING_BYTES (XSTRING (component
)) : 0)
2841 + STRING_BYTES (XSTRING (attribute
))
2844 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2845 + STRING_BYTES (XSTRING (class))
2846 + (STRINGP (subclass
)
2847 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2850 /* Start with emacs.FRAMENAME for the name (the specific one)
2851 and with `Emacs' for the class key (the general one). */
2852 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2853 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2855 strcat (class_key
, ".");
2856 strcat (class_key
, XSTRING (class)->data
);
2858 if (!NILP (component
))
2860 strcat (class_key
, ".");
2861 strcat (class_key
, XSTRING (subclass
)->data
);
2863 strcat (name_key
, ".");
2864 strcat (name_key
, XSTRING (component
)->data
);
2867 strcat (name_key
, ".");
2868 strcat (name_key
, XSTRING (attribute
)->data
);
2870 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2871 name_key
, class_key
);
2873 if (value
!= (char *) 0)
2874 return build_string (value
);
2879 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2882 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2883 struct x_display_info
*dpyinfo
;
2884 Lisp_Object attribute
, class, component
, subclass
;
2886 register char *value
;
2890 CHECK_STRING (attribute
);
2891 CHECK_STRING (class);
2893 if (!NILP (component
))
2894 CHECK_STRING (component
);
2895 if (!NILP (subclass
))
2896 CHECK_STRING (subclass
);
2897 if (NILP (component
) != NILP (subclass
))
2898 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2900 validate_x_resource_name ();
2902 /* Allocate space for the components, the dots which separate them,
2903 and the final '\0'. Make them big enough for the worst case. */
2904 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2905 + (STRINGP (component
)
2906 ? STRING_BYTES (XSTRING (component
)) : 0)
2907 + STRING_BYTES (XSTRING (attribute
))
2910 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2911 + STRING_BYTES (XSTRING (class))
2912 + (STRINGP (subclass
)
2913 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2916 /* Start with emacs.FRAMENAME for the name (the specific one)
2917 and with `Emacs' for the class key (the general one). */
2918 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2919 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2921 strcat (class_key
, ".");
2922 strcat (class_key
, XSTRING (class)->data
);
2924 if (!NILP (component
))
2926 strcat (class_key
, ".");
2927 strcat (class_key
, XSTRING (subclass
)->data
);
2929 strcat (name_key
, ".");
2930 strcat (name_key
, XSTRING (component
)->data
);
2933 strcat (name_key
, ".");
2934 strcat (name_key
, XSTRING (attribute
)->data
);
2936 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2938 if (value
!= (char *) 0)
2939 return build_string (value
);
2944 /* Used when C code wants a resource value. */
2947 x_get_resource_string (attribute
, class)
2948 char *attribute
, *class;
2952 struct frame
*sf
= SELECTED_FRAME ();
2954 /* Allocate space for the components, the dots which separate them,
2955 and the final '\0'. */
2956 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2957 + strlen (attribute
) + 2);
2958 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2959 + strlen (class) + 2);
2961 sprintf (name_key
, "%s.%s",
2962 XSTRING (Vinvocation_name
)->data
,
2964 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2966 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2967 name_key
, class_key
);
2970 /* Types we might convert a resource string into. */
2980 /* Return the value of parameter PARAM.
2982 First search ALIST, then Vdefault_frame_alist, then the X defaults
2983 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2985 Convert the resource to the type specified by desired_type.
2987 If no default is specified, return Qunbound. If you call
2988 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2989 and don't let it get stored in any Lisp-visible variables! */
2992 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2993 struct x_display_info
*dpyinfo
;
2994 Lisp_Object alist
, param
;
2997 enum resource_types type
;
2999 register Lisp_Object tem
;
3001 tem
= Fassq (param
, alist
);
3003 tem
= Fassq (param
, Vdefault_frame_alist
);
3009 tem
= display_x_get_resource (dpyinfo
,
3010 build_string (attribute
),
3011 build_string (class),
3019 case RES_TYPE_NUMBER
:
3020 return make_number (atoi (XSTRING (tem
)->data
));
3022 case RES_TYPE_FLOAT
:
3023 return make_float (atof (XSTRING (tem
)->data
));
3025 case RES_TYPE_BOOLEAN
:
3026 tem
= Fdowncase (tem
);
3027 if (!strcmp (XSTRING (tem
)->data
, "on")
3028 || !strcmp (XSTRING (tem
)->data
, "true"))
3033 case RES_TYPE_STRING
:
3036 case RES_TYPE_SYMBOL
:
3037 /* As a special case, we map the values `true' and `on'
3038 to Qt, and `false' and `off' to Qnil. */
3041 lower
= Fdowncase (tem
);
3042 if (!strcmp (XSTRING (lower
)->data
, "on")
3043 || !strcmp (XSTRING (lower
)->data
, "true"))
3045 else if (!strcmp (XSTRING (lower
)->data
, "off")
3046 || !strcmp (XSTRING (lower
)->data
, "false"))
3049 return Fintern (tem
, Qnil
);
3062 /* Like x_get_arg, but also record the value in f->param_alist. */
3065 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
3067 Lisp_Object alist
, param
;
3070 enum resource_types type
;
3074 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
3075 attribute
, class, type
);
3077 store_frame_param (f
, param
, value
);
3082 /* Record in frame F the specified or default value according to ALIST
3083 of the parameter named PROP (a Lisp symbol).
3084 If no value is specified for PROP, look for an X default for XPROP
3085 on the frame named NAME.
3086 If that is not found either, use the value DEFLT. */
3089 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
3096 enum resource_types type
;
3100 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
3101 if (EQ (tem
, Qunbound
))
3103 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3108 /* Record in frame F the specified or default value according to ALIST
3109 of the parameter named PROP (a Lisp symbol). If no value is
3110 specified for PROP, look for an X default for XPROP on the frame
3111 named NAME. If that is not found either, use the value DEFLT. */
3114 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
3123 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3126 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
3127 if (EQ (tem
, Qunbound
))
3129 #ifdef USE_TOOLKIT_SCROLL_BARS
3131 /* See if an X resource for the scroll bar color has been
3133 tem
= display_x_get_resource (dpyinfo
,
3134 build_string (foreground_p
3138 build_string ("verticalScrollBar"),
3142 /* If nothing has been specified, scroll bars will use a
3143 toolkit-dependent default. Because these defaults are
3144 difficult to get at without actually creating a scroll
3145 bar, use nil to indicate that no color has been
3150 #else /* not USE_TOOLKIT_SCROLL_BARS */
3154 #endif /* not USE_TOOLKIT_SCROLL_BARS */
3157 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3163 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3164 doc
: /* Parse an X-style geometry string STRING.
3165 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3166 The properties returned may include `top', `left', `height', and `width'.
3167 The value of `left' or `top' may be an integer,
3168 or a list (+ N) meaning N pixels relative to top/left corner,
3169 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3174 unsigned int width
, height
;
3177 CHECK_STRING (string
);
3179 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
3180 &x
, &y
, &width
, &height
);
3183 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
3184 error ("Must specify both x and y position, or neither");
3188 if (geometry
& XValue
)
3190 Lisp_Object element
;
3192 if (x
>= 0 && (geometry
& XNegative
))
3193 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3194 else if (x
< 0 && ! (geometry
& XNegative
))
3195 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3197 element
= Fcons (Qleft
, make_number (x
));
3198 result
= Fcons (element
, result
);
3201 if (geometry
& YValue
)
3203 Lisp_Object element
;
3205 if (y
>= 0 && (geometry
& YNegative
))
3206 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3207 else if (y
< 0 && ! (geometry
& YNegative
))
3208 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3210 element
= Fcons (Qtop
, make_number (y
));
3211 result
= Fcons (element
, result
);
3214 if (geometry
& WidthValue
)
3215 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3216 if (geometry
& HeightValue
)
3217 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3222 /* Calculate the desired size and position of this window,
3223 and return the flags saying which aspects were specified.
3225 This function does not make the coordinates positive. */
3227 #define DEFAULT_ROWS 40
3228 #define DEFAULT_COLS 80
3231 x_figure_window_size (f
, parms
)
3235 register Lisp_Object tem0
, tem1
, tem2
;
3236 long window_prompting
= 0;
3237 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3239 /* Default values if we fall through.
3240 Actually, if that happens we should get
3241 window manager prompting. */
3242 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3243 f
->height
= DEFAULT_ROWS
;
3244 /* Window managers expect that if program-specified
3245 positions are not (0,0), they're intentional, not defaults. */
3246 f
->output_data
.x
->top_pos
= 0;
3247 f
->output_data
.x
->left_pos
= 0;
3249 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3250 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3251 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3252 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3254 if (!EQ (tem0
, Qunbound
))
3256 CHECK_NUMBER (tem0
);
3257 f
->height
= XINT (tem0
);
3259 if (!EQ (tem1
, Qunbound
))
3261 CHECK_NUMBER (tem1
);
3262 SET_FRAME_WIDTH (f
, XINT (tem1
));
3264 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3265 window_prompting
|= USSize
;
3267 window_prompting
|= PSize
;
3270 f
->output_data
.x
->vertical_scroll_bar_extra
3271 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3273 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3275 x_compute_fringe_widths (f
, 0);
3277 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3278 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3280 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3281 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3282 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3283 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3285 if (EQ (tem0
, Qminus
))
3287 f
->output_data
.x
->top_pos
= 0;
3288 window_prompting
|= YNegative
;
3290 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3291 && CONSP (XCDR (tem0
))
3292 && INTEGERP (XCAR (XCDR (tem0
))))
3294 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3295 window_prompting
|= YNegative
;
3297 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3298 && CONSP (XCDR (tem0
))
3299 && INTEGERP (XCAR (XCDR (tem0
))))
3301 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3303 else if (EQ (tem0
, Qunbound
))
3304 f
->output_data
.x
->top_pos
= 0;
3307 CHECK_NUMBER (tem0
);
3308 f
->output_data
.x
->top_pos
= XINT (tem0
);
3309 if (f
->output_data
.x
->top_pos
< 0)
3310 window_prompting
|= YNegative
;
3313 if (EQ (tem1
, Qminus
))
3315 f
->output_data
.x
->left_pos
= 0;
3316 window_prompting
|= XNegative
;
3318 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3319 && CONSP (XCDR (tem1
))
3320 && INTEGERP (XCAR (XCDR (tem1
))))
3322 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3323 window_prompting
|= XNegative
;
3325 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3326 && CONSP (XCDR (tem1
))
3327 && INTEGERP (XCAR (XCDR (tem1
))))
3329 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3331 else if (EQ (tem1
, Qunbound
))
3332 f
->output_data
.x
->left_pos
= 0;
3335 CHECK_NUMBER (tem1
);
3336 f
->output_data
.x
->left_pos
= XINT (tem1
);
3337 if (f
->output_data
.x
->left_pos
< 0)
3338 window_prompting
|= XNegative
;
3341 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3342 window_prompting
|= USPosition
;
3344 window_prompting
|= PPosition
;
3347 if (f
->output_data
.x
->want_fullscreen
!= FULLSCREEN_NONE
)
3352 /* It takes both for some WM:s to place it where we want */
3353 window_prompting
= USPosition
| PPosition
;
3354 x_fullscreen_adjust (f
, &width
, &height
, &top
, &left
);
3357 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3358 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3359 f
->output_data
.x
->left_pos
= left
;
3360 f
->output_data
.x
->top_pos
= top
;
3363 return window_prompting
;
3366 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3369 XSetWMProtocols (dpy
, w
, protocols
, count
)
3376 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3377 if (prop
== None
) return False
;
3378 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3379 (unsigned char *) protocols
, count
);
3382 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3384 #ifdef USE_X_TOOLKIT
3386 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3387 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3388 already be present because of the toolkit (Motif adds some of them,
3389 for example, but Xt doesn't). */
3392 hack_wm_protocols (f
, widget
)
3396 Display
*dpy
= XtDisplay (widget
);
3397 Window w
= XtWindow (widget
);
3398 int need_delete
= 1;
3404 Atom type
, *atoms
= 0;
3406 unsigned long nitems
= 0;
3407 unsigned long bytes_after
;
3409 if ((XGetWindowProperty (dpy
, w
,
3410 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3411 (long)0, (long)100, False
, XA_ATOM
,
3412 &type
, &format
, &nitems
, &bytes_after
,
3413 (unsigned char **) &atoms
)
3415 && format
== 32 && type
== XA_ATOM
)
3419 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3421 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3423 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3426 if (atoms
) XFree ((char *) atoms
);
3432 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3434 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3436 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3438 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3439 XA_ATOM
, 32, PropModeAppend
,
3440 (unsigned char *) props
, count
);
3448 /* Support routines for XIC (X Input Context). */
3452 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3453 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3456 /* Supported XIM styles, ordered by preferenc. */
3458 static XIMStyle supported_xim_styles
[] =
3460 XIMPreeditPosition
| XIMStatusArea
,
3461 XIMPreeditPosition
| XIMStatusNothing
,
3462 XIMPreeditPosition
| XIMStatusNone
,
3463 XIMPreeditNothing
| XIMStatusArea
,
3464 XIMPreeditNothing
| XIMStatusNothing
,
3465 XIMPreeditNothing
| XIMStatusNone
,
3466 XIMPreeditNone
| XIMStatusArea
,
3467 XIMPreeditNone
| XIMStatusNothing
,
3468 XIMPreeditNone
| XIMStatusNone
,
3473 /* Create an X fontset on frame F with base font name
3477 xic_create_xfontset (f
, base_fontname
)
3479 char *base_fontname
;
3482 char **missing_list
;
3486 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3487 base_fontname
, &missing_list
,
3488 &missing_count
, &def_string
);
3490 XFreeStringList (missing_list
);
3492 /* No need to free def_string. */
3497 /* Value is the best input style, given user preferences USER (already
3498 checked to be supported by Emacs), and styles supported by the
3499 input method XIM. */
3502 best_xim_style (user
, xim
)
3508 for (i
= 0; i
< user
->count_styles
; ++i
)
3509 for (j
= 0; j
< xim
->count_styles
; ++j
)
3510 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3511 return user
->supported_styles
[i
];
3513 /* Return the default style. */
3514 return XIMPreeditNothing
| XIMStatusNothing
;
3517 /* Create XIC for frame F. */
3519 static XIMStyle xic_style
;
3522 create_frame_xic (f
)
3527 XFontSet xfs
= NULL
;
3532 xim
= FRAME_X_XIM (f
);
3537 XVaNestedList preedit_attr
;
3538 XVaNestedList status_attr
;
3539 char *base_fontname
;
3542 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3543 spot
.x
= 0; spot
.y
= 1;
3544 /* Create X fontset. */
3545 fontset
= FRAME_FONTSET (f
);
3547 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3550 /* Determine the base fontname from the ASCII font name of
3552 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3553 char *p
= ascii_font
;
3556 for (i
= 0; *p
; p
++)
3559 /* As the font name doesn't conform to XLFD, we can't
3560 modify it to get a suitable base fontname for the
3562 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3565 int len
= strlen (ascii_font
) + 1;
3568 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3577 base_fontname
= (char *) alloca (len
);
3578 bzero (base_fontname
, len
);
3579 strcpy (base_fontname
, "-*-*-");
3580 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3581 strcat (base_fontname
, "*-*-*-*-*-*-*");
3584 xfs
= xic_create_xfontset (f
, base_fontname
);
3586 /* Determine XIC style. */
3589 XIMStyles supported_list
;
3590 supported_list
.count_styles
= (sizeof supported_xim_styles
3591 / sizeof supported_xim_styles
[0]);
3592 supported_list
.supported_styles
= supported_xim_styles
;
3593 xic_style
= best_xim_style (&supported_list
,
3594 FRAME_X_XIM_STYLES (f
));
3597 preedit_attr
= XVaCreateNestedList (0,
3600 FRAME_FOREGROUND_PIXEL (f
),
3602 FRAME_BACKGROUND_PIXEL (f
),
3603 (xic_style
& XIMPreeditPosition
3608 status_attr
= XVaCreateNestedList (0,
3614 FRAME_FOREGROUND_PIXEL (f
),
3616 FRAME_BACKGROUND_PIXEL (f
),
3619 xic
= XCreateIC (xim
,
3620 XNInputStyle
, xic_style
,
3621 XNClientWindow
, FRAME_X_WINDOW(f
),
3622 XNFocusWindow
, FRAME_X_WINDOW(f
),
3623 XNStatusAttributes
, status_attr
,
3624 XNPreeditAttributes
, preedit_attr
,
3626 XFree (preedit_attr
);
3627 XFree (status_attr
);
3630 FRAME_XIC (f
) = xic
;
3631 FRAME_XIC_STYLE (f
) = xic_style
;
3632 FRAME_XIC_FONTSET (f
) = xfs
;
3636 /* Destroy XIC and free XIC fontset of frame F, if any. */
3642 if (FRAME_XIC (f
) == NULL
)
3645 XDestroyIC (FRAME_XIC (f
));
3646 if (FRAME_XIC_FONTSET (f
))
3647 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3649 FRAME_XIC (f
) = NULL
;
3650 FRAME_XIC_FONTSET (f
) = NULL
;
3654 /* Place preedit area for XIC of window W's frame to specified
3655 pixel position X/Y. X and Y are relative to window W. */
3658 xic_set_preeditarea (w
, x
, y
)
3662 struct frame
*f
= XFRAME (w
->frame
);
3666 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3667 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3668 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3669 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3674 /* Place status area for XIC in bottom right corner of frame F.. */
3677 xic_set_statusarea (f
)
3680 XIC xic
= FRAME_XIC (f
);
3685 /* Negotiate geometry of status area. If input method has existing
3686 status area, use its current size. */
3687 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3688 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3689 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3692 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3693 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3696 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3698 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3699 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3703 area
.width
= needed
->width
;
3704 area
.height
= needed
->height
;
3705 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3706 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3707 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3710 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3711 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3716 /* Set X fontset for XIC of frame F, using base font name
3717 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3720 xic_set_xfontset (f
, base_fontname
)
3722 char *base_fontname
;
3727 xfs
= xic_create_xfontset (f
, base_fontname
);
3729 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3730 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3731 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3732 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3733 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3736 if (FRAME_XIC_FONTSET (f
))
3737 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3738 FRAME_XIC_FONTSET (f
) = xfs
;
3741 #endif /* HAVE_X_I18N */
3745 #ifdef USE_X_TOOLKIT
3747 /* Create and set up the X widget for frame F. */
3750 x_window (f
, window_prompting
, minibuffer_only
)
3752 long window_prompting
;
3753 int minibuffer_only
;
3755 XClassHint class_hints
;
3756 XSetWindowAttributes attributes
;
3757 unsigned long attribute_mask
;
3758 Widget shell_widget
;
3760 Widget frame_widget
;
3766 /* Use the resource name as the top-level widget name
3767 for looking up resources. Make a non-Lisp copy
3768 for the window manager, so GC relocation won't bother it.
3770 Elsewhere we specify the window name for the window manager. */
3773 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3774 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3775 strcpy (f
->namebuf
, str
);
3779 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3780 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3781 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3782 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3783 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3784 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3785 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3786 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3787 applicationShellWidgetClass
,
3788 FRAME_X_DISPLAY (f
), al
, ac
);
3790 f
->output_data
.x
->widget
= shell_widget
;
3791 /* maybe_set_screen_title_format (shell_widget); */
3793 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3794 (widget_value
*) NULL
,
3795 shell_widget
, False
,
3799 (lw_callback
) NULL
);
3802 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3803 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3804 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3805 XtSetValues (pane_widget
, al
, ac
);
3806 f
->output_data
.x
->column_widget
= pane_widget
;
3808 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3809 the emacs screen when changing menubar. This reduces flickering. */
3812 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3813 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3814 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3815 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3816 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3817 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3818 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3819 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3820 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3823 f
->output_data
.x
->edit_widget
= frame_widget
;
3825 XtManageChild (frame_widget
);
3827 /* Do some needed geometry management. */
3830 char *tem
, shell_position
[32];
3833 int extra_borders
= 0;
3835 = (f
->output_data
.x
->menubar_widget
3836 ? (f
->output_data
.x
->menubar_widget
->core
.height
3837 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3840 #if 0 /* Experimentally, we now get the right results
3841 for -geometry -0-0 without this. 24 Aug 96, rms. */
3842 if (FRAME_EXTERNAL_MENU_BAR (f
))
3845 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3846 menubar_size
+= ibw
;
3850 f
->output_data
.x
->menubar_height
= menubar_size
;
3853 /* Motif seems to need this amount added to the sizes
3854 specified for the shell widget. The Athena/Lucid widgets don't.
3855 Both conclusions reached experimentally. -- rms. */
3856 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3857 &extra_borders
, NULL
);
3861 /* Convert our geometry parameters into a geometry string
3863 Note that we do not specify here whether the position
3864 is a user-specified or program-specified one.
3865 We pass that information later, in x_wm_set_size_hints. */
3867 int left
= f
->output_data
.x
->left_pos
;
3868 int xneg
= window_prompting
& XNegative
;
3869 int top
= f
->output_data
.x
->top_pos
;
3870 int yneg
= window_prompting
& YNegative
;
3876 if (window_prompting
& USPosition
)
3877 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3878 PIXEL_WIDTH (f
) + extra_borders
,
3879 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3880 (xneg
? '-' : '+'), left
,
3881 (yneg
? '-' : '+'), top
);
3883 sprintf (shell_position
, "=%dx%d",
3884 PIXEL_WIDTH (f
) + extra_borders
,
3885 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3888 len
= strlen (shell_position
) + 1;
3889 /* We don't free this because we don't know whether
3890 it is safe to free it while the frame exists.
3891 It isn't worth the trouble of arranging to free it
3892 when the frame is deleted. */
3893 tem
= (char *) xmalloc (len
);
3894 strncpy (tem
, shell_position
, len
);
3895 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3896 XtSetValues (shell_widget
, al
, ac
);
3899 XtManageChild (pane_widget
);
3900 XtRealizeWidget (shell_widget
);
3902 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3904 validate_x_resource_name ();
3906 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3907 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3908 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3911 FRAME_XIC (f
) = NULL
;
3913 create_frame_xic (f
);
3917 f
->output_data
.x
->wm_hints
.input
= True
;
3918 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3919 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3920 &f
->output_data
.x
->wm_hints
);
3922 hack_wm_protocols (f
, shell_widget
);
3925 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3928 /* Do a stupid property change to force the server to generate a
3929 PropertyNotify event so that the event_stream server timestamp will
3930 be initialized to something relevant to the time we created the window.
3932 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3933 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3934 XA_ATOM
, 32, PropModeAppend
,
3935 (unsigned char*) NULL
, 0);
3937 /* Make all the standard events reach the Emacs frame. */
3938 attributes
.event_mask
= STANDARD_EVENT_SET
;
3943 /* XIM server might require some X events. */
3944 unsigned long fevent
= NoEventMask
;
3945 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3946 attributes
.event_mask
|= fevent
;
3948 #endif /* HAVE_X_I18N */
3950 attribute_mask
= CWEventMask
;
3951 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3952 attribute_mask
, &attributes
);
3954 XtMapWidget (frame_widget
);
3956 /* x_set_name normally ignores requests to set the name if the
3957 requested name is the same as the current name. This is the one
3958 place where that assumption isn't correct; f->name is set, but
3959 the X server hasn't been told. */
3962 int explicit = f
->explicit_name
;
3964 f
->explicit_name
= 0;
3967 x_set_name (f
, name
, explicit);
3970 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3971 f
->output_data
.x
->text_cursor
);
3975 /* This is a no-op, except under Motif. Make sure main areas are
3976 set to something reasonable, in case we get an error later. */
3977 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3980 #else /* not USE_X_TOOLKIT */
3982 /* Create and set up the X window for frame F. */
3989 XClassHint class_hints
;
3990 XSetWindowAttributes attributes
;
3991 unsigned long attribute_mask
;
3993 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3994 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3995 attributes
.bit_gravity
= StaticGravity
;
3996 attributes
.backing_store
= NotUseful
;
3997 attributes
.save_under
= True
;
3998 attributes
.event_mask
= STANDARD_EVENT_SET
;
3999 attributes
.colormap
= FRAME_X_COLORMAP (f
);
4000 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
4005 = XCreateWindow (FRAME_X_DISPLAY (f
),
4006 f
->output_data
.x
->parent_desc
,
4007 f
->output_data
.x
->left_pos
,
4008 f
->output_data
.x
->top_pos
,
4009 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
4010 f
->output_data
.x
->border_width
,
4011 CopyFromParent
, /* depth */
4012 InputOutput
, /* class */
4014 attribute_mask
, &attributes
);
4018 create_frame_xic (f
);
4021 /* XIM server might require some X events. */
4022 unsigned long fevent
= NoEventMask
;
4023 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
4024 attributes
.event_mask
|= fevent
;
4025 attribute_mask
= CWEventMask
;
4026 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4027 attribute_mask
, &attributes
);
4030 #endif /* HAVE_X_I18N */
4032 validate_x_resource_name ();
4034 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
4035 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
4036 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
4038 /* The menubar is part of the ordinary display;
4039 it does not count in addition to the height of the window. */
4040 f
->output_data
.x
->menubar_height
= 0;
4042 /* This indicates that we use the "Passive Input" input model.
4043 Unless we do this, we don't get the Focus{In,Out} events that we
4044 need to draw the cursor correctly. Accursed bureaucrats.
4045 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
4047 f
->output_data
.x
->wm_hints
.input
= True
;
4048 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
4049 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4050 &f
->output_data
.x
->wm_hints
);
4051 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
4053 /* Request "save yourself" and "delete window" commands from wm. */
4056 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
4057 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
4058 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
4061 /* x_set_name normally ignores requests to set the name if the
4062 requested name is the same as the current name. This is the one
4063 place where that assumption isn't correct; f->name is set, but
4064 the X server hasn't been told. */
4067 int explicit = f
->explicit_name
;
4069 f
->explicit_name
= 0;
4072 x_set_name (f
, name
, explicit);
4075 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4076 f
->output_data
.x
->text_cursor
);
4080 if (FRAME_X_WINDOW (f
) == 0)
4081 error ("Unable to create window");
4084 #endif /* not USE_X_TOOLKIT */
4086 /* Handle the icon stuff for this window. Perhaps later we might
4087 want an x_set_icon_position which can be called interactively as
4095 Lisp_Object icon_x
, icon_y
;
4096 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4098 /* Set the position of the icon. Note that twm groups all
4099 icons in an icon window. */
4100 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
4101 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
4102 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
4104 CHECK_NUMBER (icon_x
);
4105 CHECK_NUMBER (icon_y
);
4107 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
4108 error ("Both left and top icon corners of icon must be specified");
4112 if (! EQ (icon_x
, Qunbound
))
4113 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
4115 /* Start up iconic or window? */
4116 x_wm_set_window_state
4117 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
4122 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
4129 /* Make the GCs needed for this window, setting the
4130 background, border and mouse colors; also create the
4131 mouse cursor and the gray border tile. */
4133 static char cursor_bits
[] =
4135 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4136 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4137 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4138 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
4145 XGCValues gc_values
;
4149 /* Create the GCs of this frame.
4150 Note that many default values are used. */
4153 gc_values
.font
= f
->output_data
.x
->font
->fid
;
4154 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
4155 gc_values
.background
= f
->output_data
.x
->background_pixel
;
4156 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
4157 f
->output_data
.x
->normal_gc
4158 = XCreateGC (FRAME_X_DISPLAY (f
),
4160 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
4163 /* Reverse video style. */
4164 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4165 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
4166 f
->output_data
.x
->reverse_gc
4167 = XCreateGC (FRAME_X_DISPLAY (f
),
4169 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
4172 /* Cursor has cursor-color background, background-color foreground. */
4173 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4174 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
4175 gc_values
.fill_style
= FillOpaqueStippled
;
4177 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
4178 FRAME_X_DISPLAY_INFO (f
)->root_window
,
4179 cursor_bits
, 16, 16);
4180 f
->output_data
.x
->cursor_gc
4181 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4182 (GCFont
| GCForeground
| GCBackground
4183 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
4187 f
->output_data
.x
->white_relief
.gc
= 0;
4188 f
->output_data
.x
->black_relief
.gc
= 0;
4190 /* Create the gray border tile used when the pointer is not in
4191 the frame. Since this depends on the frame's pixel values,
4192 this must be done on a per-frame basis. */
4193 f
->output_data
.x
->border_tile
4194 = (XCreatePixmapFromBitmapData
4195 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
4196 gray_bits
, gray_width
, gray_height
,
4197 f
->output_data
.x
->foreground_pixel
,
4198 f
->output_data
.x
->background_pixel
,
4199 DefaultDepth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
))));
4205 /* Free what was was allocated in x_make_gc. */
4211 Display
*dpy
= FRAME_X_DISPLAY (f
);
4215 if (f
->output_data
.x
->normal_gc
)
4217 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
4218 f
->output_data
.x
->normal_gc
= 0;
4221 if (f
->output_data
.x
->reverse_gc
)
4223 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4224 f
->output_data
.x
->reverse_gc
= 0;
4227 if (f
->output_data
.x
->cursor_gc
)
4229 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4230 f
->output_data
.x
->cursor_gc
= 0;
4233 if (f
->output_data
.x
->border_tile
)
4235 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4236 f
->output_data
.x
->border_tile
= 0;
4243 /* Handler for signals raised during x_create_frame and
4244 x_create_top_frame. FRAME is the frame which is partially
4248 unwind_create_frame (frame
)
4251 struct frame
*f
= XFRAME (frame
);
4253 /* If frame is ``official'', nothing to do. */
4254 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4257 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4260 x_free_frame_resources (f
);
4262 /* Check that reference counts are indeed correct. */
4263 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4264 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4272 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4274 doc
: /* Make a new X window, which is called a "frame" in Emacs terms.
4275 Returns an Emacs frame object.
4276 ALIST is an alist of frame parameters.
4277 If the parameters specify that the frame should not have a minibuffer,
4278 and do not specify a specific minibuffer window to use,
4279 then `default-minibuffer-frame' must be a frame whose minibuffer can
4280 be shared by the new frame.
4282 This function is an internal primitive--use `make-frame' instead. */)
4287 Lisp_Object frame
, tem
;
4289 int minibuffer_only
= 0;
4290 long window_prompting
= 0;
4292 int count
= BINDING_STACK_SIZE ();
4293 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4294 Lisp_Object display
;
4295 struct x_display_info
*dpyinfo
= NULL
;
4301 /* Use this general default value to start with
4302 until we know if this frame has a specified name. */
4303 Vx_resource_name
= Vinvocation_name
;
4305 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4306 if (EQ (display
, Qunbound
))
4308 dpyinfo
= check_x_display_info (display
);
4310 kb
= dpyinfo
->kboard
;
4312 kb
= &the_only_kboard
;
4315 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4317 && ! EQ (name
, Qunbound
)
4319 error ("Invalid frame name--not a string or nil");
4322 Vx_resource_name
= name
;
4324 /* See if parent window is specified. */
4325 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4326 if (EQ (parent
, Qunbound
))
4328 if (! NILP (parent
))
4329 CHECK_NUMBER (parent
);
4331 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4332 /* No need to protect DISPLAY because that's not used after passing
4333 it to make_frame_without_minibuffer. */
4335 GCPRO4 (parms
, parent
, name
, frame
);
4336 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4338 if (EQ (tem
, Qnone
) || NILP (tem
))
4339 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4340 else if (EQ (tem
, Qonly
))
4342 f
= make_minibuffer_frame ();
4343 minibuffer_only
= 1;
4345 else if (WINDOWP (tem
))
4346 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4350 XSETFRAME (frame
, f
);
4352 /* Note that X Windows does support scroll bars. */
4353 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4355 f
->output_method
= output_x_window
;
4356 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4357 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4358 f
->output_data
.x
->icon_bitmap
= -1;
4359 f
->output_data
.x
->fontset
= -1;
4360 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4361 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4362 #ifdef USE_TOOLKIT_SCROLL_BARS
4363 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
4364 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
4365 #endif /* USE_TOOLKIT_SCROLL_BARS */
4366 record_unwind_protect (unwind_create_frame
, frame
);
4369 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4371 if (! STRINGP (f
->icon_name
))
4372 f
->icon_name
= Qnil
;
4374 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4376 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4377 dpyinfo_refcount
= dpyinfo
->reference_count
;
4378 #endif /* GLYPH_DEBUG */
4380 FRAME_KBOARD (f
) = kb
;
4383 /* These colors will be set anyway later, but it's important
4384 to get the color reference counts right, so initialize them! */
4387 struct gcpro gcpro1
;
4389 /* Function x_decode_color can signal an error. Make
4390 sure to initialize color slots so that we won't try
4391 to free colors we haven't allocated. */
4392 f
->output_data
.x
->foreground_pixel
= -1;
4393 f
->output_data
.x
->background_pixel
= -1;
4394 f
->output_data
.x
->cursor_pixel
= -1;
4395 f
->output_data
.x
->cursor_foreground_pixel
= -1;
4396 f
->output_data
.x
->border_pixel
= -1;
4397 f
->output_data
.x
->mouse_pixel
= -1;
4399 black
= build_string ("black");
4401 f
->output_data
.x
->foreground_pixel
4402 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4403 f
->output_data
.x
->background_pixel
4404 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4405 f
->output_data
.x
->cursor_pixel
4406 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4407 f
->output_data
.x
->cursor_foreground_pixel
4408 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4409 f
->output_data
.x
->border_pixel
4410 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4411 f
->output_data
.x
->mouse_pixel
4412 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4416 /* Specify the parent under which to make this X window. */
4420 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4421 f
->output_data
.x
->explicit_parent
= 1;
4425 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4426 f
->output_data
.x
->explicit_parent
= 0;
4429 /* Set the name; the functions to which we pass f expect the name to
4431 if (EQ (name
, Qunbound
) || NILP (name
))
4433 f
->name
= build_string (dpyinfo
->x_id_name
);
4434 f
->explicit_name
= 0;
4439 f
->explicit_name
= 1;
4440 /* use the frame's title when getting resources for this frame. */
4441 specbind (Qx_resource_name
, name
);
4444 /* Extract the window parameters from the supplied values
4445 that are needed to determine window geometry. */
4449 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4452 /* First, try whatever font the caller has specified. */
4455 tem
= Fquery_fontset (font
, Qnil
);
4457 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4459 font
= x_new_font (f
, XSTRING (font
)->data
);
4462 /* Try out a font which we hope has bold and italic variations. */
4463 if (!STRINGP (font
))
4464 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4465 if (!STRINGP (font
))
4466 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4467 if (! STRINGP (font
))
4468 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4469 if (! STRINGP (font
))
4470 /* This was formerly the first thing tried, but it finds too many fonts
4471 and takes too long. */
4472 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4473 /* If those didn't work, look for something which will at least work. */
4474 if (! STRINGP (font
))
4475 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4477 if (! STRINGP (font
))
4478 font
= build_string ("fixed");
4480 x_default_parameter (f
, parms
, Qfont
, font
,
4481 "font", "Font", RES_TYPE_STRING
);
4485 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4486 whereby it fails to get any font. */
4487 xlwmenu_default_font
= f
->output_data
.x
->font
;
4490 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4491 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4493 /* This defaults to 1 in order to match xterm. We recognize either
4494 internalBorderWidth or internalBorder (which is what xterm calls
4496 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4500 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4501 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4502 if (! EQ (value
, Qunbound
))
4503 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4506 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4507 "internalBorderWidth", "internalBorderWidth",
4509 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4510 "verticalScrollBars", "ScrollBars",
4513 /* Also do the stuff which must be set before the window exists. */
4514 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4515 "foreground", "Foreground", RES_TYPE_STRING
);
4516 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4517 "background", "Background", RES_TYPE_STRING
);
4518 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4519 "pointerColor", "Foreground", RES_TYPE_STRING
);
4520 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4521 "cursorColor", "Foreground", RES_TYPE_STRING
);
4522 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4523 "borderColor", "BorderColor", RES_TYPE_STRING
);
4524 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4525 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4526 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4527 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4528 x_default_parameter (f
, parms
, Qleft_fringe
, Qnil
,
4529 "leftFringe", "LeftFringe", RES_TYPE_NUMBER
);
4530 x_default_parameter (f
, parms
, Qright_fringe
, Qnil
,
4531 "rightFringe", "RightFringe", RES_TYPE_NUMBER
);
4533 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4534 "scrollBarForeground",
4535 "ScrollBarForeground", 1);
4536 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4537 "scrollBarBackground",
4538 "ScrollBarBackground", 0);
4540 /* Init faces before x_default_parameter is called for scroll-bar
4541 parameters because that function calls x_set_scroll_bar_width,
4542 which calls change_frame_size, which calls Fset_window_buffer,
4543 which runs hooks, which call Fvertical_motion. At the end, we
4544 end up in init_iterator with a null face cache, which should not
4546 init_frame_faces (f
);
4548 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4549 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4550 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4551 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4552 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4553 "bufferPredicate", "BufferPredicate",
4555 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4556 "title", "Title", RES_TYPE_STRING
);
4557 x_default_parameter (f
, parms
, Qwait_for_wm
, Qt
,
4558 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN
);
4559 x_default_parameter (f
, parms
, Qfullscreen
, Qnil
,
4560 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL
);
4562 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4564 /* Add the tool-bar height to the initial frame height so that the
4565 user gets a text display area of the size he specified with -g or
4566 via .Xdefaults. Later changes of the tool-bar height don't
4567 change the frame size. This is done so that users can create
4568 tall Emacs frames without having to guess how tall the tool-bar
4570 if (FRAME_TOOL_BAR_LINES (f
))
4572 int margin
, relief
, bar_height
;
4574 relief
= (tool_bar_button_relief
>= 0
4575 ? tool_bar_button_relief
4576 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4578 if (INTEGERP (Vtool_bar_button_margin
)
4579 && XINT (Vtool_bar_button_margin
) > 0)
4580 margin
= XFASTINT (Vtool_bar_button_margin
);
4581 else if (CONSP (Vtool_bar_button_margin
)
4582 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4583 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4584 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4588 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4589 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4592 /* Compute the size of the X window. */
4593 window_prompting
= x_figure_window_size (f
, parms
);
4595 if (window_prompting
& XNegative
)
4597 if (window_prompting
& YNegative
)
4598 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4600 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4604 if (window_prompting
& YNegative
)
4605 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4607 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4610 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4612 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4613 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4615 /* Create the X widget or window. */
4616 #ifdef USE_X_TOOLKIT
4617 x_window (f
, window_prompting
, minibuffer_only
);
4625 /* Now consider the frame official. */
4626 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4627 Vframe_list
= Fcons (frame
, Vframe_list
);
4629 /* We need to do this after creating the X window, so that the
4630 icon-creation functions can say whose icon they're describing. */
4631 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4632 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4634 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4635 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4636 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4637 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4638 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4639 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4640 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4641 "scrollBarWidth", "ScrollBarWidth",
4644 /* Dimensions, especially f->height, must be done via change_frame_size.
4645 Change will not be effected unless different from the current
4651 SET_FRAME_WIDTH (f
, 0);
4652 change_frame_size (f
, height
, width
, 1, 0, 0);
4654 /* Set up faces after all frame parameters are known. This call
4655 also merges in face attributes specified for new frames. If we
4656 don't do this, the `menu' face for instance won't have the right
4657 colors, and the menu bar won't appear in the specified colors for
4659 call1 (Qface_set_after_frame_default
, frame
);
4661 #ifdef USE_X_TOOLKIT
4662 /* Create the menu bar. */
4663 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4665 /* If this signals an error, we haven't set size hints for the
4666 frame and we didn't make it visible. */
4667 initialize_frame_menubar (f
);
4669 /* This is a no-op, except under Motif where it arranges the
4670 main window for the widgets on it. */
4671 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4672 f
->output_data
.x
->menubar_widget
,
4673 f
->output_data
.x
->edit_widget
);
4675 #endif /* USE_X_TOOLKIT */
4677 /* Tell the server what size and position, etc, we want, and how
4678 badly we want them. This should be done after we have the menu
4679 bar so that its size can be taken into account. */
4681 x_wm_set_size_hint (f
, window_prompting
, 0);
4684 /* Make the window appear on the frame and enable display, unless
4685 the caller says not to. However, with explicit parent, Emacs
4686 cannot control visibility, so don't try. */
4687 if (! f
->output_data
.x
->explicit_parent
)
4689 Lisp_Object visibility
;
4691 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4693 if (EQ (visibility
, Qunbound
))
4696 if (EQ (visibility
, Qicon
))
4697 x_iconify_frame (f
);
4698 else if (! NILP (visibility
))
4699 x_make_frame_visible (f
);
4701 /* Must have been Qnil. */
4707 /* Make sure windows on this frame appear in calls to next-window
4708 and similar functions. */
4709 Vwindow_list
= Qnil
;
4711 return unbind_to (count
, frame
);
4715 /* FRAME is used only to get a handle on the X display. We don't pass the
4716 display info directly because we're called from frame.c, which doesn't
4717 know about that structure. */
4720 x_get_focus_frame (frame
)
4721 struct frame
*frame
;
4723 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4725 if (! dpyinfo
->x_focus_frame
)
4728 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4733 /* In certain situations, when the window manager follows a
4734 click-to-focus policy, there seems to be no way around calling
4735 XSetInputFocus to give another frame the input focus .
4737 In an ideal world, XSetInputFocus should generally be avoided so
4738 that applications don't interfere with the window manager's focus
4739 policy. But I think it's okay to use when it's clearly done
4740 following a user-command. */
4742 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4743 doc
: /* Set the input focus to FRAME.
4744 FRAME nil means use the selected frame. */)
4748 struct frame
*f
= check_x_frame (frame
);
4749 Display
*dpy
= FRAME_X_DISPLAY (f
);
4753 count
= x_catch_errors (dpy
);
4754 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4755 RevertToParent
, CurrentTime
);
4756 x_uncatch_errors (dpy
, count
);
4763 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4764 doc
: /* Internal function called by `color-defined-p', which see. */)
4766 Lisp_Object color
, frame
;
4769 FRAME_PTR f
= check_x_frame (frame
);
4771 CHECK_STRING (color
);
4773 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4779 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4780 doc
: /* Internal function called by `color-values', which see. */)
4782 Lisp_Object color
, frame
;
4785 FRAME_PTR f
= check_x_frame (frame
);
4787 CHECK_STRING (color
);
4789 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4793 rgb
[0] = make_number (foo
.red
);
4794 rgb
[1] = make_number (foo
.green
);
4795 rgb
[2] = make_number (foo
.blue
);
4796 return Flist (3, rgb
);
4802 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4803 doc
: /* Internal function called by `display-color-p', which see. */)
4805 Lisp_Object display
;
4807 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4809 if (dpyinfo
->n_planes
<= 2)
4812 switch (dpyinfo
->visual
->class)
4825 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4827 doc
: /* Return t if the X display supports shades of gray.
4828 Note that color displays do support shades of gray.
4829 The optional argument DISPLAY specifies which display to ask about.
4830 DISPLAY should be either a frame or a display name (a string).
4831 If omitted or nil, that stands for the selected frame's display. */)
4833 Lisp_Object display
;
4835 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4837 if (dpyinfo
->n_planes
<= 1)
4840 switch (dpyinfo
->visual
->class)
4855 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4857 doc
: /* Returns the width in pixels of the X display DISPLAY.
4858 The optional argument DISPLAY specifies which display to ask about.
4859 DISPLAY should be either a frame or a display name (a string).
4860 If omitted or nil, that stands for the selected frame's display. */)
4862 Lisp_Object display
;
4864 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4866 return make_number (dpyinfo
->width
);
4869 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4870 Sx_display_pixel_height
, 0, 1, 0,
4871 doc
: /* Returns the height in pixels of the X display DISPLAY.
4872 The optional argument DISPLAY specifies which display to ask about.
4873 DISPLAY should be either a frame or a display name (a string).
4874 If omitted or nil, that stands for the selected frame's display. */)
4876 Lisp_Object display
;
4878 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4880 return make_number (dpyinfo
->height
);
4883 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4885 doc
: /* Returns the number of bitplanes of the X display DISPLAY.
4886 The optional argument DISPLAY specifies which display to ask about.
4887 DISPLAY should be either a frame or a display name (a string).
4888 If omitted or nil, that stands for the selected frame's display. */)
4890 Lisp_Object display
;
4892 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4894 return make_number (dpyinfo
->n_planes
);
4897 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4899 doc
: /* Returns the number of color cells of the X display DISPLAY.
4900 The optional argument DISPLAY specifies which display to ask about.
4901 DISPLAY should be either a frame or a display name (a string).
4902 If omitted or nil, that stands for the selected frame's display. */)
4904 Lisp_Object display
;
4906 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4908 return make_number (DisplayCells (dpyinfo
->display
,
4909 XScreenNumberOfScreen (dpyinfo
->screen
)));
4912 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4913 Sx_server_max_request_size
,
4915 doc
: /* Returns the maximum request size of the X server of display DISPLAY.
4916 The optional argument DISPLAY specifies which display to ask about.
4917 DISPLAY should be either a frame or a display name (a string).
4918 If omitted or nil, that stands for the selected frame's display. */)
4920 Lisp_Object display
;
4922 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4924 return make_number (MAXREQUEST (dpyinfo
->display
));
4927 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4928 doc
: /* Returns the vendor ID string of the X server of display DISPLAY.
4929 The optional argument DISPLAY specifies which display to ask about.
4930 DISPLAY should be either a frame or a display name (a string).
4931 If omitted or nil, that stands for the selected frame's display. */)
4933 Lisp_Object display
;
4935 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4936 char *vendor
= ServerVendor (dpyinfo
->display
);
4938 if (! vendor
) vendor
= "";
4939 return build_string (vendor
);
4942 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4943 doc
: /* Returns the version numbers of the X server of display DISPLAY.
4944 The value is a list of three integers: the major and minor
4945 version numbers of the X Protocol in use, and the vendor-specific release
4946 number. See also the function `x-server-vendor'.
4948 The optional argument DISPLAY specifies which display to ask about.
4949 DISPLAY should be either a frame or a display name (a string).
4950 If omitted or nil, that stands for the selected frame's display. */)
4952 Lisp_Object display
;
4954 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4955 Display
*dpy
= dpyinfo
->display
;
4957 return Fcons (make_number (ProtocolVersion (dpy
)),
4958 Fcons (make_number (ProtocolRevision (dpy
)),
4959 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4962 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4963 doc
: /* Return the number of screens on the X server of display DISPLAY.
4964 The optional argument DISPLAY specifies which display to ask about.
4965 DISPLAY should be either a frame or a display name (a string).
4966 If omitted or nil, that stands for the selected frame's display. */)
4968 Lisp_Object display
;
4970 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4972 return make_number (ScreenCount (dpyinfo
->display
));
4975 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4976 doc
: /* Return the height in millimeters of the X display DISPLAY.
4977 The optional argument DISPLAY specifies which display to ask about.
4978 DISPLAY should be either a frame or a display name (a string).
4979 If omitted or nil, that stands for the selected frame's display. */)
4981 Lisp_Object display
;
4983 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4985 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4988 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4989 doc
: /* Return the width in millimeters of the X display DISPLAY.
4990 The optional argument DISPLAY specifies which display to ask about.
4991 DISPLAY should be either a frame or a display name (a string).
4992 If omitted or nil, that stands for the selected frame's display. */)
4994 Lisp_Object display
;
4996 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4998 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
5001 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
5002 Sx_display_backing_store
, 0, 1, 0,
5003 doc
: /* Returns an indication of whether X display DISPLAY does backing store.
5004 The value may be `always', `when-mapped', or `not-useful'.
5005 The optional argument DISPLAY specifies which display to ask about.
5006 DISPLAY should be either a frame or a display name (a string).
5007 If omitted or nil, that stands for the selected frame's display. */)
5009 Lisp_Object display
;
5011 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5014 switch (DoesBackingStore (dpyinfo
->screen
))
5017 result
= intern ("always");
5021 result
= intern ("when-mapped");
5025 result
= intern ("not-useful");
5029 error ("Strange value for BackingStore parameter of screen");
5036 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
5037 Sx_display_visual_class
, 0, 1, 0,
5038 doc
: /* Return the visual class of the X display DISPLAY.
5039 The value is one of the symbols `static-gray', `gray-scale',
5040 `static-color', `pseudo-color', `true-color', or `direct-color'.
5042 The optional argument DISPLAY specifies which display to ask about.
5043 DISPLAY should be either a frame or a display name (a string).
5044 If omitted or nil, that stands for the selected frame's display. */)
5046 Lisp_Object display
;
5048 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5051 switch (dpyinfo
->visual
->class)
5054 result
= intern ("static-gray");
5057 result
= intern ("gray-scale");
5060 result
= intern ("static-color");
5063 result
= intern ("pseudo-color");
5066 result
= intern ("true-color");
5069 result
= intern ("direct-color");
5072 error ("Display has an unknown visual class");
5079 DEFUN ("x-display-save-under", Fx_display_save_under
,
5080 Sx_display_save_under
, 0, 1, 0,
5081 doc
: /* Returns t if the X display DISPLAY supports the save-under feature.
5082 The optional argument DISPLAY specifies which display to ask about.
5083 DISPLAY should be either a frame or a display name (a string).
5084 If omitted or nil, that stands for the selected frame's display. */)
5086 Lisp_Object display
;
5088 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5090 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
5098 register struct frame
*f
;
5100 return PIXEL_WIDTH (f
);
5105 register struct frame
*f
;
5107 return PIXEL_HEIGHT (f
);
5112 register struct frame
*f
;
5114 return FONT_WIDTH (f
->output_data
.x
->font
);
5119 register struct frame
*f
;
5121 return f
->output_data
.x
->line_height
;
5126 register struct frame
*f
;
5128 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
5133 /************************************************************************
5135 ************************************************************************/
5138 /* Mapping visual names to visuals. */
5140 static struct visual_class
5147 {"StaticGray", StaticGray
},
5148 {"GrayScale", GrayScale
},
5149 {"StaticColor", StaticColor
},
5150 {"PseudoColor", PseudoColor
},
5151 {"TrueColor", TrueColor
},
5152 {"DirectColor", DirectColor
},
5157 #ifndef HAVE_XSCREENNUMBEROFSCREEN
5159 /* Value is the screen number of screen SCR. This is a substitute for
5160 the X function with the same name when that doesn't exist. */
5163 XScreenNumberOfScreen (scr
)
5164 register Screen
*scr
;
5166 Display
*dpy
= scr
->display
;
5169 for (i
= 0; i
< dpy
->nscreens
; ++i
)
5170 if (scr
== dpy
->screens
+ i
)
5176 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5179 /* Select the visual that should be used on display DPYINFO. Set
5180 members of DPYINFO appropriately. Called from x_term_init. */
5183 select_visual (dpyinfo
)
5184 struct x_display_info
*dpyinfo
;
5186 Display
*dpy
= dpyinfo
->display
;
5187 Screen
*screen
= dpyinfo
->screen
;
5190 /* See if a visual is specified. */
5191 value
= display_x_get_resource (dpyinfo
,
5192 build_string ("visualClass"),
5193 build_string ("VisualClass"),
5195 if (STRINGP (value
))
5197 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
5198 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
5199 depth, a decimal number. NAME is compared with case ignored. */
5200 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
5205 strcpy (s
, XSTRING (value
)->data
);
5206 dash
= index (s
, '-');
5209 dpyinfo
->n_planes
= atoi (dash
+ 1);
5213 /* We won't find a matching visual with depth 0, so that
5214 an error will be printed below. */
5215 dpyinfo
->n_planes
= 0;
5217 /* Determine the visual class. */
5218 for (i
= 0; visual_classes
[i
].name
; ++i
)
5219 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
5221 class = visual_classes
[i
].class;
5225 /* Look up a matching visual for the specified class. */
5227 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
5228 dpyinfo
->n_planes
, class, &vinfo
))
5229 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
5231 dpyinfo
->visual
= vinfo
.visual
;
5236 XVisualInfo
*vinfo
, vinfo_template
;
5238 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
5241 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
5243 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
5245 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5246 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
5247 &vinfo_template
, &n_visuals
);
5249 fatal ("Can't get proper X visual info");
5251 dpyinfo
->n_planes
= vinfo
->depth
;
5252 XFree ((char *) vinfo
);
5257 /* Return the X display structure for the display named NAME.
5258 Open a new connection if necessary. */
5260 struct x_display_info
*
5261 x_display_info_for_name (name
)
5265 struct x_display_info
*dpyinfo
;
5267 CHECK_STRING (name
);
5269 if (! EQ (Vwindow_system
, intern ("x")))
5270 error ("Not using X Windows");
5272 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5274 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5277 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5282 /* Use this general default value to start with. */
5283 Vx_resource_name
= Vinvocation_name
;
5285 validate_x_resource_name ();
5287 dpyinfo
= x_term_init (name
, (char *)0,
5288 (char *) XSTRING (Vx_resource_name
)->data
);
5291 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5294 XSETFASTINT (Vwindow_system_version
, 11);
5300 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5302 doc
: /* Open a connection to an X server.
5303 DISPLAY is the name of the display to connect to.
5304 Optional second arg XRM-STRING is a string of resources in xrdb format.
5305 If the optional third arg MUST-SUCCEED is non-nil,
5306 terminate Emacs if we can't open the connection. */)
5307 (display
, xrm_string
, must_succeed
)
5308 Lisp_Object display
, xrm_string
, must_succeed
;
5310 unsigned char *xrm_option
;
5311 struct x_display_info
*dpyinfo
;
5313 CHECK_STRING (display
);
5314 if (! NILP (xrm_string
))
5315 CHECK_STRING (xrm_string
);
5317 if (! EQ (Vwindow_system
, intern ("x")))
5318 error ("Not using X Windows");
5320 if (! NILP (xrm_string
))
5321 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5323 xrm_option
= (unsigned char *) 0;
5325 validate_x_resource_name ();
5327 /* This is what opens the connection and sets x_current_display.
5328 This also initializes many symbols, such as those used for input. */
5329 dpyinfo
= x_term_init (display
, xrm_option
,
5330 (char *) XSTRING (Vx_resource_name
)->data
);
5334 if (!NILP (must_succeed
))
5335 fatal ("Cannot connect to X server %s.\n\
5336 Check the DISPLAY environment variable or use `-d'.\n\
5337 Also use the `xhost' program to verify that it is set to permit\n\
5338 connections from your machine.\n",
5339 XSTRING (display
)->data
);
5341 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5346 XSETFASTINT (Vwindow_system_version
, 11);
5350 DEFUN ("x-close-connection", Fx_close_connection
,
5351 Sx_close_connection
, 1, 1, 0,
5352 doc
: /* Close the connection to DISPLAY's X server.
5353 For DISPLAY, specify either a frame or a display name (a string).
5354 If DISPLAY is nil, that stands for the selected frame's display. */)
5356 Lisp_Object display
;
5358 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5361 if (dpyinfo
->reference_count
> 0)
5362 error ("Display still has frames on it");
5365 /* Free the fonts in the font table. */
5366 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5367 if (dpyinfo
->font_table
[i
].name
)
5369 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5370 xfree (dpyinfo
->font_table
[i
].full_name
);
5371 xfree (dpyinfo
->font_table
[i
].name
);
5372 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5375 x_destroy_all_bitmaps (dpyinfo
);
5376 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5378 #ifdef USE_X_TOOLKIT
5379 XtCloseDisplay (dpyinfo
->display
);
5381 XCloseDisplay (dpyinfo
->display
);
5384 x_delete_display (dpyinfo
);
5390 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5391 doc
: /* Return the list of display names that Emacs has connections to. */)
5394 Lisp_Object tail
, result
;
5397 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5398 result
= Fcons (XCAR (XCAR (tail
)), result
);
5403 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5404 doc
: /* If ON is non-nil, report X errors as soon as the erring request is made.
5405 If ON is nil, allow buffering of requests.
5406 Turning on synchronization prohibits the Xlib routines from buffering
5407 requests and seriously degrades performance, but makes debugging much
5409 The optional second argument DISPLAY specifies which display to act on.
5410 DISPLAY should be either a frame or a display name (a string).
5411 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
5413 Lisp_Object display
, on
;
5415 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5417 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5422 /* Wait for responses to all X commands issued so far for frame F. */
5429 XSync (FRAME_X_DISPLAY (f
), False
);
5434 /***********************************************************************
5436 ***********************************************************************/
5438 /* Value is the number of elements of vector VECTOR. */
5440 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5442 /* List of supported image types. Use define_image_type to add new
5443 types. Use lookup_image_type to find a type for a given symbol. */
5445 static struct image_type
*image_types
;
5447 /* The symbol `image' which is the car of the lists used to represent
5450 extern Lisp_Object Qimage
;
5452 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5458 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5459 extern Lisp_Object QCdata
;
5460 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5461 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5462 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5464 /* Other symbols. */
5466 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5468 /* Time in seconds after which images should be removed from the cache
5469 if not displayed. */
5471 Lisp_Object Vimage_cache_eviction_delay
;
5473 /* Function prototypes. */
5475 static void define_image_type
P_ ((struct image_type
*type
));
5476 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5477 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5478 static void x_laplace
P_ ((struct frame
*, struct image
*));
5479 static void x_emboss
P_ ((struct frame
*, struct image
*));
5480 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5484 /* Define a new image type from TYPE. This adds a copy of TYPE to
5485 image_types and adds the symbol *TYPE->type to Vimage_types. */
5488 define_image_type (type
)
5489 struct image_type
*type
;
5491 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5492 The initialized data segment is read-only. */
5493 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5494 bcopy (type
, p
, sizeof *p
);
5495 p
->next
= image_types
;
5497 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5501 /* Look up image type SYMBOL, and return a pointer to its image_type
5502 structure. Value is null if SYMBOL is not a known image type. */
5504 static INLINE
struct image_type
*
5505 lookup_image_type (symbol
)
5508 struct image_type
*type
;
5510 for (type
= image_types
; type
; type
= type
->next
)
5511 if (EQ (symbol
, *type
->type
))
5518 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5519 valid image specification is a list whose car is the symbol
5520 `image', and whose rest is a property list. The property list must
5521 contain a value for key `:type'. That value must be the name of a
5522 supported image type. The rest of the property list depends on the
5526 valid_image_p (object
)
5531 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5535 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
5536 if (EQ (XCAR (tem
), QCtype
))
5539 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
5541 struct image_type
*type
;
5542 type
= lookup_image_type (XCAR (tem
));
5544 valid_p
= type
->valid_p (object
);
5555 /* Log error message with format string FORMAT and argument ARG.
5556 Signaling an error, e.g. when an image cannot be loaded, is not a
5557 good idea because this would interrupt redisplay, and the error
5558 message display would lead to another redisplay. This function
5559 therefore simply displays a message. */
5562 image_error (format
, arg1
, arg2
)
5564 Lisp_Object arg1
, arg2
;
5566 add_to_log (format
, arg1
, arg2
);
5571 /***********************************************************************
5572 Image specifications
5573 ***********************************************************************/
5575 enum image_value_type
5577 IMAGE_DONT_CHECK_VALUE_TYPE
,
5579 IMAGE_STRING_OR_NIL_VALUE
,
5581 IMAGE_POSITIVE_INTEGER_VALUE
,
5582 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5583 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5585 IMAGE_INTEGER_VALUE
,
5586 IMAGE_FUNCTION_VALUE
,
5591 /* Structure used when parsing image specifications. */
5593 struct image_keyword
5595 /* Name of keyword. */
5598 /* The type of value allowed. */
5599 enum image_value_type type
;
5601 /* Non-zero means key must be present. */
5604 /* Used to recognize duplicate keywords in a property list. */
5607 /* The value that was found. */
5612 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5614 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5617 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5618 has the format (image KEYWORD VALUE ...). One of the keyword/
5619 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5620 image_keywords structures of size NKEYWORDS describing other
5621 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5624 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5626 struct image_keyword
*keywords
;
5633 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5636 plist
= XCDR (spec
);
5637 while (CONSP (plist
))
5639 Lisp_Object key
, value
;
5641 /* First element of a pair must be a symbol. */
5643 plist
= XCDR (plist
);
5647 /* There must follow a value. */
5650 value
= XCAR (plist
);
5651 plist
= XCDR (plist
);
5653 /* Find key in KEYWORDS. Error if not found. */
5654 for (i
= 0; i
< nkeywords
; ++i
)
5655 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5661 /* Record that we recognized the keyword. If a keywords
5662 was found more than once, it's an error. */
5663 keywords
[i
].value
= value
;
5664 ++keywords
[i
].count
;
5666 if (keywords
[i
].count
> 1)
5669 /* Check type of value against allowed type. */
5670 switch (keywords
[i
].type
)
5672 case IMAGE_STRING_VALUE
:
5673 if (!STRINGP (value
))
5677 case IMAGE_STRING_OR_NIL_VALUE
:
5678 if (!STRINGP (value
) && !NILP (value
))
5682 case IMAGE_SYMBOL_VALUE
:
5683 if (!SYMBOLP (value
))
5687 case IMAGE_POSITIVE_INTEGER_VALUE
:
5688 if (!INTEGERP (value
) || XINT (value
) <= 0)
5692 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5693 if (INTEGERP (value
) && XINT (value
) >= 0)
5696 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5697 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5701 case IMAGE_ASCENT_VALUE
:
5702 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5704 else if (INTEGERP (value
)
5705 && XINT (value
) >= 0
5706 && XINT (value
) <= 100)
5710 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5711 if (!INTEGERP (value
) || XINT (value
) < 0)
5715 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5718 case IMAGE_FUNCTION_VALUE
:
5719 value
= indirect_function (value
);
5721 || COMPILEDP (value
)
5722 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5726 case IMAGE_NUMBER_VALUE
:
5727 if (!INTEGERP (value
) && !FLOATP (value
))
5731 case IMAGE_INTEGER_VALUE
:
5732 if (!INTEGERP (value
))
5736 case IMAGE_BOOL_VALUE
:
5737 if (!NILP (value
) && !EQ (value
, Qt
))
5746 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5750 /* Check that all mandatory fields are present. */
5751 for (i
= 0; i
< nkeywords
; ++i
)
5752 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5755 return NILP (plist
);
5759 /* Return the value of KEY in image specification SPEC. Value is nil
5760 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5761 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5764 image_spec_value (spec
, key
, found
)
5765 Lisp_Object spec
, key
;
5770 xassert (valid_image_p (spec
));
5772 for (tail
= XCDR (spec
);
5773 CONSP (tail
) && CONSP (XCDR (tail
));
5774 tail
= XCDR (XCDR (tail
)))
5776 if (EQ (XCAR (tail
), key
))
5780 return XCAR (XCDR (tail
));
5790 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5791 doc
: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
5792 PIXELS non-nil means return the size in pixels, otherwise return the
5793 size in canonical character units.
5794 FRAME is the frame on which the image will be displayed. FRAME nil
5795 or omitted means use the selected frame. */)
5796 (spec
, pixels
, frame
)
5797 Lisp_Object spec
, pixels
, frame
;
5802 if (valid_image_p (spec
))
5804 struct frame
*f
= check_x_frame (frame
);
5805 int id
= lookup_image (f
, spec
);
5806 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5807 int width
= img
->width
+ 2 * img
->hmargin
;
5808 int height
= img
->height
+ 2 * img
->vmargin
;
5811 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5812 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5814 size
= Fcons (make_number (width
), make_number (height
));
5817 error ("Invalid image specification");
5823 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5824 doc
: /* Return t if image SPEC has a mask bitmap.
5825 FRAME is the frame on which the image will be displayed. FRAME nil
5826 or omitted means use the selected frame. */)
5828 Lisp_Object spec
, frame
;
5833 if (valid_image_p (spec
))
5835 struct frame
*f
= check_x_frame (frame
);
5836 int id
= lookup_image (f
, spec
);
5837 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5842 error ("Invalid image specification");
5849 /***********************************************************************
5850 Image type independent image structures
5851 ***********************************************************************/
5853 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5854 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5857 /* Allocate and return a new image structure for image specification
5858 SPEC. SPEC has a hash value of HASH. */
5860 static struct image
*
5861 make_image (spec
, hash
)
5865 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5867 xassert (valid_image_p (spec
));
5868 bzero (img
, sizeof *img
);
5869 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5870 xassert (img
->type
!= NULL
);
5872 img
->data
.lisp_val
= Qnil
;
5873 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5879 /* Free image IMG which was used on frame F, including its resources. */
5888 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5890 /* Remove IMG from the hash table of its cache. */
5892 img
->prev
->next
= img
->next
;
5894 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5897 img
->next
->prev
= img
->prev
;
5899 c
->images
[img
->id
] = NULL
;
5901 /* Free resources, then free IMG. */
5902 img
->type
->free (f
, img
);
5908 /* Prepare image IMG for display on frame F. Must be called before
5909 drawing an image. */
5912 prepare_image_for_display (f
, img
)
5918 /* We're about to display IMG, so set its timestamp to `now'. */
5920 img
->timestamp
= EMACS_SECS (t
);
5922 /* If IMG doesn't have a pixmap yet, load it now, using the image
5923 type dependent loader function. */
5924 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5925 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5929 /* Value is the number of pixels for the ascent of image IMG when
5930 drawn in face FACE. */
5933 image_ascent (img
, face
)
5937 int height
= img
->height
+ img
->vmargin
;
5940 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5943 /* This expression is arranged so that if the image can't be
5944 exactly centered, it will be moved slightly up. This is
5945 because a typical font is `top-heavy' (due to the presence
5946 uppercase letters), so the image placement should err towards
5947 being top-heavy too. It also just generally looks better. */
5948 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5950 ascent
= height
/ 2;
5953 ascent
= height
* img
->ascent
/ 100.0;
5959 /* Image background colors. */
5961 static unsigned long
5962 four_corners_best (ximg
, width
, height
)
5964 unsigned long width
, height
;
5966 unsigned long corners
[4], best
;
5969 /* Get the colors at the corners of ximg. */
5970 corners
[0] = XGetPixel (ximg
, 0, 0);
5971 corners
[1] = XGetPixel (ximg
, width
- 1, 0);
5972 corners
[2] = XGetPixel (ximg
, width
- 1, height
- 1);
5973 corners
[3] = XGetPixel (ximg
, 0, height
- 1);
5975 /* Choose the most frequently found color as background. */
5976 for (i
= best_count
= 0; i
< 4; ++i
)
5980 for (j
= n
= 0; j
< 4; ++j
)
5981 if (corners
[i
] == corners
[j
])
5985 best
= corners
[i
], best_count
= n
;
5991 /* Return the `background' field of IMG. If IMG doesn't have one yet,
5992 it is guessed heuristically. If non-zero, XIMG is an existing XImage
5993 object to use for the heuristic. */
5996 image_background (img
, f
, ximg
)
6001 if (! img
->background_valid
)
6002 /* IMG doesn't have a background yet, try to guess a reasonable value. */
6004 int free_ximg
= !ximg
;
6007 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
6008 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
6010 img
->background
= four_corners_best (ximg
, img
->width
, img
->height
);
6013 XDestroyImage (ximg
);
6015 img
->background_valid
= 1;
6018 return img
->background
;
6021 /* Return the `background_transparent' field of IMG. If IMG doesn't
6022 have one yet, it is guessed heuristically. If non-zero, MASK is an
6023 existing XImage object to use for the heuristic. */
6026 image_background_transparent (img
, f
, mask
)
6031 if (! img
->background_transparent_valid
)
6032 /* IMG doesn't have a background yet, try to guess a reasonable value. */
6036 int free_mask
= !mask
;
6039 mask
= XGetImage (FRAME_X_DISPLAY (f
), img
->mask
,
6040 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
6042 img
->background_transparent
6043 = !four_corners_best (mask
, img
->width
, img
->height
);
6046 XDestroyImage (mask
);
6049 img
->background_transparent
= 0;
6051 img
->background_transparent_valid
= 1;
6054 return img
->background_transparent
;
6058 /***********************************************************************
6059 Helper functions for X image types
6060 ***********************************************************************/
6062 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
6064 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
6065 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
6067 Lisp_Object color_name
,
6068 unsigned long dflt
));
6071 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
6072 free the pixmap if any. MASK_P non-zero means clear the mask
6073 pixmap if any. COLORS_P non-zero means free colors allocated for
6074 the image, if any. */
6077 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
6080 int pixmap_p
, mask_p
, colors_p
;
6082 if (pixmap_p
&& img
->pixmap
)
6084 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
6086 img
->background_valid
= 0;
6089 if (mask_p
&& img
->mask
)
6091 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6093 img
->background_transparent_valid
= 0;
6096 if (colors_p
&& img
->ncolors
)
6098 x_free_colors (f
, img
->colors
, img
->ncolors
);
6099 xfree (img
->colors
);
6105 /* Free X resources of image IMG which is used on frame F. */
6108 x_clear_image (f
, img
)
6113 x_clear_image_1 (f
, img
, 1, 1, 1);
6118 /* Allocate color COLOR_NAME for image IMG on frame F. If color
6119 cannot be allocated, use DFLT. Add a newly allocated color to
6120 IMG->colors, so that it can be freed again. Value is the pixel
6123 static unsigned long
6124 x_alloc_image_color (f
, img
, color_name
, dflt
)
6127 Lisp_Object color_name
;
6131 unsigned long result
;
6133 xassert (STRINGP (color_name
));
6135 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
6137 /* This isn't called frequently so we get away with simply
6138 reallocating the color vector to the needed size, here. */
6141 (unsigned long *) xrealloc (img
->colors
,
6142 img
->ncolors
* sizeof *img
->colors
);
6143 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
6144 result
= color
.pixel
;
6154 /***********************************************************************
6156 ***********************************************************************/
6158 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
6159 static void postprocess_image
P_ ((struct frame
*, struct image
*));
6162 /* Return a new, initialized image cache that is allocated from the
6163 heap. Call free_image_cache to free an image cache. */
6165 struct image_cache
*
6168 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
6171 bzero (c
, sizeof *c
);
6173 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
6174 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
6175 c
->buckets
= (struct image
**) xmalloc (size
);
6176 bzero (c
->buckets
, size
);
6181 /* Free image cache of frame F. Be aware that X frames share images
6185 free_image_cache (f
)
6188 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6193 /* Cache should not be referenced by any frame when freed. */
6194 xassert (c
->refcount
== 0);
6196 for (i
= 0; i
< c
->used
; ++i
)
6197 free_image (f
, c
->images
[i
]);
6201 FRAME_X_IMAGE_CACHE (f
) = NULL
;
6206 /* Clear image cache of frame F. FORCE_P non-zero means free all
6207 images. FORCE_P zero means clear only images that haven't been
6208 displayed for some time. Should be called from time to time to
6209 reduce the number of loaded images. If image-eviction-seconds is
6210 non-nil, this frees images in the cache which weren't displayed for
6211 at least that many seconds. */
6214 clear_image_cache (f
, force_p
)
6218 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6220 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
6227 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
6229 /* Block input so that we won't be interrupted by a SIGIO
6230 while being in an inconsistent state. */
6233 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
6235 struct image
*img
= c
->images
[i
];
6237 && (force_p
|| img
->timestamp
< old
))
6239 free_image (f
, img
);
6244 /* We may be clearing the image cache because, for example,
6245 Emacs was iconified for a longer period of time. In that
6246 case, current matrices may still contain references to
6247 images freed above. So, clear these matrices. */
6250 Lisp_Object tail
, frame
;
6252 FOR_EACH_FRAME (tail
, frame
)
6254 struct frame
*f
= XFRAME (frame
);
6256 && FRAME_X_IMAGE_CACHE (f
) == c
)
6257 clear_current_matrices (f
);
6260 ++windows_or_buffers_changed
;
6268 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
6270 doc
: /* Clear the image cache of FRAME.
6271 FRAME nil or omitted means use the selected frame.
6272 FRAME t means clear the image caches of all frames. */)
6280 FOR_EACH_FRAME (tail
, frame
)
6281 if (FRAME_X_P (XFRAME (frame
)))
6282 clear_image_cache (XFRAME (frame
), 1);
6285 clear_image_cache (check_x_frame (frame
), 1);
6291 /* Compute masks and transform image IMG on frame F, as specified
6292 by the image's specification, */
6295 postprocess_image (f
, img
)
6299 /* Manipulation of the image's mask. */
6302 Lisp_Object conversion
, spec
;
6307 /* `:heuristic-mask t'
6309 means build a mask heuristically.
6310 `:heuristic-mask (R G B)'
6311 `:mask (heuristic (R G B))'
6312 means build a mask from color (R G B) in the
6315 means remove a mask, if any. */
6317 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6319 x_build_heuristic_mask (f
, img
, mask
);
6324 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6326 if (EQ (mask
, Qheuristic
))
6327 x_build_heuristic_mask (f
, img
, Qt
);
6328 else if (CONSP (mask
)
6329 && EQ (XCAR (mask
), Qheuristic
))
6331 if (CONSP (XCDR (mask
)))
6332 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6334 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6336 else if (NILP (mask
) && found_p
&& img
->mask
)
6338 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6344 /* Should we apply an image transformation algorithm? */
6345 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6346 if (EQ (conversion
, Qdisabled
))
6347 x_disable_image (f
, img
);
6348 else if (EQ (conversion
, Qlaplace
))
6350 else if (EQ (conversion
, Qemboss
))
6352 else if (CONSP (conversion
)
6353 && EQ (XCAR (conversion
), Qedge_detection
))
6356 tem
= XCDR (conversion
);
6358 x_edge_detection (f
, img
,
6359 Fplist_get (tem
, QCmatrix
),
6360 Fplist_get (tem
, QCcolor_adjustment
));
6366 /* Return the id of image with Lisp specification SPEC on frame F.
6367 SPEC must be a valid Lisp image specification (see valid_image_p). */
6370 lookup_image (f
, spec
)
6374 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6378 struct gcpro gcpro1
;
6381 /* F must be a window-system frame, and SPEC must be a valid image
6383 xassert (FRAME_WINDOW_P (f
));
6384 xassert (valid_image_p (spec
));
6388 /* Look up SPEC in the hash table of the image cache. */
6389 hash
= sxhash (spec
, 0);
6390 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6392 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6393 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6396 /* If not found, create a new image and cache it. */
6399 extern Lisp_Object Qpostscript
;
6402 img
= make_image (spec
, hash
);
6403 cache_image (f
, img
);
6404 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6406 /* If we can't load the image, and we don't have a width and
6407 height, use some arbitrary width and height so that we can
6408 draw a rectangle for it. */
6409 if (img
->load_failed_p
)
6413 value
= image_spec_value (spec
, QCwidth
, NULL
);
6414 img
->width
= (INTEGERP (value
)
6415 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6416 value
= image_spec_value (spec
, QCheight
, NULL
);
6417 img
->height
= (INTEGERP (value
)
6418 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6422 /* Handle image type independent image attributes
6423 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
6424 `:background COLOR'. */
6425 Lisp_Object ascent
, margin
, relief
, bg
;
6427 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6428 if (INTEGERP (ascent
))
6429 img
->ascent
= XFASTINT (ascent
);
6430 else if (EQ (ascent
, Qcenter
))
6431 img
->ascent
= CENTERED_IMAGE_ASCENT
;
6433 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6434 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6435 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
6436 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
6437 && INTEGERP (XCDR (margin
)))
6439 if (XINT (XCAR (margin
)) > 0)
6440 img
->hmargin
= XFASTINT (XCAR (margin
));
6441 if (XINT (XCDR (margin
)) > 0)
6442 img
->vmargin
= XFASTINT (XCDR (margin
));
6445 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6446 if (INTEGERP (relief
))
6448 img
->relief
= XINT (relief
);
6449 img
->hmargin
+= abs (img
->relief
);
6450 img
->vmargin
+= abs (img
->relief
);
6453 if (! img
->background_valid
)
6455 bg
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6459 = x_alloc_image_color (f
, img
, bg
,
6460 FRAME_BACKGROUND_PIXEL (f
));
6461 img
->background_valid
= 1;
6465 /* Do image transformations and compute masks, unless we
6466 don't have the image yet. */
6467 if (!EQ (*img
->type
->type
, Qpostscript
))
6468 postprocess_image (f
, img
);
6472 xassert (!interrupt_input_blocked
);
6475 /* We're using IMG, so set its timestamp to `now'. */
6476 EMACS_GET_TIME (now
);
6477 img
->timestamp
= EMACS_SECS (now
);
6481 /* Value is the image id. */
6486 /* Cache image IMG in the image cache of frame F. */
6489 cache_image (f
, img
)
6493 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6496 /* Find a free slot in c->images. */
6497 for (i
= 0; i
< c
->used
; ++i
)
6498 if (c
->images
[i
] == NULL
)
6501 /* If no free slot found, maybe enlarge c->images. */
6502 if (i
== c
->used
&& c
->used
== c
->size
)
6505 c
->images
= (struct image
**) xrealloc (c
->images
,
6506 c
->size
* sizeof *c
->images
);
6509 /* Add IMG to c->images, and assign IMG an id. */
6515 /* Add IMG to the cache's hash table. */
6516 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6517 img
->next
= c
->buckets
[i
];
6519 img
->next
->prev
= img
;
6521 c
->buckets
[i
] = img
;
6525 /* Call FN on every image in the image cache of frame F. Used to mark
6526 Lisp Objects in the image cache. */
6529 forall_images_in_image_cache (f
, fn
)
6531 void (*fn
) P_ ((struct image
*img
));
6533 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6535 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6539 for (i
= 0; i
< c
->used
; ++i
)
6548 /***********************************************************************
6550 ***********************************************************************/
6552 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6553 XImage
**, Pixmap
*));
6554 static void x_destroy_x_image
P_ ((XImage
*));
6555 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6558 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6559 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6560 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6561 via xmalloc. Print error messages via image_error if an error
6562 occurs. Value is non-zero if successful. */
6565 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6567 int width
, height
, depth
;
6571 Display
*display
= FRAME_X_DISPLAY (f
);
6572 Screen
*screen
= FRAME_X_SCREEN (f
);
6573 Window window
= FRAME_X_WINDOW (f
);
6575 xassert (interrupt_input_blocked
);
6578 depth
= DefaultDepthOfScreen (screen
);
6579 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6580 depth
, ZPixmap
, 0, NULL
, width
, height
,
6581 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6584 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6588 /* Allocate image raster. */
6589 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6591 /* Allocate a pixmap of the same size. */
6592 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6593 if (*pixmap
== None
)
6595 x_destroy_x_image (*ximg
);
6597 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6605 /* Destroy XImage XIMG. Free XIMG->data. */
6608 x_destroy_x_image (ximg
)
6611 xassert (interrupt_input_blocked
);
6616 XDestroyImage (ximg
);
6621 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6622 are width and height of both the image and pixmap. */
6625 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6632 xassert (interrupt_input_blocked
);
6633 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6634 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6635 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6640 /***********************************************************************
6642 ***********************************************************************/
6644 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6645 static char *slurp_file
P_ ((char *, int *));
6648 /* Find image file FILE. Look in data-directory, then
6649 x-bitmap-file-path. Value is the full name of the file found, or
6650 nil if not found. */
6653 x_find_image_file (file
)
6656 Lisp_Object file_found
, search_path
;
6657 struct gcpro gcpro1
, gcpro2
;
6661 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6662 GCPRO2 (file_found
, search_path
);
6664 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6665 fd
= openp (search_path
, file
, Qnil
, &file_found
, 0);
6677 /* Read FILE into memory. Value is a pointer to a buffer allocated
6678 with xmalloc holding FILE's contents. Value is null if an error
6679 occurred. *SIZE is set to the size of the file. */
6682 slurp_file (file
, size
)
6690 if (stat (file
, &st
) == 0
6691 && (fp
= fopen (file
, "r")) != NULL
6692 && (buf
= (char *) xmalloc (st
.st_size
),
6693 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6714 /***********************************************************************
6716 ***********************************************************************/
6718 static int xbm_scan
P_ ((char **, char *, char *, int *));
6719 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6720 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6722 static int xbm_image_p
P_ ((Lisp_Object object
));
6723 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6725 static int xbm_file_p
P_ ((Lisp_Object
));
6728 /* Indices of image specification fields in xbm_format, below. */
6730 enum xbm_keyword_index
6748 /* Vector of image_keyword structures describing the format
6749 of valid XBM image specifications. */
6751 static struct image_keyword xbm_format
[XBM_LAST
] =
6753 {":type", IMAGE_SYMBOL_VALUE
, 1},
6754 {":file", IMAGE_STRING_VALUE
, 0},
6755 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6756 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6757 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6758 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
6759 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
6760 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6761 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6762 {":relief", IMAGE_INTEGER_VALUE
, 0},
6763 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6764 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6765 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6768 /* Structure describing the image type XBM. */
6770 static struct image_type xbm_type
=
6779 /* Tokens returned from xbm_scan. */
6788 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6789 A valid specification is a list starting with the symbol `image'
6790 The rest of the list is a property list which must contain an
6793 If the specification specifies a file to load, it must contain
6794 an entry `:file FILENAME' where FILENAME is a string.
6796 If the specification is for a bitmap loaded from memory it must
6797 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6798 WIDTH and HEIGHT are integers > 0. DATA may be:
6800 1. a string large enough to hold the bitmap data, i.e. it must
6801 have a size >= (WIDTH + 7) / 8 * HEIGHT
6803 2. a bool-vector of size >= WIDTH * HEIGHT
6805 3. a vector of strings or bool-vectors, one for each line of the
6808 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6809 may not be specified in this case because they are defined in the
6812 Both the file and data forms may contain the additional entries
6813 `:background COLOR' and `:foreground COLOR'. If not present,
6814 foreground and background of the frame on which the image is
6815 displayed is used. */
6818 xbm_image_p (object
)
6821 struct image_keyword kw
[XBM_LAST
];
6823 bcopy (xbm_format
, kw
, sizeof kw
);
6824 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6827 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6829 if (kw
[XBM_FILE
].count
)
6831 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6834 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6836 /* In-memory XBM file. */
6837 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6845 /* Entries for `:width', `:height' and `:data' must be present. */
6846 if (!kw
[XBM_WIDTH
].count
6847 || !kw
[XBM_HEIGHT
].count
6848 || !kw
[XBM_DATA
].count
)
6851 data
= kw
[XBM_DATA
].value
;
6852 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6853 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6855 /* Check type of data, and width and height against contents of
6861 /* Number of elements of the vector must be >= height. */
6862 if (XVECTOR (data
)->size
< height
)
6865 /* Each string or bool-vector in data must be large enough
6866 for one line of the image. */
6867 for (i
= 0; i
< height
; ++i
)
6869 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6873 if (XSTRING (elt
)->size
6874 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6877 else if (BOOL_VECTOR_P (elt
))
6879 if (XBOOL_VECTOR (elt
)->size
< width
)
6886 else if (STRINGP (data
))
6888 if (XSTRING (data
)->size
6889 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6892 else if (BOOL_VECTOR_P (data
))
6894 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6905 /* Scan a bitmap file. FP is the stream to read from. Value is
6906 either an enumerator from enum xbm_token, or a character for a
6907 single-character token, or 0 at end of file. If scanning an
6908 identifier, store the lexeme of the identifier in SVAL. If
6909 scanning a number, store its value in *IVAL. */
6912 xbm_scan (s
, end
, sval
, ival
)
6921 /* Skip white space. */
6922 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6927 else if (isdigit (c
))
6929 int value
= 0, digit
;
6931 if (c
== '0' && *s
< end
)
6934 if (c
== 'x' || c
== 'X')
6941 else if (c
>= 'a' && c
<= 'f')
6942 digit
= c
- 'a' + 10;
6943 else if (c
>= 'A' && c
<= 'F')
6944 digit
= c
- 'A' + 10;
6947 value
= 16 * value
+ digit
;
6950 else if (isdigit (c
))
6954 && (c
= *(*s
)++, isdigit (c
)))
6955 value
= 8 * value
+ c
- '0';
6962 && (c
= *(*s
)++, isdigit (c
)))
6963 value
= 10 * value
+ c
- '0';
6971 else if (isalpha (c
) || c
== '_')
6975 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6982 else if (c
== '/' && **s
== '*')
6984 /* C-style comment. */
6986 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6999 /* Replacement for XReadBitmapFileData which isn't available under old
7000 X versions. CONTENTS is a pointer to a buffer to parse; END is the
7001 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
7002 the image. Return in *DATA the bitmap data allocated with xmalloc.
7003 Value is non-zero if successful. DATA null means just test if
7004 CONTENTS looks like an in-memory XBM file. */
7007 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
7008 char *contents
, *end
;
7009 int *width
, *height
;
7010 unsigned char **data
;
7013 char buffer
[BUFSIZ
];
7016 int bytes_per_line
, i
, nbytes
;
7022 LA1 = xbm_scan (&s, end, buffer, &value)
7024 #define expect(TOKEN) \
7025 if (LA1 != (TOKEN)) \
7030 #define expect_ident(IDENT) \
7031 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
7036 *width
= *height
= -1;
7039 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
7041 /* Parse defines for width, height and hot-spots. */
7045 expect_ident ("define");
7046 expect (XBM_TK_IDENT
);
7048 if (LA1
== XBM_TK_NUMBER
);
7050 char *p
= strrchr (buffer
, '_');
7051 p
= p
? p
+ 1 : buffer
;
7052 if (strcmp (p
, "width") == 0)
7054 else if (strcmp (p
, "height") == 0)
7057 expect (XBM_TK_NUMBER
);
7060 if (*width
< 0 || *height
< 0)
7062 else if (data
== NULL
)
7065 /* Parse bits. Must start with `static'. */
7066 expect_ident ("static");
7067 if (LA1
== XBM_TK_IDENT
)
7069 if (strcmp (buffer
, "unsigned") == 0)
7072 expect_ident ("char");
7074 else if (strcmp (buffer
, "short") == 0)
7078 if (*width
% 16 && *width
% 16 < 9)
7081 else if (strcmp (buffer
, "char") == 0)
7089 expect (XBM_TK_IDENT
);
7095 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
7096 nbytes
= bytes_per_line
* *height
;
7097 p
= *data
= (char *) xmalloc (nbytes
);
7101 for (i
= 0; i
< nbytes
; i
+= 2)
7104 expect (XBM_TK_NUMBER
);
7107 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
7110 if (LA1
== ',' || LA1
== '}')
7118 for (i
= 0; i
< nbytes
; ++i
)
7121 expect (XBM_TK_NUMBER
);
7125 if (LA1
== ',' || LA1
== '}')
7150 /* Load XBM image IMG which will be displayed on frame F from buffer
7151 CONTENTS. END is the end of the buffer. Value is non-zero if
7155 xbm_load_image (f
, img
, contents
, end
)
7158 char *contents
, *end
;
7161 unsigned char *data
;
7164 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
7167 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7168 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7169 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7172 xassert (img
->width
> 0 && img
->height
> 0);
7174 /* Get foreground and background colors, maybe allocate colors. */
7175 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
7177 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
7178 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
7181 background
= x_alloc_image_color (f
, img
, value
, background
);
7182 img
->background
= background
;
7183 img
->background_valid
= 1;
7187 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7190 img
->width
, img
->height
,
7191 foreground
, background
,
7195 if (img
->pixmap
== None
)
7197 x_clear_image (f
, img
);
7198 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
7204 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7210 /* Value is non-zero if DATA looks like an in-memory XBM file. */
7217 return (STRINGP (data
)
7218 && xbm_read_bitmap_data (XSTRING (data
)->data
,
7219 (XSTRING (data
)->data
7220 + STRING_BYTES (XSTRING (data
))),
7225 /* Fill image IMG which is used on frame F with pixmap data. Value is
7226 non-zero if successful. */
7234 Lisp_Object file_name
;
7236 xassert (xbm_image_p (img
->spec
));
7238 /* If IMG->spec specifies a file name, create a non-file spec from it. */
7239 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
7240 if (STRINGP (file_name
))
7245 struct gcpro gcpro1
;
7247 file
= x_find_image_file (file_name
);
7249 if (!STRINGP (file
))
7251 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
7256 contents
= slurp_file (XSTRING (file
)->data
, &size
);
7257 if (contents
== NULL
)
7259 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7264 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
7269 struct image_keyword fmt
[XBM_LAST
];
7272 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7273 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7276 int in_memory_file_p
= 0;
7278 /* See if data looks like an in-memory XBM file. */
7279 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7280 in_memory_file_p
= xbm_file_p (data
);
7282 /* Parse the image specification. */
7283 bcopy (xbm_format
, fmt
, sizeof fmt
);
7284 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
7287 /* Get specified width, and height. */
7288 if (!in_memory_file_p
)
7290 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
7291 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
7292 xassert (img
->width
> 0 && img
->height
> 0);
7295 /* Get foreground and background colors, maybe allocate colors. */
7296 if (fmt
[XBM_FOREGROUND
].count
7297 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
7298 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
7300 if (fmt
[XBM_BACKGROUND
].count
7301 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
7302 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
7305 if (in_memory_file_p
)
7306 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
7307 (XSTRING (data
)->data
7308 + STRING_BYTES (XSTRING (data
))));
7315 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
7317 p
= bits
= (char *) alloca (nbytes
* img
->height
);
7318 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
7320 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
7322 bcopy (XSTRING (line
)->data
, p
, nbytes
);
7324 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
7327 else if (STRINGP (data
))
7328 bits
= XSTRING (data
)->data
;
7330 bits
= XBOOL_VECTOR (data
)->data
;
7332 /* Create the pixmap. */
7333 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7335 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7338 img
->width
, img
->height
,
7339 foreground
, background
,
7345 image_error ("Unable to create pixmap for XBM image `%s'",
7347 x_clear_image (f
, img
);
7357 /***********************************************************************
7359 ***********************************************************************/
7363 static int xpm_image_p
P_ ((Lisp_Object object
));
7364 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
7365 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
7367 #include "X11/xpm.h"
7369 /* The symbol `xpm' identifying XPM-format images. */
7373 /* Indices of image specification fields in xpm_format, below. */
7375 enum xpm_keyword_index
7391 /* Vector of image_keyword structures describing the format
7392 of valid XPM image specifications. */
7394 static struct image_keyword xpm_format
[XPM_LAST
] =
7396 {":type", IMAGE_SYMBOL_VALUE
, 1},
7397 {":file", IMAGE_STRING_VALUE
, 0},
7398 {":data", IMAGE_STRING_VALUE
, 0},
7399 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7400 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7401 {":relief", IMAGE_INTEGER_VALUE
, 0},
7402 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7403 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7404 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7405 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7406 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
7409 /* Structure describing the image type XBM. */
7411 static struct image_type xpm_type
=
7421 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7422 functions for allocating image colors. Our own functions handle
7423 color allocation failures more gracefully than the ones on the XPM
7426 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7427 #define ALLOC_XPM_COLORS
7430 #ifdef ALLOC_XPM_COLORS
7432 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7433 static void xpm_free_color_cache
P_ ((void));
7434 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7435 static int xpm_color_bucket
P_ ((char *));
7436 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7439 /* An entry in a hash table used to cache color definitions of named
7440 colors. This cache is necessary to speed up XPM image loading in
7441 case we do color allocations ourselves. Without it, we would need
7442 a call to XParseColor per pixel in the image. */
7444 struct xpm_cached_color
7446 /* Next in collision chain. */
7447 struct xpm_cached_color
*next
;
7449 /* Color definition (RGB and pixel color). */
7456 /* The hash table used for the color cache, and its bucket vector
7459 #define XPM_COLOR_CACHE_BUCKETS 1001
7460 struct xpm_cached_color
**xpm_color_cache
;
7462 /* Initialize the color cache. */
7465 xpm_init_color_cache (f
, attrs
)
7467 XpmAttributes
*attrs
;
7469 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7470 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7471 memset (xpm_color_cache
, 0, nbytes
);
7472 init_color_table ();
7474 if (attrs
->valuemask
& XpmColorSymbols
)
7479 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7480 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7481 attrs
->colorsymbols
[i
].value
, &color
))
7483 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7485 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7491 /* Free the color cache. */
7494 xpm_free_color_cache ()
7496 struct xpm_cached_color
*p
, *next
;
7499 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7500 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7506 xfree (xpm_color_cache
);
7507 xpm_color_cache
= NULL
;
7508 free_color_table ();
7512 /* Return the bucket index for color named COLOR_NAME in the color
7516 xpm_color_bucket (color_name
)
7522 for (s
= color_name
; *s
; ++s
)
7524 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7528 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7529 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7532 static struct xpm_cached_color
*
7533 xpm_cache_color (f
, color_name
, color
, bucket
)
7540 struct xpm_cached_color
*p
;
7543 bucket
= xpm_color_bucket (color_name
);
7545 nbytes
= sizeof *p
+ strlen (color_name
);
7546 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7547 strcpy (p
->name
, color_name
);
7549 p
->next
= xpm_color_cache
[bucket
];
7550 xpm_color_cache
[bucket
] = p
;
7555 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7556 return the cached definition in *COLOR. Otherwise, make a new
7557 entry in the cache and allocate the color. Value is zero if color
7558 allocation failed. */
7561 xpm_lookup_color (f
, color_name
, color
)
7566 struct xpm_cached_color
*p
;
7567 int h
= xpm_color_bucket (color_name
);
7569 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7570 if (strcmp (p
->name
, color_name
) == 0)
7575 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7578 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7580 p
= xpm_cache_color (f
, color_name
, color
, h
);
7587 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7588 CLOSURE is a pointer to the frame on which we allocate the
7589 color. Return in *COLOR the allocated color. Value is non-zero
7593 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7600 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7604 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7605 is a pointer to the frame on which we allocate the color. Value is
7606 non-zero if successful. */
7609 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7619 #endif /* ALLOC_XPM_COLORS */
7622 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7623 for XPM images. Such a list must consist of conses whose car and
7627 xpm_valid_color_symbols_p (color_symbols
)
7628 Lisp_Object color_symbols
;
7630 while (CONSP (color_symbols
))
7632 Lisp_Object sym
= XCAR (color_symbols
);
7634 || !STRINGP (XCAR (sym
))
7635 || !STRINGP (XCDR (sym
)))
7637 color_symbols
= XCDR (color_symbols
);
7640 return NILP (color_symbols
);
7644 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7647 xpm_image_p (object
)
7650 struct image_keyword fmt
[XPM_LAST
];
7651 bcopy (xpm_format
, fmt
, sizeof fmt
);
7652 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7653 /* Either `:file' or `:data' must be present. */
7654 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7655 /* Either no `:color-symbols' or it's a list of conses
7656 whose car and cdr are strings. */
7657 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7658 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7662 /* Load image IMG which will be displayed on frame F. Value is
7663 non-zero if successful. */
7671 XpmAttributes attrs
;
7672 Lisp_Object specified_file
, color_symbols
;
7674 /* Configure the XPM lib. Use the visual of frame F. Allocate
7675 close colors. Return colors allocated. */
7676 bzero (&attrs
, sizeof attrs
);
7677 attrs
.visual
= FRAME_X_VISUAL (f
);
7678 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7679 attrs
.valuemask
|= XpmVisual
;
7680 attrs
.valuemask
|= XpmColormap
;
7682 #ifdef ALLOC_XPM_COLORS
7683 /* Allocate colors with our own functions which handle
7684 failing color allocation more gracefully. */
7685 attrs
.color_closure
= f
;
7686 attrs
.alloc_color
= xpm_alloc_color
;
7687 attrs
.free_colors
= xpm_free_colors
;
7688 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7689 #else /* not ALLOC_XPM_COLORS */
7690 /* Let the XPM lib allocate colors. */
7691 attrs
.valuemask
|= XpmReturnAllocPixels
;
7692 #ifdef XpmAllocCloseColors
7693 attrs
.alloc_close_colors
= 1;
7694 attrs
.valuemask
|= XpmAllocCloseColors
;
7695 #else /* not XpmAllocCloseColors */
7696 attrs
.closeness
= 600;
7697 attrs
.valuemask
|= XpmCloseness
;
7698 #endif /* not XpmAllocCloseColors */
7699 #endif /* ALLOC_XPM_COLORS */
7701 /* If image specification contains symbolic color definitions, add
7702 these to `attrs'. */
7703 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7704 if (CONSP (color_symbols
))
7707 XpmColorSymbol
*xpm_syms
;
7710 attrs
.valuemask
|= XpmColorSymbols
;
7712 /* Count number of symbols. */
7713 attrs
.numsymbols
= 0;
7714 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7717 /* Allocate an XpmColorSymbol array. */
7718 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7719 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7720 bzero (xpm_syms
, size
);
7721 attrs
.colorsymbols
= xpm_syms
;
7723 /* Fill the color symbol array. */
7724 for (tail
= color_symbols
, i
= 0;
7726 ++i
, tail
= XCDR (tail
))
7728 Lisp_Object name
= XCAR (XCAR (tail
));
7729 Lisp_Object color
= XCDR (XCAR (tail
));
7730 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7731 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7732 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7733 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7737 /* Create a pixmap for the image, either from a file, or from a
7738 string buffer containing data in the same format as an XPM file. */
7739 #ifdef ALLOC_XPM_COLORS
7740 xpm_init_color_cache (f
, &attrs
);
7743 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7744 if (STRINGP (specified_file
))
7746 Lisp_Object file
= x_find_image_file (specified_file
);
7747 if (!STRINGP (file
))
7749 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7753 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7754 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7759 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7760 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7761 XSTRING (buffer
)->data
,
7762 &img
->pixmap
, &img
->mask
,
7766 if (rc
== XpmSuccess
)
7768 #ifdef ALLOC_XPM_COLORS
7769 img
->colors
= colors_in_color_table (&img
->ncolors
);
7770 #else /* not ALLOC_XPM_COLORS */
7773 img
->ncolors
= attrs
.nalloc_pixels
;
7774 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7775 * sizeof *img
->colors
);
7776 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7778 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7779 #ifdef DEBUG_X_COLORS
7780 register_color (img
->colors
[i
]);
7783 #endif /* not ALLOC_XPM_COLORS */
7785 img
->width
= attrs
.width
;
7786 img
->height
= attrs
.height
;
7787 xassert (img
->width
> 0 && img
->height
> 0);
7789 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7790 XpmFreeAttributes (&attrs
);
7797 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7800 case XpmFileInvalid
:
7801 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7805 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7808 case XpmColorFailed
:
7809 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7813 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7818 #ifdef ALLOC_XPM_COLORS
7819 xpm_free_color_cache ();
7821 return rc
== XpmSuccess
;
7824 #endif /* HAVE_XPM != 0 */
7827 /***********************************************************************
7829 ***********************************************************************/
7831 /* An entry in the color table mapping an RGB color to a pixel color. */
7836 unsigned long pixel
;
7838 /* Next in color table collision list. */
7839 struct ct_color
*next
;
7842 /* The bucket vector size to use. Must be prime. */
7846 /* Value is a hash of the RGB color given by R, G, and B. */
7848 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7850 /* The color hash table. */
7852 struct ct_color
**ct_table
;
7854 /* Number of entries in the color table. */
7856 int ct_colors_allocated
;
7858 /* Initialize the color table. */
7863 int size
= CT_SIZE
* sizeof (*ct_table
);
7864 ct_table
= (struct ct_color
**) xmalloc (size
);
7865 bzero (ct_table
, size
);
7866 ct_colors_allocated
= 0;
7870 /* Free memory associated with the color table. */
7876 struct ct_color
*p
, *next
;
7878 for (i
= 0; i
< CT_SIZE
; ++i
)
7879 for (p
= ct_table
[i
]; p
; p
= next
)
7890 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7891 entry for that color already is in the color table, return the
7892 pixel color of that entry. Otherwise, allocate a new color for R,
7893 G, B, and make an entry in the color table. */
7895 static unsigned long
7896 lookup_rgb_color (f
, r
, g
, b
)
7900 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7901 int i
= hash
% CT_SIZE
;
7904 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7905 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7918 cmap
= FRAME_X_COLORMAP (f
);
7919 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7923 ++ct_colors_allocated
;
7925 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7929 p
->pixel
= color
.pixel
;
7930 p
->next
= ct_table
[i
];
7934 return FRAME_FOREGROUND_PIXEL (f
);
7941 /* Look up pixel color PIXEL which is used on frame F in the color
7942 table. If not already present, allocate it. Value is PIXEL. */
7944 static unsigned long
7945 lookup_pixel_color (f
, pixel
)
7947 unsigned long pixel
;
7949 int i
= pixel
% CT_SIZE
;
7952 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7953 if (p
->pixel
== pixel
)
7962 cmap
= FRAME_X_COLORMAP (f
);
7963 color
.pixel
= pixel
;
7964 x_query_color (f
, &color
);
7965 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7969 ++ct_colors_allocated
;
7971 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7976 p
->next
= ct_table
[i
];
7980 return FRAME_FOREGROUND_PIXEL (f
);
7987 /* Value is a vector of all pixel colors contained in the color table,
7988 allocated via xmalloc. Set *N to the number of colors. */
7990 static unsigned long *
7991 colors_in_color_table (n
)
7996 unsigned long *colors
;
7998 if (ct_colors_allocated
== 0)
8005 colors
= (unsigned long *) xmalloc (ct_colors_allocated
8007 *n
= ct_colors_allocated
;
8009 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
8010 for (p
= ct_table
[i
]; p
; p
= p
->next
)
8011 colors
[j
++] = p
->pixel
;
8019 /***********************************************************************
8021 ***********************************************************************/
8023 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
8024 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
8025 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
8027 /* Non-zero means draw a cross on images having `:conversion
8030 int cross_disabled_images
;
8032 /* Edge detection matrices for different edge-detection
8035 static int emboss_matrix
[9] = {
8037 2, -1, 0, /* y - 1 */
8039 0, 1, -2 /* y + 1 */
8042 static int laplace_matrix
[9] = {
8044 1, 0, 0, /* y - 1 */
8046 0, 0, -1 /* y + 1 */
8049 /* Value is the intensity of the color whose red/green/blue values
8052 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
8055 /* On frame F, return an array of XColor structures describing image
8056 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
8057 non-zero means also fill the red/green/blue members of the XColor
8058 structures. Value is a pointer to the array of XColors structures,
8059 allocated with xmalloc; it must be freed by the caller. */
8062 x_to_xcolors (f
, img
, rgb_p
)
8071 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
8073 /* Get the X image IMG->pixmap. */
8074 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
8075 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
8077 /* Fill the `pixel' members of the XColor array. I wished there
8078 were an easy and portable way to circumvent XGetPixel. */
8080 for (y
= 0; y
< img
->height
; ++y
)
8084 for (x
= 0; x
< img
->width
; ++x
, ++p
)
8085 p
->pixel
= XGetPixel (ximg
, x
, y
);
8088 x_query_colors (f
, row
, img
->width
);
8091 XDestroyImage (ximg
);
8096 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
8097 RGB members are set. F is the frame on which this all happens.
8098 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
8101 x_from_xcolors (f
, img
, colors
)
8111 init_color_table ();
8113 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
8116 for (y
= 0; y
< img
->height
; ++y
)
8117 for (x
= 0; x
< img
->width
; ++x
, ++p
)
8119 unsigned long pixel
;
8120 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
8121 XPutPixel (oimg
, x
, y
, pixel
);
8125 x_clear_image_1 (f
, img
, 1, 0, 1);
8127 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
8128 x_destroy_x_image (oimg
);
8129 img
->pixmap
= pixmap
;
8130 img
->colors
= colors_in_color_table (&img
->ncolors
);
8131 free_color_table ();
8135 /* On frame F, perform edge-detection on image IMG.
8137 MATRIX is a nine-element array specifying the transformation
8138 matrix. See emboss_matrix for an example.
8140 COLOR_ADJUST is a color adjustment added to each pixel of the
8144 x_detect_edges (f
, img
, matrix
, color_adjust
)
8147 int matrix
[9], color_adjust
;
8149 XColor
*colors
= x_to_xcolors (f
, img
, 1);
8153 for (i
= sum
= 0; i
< 9; ++i
)
8154 sum
+= abs (matrix
[i
]);
8156 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
8158 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
8160 for (y
= 0; y
< img
->height
; ++y
)
8162 p
= COLOR (new, 0, y
);
8163 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8164 p
= COLOR (new, img
->width
- 1, y
);
8165 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8168 for (x
= 1; x
< img
->width
- 1; ++x
)
8170 p
= COLOR (new, x
, 0);
8171 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8172 p
= COLOR (new, x
, img
->height
- 1);
8173 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8176 for (y
= 1; y
< img
->height
- 1; ++y
)
8178 p
= COLOR (new, 1, y
);
8180 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
8182 int r
, g
, b
, y1
, x1
;
8185 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
8186 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
8189 XColor
*t
= COLOR (colors
, x1
, y1
);
8190 r
+= matrix
[i
] * t
->red
;
8191 g
+= matrix
[i
] * t
->green
;
8192 b
+= matrix
[i
] * t
->blue
;
8195 r
= (r
/ sum
+ color_adjust
) & 0xffff;
8196 g
= (g
/ sum
+ color_adjust
) & 0xffff;
8197 b
= (b
/ sum
+ color_adjust
) & 0xffff;
8198 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
8203 x_from_xcolors (f
, img
, new);
8209 /* Perform the pre-defined `emboss' edge-detection on image IMG
8217 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
8221 /* Perform the pre-defined `laplace' edge-detection on image IMG
8229 x_detect_edges (f
, img
, laplace_matrix
, 45000);
8233 /* Perform edge-detection on image IMG on frame F, with specified
8234 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
8236 MATRIX must be either
8238 - a list of at least 9 numbers in row-major form
8239 - a vector of at least 9 numbers
8241 COLOR_ADJUST nil means use a default; otherwise it must be a
8245 x_edge_detection (f
, img
, matrix
, color_adjust
)
8248 Lisp_Object matrix
, color_adjust
;
8256 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
8257 ++i
, matrix
= XCDR (matrix
))
8258 trans
[i
] = XFLOATINT (XCAR (matrix
));
8260 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
8262 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
8263 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
8266 if (NILP (color_adjust
))
8267 color_adjust
= make_number (0xffff / 2);
8269 if (i
== 9 && NUMBERP (color_adjust
))
8270 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
8274 /* Transform image IMG on frame F so that it looks disabled. */
8277 x_disable_image (f
, img
)
8281 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
8283 if (dpyinfo
->n_planes
>= 2)
8285 /* Color (or grayscale). Convert to gray, and equalize. Just
8286 drawing such images with a stipple can look very odd, so
8287 we're using this method instead. */
8288 XColor
*colors
= x_to_xcolors (f
, img
, 1);
8290 const int h
= 15000;
8291 const int l
= 30000;
8293 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
8297 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
8298 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
8299 p
->red
= p
->green
= p
->blue
= i2
;
8302 x_from_xcolors (f
, img
, colors
);
8305 /* Draw a cross over the disabled image, if we must or if we
8307 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
8309 Display
*dpy
= FRAME_X_DISPLAY (f
);
8312 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
8313 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
8314 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
8315 img
->width
- 1, img
->height
- 1);
8316 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
8322 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
8323 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
8324 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
8325 img
->width
- 1, img
->height
- 1);
8326 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
8334 /* Build a mask for image IMG which is used on frame F. FILE is the
8335 name of an image file, for error messages. HOW determines how to
8336 determine the background color of IMG. If it is a list '(R G B)',
8337 with R, G, and B being integers >= 0, take that as the color of the
8338 background. Otherwise, determine the background color of IMG
8339 heuristically. Value is non-zero if successful. */
8342 x_build_heuristic_mask (f
, img
, how
)
8347 Display
*dpy
= FRAME_X_DISPLAY (f
);
8348 XImage
*ximg
, *mask_img
;
8349 int x
, y
, rc
, use_img_background
;
8350 unsigned long bg
= 0;
8354 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8356 img
->background_transparent_valid
= 0;
8359 /* Create an image and pixmap serving as mask. */
8360 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
8361 &mask_img
, &img
->mask
);
8365 /* Get the X image of IMG->pixmap. */
8366 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
8369 /* Determine the background color of ximg. If HOW is `(R G B)'
8370 take that as color. Otherwise, use the image's background color. */
8371 use_img_background
= 1;
8377 for (i
= 0; i
< 3 && CONSP (how
) && NATNUMP (XCAR (how
)); ++i
)
8379 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
8383 if (i
== 3 && NILP (how
))
8385 char color_name
[30];
8386 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
8387 bg
= x_alloc_image_color (f
, img
, build_string (color_name
), 0);
8388 use_img_background
= 0;
8392 if (use_img_background
)
8393 bg
= four_corners_best (ximg
, img
->width
, img
->height
);
8395 /* Set all bits in mask_img to 1 whose color in ximg is different
8396 from the background color bg. */
8397 for (y
= 0; y
< img
->height
; ++y
)
8398 for (x
= 0; x
< img
->width
; ++x
)
8399 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8401 /* Fill in the background_transparent field while we have the mask handy. */
8402 image_background_transparent (img
, f
, mask_img
);
8404 /* Put mask_img into img->mask. */
8405 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8406 x_destroy_x_image (mask_img
);
8407 XDestroyImage (ximg
);
8414 /***********************************************************************
8415 PBM (mono, gray, color)
8416 ***********************************************************************/
8418 static int pbm_image_p
P_ ((Lisp_Object object
));
8419 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8420 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8422 /* The symbol `pbm' identifying images of this type. */
8426 /* Indices of image specification fields in gs_format, below. */
8428 enum pbm_keyword_index
8444 /* Vector of image_keyword structures describing the format
8445 of valid user-defined image specifications. */
8447 static struct image_keyword pbm_format
[PBM_LAST
] =
8449 {":type", IMAGE_SYMBOL_VALUE
, 1},
8450 {":file", IMAGE_STRING_VALUE
, 0},
8451 {":data", IMAGE_STRING_VALUE
, 0},
8452 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8453 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8454 {":relief", IMAGE_INTEGER_VALUE
, 0},
8455 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8456 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8457 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8458 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8459 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8462 /* Structure describing the image type `pbm'. */
8464 static struct image_type pbm_type
=
8474 /* Return non-zero if OBJECT is a valid PBM image specification. */
8477 pbm_image_p (object
)
8480 struct image_keyword fmt
[PBM_LAST
];
8482 bcopy (pbm_format
, fmt
, sizeof fmt
);
8484 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8487 /* Must specify either :data or :file. */
8488 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8492 /* Scan a decimal number from *S and return it. Advance *S while
8493 reading the number. END is the end of the string. Value is -1 at
8497 pbm_scan_number (s
, end
)
8498 unsigned char **s
, *end
;
8500 int c
= 0, val
= -1;
8504 /* Skip white-space. */
8505 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8510 /* Skip comment to end of line. */
8511 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8514 else if (isdigit (c
))
8516 /* Read decimal number. */
8518 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8519 val
= 10 * val
+ c
- '0';
8530 /* Load PBM image IMG for use on frame F. */
8538 int width
, height
, max_color_idx
= 0;
8540 Lisp_Object file
, specified_file
;
8541 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8542 struct gcpro gcpro1
;
8543 unsigned char *contents
= NULL
;
8544 unsigned char *end
, *p
;
8547 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8551 if (STRINGP (specified_file
))
8553 file
= x_find_image_file (specified_file
);
8554 if (!STRINGP (file
))
8556 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8561 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8562 if (contents
== NULL
)
8564 image_error ("Error reading `%s'", file
, Qnil
);
8570 end
= contents
+ size
;
8575 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8576 p
= XSTRING (data
)->data
;
8577 end
= p
+ STRING_BYTES (XSTRING (data
));
8580 /* Check magic number. */
8581 if (end
- p
< 2 || *p
++ != 'P')
8583 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8593 raw_p
= 0, type
= PBM_MONO
;
8597 raw_p
= 0, type
= PBM_GRAY
;
8601 raw_p
= 0, type
= PBM_COLOR
;
8605 raw_p
= 1, type
= PBM_MONO
;
8609 raw_p
= 1, type
= PBM_GRAY
;
8613 raw_p
= 1, type
= PBM_COLOR
;
8617 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8621 /* Read width, height, maximum color-component. Characters
8622 starting with `#' up to the end of a line are ignored. */
8623 width
= pbm_scan_number (&p
, end
);
8624 height
= pbm_scan_number (&p
, end
);
8626 if (type
!= PBM_MONO
)
8628 max_color_idx
= pbm_scan_number (&p
, end
);
8629 if (raw_p
&& max_color_idx
> 255)
8630 max_color_idx
= 255;
8635 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8638 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8639 &ximg
, &img
->pixmap
))
8642 /* Initialize the color hash table. */
8643 init_color_table ();
8645 if (type
== PBM_MONO
)
8648 struct image_keyword fmt
[PBM_LAST
];
8649 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8650 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8652 /* Parse the image specification. */
8653 bcopy (pbm_format
, fmt
, sizeof fmt
);
8654 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8656 /* Get foreground and background colors, maybe allocate colors. */
8657 if (fmt
[PBM_FOREGROUND
].count
8658 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
8659 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8660 if (fmt
[PBM_BACKGROUND
].count
8661 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
8663 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8664 img
->background
= bg
;
8665 img
->background_valid
= 1;
8668 for (y
= 0; y
< height
; ++y
)
8669 for (x
= 0; x
< width
; ++x
)
8679 g
= pbm_scan_number (&p
, end
);
8681 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8686 for (y
= 0; y
< height
; ++y
)
8687 for (x
= 0; x
< width
; ++x
)
8691 if (type
== PBM_GRAY
)
8692 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8701 r
= pbm_scan_number (&p
, end
);
8702 g
= pbm_scan_number (&p
, end
);
8703 b
= pbm_scan_number (&p
, end
);
8706 if (r
< 0 || g
< 0 || b
< 0)
8710 XDestroyImage (ximg
);
8711 image_error ("Invalid pixel value in image `%s'",
8716 /* RGB values are now in the range 0..max_color_idx.
8717 Scale this to the range 0..0xffff supported by X. */
8718 r
= (double) r
* 65535 / max_color_idx
;
8719 g
= (double) g
* 65535 / max_color_idx
;
8720 b
= (double) b
* 65535 / max_color_idx
;
8721 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8725 /* Store in IMG->colors the colors allocated for the image, and
8726 free the color table. */
8727 img
->colors
= colors_in_color_table (&img
->ncolors
);
8728 free_color_table ();
8730 /* Maybe fill in the background field while we have ximg handy. */
8731 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
8732 IMAGE_BACKGROUND (img
, f
, ximg
);
8734 /* Put the image into a pixmap. */
8735 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8736 x_destroy_x_image (ximg
);
8739 img
->height
= height
;
8748 /***********************************************************************
8750 ***********************************************************************/
8756 /* Function prototypes. */
8758 static int png_image_p
P_ ((Lisp_Object object
));
8759 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8761 /* The symbol `png' identifying images of this type. */
8765 /* Indices of image specification fields in png_format, below. */
8767 enum png_keyword_index
8782 /* Vector of image_keyword structures describing the format
8783 of valid user-defined image specifications. */
8785 static struct image_keyword png_format
[PNG_LAST
] =
8787 {":type", IMAGE_SYMBOL_VALUE
, 1},
8788 {":data", IMAGE_STRING_VALUE
, 0},
8789 {":file", IMAGE_STRING_VALUE
, 0},
8790 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8791 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8792 {":relief", IMAGE_INTEGER_VALUE
, 0},
8793 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8794 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8795 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8796 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8799 /* Structure describing the image type `png'. */
8801 static struct image_type png_type
=
8811 /* Return non-zero if OBJECT is a valid PNG image specification. */
8814 png_image_p (object
)
8817 struct image_keyword fmt
[PNG_LAST
];
8818 bcopy (png_format
, fmt
, sizeof fmt
);
8820 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8823 /* Must specify either the :data or :file keyword. */
8824 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8828 /* Error and warning handlers installed when the PNG library
8832 my_png_error (png_ptr
, msg
)
8833 png_struct
*png_ptr
;
8836 xassert (png_ptr
!= NULL
);
8837 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8838 longjmp (png_ptr
->jmpbuf
, 1);
8843 my_png_warning (png_ptr
, msg
)
8844 png_struct
*png_ptr
;
8847 xassert (png_ptr
!= NULL
);
8848 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8851 /* Memory source for PNG decoding. */
8853 struct png_memory_storage
8855 unsigned char *bytes
; /* The data */
8856 size_t len
; /* How big is it? */
8857 int index
; /* Where are we? */
8861 /* Function set as reader function when reading PNG image from memory.
8862 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8863 bytes from the input to DATA. */
8866 png_read_from_memory (png_ptr
, data
, length
)
8867 png_structp png_ptr
;
8871 struct png_memory_storage
*tbr
8872 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8874 if (length
> tbr
->len
- tbr
->index
)
8875 png_error (png_ptr
, "Read error");
8877 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8878 tbr
->index
= tbr
->index
+ length
;
8881 /* Load PNG image IMG for use on frame F. Value is non-zero if
8889 Lisp_Object file
, specified_file
;
8890 Lisp_Object specified_data
;
8892 XImage
*ximg
, *mask_img
= NULL
;
8893 struct gcpro gcpro1
;
8894 png_struct
*png_ptr
= NULL
;
8895 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8896 FILE *volatile fp
= NULL
;
8898 png_byte
* volatile pixels
= NULL
;
8899 png_byte
** volatile rows
= NULL
;
8900 png_uint_32 width
, height
;
8901 int bit_depth
, color_type
, interlace_type
;
8903 png_uint_32 row_bytes
;
8906 double screen_gamma
, image_gamma
;
8908 struct png_memory_storage tbr
; /* Data to be read */
8910 /* Find out what file to load. */
8911 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8912 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8916 if (NILP (specified_data
))
8918 file
= x_find_image_file (specified_file
);
8919 if (!STRINGP (file
))
8921 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8926 /* Open the image file. */
8927 fp
= fopen (XSTRING (file
)->data
, "rb");
8930 image_error ("Cannot open image file `%s'", file
, Qnil
);
8936 /* Check PNG signature. */
8937 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8938 || !png_check_sig (sig
, sizeof sig
))
8940 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8948 /* Read from memory. */
8949 tbr
.bytes
= XSTRING (specified_data
)->data
;
8950 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8953 /* Check PNG signature. */
8954 if (tbr
.len
< sizeof sig
8955 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8957 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8962 /* Need to skip past the signature. */
8963 tbr
.bytes
+= sizeof (sig
);
8966 /* Initialize read and info structs for PNG lib. */
8967 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8968 my_png_error
, my_png_warning
);
8971 if (fp
) fclose (fp
);
8976 info_ptr
= png_create_info_struct (png_ptr
);
8979 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8980 if (fp
) fclose (fp
);
8985 end_info
= png_create_info_struct (png_ptr
);
8988 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8989 if (fp
) fclose (fp
);
8994 /* Set error jump-back. We come back here when the PNG library
8995 detects an error. */
8996 if (setjmp (png_ptr
->jmpbuf
))
9000 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
9003 if (fp
) fclose (fp
);
9008 /* Read image info. */
9009 if (!NILP (specified_data
))
9010 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
9012 png_init_io (png_ptr
, fp
);
9014 png_set_sig_bytes (png_ptr
, sizeof sig
);
9015 png_read_info (png_ptr
, info_ptr
);
9016 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
9017 &interlace_type
, NULL
, NULL
);
9019 /* If image contains simply transparency data, we prefer to
9020 construct a clipping mask. */
9021 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
9026 /* This function is easier to write if we only have to handle
9027 one data format: RGB or RGBA with 8 bits per channel. Let's
9028 transform other formats into that format. */
9030 /* Strip more than 8 bits per channel. */
9031 if (bit_depth
== 16)
9032 png_set_strip_16 (png_ptr
);
9034 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
9036 png_set_expand (png_ptr
);
9038 /* Convert grayscale images to RGB. */
9039 if (color_type
== PNG_COLOR_TYPE_GRAY
9040 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
9041 png_set_gray_to_rgb (png_ptr
);
9043 screen_gamma
= (f
->gamma
? 1 / f
->gamma
/ 0.45455 : 2.2);
9045 /* Tell the PNG lib to handle gamma correction for us. */
9047 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
9048 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
9049 /* The libpng documentation says this is right in this case. */
9050 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
9053 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
9054 /* Image contains gamma information. */
9055 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
9057 /* Use the standard default for the image gamma. */
9058 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
9060 /* Handle alpha channel by combining the image with a background
9061 color. Do this only if a real alpha channel is supplied. For
9062 simple transparency, we prefer a clipping mask. */
9065 png_color_16
*image_bg
;
9066 Lisp_Object specified_bg
9067 = image_spec_value (img
->spec
, QCbackground
, NULL
);
9069 if (STRINGP (specified_bg
))
9070 /* The user specified `:background', use that. */
9073 if (x_defined_color (f
, XSTRING (specified_bg
)->data
, &color
, 0))
9075 png_color_16 user_bg
;
9077 bzero (&user_bg
, sizeof user_bg
);
9078 user_bg
.red
= color
.red
;
9079 user_bg
.green
= color
.green
;
9080 user_bg
.blue
= color
.blue
;
9082 png_set_background (png_ptr
, &user_bg
,
9083 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
9086 else if (png_get_bKGD (png_ptr
, info_ptr
, &image_bg
))
9087 /* Image contains a background color with which to
9088 combine the image. */
9089 png_set_background (png_ptr
, image_bg
,
9090 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
9093 /* Image does not contain a background color with which
9094 to combine the image data via an alpha channel. Use
9095 the frame's background instead. */
9098 png_color_16 frame_background
;
9100 cmap
= FRAME_X_COLORMAP (f
);
9101 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
9102 x_query_color (f
, &color
);
9104 bzero (&frame_background
, sizeof frame_background
);
9105 frame_background
.red
= color
.red
;
9106 frame_background
.green
= color
.green
;
9107 frame_background
.blue
= color
.blue
;
9109 png_set_background (png_ptr
, &frame_background
,
9110 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
9114 /* Update info structure. */
9115 png_read_update_info (png_ptr
, info_ptr
);
9117 /* Get number of channels. Valid values are 1 for grayscale images
9118 and images with a palette, 2 for grayscale images with transparency
9119 information (alpha channel), 3 for RGB images, and 4 for RGB
9120 images with alpha channel, i.e. RGBA. If conversions above were
9121 sufficient we should only have 3 or 4 channels here. */
9122 channels
= png_get_channels (png_ptr
, info_ptr
);
9123 xassert (channels
== 3 || channels
== 4);
9125 /* Number of bytes needed for one row of the image. */
9126 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
9128 /* Allocate memory for the image. */
9129 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
9130 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
9131 for (i
= 0; i
< height
; ++i
)
9132 rows
[i
] = pixels
+ i
* row_bytes
;
9134 /* Read the entire image. */
9135 png_read_image (png_ptr
, rows
);
9136 png_read_end (png_ptr
, info_ptr
);
9143 /* Create the X image and pixmap. */
9144 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
9148 /* Create an image and pixmap serving as mask if the PNG image
9149 contains an alpha channel. */
9152 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
9153 &mask_img
, &img
->mask
))
9155 x_destroy_x_image (ximg
);
9156 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
9161 /* Fill the X image and mask from PNG data. */
9162 init_color_table ();
9164 for (y
= 0; y
< height
; ++y
)
9166 png_byte
*p
= rows
[y
];
9168 for (x
= 0; x
< width
; ++x
)
9175 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
9177 /* An alpha channel, aka mask channel, associates variable
9178 transparency with an image. Where other image formats
9179 support binary transparency---fully transparent or fully
9180 opaque---PNG allows up to 254 levels of partial transparency.
9181 The PNG library implements partial transparency by combining
9182 the image with a specified background color.
9184 I'm not sure how to handle this here nicely: because the
9185 background on which the image is displayed may change, for
9186 real alpha channel support, it would be necessary to create
9187 a new image for each possible background.
9189 What I'm doing now is that a mask is created if we have
9190 boolean transparency information. Otherwise I'm using
9191 the frame's background color to combine the image with. */
9196 XPutPixel (mask_img
, x
, y
, *p
> 0);
9202 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9203 /* Set IMG's background color from the PNG image, unless the user
9207 if (png_get_bKGD (png_ptr
, info_ptr
, &bg
))
9209 img
->background
= lookup_rgb_color (f
, bg
->red
, bg
->green
, bg
->blue
);
9210 img
->background_valid
= 1;
9214 /* Remember colors allocated for this image. */
9215 img
->colors
= colors_in_color_table (&img
->ncolors
);
9216 free_color_table ();
9219 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
9224 img
->height
= height
;
9226 /* Maybe fill in the background field while we have ximg handy. */
9227 IMAGE_BACKGROUND (img
, f
, ximg
);
9229 /* Put the image into the pixmap, then free the X image and its buffer. */
9230 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9231 x_destroy_x_image (ximg
);
9233 /* Same for the mask. */
9236 /* Fill in the background_transparent field while we have the mask
9238 image_background_transparent (img
, f
, mask_img
);
9240 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
9241 x_destroy_x_image (mask_img
);
9248 #endif /* HAVE_PNG != 0 */
9252 /***********************************************************************
9254 ***********************************************************************/
9258 /* Work around a warning about HAVE_STDLIB_H being redefined in
9260 #ifdef HAVE_STDLIB_H
9261 #define HAVE_STDLIB_H_1
9262 #undef HAVE_STDLIB_H
9263 #endif /* HAVE_STLIB_H */
9265 #include <jpeglib.h>
9269 #ifdef HAVE_STLIB_H_1
9270 #define HAVE_STDLIB_H 1
9273 static int jpeg_image_p
P_ ((Lisp_Object object
));
9274 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
9276 /* The symbol `jpeg' identifying images of this type. */
9280 /* Indices of image specification fields in gs_format, below. */
9282 enum jpeg_keyword_index
9291 JPEG_HEURISTIC_MASK
,
9297 /* Vector of image_keyword structures describing the format
9298 of valid user-defined image specifications. */
9300 static struct image_keyword jpeg_format
[JPEG_LAST
] =
9302 {":type", IMAGE_SYMBOL_VALUE
, 1},
9303 {":data", IMAGE_STRING_VALUE
, 0},
9304 {":file", IMAGE_STRING_VALUE
, 0},
9305 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9306 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9307 {":relief", IMAGE_INTEGER_VALUE
, 0},
9308 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9309 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9310 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9311 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9314 /* Structure describing the image type `jpeg'. */
9316 static struct image_type jpeg_type
=
9326 /* Return non-zero if OBJECT is a valid JPEG image specification. */
9329 jpeg_image_p (object
)
9332 struct image_keyword fmt
[JPEG_LAST
];
9334 bcopy (jpeg_format
, fmt
, sizeof fmt
);
9336 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
9339 /* Must specify either the :data or :file keyword. */
9340 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
9344 struct my_jpeg_error_mgr
9346 struct jpeg_error_mgr pub
;
9347 jmp_buf setjmp_buffer
;
9352 my_error_exit (cinfo
)
9355 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
9356 longjmp (mgr
->setjmp_buffer
, 1);
9360 /* Init source method for JPEG data source manager. Called by
9361 jpeg_read_header() before any data is actually read. See
9362 libjpeg.doc from the JPEG lib distribution. */
9365 our_init_source (cinfo
)
9366 j_decompress_ptr cinfo
;
9371 /* Fill input buffer method for JPEG data source manager. Called
9372 whenever more data is needed. We read the whole image in one step,
9373 so this only adds a fake end of input marker at the end. */
9376 our_fill_input_buffer (cinfo
)
9377 j_decompress_ptr cinfo
;
9379 /* Insert a fake EOI marker. */
9380 struct jpeg_source_mgr
*src
= cinfo
->src
;
9381 static JOCTET buffer
[2];
9383 buffer
[0] = (JOCTET
) 0xFF;
9384 buffer
[1] = (JOCTET
) JPEG_EOI
;
9386 src
->next_input_byte
= buffer
;
9387 src
->bytes_in_buffer
= 2;
9392 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9393 is the JPEG data source manager. */
9396 our_skip_input_data (cinfo
, num_bytes
)
9397 j_decompress_ptr cinfo
;
9400 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9404 if (num_bytes
> src
->bytes_in_buffer
)
9405 ERREXIT (cinfo
, JERR_INPUT_EOF
);
9407 src
->bytes_in_buffer
-= num_bytes
;
9408 src
->next_input_byte
+= num_bytes
;
9413 /* Method to terminate data source. Called by
9414 jpeg_finish_decompress() after all data has been processed. */
9417 our_term_source (cinfo
)
9418 j_decompress_ptr cinfo
;
9423 /* Set up the JPEG lib for reading an image from DATA which contains
9424 LEN bytes. CINFO is the decompression info structure created for
9425 reading the image. */
9428 jpeg_memory_src (cinfo
, data
, len
)
9429 j_decompress_ptr cinfo
;
9433 struct jpeg_source_mgr
*src
;
9435 if (cinfo
->src
== NULL
)
9437 /* First time for this JPEG object? */
9438 cinfo
->src
= (struct jpeg_source_mgr
*)
9439 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9440 sizeof (struct jpeg_source_mgr
));
9441 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9442 src
->next_input_byte
= data
;
9445 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9446 src
->init_source
= our_init_source
;
9447 src
->fill_input_buffer
= our_fill_input_buffer
;
9448 src
->skip_input_data
= our_skip_input_data
;
9449 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9450 src
->term_source
= our_term_source
;
9451 src
->bytes_in_buffer
= len
;
9452 src
->next_input_byte
= data
;
9456 /* Load image IMG for use on frame F. Patterned after example.c
9457 from the JPEG lib. */
9464 struct jpeg_decompress_struct cinfo
;
9465 struct my_jpeg_error_mgr mgr
;
9466 Lisp_Object file
, specified_file
;
9467 Lisp_Object specified_data
;
9468 FILE * volatile fp
= NULL
;
9470 int row_stride
, x
, y
;
9471 XImage
*ximg
= NULL
;
9473 unsigned long *colors
;
9475 struct gcpro gcpro1
;
9477 /* Open the JPEG file. */
9478 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9479 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9483 if (NILP (specified_data
))
9485 file
= x_find_image_file (specified_file
);
9486 if (!STRINGP (file
))
9488 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9493 fp
= fopen (XSTRING (file
)->data
, "r");
9496 image_error ("Cannot open `%s'", file
, Qnil
);
9502 /* Customize libjpeg's error handling to call my_error_exit when an
9503 error is detected. This function will perform a longjmp. */
9504 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9505 mgr
.pub
.error_exit
= my_error_exit
;
9507 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9511 /* Called from my_error_exit. Display a JPEG error. */
9512 char buffer
[JMSG_LENGTH_MAX
];
9513 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9514 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9515 build_string (buffer
));
9518 /* Close the input file and destroy the JPEG object. */
9520 fclose ((FILE *) fp
);
9521 jpeg_destroy_decompress (&cinfo
);
9523 /* If we already have an XImage, free that. */
9524 x_destroy_x_image (ximg
);
9526 /* Free pixmap and colors. */
9527 x_clear_image (f
, img
);
9533 /* Create the JPEG decompression object. Let it read from fp.
9534 Read the JPEG image header. */
9535 jpeg_create_decompress (&cinfo
);
9537 if (NILP (specified_data
))
9538 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9540 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9541 STRING_BYTES (XSTRING (specified_data
)));
9543 jpeg_read_header (&cinfo
, TRUE
);
9545 /* Customize decompression so that color quantization will be used.
9546 Start decompression. */
9547 cinfo
.quantize_colors
= TRUE
;
9548 jpeg_start_decompress (&cinfo
);
9549 width
= img
->width
= cinfo
.output_width
;
9550 height
= img
->height
= cinfo
.output_height
;
9552 /* Create X image and pixmap. */
9553 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9554 longjmp (mgr
.setjmp_buffer
, 2);
9556 /* Allocate colors. When color quantization is used,
9557 cinfo.actual_number_of_colors has been set with the number of
9558 colors generated, and cinfo.colormap is a two-dimensional array
9559 of color indices in the range 0..cinfo.actual_number_of_colors.
9560 No more than 255 colors will be generated. */
9564 if (cinfo
.out_color_components
> 2)
9565 ir
= 0, ig
= 1, ib
= 2;
9566 else if (cinfo
.out_color_components
> 1)
9567 ir
= 0, ig
= 1, ib
= 0;
9569 ir
= 0, ig
= 0, ib
= 0;
9571 /* Use the color table mechanism because it handles colors that
9572 cannot be allocated nicely. Such colors will be replaced with
9573 a default color, and we don't have to care about which colors
9574 can be freed safely, and which can't. */
9575 init_color_table ();
9576 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9579 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9581 /* Multiply RGB values with 255 because X expects RGB values
9582 in the range 0..0xffff. */
9583 int r
= cinfo
.colormap
[ir
][i
] << 8;
9584 int g
= cinfo
.colormap
[ig
][i
] << 8;
9585 int b
= cinfo
.colormap
[ib
][i
] << 8;
9586 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9589 /* Remember those colors actually allocated. */
9590 img
->colors
= colors_in_color_table (&img
->ncolors
);
9591 free_color_table ();
9595 row_stride
= width
* cinfo
.output_components
;
9596 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9598 for (y
= 0; y
< height
; ++y
)
9600 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9601 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9602 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9606 jpeg_finish_decompress (&cinfo
);
9607 jpeg_destroy_decompress (&cinfo
);
9609 fclose ((FILE *) fp
);
9611 /* Maybe fill in the background field while we have ximg handy. */
9612 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9613 IMAGE_BACKGROUND (img
, f
, ximg
);
9615 /* Put the image into the pixmap. */
9616 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9617 x_destroy_x_image (ximg
);
9622 #endif /* HAVE_JPEG */
9626 /***********************************************************************
9628 ***********************************************************************/
9634 static int tiff_image_p
P_ ((Lisp_Object object
));
9635 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9637 /* The symbol `tiff' identifying images of this type. */
9641 /* Indices of image specification fields in tiff_format, below. */
9643 enum tiff_keyword_index
9652 TIFF_HEURISTIC_MASK
,
9658 /* Vector of image_keyword structures describing the format
9659 of valid user-defined image specifications. */
9661 static struct image_keyword tiff_format
[TIFF_LAST
] =
9663 {":type", IMAGE_SYMBOL_VALUE
, 1},
9664 {":data", IMAGE_STRING_VALUE
, 0},
9665 {":file", IMAGE_STRING_VALUE
, 0},
9666 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9667 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9668 {":relief", IMAGE_INTEGER_VALUE
, 0},
9669 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9670 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9671 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9672 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9675 /* Structure describing the image type `tiff'. */
9677 static struct image_type tiff_type
=
9687 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9690 tiff_image_p (object
)
9693 struct image_keyword fmt
[TIFF_LAST
];
9694 bcopy (tiff_format
, fmt
, sizeof fmt
);
9696 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9699 /* Must specify either the :data or :file keyword. */
9700 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9704 /* Reading from a memory buffer for TIFF images Based on the PNG
9705 memory source, but we have to provide a lot of extra functions.
9708 We really only need to implement read and seek, but I am not
9709 convinced that the TIFF library is smart enough not to destroy
9710 itself if we only hand it the function pointers we need to
9715 unsigned char *bytes
;
9723 tiff_read_from_memory (data
, buf
, size
)
9728 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9730 if (size
> src
->len
- src
->index
)
9732 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9739 tiff_write_from_memory (data
, buf
, size
)
9749 tiff_seek_in_memory (data
, off
, whence
)
9754 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9759 case SEEK_SET
: /* Go from beginning of source. */
9763 case SEEK_END
: /* Go from end of source. */
9764 idx
= src
->len
+ off
;
9767 case SEEK_CUR
: /* Go from current position. */
9768 idx
= src
->index
+ off
;
9771 default: /* Invalid `whence'. */
9775 if (idx
> src
->len
|| idx
< 0)
9784 tiff_close_memory (data
)
9793 tiff_mmap_memory (data
, pbase
, psize
)
9798 /* It is already _IN_ memory. */
9804 tiff_unmap_memory (data
, base
, size
)
9809 /* We don't need to do this. */
9814 tiff_size_of_memory (data
)
9817 return ((tiff_memory_source
*) data
)->len
;
9822 tiff_error_handler (title
, format
, ap
)
9823 const char *title
, *format
;
9829 len
= sprintf (buf
, "TIFF error: %s ", title
);
9830 vsprintf (buf
+ len
, format
, ap
);
9831 add_to_log (buf
, Qnil
, Qnil
);
9836 tiff_warning_handler (title
, format
, ap
)
9837 const char *title
, *format
;
9843 len
= sprintf (buf
, "TIFF warning: %s ", title
);
9844 vsprintf (buf
+ len
, format
, ap
);
9845 add_to_log (buf
, Qnil
, Qnil
);
9849 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9857 Lisp_Object file
, specified_file
;
9858 Lisp_Object specified_data
;
9860 int width
, height
, x
, y
;
9864 struct gcpro gcpro1
;
9865 tiff_memory_source memsrc
;
9867 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9868 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9872 TIFFSetErrorHandler (tiff_error_handler
);
9873 TIFFSetWarningHandler (tiff_warning_handler
);
9875 if (NILP (specified_data
))
9877 /* Read from a file */
9878 file
= x_find_image_file (specified_file
);
9879 if (!STRINGP (file
))
9881 image_error ("Cannot find image file `%s'", file
, Qnil
);
9886 /* Try to open the image file. */
9887 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9890 image_error ("Cannot open `%s'", file
, Qnil
);
9897 /* Memory source! */
9898 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9899 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9902 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9903 (TIFFReadWriteProc
) tiff_read_from_memory
,
9904 (TIFFReadWriteProc
) tiff_write_from_memory
,
9905 tiff_seek_in_memory
,
9907 tiff_size_of_memory
,
9913 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9919 /* Get width and height of the image, and allocate a raster buffer
9920 of width x height 32-bit values. */
9921 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9922 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9923 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9925 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9929 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9935 /* Create the X image and pixmap. */
9936 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9943 /* Initialize the color table. */
9944 init_color_table ();
9946 /* Process the pixel raster. Origin is in the lower-left corner. */
9947 for (y
= 0; y
< height
; ++y
)
9949 uint32
*row
= buf
+ y
* width
;
9951 for (x
= 0; x
< width
; ++x
)
9953 uint32 abgr
= row
[x
];
9954 int r
= TIFFGetR (abgr
) << 8;
9955 int g
= TIFFGetG (abgr
) << 8;
9956 int b
= TIFFGetB (abgr
) << 8;
9957 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9961 /* Remember the colors allocated for the image. Free the color table. */
9962 img
->colors
= colors_in_color_table (&img
->ncolors
);
9963 free_color_table ();
9966 img
->height
= height
;
9968 /* Maybe fill in the background field while we have ximg handy. */
9969 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9970 IMAGE_BACKGROUND (img
, f
, ximg
);
9972 /* Put the image into the pixmap, then free the X image and its buffer. */
9973 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9974 x_destroy_x_image (ximg
);
9981 #endif /* HAVE_TIFF != 0 */
9985 /***********************************************************************
9987 ***********************************************************************/
9991 #include <gif_lib.h>
9993 static int gif_image_p
P_ ((Lisp_Object object
));
9994 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9996 /* The symbol `gif' identifying images of this type. */
10000 /* Indices of image specification fields in gif_format, below. */
10002 enum gif_keyword_index
10011 GIF_HEURISTIC_MASK
,
10018 /* Vector of image_keyword structures describing the format
10019 of valid user-defined image specifications. */
10021 static struct image_keyword gif_format
[GIF_LAST
] =
10023 {":type", IMAGE_SYMBOL_VALUE
, 1},
10024 {":data", IMAGE_STRING_VALUE
, 0},
10025 {":file", IMAGE_STRING_VALUE
, 0},
10026 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10027 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10028 {":relief", IMAGE_INTEGER_VALUE
, 0},
10029 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10030 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10031 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10032 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
10033 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10036 /* Structure describing the image type `gif'. */
10038 static struct image_type gif_type
=
10048 /* Return non-zero if OBJECT is a valid GIF image specification. */
10051 gif_image_p (object
)
10052 Lisp_Object object
;
10054 struct image_keyword fmt
[GIF_LAST
];
10055 bcopy (gif_format
, fmt
, sizeof fmt
);
10057 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
10060 /* Must specify either the :data or :file keyword. */
10061 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
10065 /* Reading a GIF image from memory
10066 Based on the PNG memory stuff to a certain extent. */
10070 unsigned char *bytes
;
10077 /* Make the current memory source available to gif_read_from_memory.
10078 It's done this way because not all versions of libungif support
10079 a UserData field in the GifFileType structure. */
10080 static gif_memory_source
*current_gif_memory_src
;
10083 gif_read_from_memory (file
, buf
, len
)
10088 gif_memory_source
*src
= current_gif_memory_src
;
10090 if (len
> src
->len
- src
->index
)
10093 bcopy (src
->bytes
+ src
->index
, buf
, len
);
10099 /* Load GIF image IMG for use on frame F. Value is non-zero if
10107 Lisp_Object file
, specified_file
;
10108 Lisp_Object specified_data
;
10109 int rc
, width
, height
, x
, y
, i
;
10111 ColorMapObject
*gif_color_map
;
10112 unsigned long pixel_colors
[256];
10114 struct gcpro gcpro1
;
10116 int ino
, image_left
, image_top
, image_width
, image_height
;
10117 gif_memory_source memsrc
;
10118 unsigned char *raster
;
10120 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10121 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10125 if (NILP (specified_data
))
10127 file
= x_find_image_file (specified_file
);
10128 if (!STRINGP (file
))
10130 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10135 /* Open the GIF file. */
10136 gif
= DGifOpenFileName (XSTRING (file
)->data
);
10139 image_error ("Cannot open `%s'", file
, Qnil
);
10146 /* Read from memory! */
10147 current_gif_memory_src
= &memsrc
;
10148 memsrc
.bytes
= XSTRING (specified_data
)->data
;
10149 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
10152 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
10155 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
10161 /* Read entire contents. */
10162 rc
= DGifSlurp (gif
);
10163 if (rc
== GIF_ERROR
)
10165 image_error ("Error reading `%s'", img
->spec
, Qnil
);
10166 DGifCloseFile (gif
);
10171 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
10172 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
10173 if (ino
>= gif
->ImageCount
)
10175 image_error ("Invalid image number `%s' in image `%s'",
10177 DGifCloseFile (gif
);
10182 width
= img
->width
= max (gif
->SWidth
, gif
->Image
.Left
+ gif
->Image
.Width
);
10183 height
= img
->height
= max (gif
->SHeight
, gif
->Image
.Top
+ gif
->Image
.Height
);
10185 /* Create the X image and pixmap. */
10186 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
10188 DGifCloseFile (gif
);
10193 /* Allocate colors. */
10194 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
10195 if (!gif_color_map
)
10196 gif_color_map
= gif
->SColorMap
;
10197 init_color_table ();
10198 bzero (pixel_colors
, sizeof pixel_colors
);
10200 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
10202 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
10203 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
10204 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
10205 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
10208 img
->colors
= colors_in_color_table (&img
->ncolors
);
10209 free_color_table ();
10211 /* Clear the part of the screen image that are not covered by
10212 the image from the GIF file. Full animated GIF support
10213 requires more than can be done here (see the gif89 spec,
10214 disposal methods). Let's simply assume that the part
10215 not covered by a sub-image is in the frame's background color. */
10216 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
10217 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
10218 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
10219 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
10221 for (y
= 0; y
< image_top
; ++y
)
10222 for (x
= 0; x
< width
; ++x
)
10223 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10225 for (y
= image_top
+ image_height
; y
< height
; ++y
)
10226 for (x
= 0; x
< width
; ++x
)
10227 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10229 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
10231 for (x
= 0; x
< image_left
; ++x
)
10232 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10233 for (x
= image_left
+ image_width
; x
< width
; ++x
)
10234 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10237 /* Read the GIF image into the X image. We use a local variable
10238 `raster' here because RasterBits below is a char *, and invites
10239 problems with bytes >= 0x80. */
10240 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
10242 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
10244 static int interlace_start
[] = {0, 4, 2, 1};
10245 static int interlace_increment
[] = {8, 8, 4, 2};
10247 int row
= interlace_start
[0];
10251 for (y
= 0; y
< image_height
; y
++)
10253 if (row
>= image_height
)
10255 row
= interlace_start
[++pass
];
10256 while (row
>= image_height
)
10257 row
= interlace_start
[++pass
];
10260 for (x
= 0; x
< image_width
; x
++)
10262 int i
= raster
[(y
* image_width
) + x
];
10263 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
10267 row
+= interlace_increment
[pass
];
10272 for (y
= 0; y
< image_height
; ++y
)
10273 for (x
= 0; x
< image_width
; ++x
)
10275 int i
= raster
[y
* image_width
+ x
];
10276 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
10280 DGifCloseFile (gif
);
10282 /* Maybe fill in the background field while we have ximg handy. */
10283 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10284 IMAGE_BACKGROUND (img
, f
, ximg
);
10286 /* Put the image into the pixmap, then free the X image and its buffer. */
10287 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10288 x_destroy_x_image (ximg
);
10294 #endif /* HAVE_GIF != 0 */
10298 /***********************************************************************
10300 ***********************************************************************/
10302 static int gs_image_p
P_ ((Lisp_Object object
));
10303 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
10304 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
10306 /* The symbol `postscript' identifying images of this type. */
10308 Lisp_Object Qpostscript
;
10310 /* Keyword symbols. */
10312 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
10314 /* Indices of image specification fields in gs_format, below. */
10316 enum gs_keyword_index
10334 /* Vector of image_keyword structures describing the format
10335 of valid user-defined image specifications. */
10337 static struct image_keyword gs_format
[GS_LAST
] =
10339 {":type", IMAGE_SYMBOL_VALUE
, 1},
10340 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10341 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10342 {":file", IMAGE_STRING_VALUE
, 1},
10343 {":loader", IMAGE_FUNCTION_VALUE
, 0},
10344 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
10345 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10346 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10347 {":relief", IMAGE_INTEGER_VALUE
, 0},
10348 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10349 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10350 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10351 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10354 /* Structure describing the image type `ghostscript'. */
10356 static struct image_type gs_type
=
10366 /* Free X resources of Ghostscript image IMG which is used on frame F. */
10369 gs_clear_image (f
, img
)
10373 /* IMG->data.ptr_val may contain a recorded colormap. */
10374 xfree (img
->data
.ptr_val
);
10375 x_clear_image (f
, img
);
10379 /* Return non-zero if OBJECT is a valid Ghostscript image
10383 gs_image_p (object
)
10384 Lisp_Object object
;
10386 struct image_keyword fmt
[GS_LAST
];
10390 bcopy (gs_format
, fmt
, sizeof fmt
);
10392 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
10395 /* Bounding box must be a list or vector containing 4 integers. */
10396 tem
= fmt
[GS_BOUNDING_BOX
].value
;
10399 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
10400 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
10405 else if (VECTORP (tem
))
10407 if (XVECTOR (tem
)->size
!= 4)
10409 for (i
= 0; i
< 4; ++i
)
10410 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
10420 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
10429 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
10430 struct gcpro gcpro1
, gcpro2
;
10432 double in_width
, in_height
;
10433 Lisp_Object pixel_colors
= Qnil
;
10435 /* Compute pixel size of pixmap needed from the given size in the
10436 image specification. Sizes in the specification are in pt. 1 pt
10437 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10439 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
10440 in_width
= XFASTINT (pt_width
) / 72.0;
10441 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
10442 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
10443 in_height
= XFASTINT (pt_height
) / 72.0;
10444 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
10446 /* Create the pixmap. */
10447 xassert (img
->pixmap
== None
);
10448 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10449 img
->width
, img
->height
,
10450 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
10454 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
10458 /* Call the loader to fill the pixmap. It returns a process object
10459 if successful. We do not record_unwind_protect here because
10460 other places in redisplay like calling window scroll functions
10461 don't either. Let the Lisp loader use `unwind-protect' instead. */
10462 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
10464 sprintf (buffer
, "%lu %lu",
10465 (unsigned long) FRAME_X_WINDOW (f
),
10466 (unsigned long) img
->pixmap
);
10467 window_and_pixmap_id
= build_string (buffer
);
10469 sprintf (buffer
, "%lu %lu",
10470 FRAME_FOREGROUND_PIXEL (f
),
10471 FRAME_BACKGROUND_PIXEL (f
));
10472 pixel_colors
= build_string (buffer
);
10474 XSETFRAME (frame
, f
);
10475 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
10477 loader
= intern ("gs-load-image");
10479 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10480 make_number (img
->width
),
10481 make_number (img
->height
),
10482 window_and_pixmap_id
,
10485 return PROCESSP (img
->data
.lisp_val
);
10489 /* Kill the Ghostscript process that was started to fill PIXMAP on
10490 frame F. Called from XTread_socket when receiving an event
10491 telling Emacs that Ghostscript has finished drawing. */
10494 x_kill_gs_process (pixmap
, f
)
10498 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10502 /* Find the image containing PIXMAP. */
10503 for (i
= 0; i
< c
->used
; ++i
)
10504 if (c
->images
[i
]->pixmap
== pixmap
)
10507 /* Should someone in between have cleared the image cache, for
10508 instance, give up. */
10512 /* Kill the GS process. We should have found PIXMAP in the image
10513 cache and its image should contain a process object. */
10514 img
= c
->images
[i
];
10515 xassert (PROCESSP (img
->data
.lisp_val
));
10516 Fkill_process (img
->data
.lisp_val
, Qnil
);
10517 img
->data
.lisp_val
= Qnil
;
10519 /* On displays with a mutable colormap, figure out the colors
10520 allocated for the image by looking at the pixels of an XImage for
10522 class = FRAME_X_VISUAL (f
)->class;
10523 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10529 /* Try to get an XImage for img->pixmep. */
10530 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10531 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10536 /* Initialize the color table. */
10537 init_color_table ();
10539 /* For each pixel of the image, look its color up in the
10540 color table. After having done so, the color table will
10541 contain an entry for each color used by the image. */
10542 for (y
= 0; y
< img
->height
; ++y
)
10543 for (x
= 0; x
< img
->width
; ++x
)
10545 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10546 lookup_pixel_color (f
, pixel
);
10549 /* Record colors in the image. Free color table and XImage. */
10550 img
->colors
= colors_in_color_table (&img
->ncolors
);
10551 free_color_table ();
10552 XDestroyImage (ximg
);
10554 #if 0 /* This doesn't seem to be the case. If we free the colors
10555 here, we get a BadAccess later in x_clear_image when
10556 freeing the colors. */
10557 /* We have allocated colors once, but Ghostscript has also
10558 allocated colors on behalf of us. So, to get the
10559 reference counts right, free them once. */
10561 x_free_colors (f
, img
->colors
, img
->ncolors
);
10565 image_error ("Cannot get X image of `%s'; colors will not be freed",
10571 /* Now that we have the pixmap, compute mask and transform the
10572 image if requested. */
10574 postprocess_image (f
, img
);
10580 /***********************************************************************
10582 ***********************************************************************/
10584 DEFUN ("x-change-window-property", Fx_change_window_property
,
10585 Sx_change_window_property
, 2, 3, 0,
10586 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
10587 PROP and VALUE must be strings. FRAME nil or omitted means use the
10588 selected frame. Value is VALUE. */)
10589 (prop
, value
, frame
)
10590 Lisp_Object frame
, prop
, value
;
10592 struct frame
*f
= check_x_frame (frame
);
10595 CHECK_STRING (prop
);
10596 CHECK_STRING (value
);
10599 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10600 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10601 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10602 XSTRING (value
)->data
, XSTRING (value
)->size
);
10604 /* Make sure the property is set when we return. */
10605 XFlush (FRAME_X_DISPLAY (f
));
10612 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10613 Sx_delete_window_property
, 1, 2, 0,
10614 doc
: /* Remove window property PROP from X window of FRAME.
10615 FRAME nil or omitted means use the selected frame. Value is PROP. */)
10617 Lisp_Object prop
, frame
;
10619 struct frame
*f
= check_x_frame (frame
);
10622 CHECK_STRING (prop
);
10624 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10625 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10627 /* Make sure the property is removed when we return. */
10628 XFlush (FRAME_X_DISPLAY (f
));
10635 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10637 doc
: /* Value is the value of window property PROP on FRAME.
10638 If FRAME is nil or omitted, use the selected frame. Value is nil
10639 if FRAME hasn't a property with name PROP or if PROP has no string
10642 Lisp_Object prop
, frame
;
10644 struct frame
*f
= check_x_frame (frame
);
10647 Lisp_Object prop_value
= Qnil
;
10648 char *tmp_data
= NULL
;
10651 unsigned long actual_size
, bytes_remaining
;
10653 CHECK_STRING (prop
);
10655 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10656 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10657 prop_atom
, 0, 0, False
, XA_STRING
,
10658 &actual_type
, &actual_format
, &actual_size
,
10659 &bytes_remaining
, (unsigned char **) &tmp_data
);
10662 int size
= bytes_remaining
;
10667 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10668 prop_atom
, 0, bytes_remaining
,
10670 &actual_type
, &actual_format
,
10671 &actual_size
, &bytes_remaining
,
10672 (unsigned char **) &tmp_data
);
10673 if (rc
== Success
&& tmp_data
)
10674 prop_value
= make_string (tmp_data
, size
);
10685 /***********************************************************************
10687 ***********************************************************************/
10689 /* If non-null, an asynchronous timer that, when it expires, displays
10690 an hourglass cursor on all frames. */
10692 static struct atimer
*hourglass_atimer
;
10694 /* Non-zero means an hourglass cursor is currently shown. */
10696 static int hourglass_shown_p
;
10698 /* Number of seconds to wait before displaying an hourglass cursor. */
10700 static Lisp_Object Vhourglass_delay
;
10702 /* Default number of seconds to wait before displaying an hourglass
10705 #define DEFAULT_HOURGLASS_DELAY 1
10707 /* Function prototypes. */
10709 static void show_hourglass
P_ ((struct atimer
*));
10710 static void hide_hourglass
P_ ((void));
10713 /* Cancel a currently active hourglass timer, and start a new one. */
10719 int secs
, usecs
= 0;
10721 cancel_hourglass ();
10723 if (INTEGERP (Vhourglass_delay
)
10724 && XINT (Vhourglass_delay
) > 0)
10725 secs
= XFASTINT (Vhourglass_delay
);
10726 else if (FLOATP (Vhourglass_delay
)
10727 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10730 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10731 secs
= XFASTINT (tem
);
10732 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10735 secs
= DEFAULT_HOURGLASS_DELAY
;
10737 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10738 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10739 show_hourglass
, NULL
);
10743 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10747 cancel_hourglass ()
10749 if (hourglass_atimer
)
10751 cancel_atimer (hourglass_atimer
);
10752 hourglass_atimer
= NULL
;
10755 if (hourglass_shown_p
)
10760 /* Timer function of hourglass_atimer. TIMER is equal to
10763 Display an hourglass pointer on all frames by mapping the frames'
10764 hourglass_window. Set the hourglass_p flag in the frames'
10765 output_data.x structure to indicate that an hourglass cursor is
10766 shown on the frames. */
10769 show_hourglass (timer
)
10770 struct atimer
*timer
;
10772 /* The timer implementation will cancel this timer automatically
10773 after this function has run. Set hourglass_atimer to null
10774 so that we know the timer doesn't have to be canceled. */
10775 hourglass_atimer
= NULL
;
10777 if (!hourglass_shown_p
)
10779 Lisp_Object rest
, frame
;
10783 FOR_EACH_FRAME (rest
, frame
)
10785 struct frame
*f
= XFRAME (frame
);
10787 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10789 Display
*dpy
= FRAME_X_DISPLAY (f
);
10791 #ifdef USE_X_TOOLKIT
10792 if (f
->output_data
.x
->widget
)
10794 if (FRAME_OUTER_WINDOW (f
))
10797 f
->output_data
.x
->hourglass_p
= 1;
10799 if (!f
->output_data
.x
->hourglass_window
)
10801 unsigned long mask
= CWCursor
;
10802 XSetWindowAttributes attrs
;
10804 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10806 f
->output_data
.x
->hourglass_window
10807 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10808 0, 0, 32000, 32000, 0, 0,
10814 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10820 hourglass_shown_p
= 1;
10826 /* Hide the hourglass pointer on all frames, if it is currently
10832 if (hourglass_shown_p
)
10834 Lisp_Object rest
, frame
;
10837 FOR_EACH_FRAME (rest
, frame
)
10839 struct frame
*f
= XFRAME (frame
);
10842 /* Watch out for newly created frames. */
10843 && f
->output_data
.x
->hourglass_window
)
10845 XUnmapWindow (FRAME_X_DISPLAY (f
),
10846 f
->output_data
.x
->hourglass_window
);
10847 /* Sync here because XTread_socket looks at the
10848 hourglass_p flag that is reset to zero below. */
10849 XSync (FRAME_X_DISPLAY (f
), False
);
10850 f
->output_data
.x
->hourglass_p
= 0;
10854 hourglass_shown_p
= 0;
10861 /***********************************************************************
10863 ***********************************************************************/
10865 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10866 Lisp_Object
, Lisp_Object
));
10867 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10868 Lisp_Object
, int, int, int *, int *));
10870 /* The frame of a currently visible tooltip. */
10872 Lisp_Object tip_frame
;
10874 /* If non-nil, a timer started that hides the last tooltip when it
10877 Lisp_Object tip_timer
;
10880 /* If non-nil, a vector of 3 elements containing the last args
10881 with which x-show-tip was called. See there. */
10883 Lisp_Object last_show_tip_args
;
10885 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
10887 Lisp_Object Vx_max_tooltip_size
;
10891 unwind_create_tip_frame (frame
)
10894 Lisp_Object deleted
;
10896 deleted
= unwind_create_frame (frame
);
10897 if (EQ (deleted
, Qt
))
10907 /* Create a frame for a tooltip on the display described by DPYINFO.
10908 PARMS is a list of frame parameters. TEXT is the string to
10909 display in the tip frame. Value is the frame.
10911 Note that functions called here, esp. x_default_parameter can
10912 signal errors, for instance when a specified color name is
10913 undefined. We have to make sure that we're in a consistent state
10914 when this happens. */
10917 x_create_tip_frame (dpyinfo
, parms
, text
)
10918 struct x_display_info
*dpyinfo
;
10919 Lisp_Object parms
, text
;
10922 Lisp_Object frame
, tem
;
10924 long window_prompting
= 0;
10926 int count
= BINDING_STACK_SIZE ();
10927 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10929 int face_change_count_before
= face_change_count
;
10930 Lisp_Object buffer
;
10931 struct buffer
*old_buffer
;
10935 /* Use this general default value to start with until we know if
10936 this frame has a specified name. */
10937 Vx_resource_name
= Vinvocation_name
;
10939 #ifdef MULTI_KBOARD
10940 kb
= dpyinfo
->kboard
;
10942 kb
= &the_only_kboard
;
10945 /* Get the name of the frame to use for resource lookup. */
10946 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10947 if (!STRINGP (name
)
10948 && !EQ (name
, Qunbound
)
10950 error ("Invalid frame name--not a string or nil");
10951 Vx_resource_name
= name
;
10954 GCPRO3 (parms
, name
, frame
);
10955 f
= make_frame (1);
10956 XSETFRAME (frame
, f
);
10958 buffer
= Fget_buffer_create (build_string (" *tip*"));
10959 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10960 old_buffer
= current_buffer
;
10961 set_buffer_internal_1 (XBUFFER (buffer
));
10962 current_buffer
->truncate_lines
= Qnil
;
10964 Finsert (1, &text
);
10965 set_buffer_internal_1 (old_buffer
);
10967 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10968 record_unwind_protect (unwind_create_tip_frame
, frame
);
10970 /* By setting the output method, we're essentially saying that
10971 the frame is live, as per FRAME_LIVE_P. If we get a signal
10972 from this point on, x_destroy_window might screw up reference
10974 f
->output_method
= output_x_window
;
10975 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10976 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10977 f
->output_data
.x
->icon_bitmap
= -1;
10978 f
->output_data
.x
->fontset
= -1;
10979 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10980 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10981 #ifdef USE_TOOLKIT_SCROLL_BARS
10982 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
10983 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
10984 #endif /* USE_TOOLKIT_SCROLL_BARS */
10985 f
->icon_name
= Qnil
;
10986 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10988 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10989 dpyinfo_refcount
= dpyinfo
->reference_count
;
10990 #endif /* GLYPH_DEBUG */
10991 #ifdef MULTI_KBOARD
10992 FRAME_KBOARD (f
) = kb
;
10994 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10995 f
->output_data
.x
->explicit_parent
= 0;
10997 /* These colors will be set anyway later, but it's important
10998 to get the color reference counts right, so initialize them! */
11001 struct gcpro gcpro1
;
11003 black
= build_string ("black");
11005 f
->output_data
.x
->foreground_pixel
11006 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11007 f
->output_data
.x
->background_pixel
11008 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11009 f
->output_data
.x
->cursor_pixel
11010 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11011 f
->output_data
.x
->cursor_foreground_pixel
11012 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11013 f
->output_data
.x
->border_pixel
11014 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11015 f
->output_data
.x
->mouse_pixel
11016 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11020 /* Set the name; the functions to which we pass f expect the name to
11022 if (EQ (name
, Qunbound
) || NILP (name
))
11024 f
->name
= build_string (dpyinfo
->x_id_name
);
11025 f
->explicit_name
= 0;
11030 f
->explicit_name
= 1;
11031 /* use the frame's title when getting resources for this frame. */
11032 specbind (Qx_resource_name
, name
);
11035 /* Extract the window parameters from the supplied values that are
11036 needed to determine window geometry. */
11040 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
11043 /* First, try whatever font the caller has specified. */
11044 if (STRINGP (font
))
11046 tem
= Fquery_fontset (font
, Qnil
);
11048 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
11050 font
= x_new_font (f
, XSTRING (font
)->data
);
11053 /* Try out a font which we hope has bold and italic variations. */
11054 if (!STRINGP (font
))
11055 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
11056 if (!STRINGP (font
))
11057 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11058 if (! STRINGP (font
))
11059 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11060 if (! STRINGP (font
))
11061 /* This was formerly the first thing tried, but it finds too many fonts
11062 and takes too long. */
11063 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
11064 /* If those didn't work, look for something which will at least work. */
11065 if (! STRINGP (font
))
11066 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
11068 if (! STRINGP (font
))
11069 font
= build_string ("fixed");
11071 x_default_parameter (f
, parms
, Qfont
, font
,
11072 "font", "Font", RES_TYPE_STRING
);
11075 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
11076 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
11078 /* This defaults to 2 in order to match xterm. We recognize either
11079 internalBorderWidth or internalBorder (which is what xterm calls
11081 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11085 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
11086 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
11087 if (! EQ (value
, Qunbound
))
11088 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
11092 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
11093 "internalBorderWidth", "internalBorderWidth",
11096 /* Also do the stuff which must be set before the window exists. */
11097 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
11098 "foreground", "Foreground", RES_TYPE_STRING
);
11099 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
11100 "background", "Background", RES_TYPE_STRING
);
11101 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
11102 "pointerColor", "Foreground", RES_TYPE_STRING
);
11103 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
11104 "cursorColor", "Foreground", RES_TYPE_STRING
);
11105 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
11106 "borderColor", "BorderColor", RES_TYPE_STRING
);
11108 /* Init faces before x_default_parameter is called for scroll-bar
11109 parameters because that function calls x_set_scroll_bar_width,
11110 which calls change_frame_size, which calls Fset_window_buffer,
11111 which runs hooks, which call Fvertical_motion. At the end, we
11112 end up in init_iterator with a null face cache, which should not
11114 init_frame_faces (f
);
11116 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
11117 window_prompting
= x_figure_window_size (f
, parms
);
11119 if (window_prompting
& XNegative
)
11121 if (window_prompting
& YNegative
)
11122 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
11124 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
11128 if (window_prompting
& YNegative
)
11129 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
11131 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
11134 f
->output_data
.x
->size_hint_flags
= window_prompting
;
11136 XSetWindowAttributes attrs
;
11137 unsigned long mask
;
11140 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
11141 if (DoesSaveUnders (dpyinfo
->screen
))
11142 mask
|= CWSaveUnder
;
11144 /* Window managers look at the override-redirect flag to determine
11145 whether or net to give windows a decoration (Xlib spec, chapter
11147 attrs
.override_redirect
= True
;
11148 attrs
.save_under
= True
;
11149 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
11150 /* Arrange for getting MapNotify and UnmapNotify events. */
11151 attrs
.event_mask
= StructureNotifyMask
;
11153 = FRAME_X_WINDOW (f
)
11154 = XCreateWindow (FRAME_X_DISPLAY (f
),
11155 FRAME_X_DISPLAY_INFO (f
)->root_window
,
11156 /* x, y, width, height */
11160 CopyFromParent
, InputOutput
, CopyFromParent
,
11167 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
11168 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
11169 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
11170 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
11171 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
11172 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
11174 /* Dimensions, especially f->height, must be done via change_frame_size.
11175 Change will not be effected unless different from the current
11178 height
= f
->height
;
11180 SET_FRAME_WIDTH (f
, 0);
11181 change_frame_size (f
, height
, width
, 1, 0, 0);
11183 /* Set up faces after all frame parameters are known. This call
11184 also merges in face attributes specified for new frames.
11186 Frame parameters may be changed if .Xdefaults contains
11187 specifications for the default font. For example, if there is an
11188 `Emacs.default.attributeBackground: pink', the `background-color'
11189 attribute of the frame get's set, which let's the internal border
11190 of the tooltip frame appear in pink. Prevent this. */
11192 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
11194 /* Set tip_frame here, so that */
11196 call1 (Qface_set_after_frame_default
, frame
);
11198 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
11199 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
11207 /* It is now ok to make the frame official even if we get an error
11208 below. And the frame needs to be on Vframe_list or making it
11209 visible won't work. */
11210 Vframe_list
= Fcons (frame
, Vframe_list
);
11212 /* Now that the frame is official, it counts as a reference to
11214 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
11216 /* Setting attributes of faces of the tooltip frame from resources
11217 and similar will increment face_change_count, which leads to the
11218 clearing of all current matrices. Since this isn't necessary
11219 here, avoid it by resetting face_change_count to the value it
11220 had before we created the tip frame. */
11221 face_change_count
= face_change_count_before
;
11223 /* Discard the unwind_protect. */
11224 return unbind_to (count
, frame
);
11228 /* Compute where to display tip frame F. PARMS is the list of frame
11229 parameters for F. DX and DY are specified offsets from the current
11230 location of the mouse. WIDTH and HEIGHT are the width and height
11231 of the tooltip. Return coordinates relative to the root window of
11232 the display in *ROOT_X, and *ROOT_Y. */
11235 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
11237 Lisp_Object parms
, dx
, dy
;
11239 int *root_x
, *root_y
;
11241 Lisp_Object left
, top
;
11243 Window root
, child
;
11246 /* User-specified position? */
11247 left
= Fcdr (Fassq (Qleft
, parms
));
11248 top
= Fcdr (Fassq (Qtop
, parms
));
11250 /* Move the tooltip window where the mouse pointer is. Resize and
11252 if (!INTEGERP (left
) || !INTEGERP (top
))
11255 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
11256 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
11260 if (INTEGERP (top
))
11261 *root_y
= XINT (top
);
11262 else if (*root_y
+ XINT (dy
) - height
< 0)
11263 *root_y
-= XINT (dy
);
11267 *root_y
+= XINT (dy
);
11270 if (INTEGERP (left
))
11271 *root_x
= XINT (left
);
11272 else if (*root_x
+ XINT (dx
) + width
<= FRAME_X_DISPLAY_INFO (f
)->width
)
11273 /* It fits to the right of the pointer. */
11274 *root_x
+= XINT (dx
);
11275 else if (width
+ XINT (dx
) <= *root_x
)
11276 /* It fits to the left of the pointer. */
11277 *root_x
-= width
+ XINT (dx
);
11279 /* Put it left-justified on the screen--it ought to fit that way. */
11284 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
11285 doc
: /* Show STRING in a "tooltip" window on frame FRAME.
11286 A tooltip window is a small X window displaying a string.
11288 FRAME nil or omitted means use the selected frame.
11290 PARMS is an optional list of frame parameters which can be used to
11291 change the tooltip's appearance.
11293 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
11294 means use the default timeout of 5 seconds.
11296 If the list of frame parameters PARAMS contains a `left' parameters,
11297 the tooltip is displayed at that x-position. Otherwise it is
11298 displayed at the mouse position, with offset DX added (default is 5 if
11299 DX isn't specified). Likewise for the y-position; if a `top' frame
11300 parameter is specified, it determines the y-position of the tooltip
11301 window, otherwise it is displayed at the mouse position, with offset
11302 DY added (default is -10).
11304 A tooltip's maximum size is specified by `x-max-tooltip-size'.
11305 Text larger than the specified size is clipped. */)
11306 (string
, frame
, parms
, timeout
, dx
, dy
)
11307 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
11311 int root_x
, root_y
;
11312 struct buffer
*old_buffer
;
11313 struct text_pos pos
;
11314 int i
, width
, height
;
11315 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
11316 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
11317 int count
= BINDING_STACK_SIZE ();
11319 specbind (Qinhibit_redisplay
, Qt
);
11321 GCPRO4 (string
, parms
, frame
, timeout
);
11323 CHECK_STRING (string
);
11324 f
= check_x_frame (frame
);
11325 if (NILP (timeout
))
11326 timeout
= make_number (5);
11328 CHECK_NATNUM (timeout
);
11331 dx
= make_number (5);
11336 dy
= make_number (-10);
11340 if (NILP (last_show_tip_args
))
11341 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
11343 if (!NILP (tip_frame
))
11345 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
11346 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
11347 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
11349 if (EQ (frame
, last_frame
)
11350 && !NILP (Fequal (last_string
, string
))
11351 && !NILP (Fequal (last_parms
, parms
)))
11353 struct frame
*f
= XFRAME (tip_frame
);
11355 /* Only DX and DY have changed. */
11356 if (!NILP (tip_timer
))
11358 Lisp_Object timer
= tip_timer
;
11360 call1 (Qcancel_timer
, timer
);
11364 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
11365 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
11366 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11373 /* Hide a previous tip, if any. */
11376 ASET (last_show_tip_args
, 0, string
);
11377 ASET (last_show_tip_args
, 1, frame
);
11378 ASET (last_show_tip_args
, 2, parms
);
11380 /* Add default values to frame parameters. */
11381 if (NILP (Fassq (Qname
, parms
)))
11382 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
11383 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11384 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
11385 if (NILP (Fassq (Qborder_width
, parms
)))
11386 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
11387 if (NILP (Fassq (Qborder_color
, parms
)))
11388 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
11389 if (NILP (Fassq (Qbackground_color
, parms
)))
11390 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
11393 /* Create a frame for the tooltip, and record it in the global
11394 variable tip_frame. */
11395 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
, string
);
11396 f
= XFRAME (frame
);
11398 /* Set up the frame's root window. */
11399 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
11400 w
->left
= w
->top
= make_number (0);
11402 if (CONSP (Vx_max_tooltip_size
)
11403 && INTEGERP (XCAR (Vx_max_tooltip_size
))
11404 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
11405 && INTEGERP (XCDR (Vx_max_tooltip_size
))
11406 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
11408 w
->width
= XCAR (Vx_max_tooltip_size
);
11409 w
->height
= XCDR (Vx_max_tooltip_size
);
11413 w
->width
= make_number (80);
11414 w
->height
= make_number (40);
11417 f
->window_width
= XINT (w
->width
);
11419 w
->pseudo_window_p
= 1;
11421 /* Display the tooltip text in a temporary buffer. */
11422 old_buffer
= current_buffer
;
11423 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
11424 current_buffer
->truncate_lines
= Qnil
;
11425 clear_glyph_matrix (w
->desired_matrix
);
11426 clear_glyph_matrix (w
->current_matrix
);
11427 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
11428 try_window (FRAME_ROOT_WINDOW (f
), pos
);
11430 /* Compute width and height of the tooltip. */
11431 width
= height
= 0;
11432 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
11434 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
11435 struct glyph
*last
;
11438 /* Stop at the first empty row at the end. */
11439 if (!row
->enabled_p
|| !row
->displays_text_p
)
11442 /* Let the row go over the full width of the frame. */
11443 row
->full_width_p
= 1;
11445 /* There's a glyph at the end of rows that is used to place
11446 the cursor there. Don't include the width of this glyph. */
11447 if (row
->used
[TEXT_AREA
])
11449 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
11450 row_width
= row
->pixel_width
- last
->pixel_width
;
11453 row_width
= row
->pixel_width
;
11455 height
+= row
->height
;
11456 width
= max (width
, row_width
);
11459 /* Add the frame's internal border to the width and height the X
11460 window should have. */
11461 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11462 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11464 /* Move the tooltip window where the mouse pointer is. Resize and
11466 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
11469 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11470 root_x
, root_y
, width
, height
);
11471 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
11474 /* Draw into the window. */
11475 w
->must_be_updated_p
= 1;
11476 update_single_window (w
, 1);
11478 /* Restore original current buffer. */
11479 set_buffer_internal_1 (old_buffer
);
11480 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
11483 /* Let the tip disappear after timeout seconds. */
11484 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
11485 intern ("x-hide-tip"));
11488 return unbind_to (count
, Qnil
);
11492 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
11493 doc
: /* Hide the current tooltip window, if there is any.
11494 Value is t if tooltip was open, nil otherwise. */)
11498 Lisp_Object deleted
, frame
, timer
;
11499 struct gcpro gcpro1
, gcpro2
;
11501 /* Return quickly if nothing to do. */
11502 if (NILP (tip_timer
) && NILP (tip_frame
))
11507 GCPRO2 (frame
, timer
);
11508 tip_frame
= tip_timer
= deleted
= Qnil
;
11510 count
= BINDING_STACK_SIZE ();
11511 specbind (Qinhibit_redisplay
, Qt
);
11512 specbind (Qinhibit_quit
, Qt
);
11515 call1 (Qcancel_timer
, timer
);
11517 if (FRAMEP (frame
))
11519 Fdelete_frame (frame
, Qnil
);
11523 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11524 redisplay procedure is not called when a tip frame over menu
11525 items is unmapped. Redisplay the menu manually... */
11527 struct frame
*f
= SELECTED_FRAME ();
11528 Widget w
= f
->output_data
.x
->menubar_widget
;
11529 extern void xlwmenu_redisplay
P_ ((Widget
));
11531 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
11535 xlwmenu_redisplay (w
);
11539 #endif /* USE_LUCID */
11543 return unbind_to (count
, deleted
);
11548 /***********************************************************************
11549 File selection dialog
11550 ***********************************************************************/
11554 /* Callback for "OK" and "Cancel" on file selection dialog. */
11557 file_dialog_cb (widget
, client_data
, call_data
)
11559 XtPointer call_data
, client_data
;
11561 int *result
= (int *) client_data
;
11562 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11563 *result
= cb
->reason
;
11567 /* Callback for unmapping a file selection dialog. This is used to
11568 capture the case where a dialog is closed via a window manager's
11569 closer button, for example. Using a XmNdestroyCallback didn't work
11573 file_dialog_unmap_cb (widget
, client_data
, call_data
)
11575 XtPointer call_data
, client_data
;
11577 int *result
= (int *) client_data
;
11578 *result
= XmCR_CANCEL
;
11582 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11583 doc
: /* Read file name, prompting with PROMPT in directory DIR.
11584 Use a file selection dialog.
11585 Select DEFAULT-FILENAME in the dialog's file selection box, if
11586 specified. Don't let the user enter a file name in the file
11587 selection dialog's entry field, if MUSTMATCH is non-nil. */)
11588 (prompt
, dir
, default_filename
, mustmatch
)
11589 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11592 struct frame
*f
= SELECTED_FRAME ();
11593 Lisp_Object file
= Qnil
;
11594 Widget dialog
, text
, list
, help
;
11597 extern XtAppContext Xt_app_con
;
11598 XmString dir_xmstring
, pattern_xmstring
;
11599 int count
= specpdl_ptr
- specpdl
;
11600 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11602 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11603 CHECK_STRING (prompt
);
11604 CHECK_STRING (dir
);
11606 /* Prevent redisplay. */
11607 specbind (Qinhibit_redisplay
, Qt
);
11611 /* Create the dialog with PROMPT as title, using DIR as initial
11612 directory and using "*" as pattern. */
11613 dir
= Fexpand_file_name (dir
, Qnil
);
11614 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11615 pattern_xmstring
= XmStringCreateLocalized ("*");
11617 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11618 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11619 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11620 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11621 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11622 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11624 XmStringFree (dir_xmstring
);
11625 XmStringFree (pattern_xmstring
);
11627 /* Add callbacks for OK and Cancel. */
11628 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11629 (XtPointer
) &result
);
11630 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11631 (XtPointer
) &result
);
11632 XtAddCallback (dialog
, XmNunmapCallback
, file_dialog_unmap_cb
,
11633 (XtPointer
) &result
);
11635 /* Disable the help button since we can't display help. */
11636 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11637 XtSetSensitive (help
, False
);
11639 /* Mark OK button as default. */
11640 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11641 XmNshowAsDefault
, True
, NULL
);
11643 /* If MUSTMATCH is non-nil, disable the file entry field of the
11644 dialog, so that the user must select a file from the files list
11645 box. We can't remove it because we wouldn't have a way to get at
11646 the result file name, then. */
11647 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11648 if (!NILP (mustmatch
))
11651 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11652 XtSetSensitive (text
, False
);
11653 XtSetSensitive (label
, False
);
11656 /* Manage the dialog, so that list boxes get filled. */
11657 XtManageChild (dialog
);
11659 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11660 must include the path for this to work. */
11661 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11662 if (STRINGP (default_filename
))
11664 XmString default_xmstring
;
11668 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11670 if (!XmListItemExists (list
, default_xmstring
))
11672 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11673 XmListAddItem (list
, default_xmstring
, 0);
11677 item_pos
= XmListItemPos (list
, default_xmstring
);
11678 XmStringFree (default_xmstring
);
11680 /* Select the item and scroll it into view. */
11681 XmListSelectPos (list
, item_pos
, True
);
11682 XmListSetPos (list
, item_pos
);
11685 /* Process events until the user presses Cancel or OK. Block
11686 and unblock input here so that we get a chance of processing
11690 while (result
== 0)
11693 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11698 /* Get the result. */
11699 if (result
== XmCR_OK
)
11704 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11705 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11706 XmStringFree (text
);
11707 file
= build_string (data
);
11714 XtUnmanageChild (dialog
);
11715 XtDestroyWidget (dialog
);
11719 /* Make "Cancel" equivalent to C-g. */
11721 Fsignal (Qquit
, Qnil
);
11723 return unbind_to (count
, file
);
11726 #endif /* USE_MOTIF */
11730 /***********************************************************************
11732 ***********************************************************************/
11734 #ifdef HAVE_XKBGETKEYBOARD
11735 #include <X11/XKBlib.h>
11736 #include <X11/keysym.h>
11739 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11740 Sx_backspace_delete_keys_p
, 0, 1, 0,
11741 doc
: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
11742 FRAME nil means use the selected frame.
11743 Value is t if we know that both keys are present, and are mapped to the
11744 usual X keysyms. */)
11748 #ifdef HAVE_XKBGETKEYBOARD
11750 struct frame
*f
= check_x_frame (frame
);
11751 Display
*dpy
= FRAME_X_DISPLAY (f
);
11752 Lisp_Object have_keys
;
11753 int major
, minor
, op
, event
, error
;
11757 /* Check library version in case we're dynamically linked. */
11758 major
= XkbMajorVersion
;
11759 minor
= XkbMinorVersion
;
11760 if (!XkbLibraryVersion (&major
, &minor
))
11766 /* Check that the server supports XKB. */
11767 major
= XkbMajorVersion
;
11768 minor
= XkbMinorVersion
;
11769 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11776 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11779 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11781 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11783 for (i
= kb
->min_key_code
;
11784 (i
< kb
->max_key_code
11785 && (delete_keycode
== 0 || backspace_keycode
== 0));
11788 /* The XKB symbolic key names can be seen most easily in
11789 the PS file generated by `xkbprint -label name
11791 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11792 delete_keycode
= i
;
11793 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11794 backspace_keycode
= i
;
11797 XkbFreeNames (kb
, 0, True
);
11800 XkbFreeClientMap (kb
, 0, True
);
11803 && backspace_keycode
11804 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11805 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11810 #else /* not HAVE_XKBGETKEYBOARD */
11812 #endif /* not HAVE_XKBGETKEYBOARD */
11817 /***********************************************************************
11819 ***********************************************************************/
11824 /* This is zero if not using X windows. */
11827 /* The section below is built by the lisp expression at the top of the file,
11828 just above where these variables are declared. */
11829 /*&&& init symbols here &&&*/
11830 Qauto_raise
= intern ("auto-raise");
11831 staticpro (&Qauto_raise
);
11832 Qauto_lower
= intern ("auto-lower");
11833 staticpro (&Qauto_lower
);
11834 Qbar
= intern ("bar");
11836 Qborder_color
= intern ("border-color");
11837 staticpro (&Qborder_color
);
11838 Qborder_width
= intern ("border-width");
11839 staticpro (&Qborder_width
);
11840 Qbox
= intern ("box");
11842 Qcursor_color
= intern ("cursor-color");
11843 staticpro (&Qcursor_color
);
11844 Qcursor_type
= intern ("cursor-type");
11845 staticpro (&Qcursor_type
);
11846 Qgeometry
= intern ("geometry");
11847 staticpro (&Qgeometry
);
11848 Qicon_left
= intern ("icon-left");
11849 staticpro (&Qicon_left
);
11850 Qicon_top
= intern ("icon-top");
11851 staticpro (&Qicon_top
);
11852 Qicon_type
= intern ("icon-type");
11853 staticpro (&Qicon_type
);
11854 Qicon_name
= intern ("icon-name");
11855 staticpro (&Qicon_name
);
11856 Qinternal_border_width
= intern ("internal-border-width");
11857 staticpro (&Qinternal_border_width
);
11858 Qleft
= intern ("left");
11859 staticpro (&Qleft
);
11860 Qright
= intern ("right");
11861 staticpro (&Qright
);
11862 Qmouse_color
= intern ("mouse-color");
11863 staticpro (&Qmouse_color
);
11864 Qnone
= intern ("none");
11865 staticpro (&Qnone
);
11866 Qparent_id
= intern ("parent-id");
11867 staticpro (&Qparent_id
);
11868 Qscroll_bar_width
= intern ("scroll-bar-width");
11869 staticpro (&Qscroll_bar_width
);
11870 Qsuppress_icon
= intern ("suppress-icon");
11871 staticpro (&Qsuppress_icon
);
11872 Qundefined_color
= intern ("undefined-color");
11873 staticpro (&Qundefined_color
);
11874 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11875 staticpro (&Qvertical_scroll_bars
);
11876 Qvisibility
= intern ("visibility");
11877 staticpro (&Qvisibility
);
11878 Qwindow_id
= intern ("window-id");
11879 staticpro (&Qwindow_id
);
11880 Qouter_window_id
= intern ("outer-window-id");
11881 staticpro (&Qouter_window_id
);
11882 Qx_frame_parameter
= intern ("x-frame-parameter");
11883 staticpro (&Qx_frame_parameter
);
11884 Qx_resource_name
= intern ("x-resource-name");
11885 staticpro (&Qx_resource_name
);
11886 Quser_position
= intern ("user-position");
11887 staticpro (&Quser_position
);
11888 Quser_size
= intern ("user-size");
11889 staticpro (&Quser_size
);
11890 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11891 staticpro (&Qscroll_bar_foreground
);
11892 Qscroll_bar_background
= intern ("scroll-bar-background");
11893 staticpro (&Qscroll_bar_background
);
11894 Qscreen_gamma
= intern ("screen-gamma");
11895 staticpro (&Qscreen_gamma
);
11896 Qline_spacing
= intern ("line-spacing");
11897 staticpro (&Qline_spacing
);
11898 Qcenter
= intern ("center");
11899 staticpro (&Qcenter
);
11900 Qcompound_text
= intern ("compound-text");
11901 staticpro (&Qcompound_text
);
11902 Qcancel_timer
= intern ("cancel-timer");
11903 staticpro (&Qcancel_timer
);
11904 Qwait_for_wm
= intern ("wait-for-wm");
11905 staticpro (&Qwait_for_wm
);
11906 Qfullscreen
= intern ("fullscreen");
11907 staticpro (&Qfullscreen
);
11908 Qfullwidth
= intern ("fullwidth");
11909 staticpro (&Qfullwidth
);
11910 Qfullheight
= intern ("fullheight");
11911 staticpro (&Qfullheight
);
11912 Qfullboth
= intern ("fullboth");
11913 staticpro (&Qfullboth
);
11914 /* This is the end of symbol initialization. */
11916 /* Text property `display' should be nonsticky by default. */
11917 Vtext_property_default_nonsticky
11918 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11921 Qlaplace
= intern ("laplace");
11922 staticpro (&Qlaplace
);
11923 Qemboss
= intern ("emboss");
11924 staticpro (&Qemboss
);
11925 Qedge_detection
= intern ("edge-detection");
11926 staticpro (&Qedge_detection
);
11927 Qheuristic
= intern ("heuristic");
11928 staticpro (&Qheuristic
);
11929 QCmatrix
= intern (":matrix");
11930 staticpro (&QCmatrix
);
11931 QCcolor_adjustment
= intern (":color-adjustment");
11932 staticpro (&QCcolor_adjustment
);
11933 QCmask
= intern (":mask");
11934 staticpro (&QCmask
);
11936 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11937 staticpro (&Qface_set_after_frame_default
);
11939 Fput (Qundefined_color
, Qerror_conditions
,
11940 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11941 Fput (Qundefined_color
, Qerror_message
,
11942 build_string ("Undefined color"));
11944 init_x_parm_symbols ();
11946 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11947 doc
: /* Non-nil means always draw a cross over disabled images.
11948 Disabled images are those having an `:conversion disabled' property.
11949 A cross is always drawn on black & white displays. */);
11950 cross_disabled_images
= 0;
11952 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11953 doc
: /* List of directories to search for bitmap files for X. */);
11954 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11956 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11957 doc
: /* The shape of the pointer when over text.
11958 Changing the value does not affect existing frames
11959 unless you set the mouse color. */);
11960 Vx_pointer_shape
= Qnil
;
11962 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11963 doc
: /* The name Emacs uses to look up X resources.
11964 `x-get-resource' uses this as the first component of the instance name
11965 when requesting resource values.
11966 Emacs initially sets `x-resource-name' to the name under which Emacs
11967 was invoked, or to the value specified with the `-name' or `-rn'
11968 switches, if present.
11970 It may be useful to bind this variable locally around a call
11971 to `x-get-resource'. See also the variable `x-resource-class'. */);
11972 Vx_resource_name
= Qnil
;
11974 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11975 doc
: /* The class Emacs uses to look up X resources.
11976 `x-get-resource' uses this as the first component of the instance class
11977 when requesting resource values.
11979 Emacs initially sets `x-resource-class' to "Emacs".
11981 Setting this variable permanently is not a reasonable thing to do,
11982 but binding this variable locally around a call to `x-get-resource'
11983 is a reasonable practice. See also the variable `x-resource-name'. */);
11984 Vx_resource_class
= build_string (EMACS_CLASS
);
11986 #if 0 /* This doesn't really do anything. */
11987 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11988 doc
: /* The shape of the pointer when not over text.
11989 This variable takes effect when you create a new frame
11990 or when you set the mouse color. */);
11992 Vx_nontext_pointer_shape
= Qnil
;
11994 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
11995 doc
: /* The shape of the pointer when Emacs is busy.
11996 This variable takes effect when you create a new frame
11997 or when you set the mouse color. */);
11998 Vx_hourglass_pointer_shape
= Qnil
;
12000 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
12001 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
12002 display_hourglass_p
= 1;
12004 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
12005 doc
: /* *Seconds to wait before displaying an hourglass pointer.
12006 Value must be an integer or float. */);
12007 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
12009 #if 0 /* This doesn't really do anything. */
12010 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
12011 doc
: /* The shape of the pointer when over the mode line.
12012 This variable takes effect when you create a new frame
12013 or when you set the mouse color. */);
12015 Vx_mode_pointer_shape
= Qnil
;
12017 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
12018 &Vx_sensitive_text_pointer_shape
,
12019 doc
: /* The shape of the pointer when over mouse-sensitive text.
12020 This variable takes effect when you create a new frame
12021 or when you set the mouse color. */);
12022 Vx_sensitive_text_pointer_shape
= Qnil
;
12024 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
12025 &Vx_window_horizontal_drag_shape
,
12026 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
12027 This variable takes effect when you create a new frame
12028 or when you set the mouse color. */);
12029 Vx_window_horizontal_drag_shape
= Qnil
;
12031 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
12032 doc
: /* A string indicating the foreground color of the cursor box. */);
12033 Vx_cursor_fore_pixel
= Qnil
;
12035 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
12036 doc
: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
12037 Text larger than this is clipped. */);
12038 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
12040 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
12041 doc
: /* Non-nil if no X window manager is in use.
12042 Emacs doesn't try to figure this out; this is always nil
12043 unless you set it to something else. */);
12044 /* We don't have any way to find this out, so set it to nil
12045 and maybe the user would like to set it to t. */
12046 Vx_no_window_manager
= Qnil
;
12048 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
12049 &Vx_pixel_size_width_font_regexp
,
12050 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
12052 Since Emacs gets width of a font matching with this regexp from
12053 PIXEL_SIZE field of the name, font finding mechanism gets faster for
12054 such a font. This is especially effective for such large fonts as
12055 Chinese, Japanese, and Korean. */);
12056 Vx_pixel_size_width_font_regexp
= Qnil
;
12058 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
12059 doc
: /* Time after which cached images are removed from the cache.
12060 When an image has not been displayed this many seconds, remove it
12061 from the image cache. Value must be an integer or nil with nil
12062 meaning don't clear the cache. */);
12063 Vimage_cache_eviction_delay
= make_number (30 * 60);
12065 #ifdef USE_X_TOOLKIT
12066 Fprovide (intern ("x-toolkit"), Qnil
);
12068 Fprovide (intern ("motif"), Qnil
);
12070 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string
,
12071 doc
: /* Version info for LessTif/Motif. */);
12072 Vmotif_version_string
= build_string (XmVERSION_STRING
);
12073 #endif /* USE_MOTIF */
12074 #endif /* USE_X_TOOLKIT */
12076 defsubr (&Sx_get_resource
);
12078 /* X window properties. */
12079 defsubr (&Sx_change_window_property
);
12080 defsubr (&Sx_delete_window_property
);
12081 defsubr (&Sx_window_property
);
12083 defsubr (&Sxw_display_color_p
);
12084 defsubr (&Sx_display_grayscale_p
);
12085 defsubr (&Sxw_color_defined_p
);
12086 defsubr (&Sxw_color_values
);
12087 defsubr (&Sx_server_max_request_size
);
12088 defsubr (&Sx_server_vendor
);
12089 defsubr (&Sx_server_version
);
12090 defsubr (&Sx_display_pixel_width
);
12091 defsubr (&Sx_display_pixel_height
);
12092 defsubr (&Sx_display_mm_width
);
12093 defsubr (&Sx_display_mm_height
);
12094 defsubr (&Sx_display_screens
);
12095 defsubr (&Sx_display_planes
);
12096 defsubr (&Sx_display_color_cells
);
12097 defsubr (&Sx_display_visual_class
);
12098 defsubr (&Sx_display_backing_store
);
12099 defsubr (&Sx_display_save_under
);
12100 defsubr (&Sx_parse_geometry
);
12101 defsubr (&Sx_create_frame
);
12102 defsubr (&Sx_open_connection
);
12103 defsubr (&Sx_close_connection
);
12104 defsubr (&Sx_display_list
);
12105 defsubr (&Sx_synchronize
);
12106 defsubr (&Sx_focus_frame
);
12107 defsubr (&Sx_backspace_delete_keys_p
);
12109 /* Setting callback functions for fontset handler. */
12110 get_font_info_func
= x_get_font_info
;
12112 #if 0 /* This function pointer doesn't seem to be used anywhere.
12113 And the pointer assigned has the wrong type, anyway. */
12114 list_fonts_func
= x_list_fonts
;
12117 load_font_func
= x_load_font
;
12118 find_ccl_program_func
= x_find_ccl_program
;
12119 query_font_func
= x_query_font
;
12120 set_frame_fontset_func
= x_set_font
;
12121 check_window_system_func
= check_x
;
12124 Qxbm
= intern ("xbm");
12126 QCtype
= intern (":type");
12127 staticpro (&QCtype
);
12128 QCconversion
= intern (":conversion");
12129 staticpro (&QCconversion
);
12130 QCheuristic_mask
= intern (":heuristic-mask");
12131 staticpro (&QCheuristic_mask
);
12132 QCcolor_symbols
= intern (":color-symbols");
12133 staticpro (&QCcolor_symbols
);
12134 QCascent
= intern (":ascent");
12135 staticpro (&QCascent
);
12136 QCmargin
= intern (":margin");
12137 staticpro (&QCmargin
);
12138 QCrelief
= intern (":relief");
12139 staticpro (&QCrelief
);
12140 Qpostscript
= intern ("postscript");
12141 staticpro (&Qpostscript
);
12142 QCloader
= intern (":loader");
12143 staticpro (&QCloader
);
12144 QCbounding_box
= intern (":bounding-box");
12145 staticpro (&QCbounding_box
);
12146 QCpt_width
= intern (":pt-width");
12147 staticpro (&QCpt_width
);
12148 QCpt_height
= intern (":pt-height");
12149 staticpro (&QCpt_height
);
12150 QCindex
= intern (":index");
12151 staticpro (&QCindex
);
12152 Qpbm
= intern ("pbm");
12156 Qxpm
= intern ("xpm");
12161 Qjpeg
= intern ("jpeg");
12162 staticpro (&Qjpeg
);
12166 Qtiff
= intern ("tiff");
12167 staticpro (&Qtiff
);
12171 Qgif
= intern ("gif");
12176 Qpng
= intern ("png");
12180 defsubr (&Sclear_image_cache
);
12181 defsubr (&Simage_size
);
12182 defsubr (&Simage_mask_p
);
12184 hourglass_atimer
= NULL
;
12185 hourglass_shown_p
= 0;
12187 defsubr (&Sx_show_tip
);
12188 defsubr (&Sx_hide_tip
);
12190 staticpro (&tip_timer
);
12192 staticpro (&tip_frame
);
12194 last_show_tip_args
= Qnil
;
12195 staticpro (&last_show_tip_args
);
12198 defsubr (&Sx_file_dialog
);
12206 image_types
= NULL
;
12207 Vimage_types
= Qnil
;
12209 define_image_type (&xbm_type
);
12210 define_image_type (&gs_type
);
12211 define_image_type (&pbm_type
);
12214 define_image_type (&xpm_type
);
12218 define_image_type (&jpeg_type
);
12222 define_image_type (&tiff_type
);
12226 define_image_type (&gif_type
);
12230 define_image_type (&png_type
);
12234 #endif /* HAVE_X_WINDOWS */