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
;
188 Lisp_Object Qbar
, Qhbar
;
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
, Qnil
);
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_hand2
);
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 (EQ (arg
, Qhbar
))
1871 else if (CONSP (arg
)
1872 && EQ (XCAR (arg
), Qhbar
)
1873 && INTEGERP (XCDR (arg
))
1874 && XINT (XCDR (arg
)) >= 0)
1877 *width
= XINT (XCDR (arg
));
1879 else if (NILP (arg
))
1882 /* Treat anything unknown as "box cursor".
1883 It was bad to signal an error; people have trouble fixing
1884 .Xdefaults with Emacs, when it has something bad in it. */
1885 type
= FILLED_BOX_CURSOR
;
1891 x_set_cursor_type (f
, arg
, oldval
)
1893 Lisp_Object arg
, oldval
;
1897 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1898 f
->output_data
.x
->cursor_width
= width
;
1900 /* Make sure the cursor gets redrawn. */
1901 cursor_type_changed
= 1;
1905 x_set_icon_type (f
, arg
, oldval
)
1907 Lisp_Object arg
, oldval
;
1913 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1916 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1921 result
= x_text_icon (f
,
1922 (char *) XSTRING ((!NILP (f
->icon_name
)
1926 result
= x_bitmap_icon (f
, arg
);
1931 error ("No icon window available");
1934 XFlush (FRAME_X_DISPLAY (f
));
1938 /* Return non-nil if frame F wants a bitmap icon. */
1946 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1954 x_set_icon_name (f
, arg
, oldval
)
1956 Lisp_Object arg
, oldval
;
1962 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1965 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1970 if (f
->output_data
.x
->icon_bitmap
!= 0)
1975 result
= x_text_icon (f
,
1976 (char *) XSTRING ((!NILP (f
->icon_name
)
1985 error ("No icon window available");
1988 XFlush (FRAME_X_DISPLAY (f
));
1993 x_set_font (f
, arg
, oldval
)
1995 Lisp_Object arg
, oldval
;
1998 Lisp_Object fontset_name
;
2000 int old_fontset
= f
->output_data
.x
->fontset
;
2004 fontset_name
= Fquery_fontset (arg
, Qnil
);
2007 result
= (STRINGP (fontset_name
)
2008 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
2009 : x_new_font (f
, XSTRING (arg
)->data
));
2012 if (EQ (result
, Qnil
))
2013 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
2014 else if (EQ (result
, Qt
))
2015 error ("The characters of the given font have varying widths");
2016 else if (STRINGP (result
))
2018 if (STRINGP (fontset_name
))
2020 /* Fontset names are built from ASCII font names, so the
2021 names may be equal despite there was a change. */
2022 if (old_fontset
== f
->output_data
.x
->fontset
)
2025 else if (!NILP (Fequal (result
, oldval
)))
2028 store_frame_param (f
, Qfont
, result
);
2029 recompute_basic_faces (f
);
2034 do_pending_window_change (0);
2036 /* Don't call `face-set-after-frame-default' when faces haven't been
2037 initialized yet. This is the case when called from
2038 Fx_create_frame. In that case, the X widget or window doesn't
2039 exist either, and we can end up in x_report_frame_params with a
2040 null widget which gives a segfault. */
2041 if (FRAME_FACE_CACHE (f
))
2043 XSETFRAME (frame
, f
);
2044 call1 (Qface_set_after_frame_default
, frame
);
2049 x_set_fringe_width (f
, new_value
, old_value
)
2051 Lisp_Object new_value
, old_value
;
2053 x_compute_fringe_widths (f
, 1);
2057 x_set_border_width (f
, arg
, oldval
)
2059 Lisp_Object arg
, oldval
;
2063 if (XINT (arg
) == f
->output_data
.x
->border_width
)
2066 if (FRAME_X_WINDOW (f
) != 0)
2067 error ("Cannot change the border width of a window");
2069 f
->output_data
.x
->border_width
= XINT (arg
);
2073 x_set_internal_border_width (f
, arg
, oldval
)
2075 Lisp_Object arg
, oldval
;
2077 int old
= f
->output_data
.x
->internal_border_width
;
2080 f
->output_data
.x
->internal_border_width
= XINT (arg
);
2081 if (f
->output_data
.x
->internal_border_width
< 0)
2082 f
->output_data
.x
->internal_border_width
= 0;
2084 #ifdef USE_X_TOOLKIT
2085 if (f
->output_data
.x
->edit_widget
)
2086 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
2089 if (f
->output_data
.x
->internal_border_width
== old
)
2092 if (FRAME_X_WINDOW (f
) != 0)
2094 x_set_window_size (f
, 0, f
->width
, f
->height
);
2095 SET_FRAME_GARBAGED (f
);
2096 do_pending_window_change (0);
2099 SET_FRAME_GARBAGED (f
);
2103 x_set_visibility (f
, value
, oldval
)
2105 Lisp_Object value
, oldval
;
2108 XSETFRAME (frame
, f
);
2111 Fmake_frame_invisible (frame
, Qt
);
2112 else if (EQ (value
, Qicon
))
2113 Ficonify_frame (frame
);
2115 Fmake_frame_visible (frame
);
2119 /* Change window heights in windows rooted in WINDOW by N lines. */
2122 x_change_window_heights (window
, n
)
2126 struct window
*w
= XWINDOW (window
);
2128 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
2129 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
2131 if (INTEGERP (w
->orig_top
))
2132 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
2133 if (INTEGERP (w
->orig_height
))
2134 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
2136 /* Handle just the top child in a vertical split. */
2137 if (!NILP (w
->vchild
))
2138 x_change_window_heights (w
->vchild
, n
);
2140 /* Adjust all children in a horizontal split. */
2141 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
2143 w
= XWINDOW (window
);
2144 x_change_window_heights (window
, n
);
2149 x_set_menu_bar_lines (f
, value
, oldval
)
2151 Lisp_Object value
, oldval
;
2154 #ifndef USE_X_TOOLKIT
2155 int olines
= FRAME_MENU_BAR_LINES (f
);
2158 /* Right now, menu bars don't work properly in minibuf-only frames;
2159 most of the commands try to apply themselves to the minibuffer
2160 frame itself, and get an error because you can't switch buffers
2161 in or split the minibuffer window. */
2162 if (FRAME_MINIBUF_ONLY_P (f
))
2165 if (INTEGERP (value
))
2166 nlines
= XINT (value
);
2170 /* Make sure we redisplay all windows in this frame. */
2171 windows_or_buffers_changed
++;
2173 #ifdef USE_X_TOOLKIT
2174 FRAME_MENU_BAR_LINES (f
) = 0;
2177 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2178 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
2179 /* Make sure next redisplay shows the menu bar. */
2180 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2184 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2185 free_frame_menubar (f
);
2186 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2188 f
->output_data
.x
->menubar_widget
= 0;
2190 #else /* not USE_X_TOOLKIT */
2191 FRAME_MENU_BAR_LINES (f
) = nlines
;
2192 x_change_window_heights (f
->root_window
, nlines
- olines
);
2193 #endif /* not USE_X_TOOLKIT */
2198 /* Set the number of lines used for the tool bar of frame F to VALUE.
2199 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2200 is the old number of tool bar lines. This function changes the
2201 height of all windows on frame F to match the new tool bar height.
2202 The frame's height doesn't change. */
2205 x_set_tool_bar_lines (f
, value
, oldval
)
2207 Lisp_Object value
, oldval
;
2209 int delta
, nlines
, root_height
;
2210 Lisp_Object root_window
;
2212 /* Treat tool bars like menu bars. */
2213 if (FRAME_MINIBUF_ONLY_P (f
))
2216 /* Use VALUE only if an integer >= 0. */
2217 if (INTEGERP (value
) && XINT (value
) >= 0)
2218 nlines
= XFASTINT (value
);
2222 /* Make sure we redisplay all windows in this frame. */
2223 ++windows_or_buffers_changed
;
2225 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2227 /* Don't resize the tool-bar to more than we have room for. */
2228 root_window
= FRAME_ROOT_WINDOW (f
);
2229 root_height
= XINT (XWINDOW (root_window
)->height
);
2230 if (root_height
- delta
< 1)
2232 delta
= root_height
- 1;
2233 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2236 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2237 x_change_window_heights (root_window
, delta
);
2240 /* We also have to make sure that the internal border at the top of
2241 the frame, below the menu bar or tool bar, is redrawn when the
2242 tool bar disappears. This is so because the internal border is
2243 below the tool bar if one is displayed, but is below the menu bar
2244 if there isn't a tool bar. The tool bar draws into the area
2245 below the menu bar. */
2246 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2250 clear_current_matrices (f
);
2251 updating_frame
= NULL
;
2254 /* If the tool bar gets smaller, the internal border below it
2255 has to be cleared. It was formerly part of the display
2256 of the larger tool bar, and updating windows won't clear it. */
2259 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2260 int width
= PIXEL_WIDTH (f
);
2261 int y
= nlines
* CANON_Y_UNIT (f
);
2264 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2265 0, y
, width
, height
, False
);
2268 if (WINDOWP (f
->tool_bar_window
))
2269 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2274 /* Set the foreground color for scroll bars on frame F to VALUE.
2275 VALUE should be a string, a color name. If it isn't a string or
2276 isn't a valid color name, do nothing. OLDVAL is the old value of
2277 the frame parameter. */
2280 x_set_scroll_bar_foreground (f
, value
, oldval
)
2282 Lisp_Object value
, oldval
;
2284 unsigned long pixel
;
2286 if (STRINGP (value
))
2287 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2291 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2292 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2294 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2295 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2297 /* Remove all scroll bars because they have wrong colors. */
2298 if (condemn_scroll_bars_hook
)
2299 (*condemn_scroll_bars_hook
) (f
);
2300 if (judge_scroll_bars_hook
)
2301 (*judge_scroll_bars_hook
) (f
);
2303 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2309 /* Set the background color for scroll bars on frame F to VALUE VALUE
2310 should be a string, a color name. If it isn't a string or isn't a
2311 valid color name, do nothing. OLDVAL is the old value of the frame
2315 x_set_scroll_bar_background (f
, value
, oldval
)
2317 Lisp_Object value
, oldval
;
2319 unsigned long pixel
;
2321 if (STRINGP (value
))
2322 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2326 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2327 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2329 #ifdef USE_TOOLKIT_SCROLL_BARS
2330 /* Scrollbar shadow colors. */
2331 if (f
->output_data
.x
->scroll_bar_top_shadow_pixel
!= -1)
2333 unload_color (f
, f
->output_data
.x
->scroll_bar_top_shadow_pixel
);
2334 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
2336 if (f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
!= -1)
2338 unload_color (f
, f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
);
2339 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
2341 #endif /* USE_TOOLKIT_SCROLL_BARS */
2343 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2344 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2346 /* Remove all scroll bars because they have wrong colors. */
2347 if (condemn_scroll_bars_hook
)
2348 (*condemn_scroll_bars_hook
) (f
);
2349 if (judge_scroll_bars_hook
)
2350 (*judge_scroll_bars_hook
) (f
);
2352 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2358 /* Encode Lisp string STRING as a text in a format appropriate for
2359 XICCC (X Inter Client Communication Conventions).
2361 If STRING contains only ASCII characters, do no conversion and
2362 return the string data of STRING. Otherwise, encode the text by
2363 CODING_SYSTEM, and return a newly allocated memory area which
2364 should be freed by `xfree' by a caller.
2366 SELECTIONP non-zero means the string is being encoded for an X
2367 selection, so it is safe to run pre-write conversions (which
2370 Store the byte length of resulting text in *TEXT_BYTES.
2372 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2373 which means that the `encoding' of the result can be `STRING'.
2374 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2375 the result should be `COMPOUND_TEXT'. */
2378 x_encode_text (string
, coding_system
, selectionp
, text_bytes
, stringp
)
2379 Lisp_Object string
, coding_system
;
2380 int *text_bytes
, *stringp
;
2383 unsigned char *str
= XSTRING (string
)->data
;
2384 int chars
= XSTRING (string
)->size
;
2385 int bytes
= STRING_BYTES (XSTRING (string
));
2389 struct coding_system coding
;
2390 extern Lisp_Object Qcompound_text_with_extensions
;
2392 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2393 if (charset_info
== 0)
2395 /* No multibyte character in OBJ. We need not encode it. */
2396 *text_bytes
= bytes
;
2401 setup_coding_system (coding_system
, &coding
);
2403 && SYMBOLP (coding
.pre_write_conversion
)
2404 && !NILP (Ffboundp (coding
.pre_write_conversion
)))
2406 string
= run_pre_post_conversion_on_str (string
, &coding
, 1);
2407 str
= XSTRING (string
)->data
;
2408 chars
= XSTRING (string
)->size
;
2409 bytes
= STRING_BYTES (XSTRING (string
));
2411 coding
.src_multibyte
= 1;
2412 coding
.dst_multibyte
= 0;
2413 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2414 if (coding
.type
== coding_type_iso2022
)
2415 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2416 /* We suppress producing escape sequences for composition. */
2417 coding
.composing
= COMPOSITION_DISABLED
;
2418 bufsize
= encoding_buffer_size (&coding
, bytes
);
2419 buf
= (unsigned char *) xmalloc (bufsize
);
2420 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2421 *text_bytes
= coding
.produced
;
2422 *stringp
= (charset_info
== 1
2423 || (!EQ (coding_system
, Qcompound_text
)
2424 && !EQ (coding_system
, Qcompound_text_with_extensions
)));
2429 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2432 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2433 name; if NAME is a string, set F's name to NAME and set
2434 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2436 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2437 suggesting a new name, which lisp code should override; if
2438 F->explicit_name is set, ignore the new name; otherwise, set it. */
2441 x_set_name (f
, name
, explicit)
2446 /* Make sure that requests from lisp code override requests from
2447 Emacs redisplay code. */
2450 /* If we're switching from explicit to implicit, we had better
2451 update the mode lines and thereby update the title. */
2452 if (f
->explicit_name
&& NILP (name
))
2453 update_mode_lines
= 1;
2455 f
->explicit_name
= ! NILP (name
);
2457 else if (f
->explicit_name
)
2460 /* If NAME is nil, set the name to the x_id_name. */
2463 /* Check for no change needed in this very common case
2464 before we do any consing. */
2465 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2466 XSTRING (f
->name
)->data
))
2468 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2471 CHECK_STRING (name
);
2473 /* Don't change the name if it's already NAME. */
2474 if (! NILP (Fstring_equal (name
, f
->name
)))
2479 /* For setting the frame title, the title parameter should override
2480 the name parameter. */
2481 if (! NILP (f
->title
))
2484 if (FRAME_X_WINDOW (f
))
2489 XTextProperty text
, icon
;
2491 Lisp_Object coding_system
;
2493 coding_system
= Vlocale_coding_system
;
2494 if (NILP (coding_system
))
2495 coding_system
= Qcompound_text
;
2496 text
.value
= x_encode_text (name
, coding_system
, 0, &bytes
, &stringp
);
2497 text
.encoding
= (stringp
? XA_STRING
2498 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2500 text
.nitems
= bytes
;
2502 if (NILP (f
->icon_name
))
2508 icon
.value
= x_encode_text (f
->icon_name
, coding_system
, 0,
2510 icon
.encoding
= (stringp
? XA_STRING
2511 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2513 icon
.nitems
= bytes
;
2515 #ifdef USE_X_TOOLKIT
2516 XSetWMName (FRAME_X_DISPLAY (f
),
2517 XtWindow (f
->output_data
.x
->widget
), &text
);
2518 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2520 #else /* not USE_X_TOOLKIT */
2521 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2522 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2523 #endif /* not USE_X_TOOLKIT */
2524 if (!NILP (f
->icon_name
)
2525 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2527 if (text
.value
!= XSTRING (name
)->data
)
2530 #else /* not HAVE_X11R4 */
2531 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2532 XSTRING (name
)->data
);
2533 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2534 XSTRING (name
)->data
);
2535 #endif /* not HAVE_X11R4 */
2540 /* This function should be called when the user's lisp code has
2541 specified a name for the frame; the name will override any set by the
2544 x_explicitly_set_name (f
, arg
, oldval
)
2546 Lisp_Object arg
, oldval
;
2548 x_set_name (f
, arg
, 1);
2551 /* This function should be called by Emacs redisplay code to set the
2552 name; names set this way will never override names set by the user's
2555 x_implicitly_set_name (f
, arg
, oldval
)
2557 Lisp_Object arg
, oldval
;
2559 x_set_name (f
, arg
, 0);
2562 /* Change the title of frame F to NAME.
2563 If NAME is nil, use the frame name as the title.
2565 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2566 name; if NAME is a string, set F's name to NAME and set
2567 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2569 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2570 suggesting a new name, which lisp code should override; if
2571 F->explicit_name is set, ignore the new name; otherwise, set it. */
2574 x_set_title (f
, name
, old_name
)
2576 Lisp_Object name
, old_name
;
2578 /* Don't change the title if it's already NAME. */
2579 if (EQ (name
, f
->title
))
2582 update_mode_lines
= 1;
2589 CHECK_STRING (name
);
2591 if (FRAME_X_WINDOW (f
))
2596 XTextProperty text
, icon
;
2598 Lisp_Object coding_system
;
2600 coding_system
= Vlocale_coding_system
;
2601 if (NILP (coding_system
))
2602 coding_system
= Qcompound_text
;
2603 text
.value
= x_encode_text (name
, coding_system
, 0, &bytes
, &stringp
);
2604 text
.encoding
= (stringp
? XA_STRING
2605 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2607 text
.nitems
= bytes
;
2609 if (NILP (f
->icon_name
))
2615 icon
.value
= x_encode_text (f
->icon_name
, coding_system
, 0,
2617 icon
.encoding
= (stringp
? XA_STRING
2618 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2620 icon
.nitems
= bytes
;
2622 #ifdef USE_X_TOOLKIT
2623 XSetWMName (FRAME_X_DISPLAY (f
),
2624 XtWindow (f
->output_data
.x
->widget
), &text
);
2625 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2627 #else /* not USE_X_TOOLKIT */
2628 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2629 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2630 #endif /* not USE_X_TOOLKIT */
2631 if (!NILP (f
->icon_name
)
2632 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2634 if (text
.value
!= XSTRING (name
)->data
)
2637 #else /* not HAVE_X11R4 */
2638 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2639 XSTRING (name
)->data
);
2640 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2641 XSTRING (name
)->data
);
2642 #endif /* not HAVE_X11R4 */
2648 x_set_autoraise (f
, arg
, oldval
)
2650 Lisp_Object arg
, oldval
;
2652 f
->auto_raise
= !EQ (Qnil
, arg
);
2656 x_set_autolower (f
, arg
, oldval
)
2658 Lisp_Object arg
, oldval
;
2660 f
->auto_lower
= !EQ (Qnil
, arg
);
2664 x_set_unsplittable (f
, arg
, oldval
)
2666 Lisp_Object arg
, oldval
;
2668 f
->no_split
= !NILP (arg
);
2672 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2674 Lisp_Object arg
, oldval
;
2676 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2677 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2678 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2679 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2681 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2683 ? vertical_scroll_bar_none
2685 ? vertical_scroll_bar_right
2686 : vertical_scroll_bar_left
);
2688 /* We set this parameter before creating the X window for the
2689 frame, so we can get the geometry right from the start.
2690 However, if the window hasn't been created yet, we shouldn't
2691 call x_set_window_size. */
2692 if (FRAME_X_WINDOW (f
))
2693 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2694 do_pending_window_change (0);
2699 x_set_scroll_bar_width (f
, arg
, oldval
)
2701 Lisp_Object arg
, oldval
;
2703 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2707 #ifdef USE_TOOLKIT_SCROLL_BARS
2708 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2709 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2710 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2711 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2713 /* Make the actual width at least 14 pixels and a multiple of a
2715 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2717 /* Use all of that space (aside from required margins) for the
2719 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2722 if (FRAME_X_WINDOW (f
))
2723 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2724 do_pending_window_change (0);
2726 else if (INTEGERP (arg
) && XINT (arg
) > 0
2727 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2729 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2730 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2732 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2733 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2734 if (FRAME_X_WINDOW (f
))
2735 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2738 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2739 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2740 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2745 /* Subroutines of creating an X frame. */
2747 /* Make sure that Vx_resource_name is set to a reasonable value.
2748 Fix it up, or set it to `emacs' if it is too hopeless. */
2751 validate_x_resource_name ()
2754 /* Number of valid characters in the resource name. */
2756 /* Number of invalid characters in the resource name. */
2761 if (!STRINGP (Vx_resource_class
))
2762 Vx_resource_class
= build_string (EMACS_CLASS
);
2764 if (STRINGP (Vx_resource_name
))
2766 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2769 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2771 /* Only letters, digits, - and _ are valid in resource names.
2772 Count the valid characters and count the invalid ones. */
2773 for (i
= 0; i
< len
; i
++)
2776 if (! ((c
>= 'a' && c
<= 'z')
2777 || (c
>= 'A' && c
<= 'Z')
2778 || (c
>= '0' && c
<= '9')
2779 || c
== '-' || c
== '_'))
2786 /* Not a string => completely invalid. */
2787 bad_count
= 5, good_count
= 0;
2789 /* If name is valid already, return. */
2793 /* If name is entirely invalid, or nearly so, use `emacs'. */
2795 || (good_count
== 1 && bad_count
> 0))
2797 Vx_resource_name
= build_string ("emacs");
2801 /* Name is partly valid. Copy it and replace the invalid characters
2802 with underscores. */
2804 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2806 for (i
= 0; i
< len
; i
++)
2808 int c
= XSTRING (new)->data
[i
];
2809 if (! ((c
>= 'a' && c
<= 'z')
2810 || (c
>= 'A' && c
<= 'Z')
2811 || (c
>= '0' && c
<= '9')
2812 || c
== '-' || c
== '_'))
2813 XSTRING (new)->data
[i
] = '_';
2818 extern char *x_get_string_resource ();
2820 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2821 doc
: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
2822 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
2823 class, where INSTANCE is the name under which Emacs was invoked, or
2824 the name specified by the `-name' or `-rn' command-line arguments.
2826 The optional arguments COMPONENT and SUBCLASS add to the key and the
2827 class, respectively. You must specify both of them or neither.
2828 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
2829 and the class is `Emacs.CLASS.SUBCLASS'. */)
2830 (attribute
, class, component
, subclass
)
2831 Lisp_Object attribute
, class, component
, subclass
;
2833 register char *value
;
2839 CHECK_STRING (attribute
);
2840 CHECK_STRING (class);
2842 if (!NILP (component
))
2843 CHECK_STRING (component
);
2844 if (!NILP (subclass
))
2845 CHECK_STRING (subclass
);
2846 if (NILP (component
) != NILP (subclass
))
2847 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2849 validate_x_resource_name ();
2851 /* Allocate space for the components, the dots which separate them,
2852 and the final '\0'. Make them big enough for the worst case. */
2853 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2854 + (STRINGP (component
)
2855 ? STRING_BYTES (XSTRING (component
)) : 0)
2856 + STRING_BYTES (XSTRING (attribute
))
2859 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2860 + STRING_BYTES (XSTRING (class))
2861 + (STRINGP (subclass
)
2862 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2865 /* Start with emacs.FRAMENAME for the name (the specific one)
2866 and with `Emacs' for the class key (the general one). */
2867 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2868 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2870 strcat (class_key
, ".");
2871 strcat (class_key
, XSTRING (class)->data
);
2873 if (!NILP (component
))
2875 strcat (class_key
, ".");
2876 strcat (class_key
, XSTRING (subclass
)->data
);
2878 strcat (name_key
, ".");
2879 strcat (name_key
, XSTRING (component
)->data
);
2882 strcat (name_key
, ".");
2883 strcat (name_key
, XSTRING (attribute
)->data
);
2885 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2886 name_key
, class_key
);
2888 if (value
!= (char *) 0)
2889 return build_string (value
);
2894 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2897 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2898 struct x_display_info
*dpyinfo
;
2899 Lisp_Object attribute
, class, component
, subclass
;
2901 register char *value
;
2905 CHECK_STRING (attribute
);
2906 CHECK_STRING (class);
2908 if (!NILP (component
))
2909 CHECK_STRING (component
);
2910 if (!NILP (subclass
))
2911 CHECK_STRING (subclass
);
2912 if (NILP (component
) != NILP (subclass
))
2913 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2915 validate_x_resource_name ();
2917 /* Allocate space for the components, the dots which separate them,
2918 and the final '\0'. Make them big enough for the worst case. */
2919 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2920 + (STRINGP (component
)
2921 ? STRING_BYTES (XSTRING (component
)) : 0)
2922 + STRING_BYTES (XSTRING (attribute
))
2925 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2926 + STRING_BYTES (XSTRING (class))
2927 + (STRINGP (subclass
)
2928 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2931 /* Start with emacs.FRAMENAME for the name (the specific one)
2932 and with `Emacs' for the class key (the general one). */
2933 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2934 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2936 strcat (class_key
, ".");
2937 strcat (class_key
, XSTRING (class)->data
);
2939 if (!NILP (component
))
2941 strcat (class_key
, ".");
2942 strcat (class_key
, XSTRING (subclass
)->data
);
2944 strcat (name_key
, ".");
2945 strcat (name_key
, XSTRING (component
)->data
);
2948 strcat (name_key
, ".");
2949 strcat (name_key
, XSTRING (attribute
)->data
);
2951 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2953 if (value
!= (char *) 0)
2954 return build_string (value
);
2959 /* Used when C code wants a resource value. */
2962 x_get_resource_string (attribute
, class)
2963 char *attribute
, *class;
2967 struct frame
*sf
= SELECTED_FRAME ();
2969 /* Allocate space for the components, the dots which separate them,
2970 and the final '\0'. */
2971 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2972 + strlen (attribute
) + 2);
2973 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2974 + strlen (class) + 2);
2976 sprintf (name_key
, "%s.%s",
2977 XSTRING (Vinvocation_name
)->data
,
2979 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2981 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2982 name_key
, class_key
);
2985 /* Types we might convert a resource string into. */
2995 /* Return the value of parameter PARAM.
2997 First search ALIST, then Vdefault_frame_alist, then the X defaults
2998 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3000 Convert the resource to the type specified by desired_type.
3002 If no default is specified, return Qunbound. If you call
3003 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3004 and don't let it get stored in any Lisp-visible variables! */
3007 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
3008 struct x_display_info
*dpyinfo
;
3009 Lisp_Object alist
, param
;
3012 enum resource_types type
;
3014 register Lisp_Object tem
;
3016 tem
= Fassq (param
, alist
);
3018 tem
= Fassq (param
, Vdefault_frame_alist
);
3024 tem
= display_x_get_resource (dpyinfo
,
3025 build_string (attribute
),
3026 build_string (class),
3034 case RES_TYPE_NUMBER
:
3035 return make_number (atoi (XSTRING (tem
)->data
));
3037 case RES_TYPE_FLOAT
:
3038 return make_float (atof (XSTRING (tem
)->data
));
3040 case RES_TYPE_BOOLEAN
:
3041 tem
= Fdowncase (tem
);
3042 if (!strcmp (XSTRING (tem
)->data
, "on")
3043 || !strcmp (XSTRING (tem
)->data
, "true"))
3048 case RES_TYPE_STRING
:
3051 case RES_TYPE_SYMBOL
:
3052 /* As a special case, we map the values `true' and `on'
3053 to Qt, and `false' and `off' to Qnil. */
3056 lower
= Fdowncase (tem
);
3057 if (!strcmp (XSTRING (lower
)->data
, "on")
3058 || !strcmp (XSTRING (lower
)->data
, "true"))
3060 else if (!strcmp (XSTRING (lower
)->data
, "off")
3061 || !strcmp (XSTRING (lower
)->data
, "false"))
3064 return Fintern (tem
, Qnil
);
3077 /* Like x_get_arg, but also record the value in f->param_alist. */
3080 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
3082 Lisp_Object alist
, param
;
3085 enum resource_types type
;
3089 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
3090 attribute
, class, type
);
3092 store_frame_param (f
, param
, value
);
3097 /* Record in frame F the specified or default value according to ALIST
3098 of the parameter named PROP (a Lisp symbol).
3099 If no value is specified for PROP, look for an X default for XPROP
3100 on the frame named NAME.
3101 If that is not found either, use the value DEFLT. */
3104 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
3111 enum resource_types type
;
3115 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
3116 if (EQ (tem
, Qunbound
))
3118 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3123 /* Record in frame F the specified or default value according to ALIST
3124 of the parameter named PROP (a Lisp symbol). If no value is
3125 specified for PROP, look for an X default for XPROP on the frame
3126 named NAME. If that is not found either, use the value DEFLT. */
3129 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
3138 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3141 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
3142 if (EQ (tem
, Qunbound
))
3144 #ifdef USE_TOOLKIT_SCROLL_BARS
3146 /* See if an X resource for the scroll bar color has been
3148 tem
= display_x_get_resource (dpyinfo
,
3149 build_string (foreground_p
3153 build_string ("verticalScrollBar"),
3157 /* If nothing has been specified, scroll bars will use a
3158 toolkit-dependent default. Because these defaults are
3159 difficult to get at without actually creating a scroll
3160 bar, use nil to indicate that no color has been
3165 #else /* not USE_TOOLKIT_SCROLL_BARS */
3169 #endif /* not USE_TOOLKIT_SCROLL_BARS */
3172 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3178 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3179 doc
: /* Parse an X-style geometry string STRING.
3180 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3181 The properties returned may include `top', `left', `height', and `width'.
3182 The value of `left' or `top' may be an integer,
3183 or a list (+ N) meaning N pixels relative to top/left corner,
3184 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3189 unsigned int width
, height
;
3192 CHECK_STRING (string
);
3194 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
3195 &x
, &y
, &width
, &height
);
3198 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
3199 error ("Must specify both x and y position, or neither");
3203 if (geometry
& XValue
)
3205 Lisp_Object element
;
3207 if (x
>= 0 && (geometry
& XNegative
))
3208 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3209 else if (x
< 0 && ! (geometry
& XNegative
))
3210 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3212 element
= Fcons (Qleft
, make_number (x
));
3213 result
= Fcons (element
, result
);
3216 if (geometry
& YValue
)
3218 Lisp_Object element
;
3220 if (y
>= 0 && (geometry
& YNegative
))
3221 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3222 else if (y
< 0 && ! (geometry
& YNegative
))
3223 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3225 element
= Fcons (Qtop
, make_number (y
));
3226 result
= Fcons (element
, result
);
3229 if (geometry
& WidthValue
)
3230 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3231 if (geometry
& HeightValue
)
3232 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3237 /* Calculate the desired size and position of this window,
3238 and return the flags saying which aspects were specified.
3240 This function does not make the coordinates positive. */
3242 #define DEFAULT_ROWS 40
3243 #define DEFAULT_COLS 80
3246 x_figure_window_size (f
, parms
)
3250 register Lisp_Object tem0
, tem1
, tem2
;
3251 long window_prompting
= 0;
3252 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3254 /* Default values if we fall through.
3255 Actually, if that happens we should get
3256 window manager prompting. */
3257 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3258 f
->height
= DEFAULT_ROWS
;
3259 /* Window managers expect that if program-specified
3260 positions are not (0,0), they're intentional, not defaults. */
3261 f
->output_data
.x
->top_pos
= 0;
3262 f
->output_data
.x
->left_pos
= 0;
3264 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3265 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3266 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3267 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3269 if (!EQ (tem0
, Qunbound
))
3271 CHECK_NUMBER (tem0
);
3272 f
->height
= XINT (tem0
);
3274 if (!EQ (tem1
, Qunbound
))
3276 CHECK_NUMBER (tem1
);
3277 SET_FRAME_WIDTH (f
, XINT (tem1
));
3279 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3280 window_prompting
|= USSize
;
3282 window_prompting
|= PSize
;
3285 f
->output_data
.x
->vertical_scroll_bar_extra
3286 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3288 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3290 x_compute_fringe_widths (f
, 0);
3292 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3293 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3295 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3296 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3297 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3298 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3300 if (EQ (tem0
, Qminus
))
3302 f
->output_data
.x
->top_pos
= 0;
3303 window_prompting
|= YNegative
;
3305 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3306 && CONSP (XCDR (tem0
))
3307 && INTEGERP (XCAR (XCDR (tem0
))))
3309 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3310 window_prompting
|= YNegative
;
3312 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3313 && CONSP (XCDR (tem0
))
3314 && INTEGERP (XCAR (XCDR (tem0
))))
3316 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3318 else if (EQ (tem0
, Qunbound
))
3319 f
->output_data
.x
->top_pos
= 0;
3322 CHECK_NUMBER (tem0
);
3323 f
->output_data
.x
->top_pos
= XINT (tem0
);
3324 if (f
->output_data
.x
->top_pos
< 0)
3325 window_prompting
|= YNegative
;
3328 if (EQ (tem1
, Qminus
))
3330 f
->output_data
.x
->left_pos
= 0;
3331 window_prompting
|= XNegative
;
3333 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3334 && CONSP (XCDR (tem1
))
3335 && INTEGERP (XCAR (XCDR (tem1
))))
3337 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3338 window_prompting
|= XNegative
;
3340 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3341 && CONSP (XCDR (tem1
))
3342 && INTEGERP (XCAR (XCDR (tem1
))))
3344 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3346 else if (EQ (tem1
, Qunbound
))
3347 f
->output_data
.x
->left_pos
= 0;
3350 CHECK_NUMBER (tem1
);
3351 f
->output_data
.x
->left_pos
= XINT (tem1
);
3352 if (f
->output_data
.x
->left_pos
< 0)
3353 window_prompting
|= XNegative
;
3356 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3357 window_prompting
|= USPosition
;
3359 window_prompting
|= PPosition
;
3362 if (f
->output_data
.x
->want_fullscreen
!= FULLSCREEN_NONE
)
3367 /* It takes both for some WM:s to place it where we want */
3368 window_prompting
= USPosition
| PPosition
;
3369 x_fullscreen_adjust (f
, &width
, &height
, &top
, &left
);
3372 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3373 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3374 f
->output_data
.x
->left_pos
= left
;
3375 f
->output_data
.x
->top_pos
= top
;
3378 return window_prompting
;
3381 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3384 XSetWMProtocols (dpy
, w
, protocols
, count
)
3391 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3392 if (prop
== None
) return False
;
3393 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3394 (unsigned char *) protocols
, count
);
3397 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3399 #ifdef USE_X_TOOLKIT
3401 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3402 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3403 already be present because of the toolkit (Motif adds some of them,
3404 for example, but Xt doesn't). */
3407 hack_wm_protocols (f
, widget
)
3411 Display
*dpy
= XtDisplay (widget
);
3412 Window w
= XtWindow (widget
);
3413 int need_delete
= 1;
3419 Atom type
, *atoms
= 0;
3421 unsigned long nitems
= 0;
3422 unsigned long bytes_after
;
3424 if ((XGetWindowProperty (dpy
, w
,
3425 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3426 (long)0, (long)100, False
, XA_ATOM
,
3427 &type
, &format
, &nitems
, &bytes_after
,
3428 (unsigned char **) &atoms
)
3430 && format
== 32 && type
== XA_ATOM
)
3434 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3436 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3438 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3441 if (atoms
) XFree ((char *) atoms
);
3447 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3449 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3451 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3453 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3454 XA_ATOM
, 32, PropModeAppend
,
3455 (unsigned char *) props
, count
);
3463 /* Support routines for XIC (X Input Context). */
3467 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3468 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3471 /* Supported XIM styles, ordered by preferenc. */
3473 static XIMStyle supported_xim_styles
[] =
3475 XIMPreeditPosition
| XIMStatusArea
,
3476 XIMPreeditPosition
| XIMStatusNothing
,
3477 XIMPreeditPosition
| XIMStatusNone
,
3478 XIMPreeditNothing
| XIMStatusArea
,
3479 XIMPreeditNothing
| XIMStatusNothing
,
3480 XIMPreeditNothing
| XIMStatusNone
,
3481 XIMPreeditNone
| XIMStatusArea
,
3482 XIMPreeditNone
| XIMStatusNothing
,
3483 XIMPreeditNone
| XIMStatusNone
,
3488 /* Create an X fontset on frame F with base font name
3492 xic_create_xfontset (f
, base_fontname
)
3494 char *base_fontname
;
3497 char **missing_list
;
3501 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3502 base_fontname
, &missing_list
,
3503 &missing_count
, &def_string
);
3505 XFreeStringList (missing_list
);
3507 /* No need to free def_string. */
3512 /* Value is the best input style, given user preferences USER (already
3513 checked to be supported by Emacs), and styles supported by the
3514 input method XIM. */
3517 best_xim_style (user
, xim
)
3523 for (i
= 0; i
< user
->count_styles
; ++i
)
3524 for (j
= 0; j
< xim
->count_styles
; ++j
)
3525 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3526 return user
->supported_styles
[i
];
3528 /* Return the default style. */
3529 return XIMPreeditNothing
| XIMStatusNothing
;
3532 /* Create XIC for frame F. */
3534 static XIMStyle xic_style
;
3537 create_frame_xic (f
)
3542 XFontSet xfs
= NULL
;
3547 xim
= FRAME_X_XIM (f
);
3552 XVaNestedList preedit_attr
;
3553 XVaNestedList status_attr
;
3554 char *base_fontname
;
3557 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3558 spot
.x
= 0; spot
.y
= 1;
3559 /* Create X fontset. */
3560 fontset
= FRAME_FONTSET (f
);
3562 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3565 /* Determine the base fontname from the ASCII font name of
3567 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3568 char *p
= ascii_font
;
3571 for (i
= 0; *p
; p
++)
3574 /* As the font name doesn't conform to XLFD, we can't
3575 modify it to get a suitable base fontname for the
3577 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3580 int len
= strlen (ascii_font
) + 1;
3583 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3592 base_fontname
= (char *) alloca (len
);
3593 bzero (base_fontname
, len
);
3594 strcpy (base_fontname
, "-*-*-");
3595 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3596 strcat (base_fontname
, "*-*-*-*-*-*-*");
3599 xfs
= xic_create_xfontset (f
, base_fontname
);
3601 /* Determine XIC style. */
3604 XIMStyles supported_list
;
3605 supported_list
.count_styles
= (sizeof supported_xim_styles
3606 / sizeof supported_xim_styles
[0]);
3607 supported_list
.supported_styles
= supported_xim_styles
;
3608 xic_style
= best_xim_style (&supported_list
,
3609 FRAME_X_XIM_STYLES (f
));
3612 preedit_attr
= XVaCreateNestedList (0,
3615 FRAME_FOREGROUND_PIXEL (f
),
3617 FRAME_BACKGROUND_PIXEL (f
),
3618 (xic_style
& XIMPreeditPosition
3623 status_attr
= XVaCreateNestedList (0,
3629 FRAME_FOREGROUND_PIXEL (f
),
3631 FRAME_BACKGROUND_PIXEL (f
),
3634 xic
= XCreateIC (xim
,
3635 XNInputStyle
, xic_style
,
3636 XNClientWindow
, FRAME_X_WINDOW(f
),
3637 XNFocusWindow
, FRAME_X_WINDOW(f
),
3638 XNStatusAttributes
, status_attr
,
3639 XNPreeditAttributes
, preedit_attr
,
3641 XFree (preedit_attr
);
3642 XFree (status_attr
);
3645 FRAME_XIC (f
) = xic
;
3646 FRAME_XIC_STYLE (f
) = xic_style
;
3647 FRAME_XIC_FONTSET (f
) = xfs
;
3651 /* Destroy XIC and free XIC fontset of frame F, if any. */
3657 if (FRAME_XIC (f
) == NULL
)
3660 XDestroyIC (FRAME_XIC (f
));
3661 if (FRAME_XIC_FONTSET (f
))
3662 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3664 FRAME_XIC (f
) = NULL
;
3665 FRAME_XIC_FONTSET (f
) = NULL
;
3669 /* Place preedit area for XIC of window W's frame to specified
3670 pixel position X/Y. X and Y are relative to window W. */
3673 xic_set_preeditarea (w
, x
, y
)
3677 struct frame
*f
= XFRAME (w
->frame
);
3681 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3682 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3683 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3684 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3689 /* Place status area for XIC in bottom right corner of frame F.. */
3692 xic_set_statusarea (f
)
3695 XIC xic
= FRAME_XIC (f
);
3700 /* Negotiate geometry of status area. If input method has existing
3701 status area, use its current size. */
3702 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3703 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3704 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3707 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3708 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3711 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3713 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3714 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3718 area
.width
= needed
->width
;
3719 area
.height
= needed
->height
;
3720 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3721 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3722 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3725 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3726 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3731 /* Set X fontset for XIC of frame F, using base font name
3732 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3735 xic_set_xfontset (f
, base_fontname
)
3737 char *base_fontname
;
3742 xfs
= xic_create_xfontset (f
, base_fontname
);
3744 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3745 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3746 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3747 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3748 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3751 if (FRAME_XIC_FONTSET (f
))
3752 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3753 FRAME_XIC_FONTSET (f
) = xfs
;
3756 #endif /* HAVE_X_I18N */
3760 #ifdef USE_X_TOOLKIT
3762 /* Create and set up the X widget for frame F. */
3765 x_window (f
, window_prompting
, minibuffer_only
)
3767 long window_prompting
;
3768 int minibuffer_only
;
3770 XClassHint class_hints
;
3771 XSetWindowAttributes attributes
;
3772 unsigned long attribute_mask
;
3773 Widget shell_widget
;
3775 Widget frame_widget
;
3781 /* Use the resource name as the top-level widget name
3782 for looking up resources. Make a non-Lisp copy
3783 for the window manager, so GC relocation won't bother it.
3785 Elsewhere we specify the window name for the window manager. */
3788 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3789 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3790 strcpy (f
->namebuf
, str
);
3794 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3795 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3796 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3797 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3798 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3799 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3800 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3801 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3802 applicationShellWidgetClass
,
3803 FRAME_X_DISPLAY (f
), al
, ac
);
3805 f
->output_data
.x
->widget
= shell_widget
;
3806 /* maybe_set_screen_title_format (shell_widget); */
3808 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3809 (widget_value
*) NULL
,
3810 shell_widget
, False
,
3814 (lw_callback
) NULL
);
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 XtSetValues (pane_widget
, al
, ac
);
3821 f
->output_data
.x
->column_widget
= pane_widget
;
3823 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3824 the emacs screen when changing menubar. This reduces flickering. */
3827 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3828 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3829 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3830 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3831 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3832 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3833 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3834 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3835 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3838 f
->output_data
.x
->edit_widget
= frame_widget
;
3840 XtManageChild (frame_widget
);
3842 /* Do some needed geometry management. */
3845 char *tem
, shell_position
[32];
3848 int extra_borders
= 0;
3850 = (f
->output_data
.x
->menubar_widget
3851 ? (f
->output_data
.x
->menubar_widget
->core
.height
3852 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3855 #if 0 /* Experimentally, we now get the right results
3856 for -geometry -0-0 without this. 24 Aug 96, rms. */
3857 if (FRAME_EXTERNAL_MENU_BAR (f
))
3860 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3861 menubar_size
+= ibw
;
3865 f
->output_data
.x
->menubar_height
= menubar_size
;
3868 /* Motif seems to need this amount added to the sizes
3869 specified for the shell widget. The Athena/Lucid widgets don't.
3870 Both conclusions reached experimentally. -- rms. */
3871 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3872 &extra_borders
, NULL
);
3876 /* Convert our geometry parameters into a geometry string
3878 Note that we do not specify here whether the position
3879 is a user-specified or program-specified one.
3880 We pass that information later, in x_wm_set_size_hints. */
3882 int left
= f
->output_data
.x
->left_pos
;
3883 int xneg
= window_prompting
& XNegative
;
3884 int top
= f
->output_data
.x
->top_pos
;
3885 int yneg
= window_prompting
& YNegative
;
3891 if (window_prompting
& USPosition
)
3892 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3893 PIXEL_WIDTH (f
) + extra_borders
,
3894 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3895 (xneg
? '-' : '+'), left
,
3896 (yneg
? '-' : '+'), top
);
3898 sprintf (shell_position
, "=%dx%d",
3899 PIXEL_WIDTH (f
) + extra_borders
,
3900 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3903 len
= strlen (shell_position
) + 1;
3904 /* We don't free this because we don't know whether
3905 it is safe to free it while the frame exists.
3906 It isn't worth the trouble of arranging to free it
3907 when the frame is deleted. */
3908 tem
= (char *) xmalloc (len
);
3909 strncpy (tem
, shell_position
, len
);
3910 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3911 XtSetValues (shell_widget
, al
, ac
);
3914 XtManageChild (pane_widget
);
3915 XtRealizeWidget (shell_widget
);
3917 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3919 validate_x_resource_name ();
3921 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3922 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3923 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3926 FRAME_XIC (f
) = NULL
;
3928 create_frame_xic (f
);
3932 f
->output_data
.x
->wm_hints
.input
= True
;
3933 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3934 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3935 &f
->output_data
.x
->wm_hints
);
3937 hack_wm_protocols (f
, shell_widget
);
3940 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3943 /* Do a stupid property change to force the server to generate a
3944 PropertyNotify event so that the event_stream server timestamp will
3945 be initialized to something relevant to the time we created the window.
3947 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3948 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3949 XA_ATOM
, 32, PropModeAppend
,
3950 (unsigned char*) NULL
, 0);
3952 /* Make all the standard events reach the Emacs frame. */
3953 attributes
.event_mask
= STANDARD_EVENT_SET
;
3958 /* XIM server might require some X events. */
3959 unsigned long fevent
= NoEventMask
;
3960 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3961 attributes
.event_mask
|= fevent
;
3963 #endif /* HAVE_X_I18N */
3965 attribute_mask
= CWEventMask
;
3966 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3967 attribute_mask
, &attributes
);
3969 XtMapWidget (frame_widget
);
3971 /* x_set_name normally ignores requests to set the name if the
3972 requested name is the same as the current name. This is the one
3973 place where that assumption isn't correct; f->name is set, but
3974 the X server hasn't been told. */
3977 int explicit = f
->explicit_name
;
3979 f
->explicit_name
= 0;
3982 x_set_name (f
, name
, explicit);
3985 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3986 f
->output_data
.x
->text_cursor
);
3990 /* This is a no-op, except under Motif. Make sure main areas are
3991 set to something reasonable, in case we get an error later. */
3992 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3995 #else /* not USE_X_TOOLKIT */
3997 /* Create and set up the X window for frame F. */
4004 XClassHint class_hints
;
4005 XSetWindowAttributes attributes
;
4006 unsigned long attribute_mask
;
4008 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
4009 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
4010 attributes
.bit_gravity
= StaticGravity
;
4011 attributes
.backing_store
= NotUseful
;
4012 attributes
.save_under
= True
;
4013 attributes
.event_mask
= STANDARD_EVENT_SET
;
4014 attributes
.colormap
= FRAME_X_COLORMAP (f
);
4015 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
4020 = XCreateWindow (FRAME_X_DISPLAY (f
),
4021 f
->output_data
.x
->parent_desc
,
4022 f
->output_data
.x
->left_pos
,
4023 f
->output_data
.x
->top_pos
,
4024 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
4025 f
->output_data
.x
->border_width
,
4026 CopyFromParent
, /* depth */
4027 InputOutput
, /* class */
4029 attribute_mask
, &attributes
);
4033 create_frame_xic (f
);
4036 /* XIM server might require some X events. */
4037 unsigned long fevent
= NoEventMask
;
4038 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
4039 attributes
.event_mask
|= fevent
;
4040 attribute_mask
= CWEventMask
;
4041 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4042 attribute_mask
, &attributes
);
4045 #endif /* HAVE_X_I18N */
4047 validate_x_resource_name ();
4049 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
4050 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
4051 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
4053 /* The menubar is part of the ordinary display;
4054 it does not count in addition to the height of the window. */
4055 f
->output_data
.x
->menubar_height
= 0;
4057 /* This indicates that we use the "Passive Input" input model.
4058 Unless we do this, we don't get the Focus{In,Out} events that we
4059 need to draw the cursor correctly. Accursed bureaucrats.
4060 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
4062 f
->output_data
.x
->wm_hints
.input
= True
;
4063 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
4064 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4065 &f
->output_data
.x
->wm_hints
);
4066 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
4068 /* Request "save yourself" and "delete window" commands from wm. */
4071 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
4072 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
4073 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
4076 /* x_set_name normally ignores requests to set the name if the
4077 requested name is the same as the current name. This is the one
4078 place where that assumption isn't correct; f->name is set, but
4079 the X server hasn't been told. */
4082 int explicit = f
->explicit_name
;
4084 f
->explicit_name
= 0;
4087 x_set_name (f
, name
, explicit);
4090 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4091 f
->output_data
.x
->text_cursor
);
4095 if (FRAME_X_WINDOW (f
) == 0)
4096 error ("Unable to create window");
4099 #endif /* not USE_X_TOOLKIT */
4101 /* Handle the icon stuff for this window. Perhaps later we might
4102 want an x_set_icon_position which can be called interactively as
4110 Lisp_Object icon_x
, icon_y
;
4111 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4113 /* Set the position of the icon. Note that twm groups all
4114 icons in an icon window. */
4115 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
4116 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
4117 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
4119 CHECK_NUMBER (icon_x
);
4120 CHECK_NUMBER (icon_y
);
4122 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
4123 error ("Both left and top icon corners of icon must be specified");
4127 if (! EQ (icon_x
, Qunbound
))
4128 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
4130 /* Start up iconic or window? */
4131 x_wm_set_window_state
4132 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
4137 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
4144 /* Make the GCs needed for this window, setting the
4145 background, border and mouse colors; also create the
4146 mouse cursor and the gray border tile. */
4148 static char cursor_bits
[] =
4150 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4151 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4152 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4153 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
4160 XGCValues gc_values
;
4164 /* Create the GCs of this frame.
4165 Note that many default values are used. */
4168 gc_values
.font
= f
->output_data
.x
->font
->fid
;
4169 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
4170 gc_values
.background
= f
->output_data
.x
->background_pixel
;
4171 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
4172 f
->output_data
.x
->normal_gc
4173 = XCreateGC (FRAME_X_DISPLAY (f
),
4175 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
4178 /* Reverse video style. */
4179 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4180 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
4181 f
->output_data
.x
->reverse_gc
4182 = XCreateGC (FRAME_X_DISPLAY (f
),
4184 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
4187 /* Cursor has cursor-color background, background-color foreground. */
4188 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4189 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
4190 gc_values
.fill_style
= FillOpaqueStippled
;
4192 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
4193 FRAME_X_DISPLAY_INFO (f
)->root_window
,
4194 cursor_bits
, 16, 16);
4195 f
->output_data
.x
->cursor_gc
4196 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4197 (GCFont
| GCForeground
| GCBackground
4198 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
4202 f
->output_data
.x
->white_relief
.gc
= 0;
4203 f
->output_data
.x
->black_relief
.gc
= 0;
4205 /* Create the gray border tile used when the pointer is not in
4206 the frame. Since this depends on the frame's pixel values,
4207 this must be done on a per-frame basis. */
4208 f
->output_data
.x
->border_tile
4209 = (XCreatePixmapFromBitmapData
4210 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
4211 gray_bits
, gray_width
, gray_height
,
4212 f
->output_data
.x
->foreground_pixel
,
4213 f
->output_data
.x
->background_pixel
,
4214 DefaultDepth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
))));
4220 /* Free what was was allocated in x_make_gc. */
4226 Display
*dpy
= FRAME_X_DISPLAY (f
);
4230 if (f
->output_data
.x
->normal_gc
)
4232 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
4233 f
->output_data
.x
->normal_gc
= 0;
4236 if (f
->output_data
.x
->reverse_gc
)
4238 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4239 f
->output_data
.x
->reverse_gc
= 0;
4242 if (f
->output_data
.x
->cursor_gc
)
4244 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4245 f
->output_data
.x
->cursor_gc
= 0;
4248 if (f
->output_data
.x
->border_tile
)
4250 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4251 f
->output_data
.x
->border_tile
= 0;
4258 /* Handler for signals raised during x_create_frame and
4259 x_create_top_frame. FRAME is the frame which is partially
4263 unwind_create_frame (frame
)
4266 struct frame
*f
= XFRAME (frame
);
4268 /* If frame is ``official'', nothing to do. */
4269 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4272 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4275 x_free_frame_resources (f
);
4277 /* Check that reference counts are indeed correct. */
4278 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4279 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4287 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4289 doc
: /* Make a new X window, which is called a "frame" in Emacs terms.
4290 Returns an Emacs frame object.
4291 ALIST is an alist of frame parameters.
4292 If the parameters specify that the frame should not have a minibuffer,
4293 and do not specify a specific minibuffer window to use,
4294 then `default-minibuffer-frame' must be a frame whose minibuffer can
4295 be shared by the new frame.
4297 This function is an internal primitive--use `make-frame' instead. */)
4302 Lisp_Object frame
, tem
;
4304 int minibuffer_only
= 0;
4305 long window_prompting
= 0;
4307 int count
= BINDING_STACK_SIZE ();
4308 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4309 Lisp_Object display
;
4310 struct x_display_info
*dpyinfo
= NULL
;
4316 /* Use this general default value to start with
4317 until we know if this frame has a specified name. */
4318 Vx_resource_name
= Vinvocation_name
;
4320 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4321 if (EQ (display
, Qunbound
))
4323 dpyinfo
= check_x_display_info (display
);
4325 kb
= dpyinfo
->kboard
;
4327 kb
= &the_only_kboard
;
4330 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4332 && ! EQ (name
, Qunbound
)
4334 error ("Invalid frame name--not a string or nil");
4337 Vx_resource_name
= name
;
4339 /* See if parent window is specified. */
4340 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4341 if (EQ (parent
, Qunbound
))
4343 if (! NILP (parent
))
4344 CHECK_NUMBER (parent
);
4346 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4347 /* No need to protect DISPLAY because that's not used after passing
4348 it to make_frame_without_minibuffer. */
4350 GCPRO4 (parms
, parent
, name
, frame
);
4351 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4353 if (EQ (tem
, Qnone
) || NILP (tem
))
4354 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4355 else if (EQ (tem
, Qonly
))
4357 f
= make_minibuffer_frame ();
4358 minibuffer_only
= 1;
4360 else if (WINDOWP (tem
))
4361 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4365 XSETFRAME (frame
, f
);
4367 /* Note that X Windows does support scroll bars. */
4368 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4370 f
->output_method
= output_x_window
;
4371 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4372 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4373 f
->output_data
.x
->icon_bitmap
= -1;
4374 f
->output_data
.x
->fontset
= -1;
4375 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4376 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4377 #ifdef USE_TOOLKIT_SCROLL_BARS
4378 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
4379 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
4380 #endif /* USE_TOOLKIT_SCROLL_BARS */
4381 record_unwind_protect (unwind_create_frame
, frame
);
4384 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4386 if (! STRINGP (f
->icon_name
))
4387 f
->icon_name
= Qnil
;
4389 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4391 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4392 dpyinfo_refcount
= dpyinfo
->reference_count
;
4393 #endif /* GLYPH_DEBUG */
4395 FRAME_KBOARD (f
) = kb
;
4398 /* These colors will be set anyway later, but it's important
4399 to get the color reference counts right, so initialize them! */
4402 struct gcpro gcpro1
;
4404 /* Function x_decode_color can signal an error. Make
4405 sure to initialize color slots so that we won't try
4406 to free colors we haven't allocated. */
4407 f
->output_data
.x
->foreground_pixel
= -1;
4408 f
->output_data
.x
->background_pixel
= -1;
4409 f
->output_data
.x
->cursor_pixel
= -1;
4410 f
->output_data
.x
->cursor_foreground_pixel
= -1;
4411 f
->output_data
.x
->border_pixel
= -1;
4412 f
->output_data
.x
->mouse_pixel
= -1;
4414 black
= build_string ("black");
4416 f
->output_data
.x
->foreground_pixel
4417 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4418 f
->output_data
.x
->background_pixel
4419 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4420 f
->output_data
.x
->cursor_pixel
4421 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4422 f
->output_data
.x
->cursor_foreground_pixel
4423 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4424 f
->output_data
.x
->border_pixel
4425 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4426 f
->output_data
.x
->mouse_pixel
4427 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4431 /* Specify the parent under which to make this X window. */
4435 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4436 f
->output_data
.x
->explicit_parent
= 1;
4440 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4441 f
->output_data
.x
->explicit_parent
= 0;
4444 /* Set the name; the functions to which we pass f expect the name to
4446 if (EQ (name
, Qunbound
) || NILP (name
))
4448 f
->name
= build_string (dpyinfo
->x_id_name
);
4449 f
->explicit_name
= 0;
4454 f
->explicit_name
= 1;
4455 /* use the frame's title when getting resources for this frame. */
4456 specbind (Qx_resource_name
, name
);
4459 /* Extract the window parameters from the supplied values
4460 that are needed to determine window geometry. */
4464 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4467 /* First, try whatever font the caller has specified. */
4470 tem
= Fquery_fontset (font
, Qnil
);
4472 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4474 font
= x_new_font (f
, XSTRING (font
)->data
);
4477 /* Try out a font which we hope has bold and italic variations. */
4478 if (!STRINGP (font
))
4479 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4480 if (!STRINGP (font
))
4481 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4482 if (! STRINGP (font
))
4483 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4484 if (! STRINGP (font
))
4485 /* This was formerly the first thing tried, but it finds too many fonts
4486 and takes too long. */
4487 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4488 /* If those didn't work, look for something which will at least work. */
4489 if (! STRINGP (font
))
4490 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4492 if (! STRINGP (font
))
4493 font
= build_string ("fixed");
4495 x_default_parameter (f
, parms
, Qfont
, font
,
4496 "font", "Font", RES_TYPE_STRING
);
4500 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4501 whereby it fails to get any font. */
4502 xlwmenu_default_font
= f
->output_data
.x
->font
;
4505 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4506 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4508 /* This defaults to 1 in order to match xterm. We recognize either
4509 internalBorderWidth or internalBorder (which is what xterm calls
4511 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4515 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4516 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4517 if (! EQ (value
, Qunbound
))
4518 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4521 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4522 "internalBorderWidth", "internalBorderWidth",
4524 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4525 "verticalScrollBars", "ScrollBars",
4528 /* Also do the stuff which must be set before the window exists. */
4529 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4530 "foreground", "Foreground", RES_TYPE_STRING
);
4531 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4532 "background", "Background", RES_TYPE_STRING
);
4533 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4534 "pointerColor", "Foreground", RES_TYPE_STRING
);
4535 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4536 "cursorColor", "Foreground", RES_TYPE_STRING
);
4537 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4538 "borderColor", "BorderColor", RES_TYPE_STRING
);
4539 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4540 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4541 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4542 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4543 x_default_parameter (f
, parms
, Qleft_fringe
, Qnil
,
4544 "leftFringe", "LeftFringe", RES_TYPE_NUMBER
);
4545 x_default_parameter (f
, parms
, Qright_fringe
, Qnil
,
4546 "rightFringe", "RightFringe", RES_TYPE_NUMBER
);
4548 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4549 "scrollBarForeground",
4550 "ScrollBarForeground", 1);
4551 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4552 "scrollBarBackground",
4553 "ScrollBarBackground", 0);
4555 /* Init faces before x_default_parameter is called for scroll-bar
4556 parameters because that function calls x_set_scroll_bar_width,
4557 which calls change_frame_size, which calls Fset_window_buffer,
4558 which runs hooks, which call Fvertical_motion. At the end, we
4559 end up in init_iterator with a null face cache, which should not
4561 init_frame_faces (f
);
4563 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4564 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4565 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4566 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4567 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4568 "bufferPredicate", "BufferPredicate",
4570 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4571 "title", "Title", RES_TYPE_STRING
);
4572 x_default_parameter (f
, parms
, Qwait_for_wm
, Qt
,
4573 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN
);
4574 x_default_parameter (f
, parms
, Qfullscreen
, Qnil
,
4575 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL
);
4577 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4579 /* Add the tool-bar height to the initial frame height so that the
4580 user gets a text display area of the size he specified with -g or
4581 via .Xdefaults. Later changes of the tool-bar height don't
4582 change the frame size. This is done so that users can create
4583 tall Emacs frames without having to guess how tall the tool-bar
4585 if (FRAME_TOOL_BAR_LINES (f
))
4587 int margin
, relief
, bar_height
;
4589 relief
= (tool_bar_button_relief
>= 0
4590 ? tool_bar_button_relief
4591 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4593 if (INTEGERP (Vtool_bar_button_margin
)
4594 && XINT (Vtool_bar_button_margin
) > 0)
4595 margin
= XFASTINT (Vtool_bar_button_margin
);
4596 else if (CONSP (Vtool_bar_button_margin
)
4597 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4598 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4599 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4603 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4604 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4607 /* Compute the size of the X window. */
4608 window_prompting
= x_figure_window_size (f
, parms
);
4610 if (window_prompting
& XNegative
)
4612 if (window_prompting
& YNegative
)
4613 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4615 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4619 if (window_prompting
& YNegative
)
4620 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4622 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4625 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4627 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4628 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4630 /* Create the X widget or window. */
4631 #ifdef USE_X_TOOLKIT
4632 x_window (f
, window_prompting
, minibuffer_only
);
4640 /* Now consider the frame official. */
4641 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4642 Vframe_list
= Fcons (frame
, Vframe_list
);
4644 /* We need to do this after creating the X window, so that the
4645 icon-creation functions can say whose icon they're describing. */
4646 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4647 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4649 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4650 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4651 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4652 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4653 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4654 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4655 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4656 "scrollBarWidth", "ScrollBarWidth",
4659 /* Dimensions, especially f->height, must be done via change_frame_size.
4660 Change will not be effected unless different from the current
4666 SET_FRAME_WIDTH (f
, 0);
4667 change_frame_size (f
, height
, width
, 1, 0, 0);
4669 /* Set up faces after all frame parameters are known. This call
4670 also merges in face attributes specified for new frames. If we
4671 don't do this, the `menu' face for instance won't have the right
4672 colors, and the menu bar won't appear in the specified colors for
4674 call1 (Qface_set_after_frame_default
, frame
);
4676 #ifdef USE_X_TOOLKIT
4677 /* Create the menu bar. */
4678 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4680 /* If this signals an error, we haven't set size hints for the
4681 frame and we didn't make it visible. */
4682 initialize_frame_menubar (f
);
4684 /* This is a no-op, except under Motif where it arranges the
4685 main window for the widgets on it. */
4686 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4687 f
->output_data
.x
->menubar_widget
,
4688 f
->output_data
.x
->edit_widget
);
4690 #endif /* USE_X_TOOLKIT */
4692 /* Tell the server what size and position, etc, we want, and how
4693 badly we want them. This should be done after we have the menu
4694 bar so that its size can be taken into account. */
4696 x_wm_set_size_hint (f
, window_prompting
, 0);
4699 /* Make the window appear on the frame and enable display, unless
4700 the caller says not to. However, with explicit parent, Emacs
4701 cannot control visibility, so don't try. */
4702 if (! f
->output_data
.x
->explicit_parent
)
4704 Lisp_Object visibility
;
4706 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4708 if (EQ (visibility
, Qunbound
))
4711 if (EQ (visibility
, Qicon
))
4712 x_iconify_frame (f
);
4713 else if (! NILP (visibility
))
4714 x_make_frame_visible (f
);
4716 /* Must have been Qnil. */
4722 /* Make sure windows on this frame appear in calls to next-window
4723 and similar functions. */
4724 Vwindow_list
= Qnil
;
4726 return unbind_to (count
, frame
);
4730 /* FRAME is used only to get a handle on the X display. We don't pass the
4731 display info directly because we're called from frame.c, which doesn't
4732 know about that structure. */
4735 x_get_focus_frame (frame
)
4736 struct frame
*frame
;
4738 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4740 if (! dpyinfo
->x_focus_frame
)
4743 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4748 /* In certain situations, when the window manager follows a
4749 click-to-focus policy, there seems to be no way around calling
4750 XSetInputFocus to give another frame the input focus .
4752 In an ideal world, XSetInputFocus should generally be avoided so
4753 that applications don't interfere with the window manager's focus
4754 policy. But I think it's okay to use when it's clearly done
4755 following a user-command. */
4757 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4758 doc
: /* Set the input focus to FRAME.
4759 FRAME nil means use the selected frame. */)
4763 struct frame
*f
= check_x_frame (frame
);
4764 Display
*dpy
= FRAME_X_DISPLAY (f
);
4768 count
= x_catch_errors (dpy
);
4769 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4770 RevertToParent
, CurrentTime
);
4771 x_uncatch_errors (dpy
, count
);
4778 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4779 doc
: /* Internal function called by `color-defined-p', which see. */)
4781 Lisp_Object color
, frame
;
4784 FRAME_PTR f
= check_x_frame (frame
);
4786 CHECK_STRING (color
);
4788 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4794 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4795 doc
: /* Internal function called by `color-values', which see. */)
4797 Lisp_Object color
, frame
;
4800 FRAME_PTR f
= check_x_frame (frame
);
4802 CHECK_STRING (color
);
4804 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4808 rgb
[0] = make_number (foo
.red
);
4809 rgb
[1] = make_number (foo
.green
);
4810 rgb
[2] = make_number (foo
.blue
);
4811 return Flist (3, rgb
);
4817 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4818 doc
: /* Internal function called by `display-color-p', which see. */)
4820 Lisp_Object display
;
4822 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4824 if (dpyinfo
->n_planes
<= 2)
4827 switch (dpyinfo
->visual
->class)
4840 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4842 doc
: /* Return t if the X display supports shades of gray.
4843 Note that color displays do support shades of gray.
4844 The optional argument DISPLAY specifies which display to ask about.
4845 DISPLAY should be either a frame or a display name (a string).
4846 If omitted or nil, that stands for the selected frame's display. */)
4848 Lisp_Object display
;
4850 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4852 if (dpyinfo
->n_planes
<= 1)
4855 switch (dpyinfo
->visual
->class)
4870 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4872 doc
: /* Returns the width in pixels of the X display DISPLAY.
4873 The optional argument DISPLAY specifies which display to ask about.
4874 DISPLAY should be either a frame or a display name (a string).
4875 If omitted or nil, that stands for the selected frame's display. */)
4877 Lisp_Object display
;
4879 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4881 return make_number (dpyinfo
->width
);
4884 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4885 Sx_display_pixel_height
, 0, 1, 0,
4886 doc
: /* Returns the height in pixels of the X display DISPLAY.
4887 The optional argument DISPLAY specifies which display to ask about.
4888 DISPLAY should be either a frame or a display name (a string).
4889 If omitted or nil, that stands for the selected frame's display. */)
4891 Lisp_Object display
;
4893 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4895 return make_number (dpyinfo
->height
);
4898 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4900 doc
: /* Returns the number of bitplanes of the X display DISPLAY.
4901 The optional argument DISPLAY specifies which display to ask about.
4902 DISPLAY should be either a frame or a display name (a string).
4903 If omitted or nil, that stands for the selected frame's display. */)
4905 Lisp_Object display
;
4907 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4909 return make_number (dpyinfo
->n_planes
);
4912 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4914 doc
: /* Returns the number of color cells of the X display DISPLAY.
4915 The optional argument DISPLAY specifies which display to ask about.
4916 DISPLAY should be either a frame or a display name (a string).
4917 If omitted or nil, that stands for the selected frame's display. */)
4919 Lisp_Object display
;
4921 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4923 return make_number (DisplayCells (dpyinfo
->display
,
4924 XScreenNumberOfScreen (dpyinfo
->screen
)));
4927 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4928 Sx_server_max_request_size
,
4930 doc
: /* Returns the maximum request size of the X server of display DISPLAY.
4931 The optional argument DISPLAY specifies which display to ask about.
4932 DISPLAY should be either a frame or a display name (a string).
4933 If omitted or nil, that stands for the selected frame's display. */)
4935 Lisp_Object display
;
4937 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4939 return make_number (MAXREQUEST (dpyinfo
->display
));
4942 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4943 doc
: /* Returns the vendor ID string of the X server of display DISPLAY.
4944 The optional argument DISPLAY specifies which display to ask about.
4945 DISPLAY should be either a frame or a display name (a string).
4946 If omitted or nil, that stands for the selected frame's display. */)
4948 Lisp_Object display
;
4950 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4951 char *vendor
= ServerVendor (dpyinfo
->display
);
4953 if (! vendor
) vendor
= "";
4954 return build_string (vendor
);
4957 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4958 doc
: /* Returns the version numbers of the X server of display DISPLAY.
4959 The value is a list of three integers: the major and minor
4960 version numbers of the X Protocol in use, and the vendor-specific release
4961 number. See also the function `x-server-vendor'.
4963 The optional argument DISPLAY specifies which display to ask about.
4964 DISPLAY should be either a frame or a display name (a string).
4965 If omitted or nil, that stands for the selected frame's display. */)
4967 Lisp_Object display
;
4969 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4970 Display
*dpy
= dpyinfo
->display
;
4972 return Fcons (make_number (ProtocolVersion (dpy
)),
4973 Fcons (make_number (ProtocolRevision (dpy
)),
4974 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4977 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4978 doc
: /* Return the number of screens on the X server of display DISPLAY.
4979 The optional argument DISPLAY specifies which display to ask about.
4980 DISPLAY should be either a frame or a display name (a string).
4981 If omitted or nil, that stands for the selected frame's display. */)
4983 Lisp_Object display
;
4985 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4987 return make_number (ScreenCount (dpyinfo
->display
));
4990 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4991 doc
: /* Return the height in millimeters of the X display DISPLAY.
4992 The optional argument DISPLAY specifies which display to ask about.
4993 DISPLAY should be either a frame or a display name (a string).
4994 If omitted or nil, that stands for the selected frame's display. */)
4996 Lisp_Object display
;
4998 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5000 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
5003 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
5004 doc
: /* Return the width in millimeters of the X display DISPLAY.
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
);
5013 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
5016 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
5017 Sx_display_backing_store
, 0, 1, 0,
5018 doc
: /* Returns an indication of whether X display DISPLAY does backing store.
5019 The value may be `always', `when-mapped', or `not-useful'.
5020 The optional argument DISPLAY specifies which display to ask about.
5021 DISPLAY should be either a frame or a display name (a string).
5022 If omitted or nil, that stands for the selected frame's display. */)
5024 Lisp_Object display
;
5026 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5029 switch (DoesBackingStore (dpyinfo
->screen
))
5032 result
= intern ("always");
5036 result
= intern ("when-mapped");
5040 result
= intern ("not-useful");
5044 error ("Strange value for BackingStore parameter of screen");
5051 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
5052 Sx_display_visual_class
, 0, 1, 0,
5053 doc
: /* Return the visual class of the X display DISPLAY.
5054 The value is one of the symbols `static-gray', `gray-scale',
5055 `static-color', `pseudo-color', `true-color', or `direct-color'.
5057 The optional argument DISPLAY specifies which display to ask about.
5058 DISPLAY should be either a frame or a display name (a string).
5059 If omitted or nil, that stands for the selected frame's display. */)
5061 Lisp_Object display
;
5063 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5066 switch (dpyinfo
->visual
->class)
5069 result
= intern ("static-gray");
5072 result
= intern ("gray-scale");
5075 result
= intern ("static-color");
5078 result
= intern ("pseudo-color");
5081 result
= intern ("true-color");
5084 result
= intern ("direct-color");
5087 error ("Display has an unknown visual class");
5094 DEFUN ("x-display-save-under", Fx_display_save_under
,
5095 Sx_display_save_under
, 0, 1, 0,
5096 doc
: /* Returns t if the X display DISPLAY supports the save-under feature.
5097 The optional argument DISPLAY specifies which display to ask about.
5098 DISPLAY should be either a frame or a display name (a string).
5099 If omitted or nil, that stands for the selected frame's display. */)
5101 Lisp_Object display
;
5103 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5105 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
5113 register struct frame
*f
;
5115 return PIXEL_WIDTH (f
);
5120 register struct frame
*f
;
5122 return PIXEL_HEIGHT (f
);
5127 register struct frame
*f
;
5129 return FONT_WIDTH (f
->output_data
.x
->font
);
5134 register struct frame
*f
;
5136 return f
->output_data
.x
->line_height
;
5141 register struct frame
*f
;
5143 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
5148 /************************************************************************
5150 ************************************************************************/
5153 /* Mapping visual names to visuals. */
5155 static struct visual_class
5162 {"StaticGray", StaticGray
},
5163 {"GrayScale", GrayScale
},
5164 {"StaticColor", StaticColor
},
5165 {"PseudoColor", PseudoColor
},
5166 {"TrueColor", TrueColor
},
5167 {"DirectColor", DirectColor
},
5172 #ifndef HAVE_XSCREENNUMBEROFSCREEN
5174 /* Value is the screen number of screen SCR. This is a substitute for
5175 the X function with the same name when that doesn't exist. */
5178 XScreenNumberOfScreen (scr
)
5179 register Screen
*scr
;
5181 Display
*dpy
= scr
->display
;
5184 for (i
= 0; i
< dpy
->nscreens
; ++i
)
5185 if (scr
== dpy
->screens
+ i
)
5191 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5194 /* Select the visual that should be used on display DPYINFO. Set
5195 members of DPYINFO appropriately. Called from x_term_init. */
5198 select_visual (dpyinfo
)
5199 struct x_display_info
*dpyinfo
;
5201 Display
*dpy
= dpyinfo
->display
;
5202 Screen
*screen
= dpyinfo
->screen
;
5205 /* See if a visual is specified. */
5206 value
= display_x_get_resource (dpyinfo
,
5207 build_string ("visualClass"),
5208 build_string ("VisualClass"),
5210 if (STRINGP (value
))
5212 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
5213 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
5214 depth, a decimal number. NAME is compared with case ignored. */
5215 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
5220 strcpy (s
, XSTRING (value
)->data
);
5221 dash
= index (s
, '-');
5224 dpyinfo
->n_planes
= atoi (dash
+ 1);
5228 /* We won't find a matching visual with depth 0, so that
5229 an error will be printed below. */
5230 dpyinfo
->n_planes
= 0;
5232 /* Determine the visual class. */
5233 for (i
= 0; visual_classes
[i
].name
; ++i
)
5234 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
5236 class = visual_classes
[i
].class;
5240 /* Look up a matching visual for the specified class. */
5242 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
5243 dpyinfo
->n_planes
, class, &vinfo
))
5244 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
5246 dpyinfo
->visual
= vinfo
.visual
;
5251 XVisualInfo
*vinfo
, vinfo_template
;
5253 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
5256 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
5258 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
5260 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5261 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
5262 &vinfo_template
, &n_visuals
);
5264 fatal ("Can't get proper X visual info");
5266 dpyinfo
->n_planes
= vinfo
->depth
;
5267 XFree ((char *) vinfo
);
5272 /* Return the X display structure for the display named NAME.
5273 Open a new connection if necessary. */
5275 struct x_display_info
*
5276 x_display_info_for_name (name
)
5280 struct x_display_info
*dpyinfo
;
5282 CHECK_STRING (name
);
5284 if (! EQ (Vwindow_system
, intern ("x")))
5285 error ("Not using X Windows");
5287 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5289 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5292 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5297 /* Use this general default value to start with. */
5298 Vx_resource_name
= Vinvocation_name
;
5300 validate_x_resource_name ();
5302 dpyinfo
= x_term_init (name
, (char *)0,
5303 (char *) XSTRING (Vx_resource_name
)->data
);
5306 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5309 XSETFASTINT (Vwindow_system_version
, 11);
5315 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5317 doc
: /* Open a connection to an X server.
5318 DISPLAY is the name of the display to connect to.
5319 Optional second arg XRM-STRING is a string of resources in xrdb format.
5320 If the optional third arg MUST-SUCCEED is non-nil,
5321 terminate Emacs if we can't open the connection. */)
5322 (display
, xrm_string
, must_succeed
)
5323 Lisp_Object display
, xrm_string
, must_succeed
;
5325 unsigned char *xrm_option
;
5326 struct x_display_info
*dpyinfo
;
5328 CHECK_STRING (display
);
5329 if (! NILP (xrm_string
))
5330 CHECK_STRING (xrm_string
);
5332 if (! EQ (Vwindow_system
, intern ("x")))
5333 error ("Not using X Windows");
5335 if (! NILP (xrm_string
))
5336 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5338 xrm_option
= (unsigned char *) 0;
5340 validate_x_resource_name ();
5342 /* This is what opens the connection and sets x_current_display.
5343 This also initializes many symbols, such as those used for input. */
5344 dpyinfo
= x_term_init (display
, xrm_option
,
5345 (char *) XSTRING (Vx_resource_name
)->data
);
5349 if (!NILP (must_succeed
))
5350 fatal ("Cannot connect to X server %s.\n\
5351 Check the DISPLAY environment variable or use `-d'.\n\
5352 Also use the `xhost' program to verify that it is set to permit\n\
5353 connections from your machine.\n",
5354 XSTRING (display
)->data
);
5356 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5361 XSETFASTINT (Vwindow_system_version
, 11);
5365 DEFUN ("x-close-connection", Fx_close_connection
,
5366 Sx_close_connection
, 1, 1, 0,
5367 doc
: /* Close the connection to DISPLAY's X server.
5368 For DISPLAY, specify either a frame or a display name (a string).
5369 If DISPLAY is nil, that stands for the selected frame's display. */)
5371 Lisp_Object display
;
5373 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5376 if (dpyinfo
->reference_count
> 0)
5377 error ("Display still has frames on it");
5380 /* Free the fonts in the font table. */
5381 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5382 if (dpyinfo
->font_table
[i
].name
)
5384 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5385 xfree (dpyinfo
->font_table
[i
].full_name
);
5386 xfree (dpyinfo
->font_table
[i
].name
);
5387 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5390 x_destroy_all_bitmaps (dpyinfo
);
5391 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5393 #ifdef USE_X_TOOLKIT
5394 XtCloseDisplay (dpyinfo
->display
);
5396 XCloseDisplay (dpyinfo
->display
);
5399 x_delete_display (dpyinfo
);
5405 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5406 doc
: /* Return the list of display names that Emacs has connections to. */)
5409 Lisp_Object tail
, result
;
5412 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5413 result
= Fcons (XCAR (XCAR (tail
)), result
);
5418 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5419 doc
: /* If ON is non-nil, report X errors as soon as the erring request is made.
5420 If ON is nil, allow buffering of requests.
5421 Turning on synchronization prohibits the Xlib routines from buffering
5422 requests and seriously degrades performance, but makes debugging much
5424 The optional second argument DISPLAY specifies which display to act on.
5425 DISPLAY should be either a frame or a display name (a string).
5426 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
5428 Lisp_Object display
, on
;
5430 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5432 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5437 /* Wait for responses to all X commands issued so far for frame F. */
5444 XSync (FRAME_X_DISPLAY (f
), False
);
5449 /***********************************************************************
5451 ***********************************************************************/
5453 /* Value is the number of elements of vector VECTOR. */
5455 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5457 /* List of supported image types. Use define_image_type to add new
5458 types. Use lookup_image_type to find a type for a given symbol. */
5460 static struct image_type
*image_types
;
5462 /* The symbol `image' which is the car of the lists used to represent
5465 extern Lisp_Object Qimage
;
5467 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5473 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5474 extern Lisp_Object QCdata
, QCtype
;
5475 Lisp_Object QCascent
, QCmargin
, QCrelief
;
5476 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5477 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5479 /* Other symbols. */
5481 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5483 /* Time in seconds after which images should be removed from the cache
5484 if not displayed. */
5486 Lisp_Object Vimage_cache_eviction_delay
;
5488 /* Function prototypes. */
5490 static void define_image_type
P_ ((struct image_type
*type
));
5491 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5492 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5493 static void x_laplace
P_ ((struct frame
*, struct image
*));
5494 static void x_emboss
P_ ((struct frame
*, struct image
*));
5495 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5499 /* Define a new image type from TYPE. This adds a copy of TYPE to
5500 image_types and adds the symbol *TYPE->type to Vimage_types. */
5503 define_image_type (type
)
5504 struct image_type
*type
;
5506 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5507 The initialized data segment is read-only. */
5508 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5509 bcopy (type
, p
, sizeof *p
);
5510 p
->next
= image_types
;
5512 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5516 /* Look up image type SYMBOL, and return a pointer to its image_type
5517 structure. Value is null if SYMBOL is not a known image type. */
5519 static INLINE
struct image_type
*
5520 lookup_image_type (symbol
)
5523 struct image_type
*type
;
5525 for (type
= image_types
; type
; type
= type
->next
)
5526 if (EQ (symbol
, *type
->type
))
5533 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5534 valid image specification is a list whose car is the symbol
5535 `image', and whose rest is a property list. The property list must
5536 contain a value for key `:type'. That value must be the name of a
5537 supported image type. The rest of the property list depends on the
5541 valid_image_p (object
)
5546 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5550 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
5551 if (EQ (XCAR (tem
), QCtype
))
5554 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
5556 struct image_type
*type
;
5557 type
= lookup_image_type (XCAR (tem
));
5559 valid_p
= type
->valid_p (object
);
5570 /* Log error message with format string FORMAT and argument ARG.
5571 Signaling an error, e.g. when an image cannot be loaded, is not a
5572 good idea because this would interrupt redisplay, and the error
5573 message display would lead to another redisplay. This function
5574 therefore simply displays a message. */
5577 image_error (format
, arg1
, arg2
)
5579 Lisp_Object arg1
, arg2
;
5581 add_to_log (format
, arg1
, arg2
);
5586 /***********************************************************************
5587 Image specifications
5588 ***********************************************************************/
5590 enum image_value_type
5592 IMAGE_DONT_CHECK_VALUE_TYPE
,
5594 IMAGE_STRING_OR_NIL_VALUE
,
5596 IMAGE_POSITIVE_INTEGER_VALUE
,
5597 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5598 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5600 IMAGE_INTEGER_VALUE
,
5601 IMAGE_FUNCTION_VALUE
,
5606 /* Structure used when parsing image specifications. */
5608 struct image_keyword
5610 /* Name of keyword. */
5613 /* The type of value allowed. */
5614 enum image_value_type type
;
5616 /* Non-zero means key must be present. */
5619 /* Used to recognize duplicate keywords in a property list. */
5622 /* The value that was found. */
5627 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5629 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5632 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5633 has the format (image KEYWORD VALUE ...). One of the keyword/
5634 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5635 image_keywords structures of size NKEYWORDS describing other
5636 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5639 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5641 struct image_keyword
*keywords
;
5648 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5651 plist
= XCDR (spec
);
5652 while (CONSP (plist
))
5654 Lisp_Object key
, value
;
5656 /* First element of a pair must be a symbol. */
5658 plist
= XCDR (plist
);
5662 /* There must follow a value. */
5665 value
= XCAR (plist
);
5666 plist
= XCDR (plist
);
5668 /* Find key in KEYWORDS. Error if not found. */
5669 for (i
= 0; i
< nkeywords
; ++i
)
5670 if (strcmp (keywords
[i
].name
, XSTRING (SYMBOL_NAME (key
))->data
) == 0)
5676 /* Record that we recognized the keyword. If a keywords
5677 was found more than once, it's an error. */
5678 keywords
[i
].value
= value
;
5679 ++keywords
[i
].count
;
5681 if (keywords
[i
].count
> 1)
5684 /* Check type of value against allowed type. */
5685 switch (keywords
[i
].type
)
5687 case IMAGE_STRING_VALUE
:
5688 if (!STRINGP (value
))
5692 case IMAGE_STRING_OR_NIL_VALUE
:
5693 if (!STRINGP (value
) && !NILP (value
))
5697 case IMAGE_SYMBOL_VALUE
:
5698 if (!SYMBOLP (value
))
5702 case IMAGE_POSITIVE_INTEGER_VALUE
:
5703 if (!INTEGERP (value
) || XINT (value
) <= 0)
5707 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5708 if (INTEGERP (value
) && XINT (value
) >= 0)
5711 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5712 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5716 case IMAGE_ASCENT_VALUE
:
5717 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5719 else if (INTEGERP (value
)
5720 && XINT (value
) >= 0
5721 && XINT (value
) <= 100)
5725 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5726 if (!INTEGERP (value
) || XINT (value
) < 0)
5730 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5733 case IMAGE_FUNCTION_VALUE
:
5734 value
= indirect_function (value
);
5736 || COMPILEDP (value
)
5737 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5741 case IMAGE_NUMBER_VALUE
:
5742 if (!INTEGERP (value
) && !FLOATP (value
))
5746 case IMAGE_INTEGER_VALUE
:
5747 if (!INTEGERP (value
))
5751 case IMAGE_BOOL_VALUE
:
5752 if (!NILP (value
) && !EQ (value
, Qt
))
5761 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5765 /* Check that all mandatory fields are present. */
5766 for (i
= 0; i
< nkeywords
; ++i
)
5767 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5770 return NILP (plist
);
5774 /* Return the value of KEY in image specification SPEC. Value is nil
5775 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5776 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5779 image_spec_value (spec
, key
, found
)
5780 Lisp_Object spec
, key
;
5785 xassert (valid_image_p (spec
));
5787 for (tail
= XCDR (spec
);
5788 CONSP (tail
) && CONSP (XCDR (tail
));
5789 tail
= XCDR (XCDR (tail
)))
5791 if (EQ (XCAR (tail
), key
))
5795 return XCAR (XCDR (tail
));
5805 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5806 doc
: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
5807 PIXELS non-nil means return the size in pixels, otherwise return the
5808 size in canonical character units.
5809 FRAME is the frame on which the image will be displayed. FRAME nil
5810 or omitted means use the selected frame. */)
5811 (spec
, pixels
, frame
)
5812 Lisp_Object spec
, pixels
, frame
;
5817 if (valid_image_p (spec
))
5819 struct frame
*f
= check_x_frame (frame
);
5820 int id
= lookup_image (f
, spec
);
5821 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5822 int width
= img
->width
+ 2 * img
->hmargin
;
5823 int height
= img
->height
+ 2 * img
->vmargin
;
5826 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5827 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5829 size
= Fcons (make_number (width
), make_number (height
));
5832 error ("Invalid image specification");
5838 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5839 doc
: /* Return t if image SPEC has a mask bitmap.
5840 FRAME is the frame on which the image will be displayed. FRAME nil
5841 or omitted means use the selected frame. */)
5843 Lisp_Object spec
, frame
;
5848 if (valid_image_p (spec
))
5850 struct frame
*f
= check_x_frame (frame
);
5851 int id
= lookup_image (f
, spec
);
5852 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5857 error ("Invalid image specification");
5864 /***********************************************************************
5865 Image type independent image structures
5866 ***********************************************************************/
5868 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5869 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5872 /* Allocate and return a new image structure for image specification
5873 SPEC. SPEC has a hash value of HASH. */
5875 static struct image
*
5876 make_image (spec
, hash
)
5880 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5882 xassert (valid_image_p (spec
));
5883 bzero (img
, sizeof *img
);
5884 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5885 xassert (img
->type
!= NULL
);
5887 img
->data
.lisp_val
= Qnil
;
5888 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5894 /* Free image IMG which was used on frame F, including its resources. */
5903 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5905 /* Remove IMG from the hash table of its cache. */
5907 img
->prev
->next
= img
->next
;
5909 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5912 img
->next
->prev
= img
->prev
;
5914 c
->images
[img
->id
] = NULL
;
5916 /* Free resources, then free IMG. */
5917 img
->type
->free (f
, img
);
5923 /* Prepare image IMG for display on frame F. Must be called before
5924 drawing an image. */
5927 prepare_image_for_display (f
, img
)
5933 /* We're about to display IMG, so set its timestamp to `now'. */
5935 img
->timestamp
= EMACS_SECS (t
);
5937 /* If IMG doesn't have a pixmap yet, load it now, using the image
5938 type dependent loader function. */
5939 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5940 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5944 /* Value is the number of pixels for the ascent of image IMG when
5945 drawn in face FACE. */
5948 image_ascent (img
, face
)
5952 int height
= img
->height
+ img
->vmargin
;
5955 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5958 /* This expression is arranged so that if the image can't be
5959 exactly centered, it will be moved slightly up. This is
5960 because a typical font is `top-heavy' (due to the presence
5961 uppercase letters), so the image placement should err towards
5962 being top-heavy too. It also just generally looks better. */
5963 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5965 ascent
= height
/ 2;
5968 ascent
= height
* img
->ascent
/ 100.0;
5974 /* Image background colors. */
5976 static unsigned long
5977 four_corners_best (ximg
, width
, height
)
5979 unsigned long width
, height
;
5981 unsigned long corners
[4], best
;
5984 /* Get the colors at the corners of ximg. */
5985 corners
[0] = XGetPixel (ximg
, 0, 0);
5986 corners
[1] = XGetPixel (ximg
, width
- 1, 0);
5987 corners
[2] = XGetPixel (ximg
, width
- 1, height
- 1);
5988 corners
[3] = XGetPixel (ximg
, 0, height
- 1);
5990 /* Choose the most frequently found color as background. */
5991 for (i
= best_count
= 0; i
< 4; ++i
)
5995 for (j
= n
= 0; j
< 4; ++j
)
5996 if (corners
[i
] == corners
[j
])
6000 best
= corners
[i
], best_count
= n
;
6006 /* Return the `background' field of IMG. If IMG doesn't have one yet,
6007 it is guessed heuristically. If non-zero, XIMG is an existing XImage
6008 object to use for the heuristic. */
6011 image_background (img
, f
, ximg
)
6016 if (! img
->background_valid
)
6017 /* IMG doesn't have a background yet, try to guess a reasonable value. */
6019 int free_ximg
= !ximg
;
6022 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
6023 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
6025 img
->background
= four_corners_best (ximg
, img
->width
, img
->height
);
6028 XDestroyImage (ximg
);
6030 img
->background_valid
= 1;
6033 return img
->background
;
6036 /* Return the `background_transparent' field of IMG. If IMG doesn't
6037 have one yet, it is guessed heuristically. If non-zero, MASK is an
6038 existing XImage object to use for the heuristic. */
6041 image_background_transparent (img
, f
, mask
)
6046 if (! img
->background_transparent_valid
)
6047 /* IMG doesn't have a background yet, try to guess a reasonable value. */
6051 int free_mask
= !mask
;
6054 mask
= XGetImage (FRAME_X_DISPLAY (f
), img
->mask
,
6055 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
6057 img
->background_transparent
6058 = !four_corners_best (mask
, img
->width
, img
->height
);
6061 XDestroyImage (mask
);
6064 img
->background_transparent
= 0;
6066 img
->background_transparent_valid
= 1;
6069 return img
->background_transparent
;
6073 /***********************************************************************
6074 Helper functions for X image types
6075 ***********************************************************************/
6077 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
6079 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
6080 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
6082 Lisp_Object color_name
,
6083 unsigned long dflt
));
6086 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
6087 free the pixmap if any. MASK_P non-zero means clear the mask
6088 pixmap if any. COLORS_P non-zero means free colors allocated for
6089 the image, if any. */
6092 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
6095 int pixmap_p
, mask_p
, colors_p
;
6097 if (pixmap_p
&& img
->pixmap
)
6099 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
6101 img
->background_valid
= 0;
6104 if (mask_p
&& img
->mask
)
6106 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6108 img
->background_transparent_valid
= 0;
6111 if (colors_p
&& img
->ncolors
)
6113 x_free_colors (f
, img
->colors
, img
->ncolors
);
6114 xfree (img
->colors
);
6120 /* Free X resources of image IMG which is used on frame F. */
6123 x_clear_image (f
, img
)
6128 x_clear_image_1 (f
, img
, 1, 1, 1);
6133 /* Allocate color COLOR_NAME for image IMG on frame F. If color
6134 cannot be allocated, use DFLT. Add a newly allocated color to
6135 IMG->colors, so that it can be freed again. Value is the pixel
6138 static unsigned long
6139 x_alloc_image_color (f
, img
, color_name
, dflt
)
6142 Lisp_Object color_name
;
6146 unsigned long result
;
6148 xassert (STRINGP (color_name
));
6150 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
6152 /* This isn't called frequently so we get away with simply
6153 reallocating the color vector to the needed size, here. */
6156 (unsigned long *) xrealloc (img
->colors
,
6157 img
->ncolors
* sizeof *img
->colors
);
6158 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
6159 result
= color
.pixel
;
6169 /***********************************************************************
6171 ***********************************************************************/
6173 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
6174 static void postprocess_image
P_ ((struct frame
*, struct image
*));
6177 /* Return a new, initialized image cache that is allocated from the
6178 heap. Call free_image_cache to free an image cache. */
6180 struct image_cache
*
6183 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
6186 bzero (c
, sizeof *c
);
6188 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
6189 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
6190 c
->buckets
= (struct image
**) xmalloc (size
);
6191 bzero (c
->buckets
, size
);
6196 /* Free image cache of frame F. Be aware that X frames share images
6200 free_image_cache (f
)
6203 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6208 /* Cache should not be referenced by any frame when freed. */
6209 xassert (c
->refcount
== 0);
6211 for (i
= 0; i
< c
->used
; ++i
)
6212 free_image (f
, c
->images
[i
]);
6216 FRAME_X_IMAGE_CACHE (f
) = NULL
;
6221 /* Clear image cache of frame F. FORCE_P non-zero means free all
6222 images. FORCE_P zero means clear only images that haven't been
6223 displayed for some time. Should be called from time to time to
6224 reduce the number of loaded images. If image-eviction-seconds is
6225 non-nil, this frees images in the cache which weren't displayed for
6226 at least that many seconds. */
6229 clear_image_cache (f
, force_p
)
6233 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6235 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
6242 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
6244 /* Block input so that we won't be interrupted by a SIGIO
6245 while being in an inconsistent state. */
6248 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
6250 struct image
*img
= c
->images
[i
];
6252 && (force_p
|| img
->timestamp
< old
))
6254 free_image (f
, img
);
6259 /* We may be clearing the image cache because, for example,
6260 Emacs was iconified for a longer period of time. In that
6261 case, current matrices may still contain references to
6262 images freed above. So, clear these matrices. */
6265 Lisp_Object tail
, frame
;
6267 FOR_EACH_FRAME (tail
, frame
)
6269 struct frame
*f
= XFRAME (frame
);
6271 && FRAME_X_IMAGE_CACHE (f
) == c
)
6272 clear_current_matrices (f
);
6275 ++windows_or_buffers_changed
;
6283 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
6285 doc
: /* Clear the image cache of FRAME.
6286 FRAME nil or omitted means use the selected frame.
6287 FRAME t means clear the image caches of all frames. */)
6295 FOR_EACH_FRAME (tail
, frame
)
6296 if (FRAME_X_P (XFRAME (frame
)))
6297 clear_image_cache (XFRAME (frame
), 1);
6300 clear_image_cache (check_x_frame (frame
), 1);
6306 /* Compute masks and transform image IMG on frame F, as specified
6307 by the image's specification, */
6310 postprocess_image (f
, img
)
6314 /* Manipulation of the image's mask. */
6317 Lisp_Object conversion
, spec
;
6322 /* `:heuristic-mask t'
6324 means build a mask heuristically.
6325 `:heuristic-mask (R G B)'
6326 `:mask (heuristic (R G B))'
6327 means build a mask from color (R G B) in the
6330 means remove a mask, if any. */
6332 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6334 x_build_heuristic_mask (f
, img
, mask
);
6339 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6341 if (EQ (mask
, Qheuristic
))
6342 x_build_heuristic_mask (f
, img
, Qt
);
6343 else if (CONSP (mask
)
6344 && EQ (XCAR (mask
), Qheuristic
))
6346 if (CONSP (XCDR (mask
)))
6347 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6349 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6351 else if (NILP (mask
) && found_p
&& img
->mask
)
6353 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6359 /* Should we apply an image transformation algorithm? */
6360 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6361 if (EQ (conversion
, Qdisabled
))
6362 x_disable_image (f
, img
);
6363 else if (EQ (conversion
, Qlaplace
))
6365 else if (EQ (conversion
, Qemboss
))
6367 else if (CONSP (conversion
)
6368 && EQ (XCAR (conversion
), Qedge_detection
))
6371 tem
= XCDR (conversion
);
6373 x_edge_detection (f
, img
,
6374 Fplist_get (tem
, QCmatrix
),
6375 Fplist_get (tem
, QCcolor_adjustment
));
6381 /* Return the id of image with Lisp specification SPEC on frame F.
6382 SPEC must be a valid Lisp image specification (see valid_image_p). */
6385 lookup_image (f
, spec
)
6389 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6393 struct gcpro gcpro1
;
6396 /* F must be a window-system frame, and SPEC must be a valid image
6398 xassert (FRAME_WINDOW_P (f
));
6399 xassert (valid_image_p (spec
));
6403 /* Look up SPEC in the hash table of the image cache. */
6404 hash
= sxhash (spec
, 0);
6405 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6407 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6408 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6411 /* If not found, create a new image and cache it. */
6414 extern Lisp_Object Qpostscript
;
6417 img
= make_image (spec
, hash
);
6418 cache_image (f
, img
);
6419 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6421 /* If we can't load the image, and we don't have a width and
6422 height, use some arbitrary width and height so that we can
6423 draw a rectangle for it. */
6424 if (img
->load_failed_p
)
6428 value
= image_spec_value (spec
, QCwidth
, NULL
);
6429 img
->width
= (INTEGERP (value
)
6430 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6431 value
= image_spec_value (spec
, QCheight
, NULL
);
6432 img
->height
= (INTEGERP (value
)
6433 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6437 /* Handle image type independent image attributes
6438 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
6439 `:background COLOR'. */
6440 Lisp_Object ascent
, margin
, relief
, bg
;
6442 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6443 if (INTEGERP (ascent
))
6444 img
->ascent
= XFASTINT (ascent
);
6445 else if (EQ (ascent
, Qcenter
))
6446 img
->ascent
= CENTERED_IMAGE_ASCENT
;
6448 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6449 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6450 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
6451 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
6452 && INTEGERP (XCDR (margin
)))
6454 if (XINT (XCAR (margin
)) > 0)
6455 img
->hmargin
= XFASTINT (XCAR (margin
));
6456 if (XINT (XCDR (margin
)) > 0)
6457 img
->vmargin
= XFASTINT (XCDR (margin
));
6460 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6461 if (INTEGERP (relief
))
6463 img
->relief
= XINT (relief
);
6464 img
->hmargin
+= abs (img
->relief
);
6465 img
->vmargin
+= abs (img
->relief
);
6468 if (! img
->background_valid
)
6470 bg
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6474 = x_alloc_image_color (f
, img
, bg
,
6475 FRAME_BACKGROUND_PIXEL (f
));
6476 img
->background_valid
= 1;
6480 /* Do image transformations and compute masks, unless we
6481 don't have the image yet. */
6482 if (!EQ (*img
->type
->type
, Qpostscript
))
6483 postprocess_image (f
, img
);
6487 xassert (!interrupt_input_blocked
);
6490 /* We're using IMG, so set its timestamp to `now'. */
6491 EMACS_GET_TIME (now
);
6492 img
->timestamp
= EMACS_SECS (now
);
6496 /* Value is the image id. */
6501 /* Cache image IMG in the image cache of frame F. */
6504 cache_image (f
, img
)
6508 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6511 /* Find a free slot in c->images. */
6512 for (i
= 0; i
< c
->used
; ++i
)
6513 if (c
->images
[i
] == NULL
)
6516 /* If no free slot found, maybe enlarge c->images. */
6517 if (i
== c
->used
&& c
->used
== c
->size
)
6520 c
->images
= (struct image
**) xrealloc (c
->images
,
6521 c
->size
* sizeof *c
->images
);
6524 /* Add IMG to c->images, and assign IMG an id. */
6530 /* Add IMG to the cache's hash table. */
6531 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6532 img
->next
= c
->buckets
[i
];
6534 img
->next
->prev
= img
;
6536 c
->buckets
[i
] = img
;
6540 /* Call FN on every image in the image cache of frame F. Used to mark
6541 Lisp Objects in the image cache. */
6544 forall_images_in_image_cache (f
, fn
)
6546 void (*fn
) P_ ((struct image
*img
));
6548 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6550 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6554 for (i
= 0; i
< c
->used
; ++i
)
6563 /***********************************************************************
6565 ***********************************************************************/
6567 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6568 XImage
**, Pixmap
*));
6569 static void x_destroy_x_image
P_ ((XImage
*));
6570 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6573 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6574 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6575 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6576 via xmalloc. Print error messages via image_error if an error
6577 occurs. Value is non-zero if successful. */
6580 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6582 int width
, height
, depth
;
6586 Display
*display
= FRAME_X_DISPLAY (f
);
6587 Screen
*screen
= FRAME_X_SCREEN (f
);
6588 Window window
= FRAME_X_WINDOW (f
);
6590 xassert (interrupt_input_blocked
);
6593 depth
= DefaultDepthOfScreen (screen
);
6594 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6595 depth
, ZPixmap
, 0, NULL
, width
, height
,
6596 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6599 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6603 /* Allocate image raster. */
6604 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6606 /* Allocate a pixmap of the same size. */
6607 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6608 if (*pixmap
== None
)
6610 x_destroy_x_image (*ximg
);
6612 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6620 /* Destroy XImage XIMG. Free XIMG->data. */
6623 x_destroy_x_image (ximg
)
6626 xassert (interrupt_input_blocked
);
6631 XDestroyImage (ximg
);
6636 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6637 are width and height of both the image and pixmap. */
6640 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6647 xassert (interrupt_input_blocked
);
6648 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6649 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6650 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6655 /***********************************************************************
6657 ***********************************************************************/
6659 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6660 static char *slurp_file
P_ ((char *, int *));
6663 /* Find image file FILE. Look in data-directory, then
6664 x-bitmap-file-path. Value is the full name of the file found, or
6665 nil if not found. */
6668 x_find_image_file (file
)
6671 Lisp_Object file_found
, search_path
;
6672 struct gcpro gcpro1
, gcpro2
;
6676 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6677 GCPRO2 (file_found
, search_path
);
6679 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6680 fd
= openp (search_path
, file
, Qnil
, &file_found
, Qnil
);
6692 /* Read FILE into memory. Value is a pointer to a buffer allocated
6693 with xmalloc holding FILE's contents. Value is null if an error
6694 occurred. *SIZE is set to the size of the file. */
6697 slurp_file (file
, size
)
6705 if (stat (file
, &st
) == 0
6706 && (fp
= fopen (file
, "r")) != NULL
6707 && (buf
= (char *) xmalloc (st
.st_size
),
6708 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6729 /***********************************************************************
6731 ***********************************************************************/
6733 static int xbm_scan
P_ ((char **, char *, char *, int *));
6734 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6735 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6737 static int xbm_image_p
P_ ((Lisp_Object object
));
6738 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6740 static int xbm_file_p
P_ ((Lisp_Object
));
6743 /* Indices of image specification fields in xbm_format, below. */
6745 enum xbm_keyword_index
6763 /* Vector of image_keyword structures describing the format
6764 of valid XBM image specifications. */
6766 static struct image_keyword xbm_format
[XBM_LAST
] =
6768 {":type", IMAGE_SYMBOL_VALUE
, 1},
6769 {":file", IMAGE_STRING_VALUE
, 0},
6770 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6771 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6772 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6773 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
6774 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
6775 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6776 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6777 {":relief", IMAGE_INTEGER_VALUE
, 0},
6778 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6779 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6780 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6783 /* Structure describing the image type XBM. */
6785 static struct image_type xbm_type
=
6794 /* Tokens returned from xbm_scan. */
6803 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6804 A valid specification is a list starting with the symbol `image'
6805 The rest of the list is a property list which must contain an
6808 If the specification specifies a file to load, it must contain
6809 an entry `:file FILENAME' where FILENAME is a string.
6811 If the specification is for a bitmap loaded from memory it must
6812 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6813 WIDTH and HEIGHT are integers > 0. DATA may be:
6815 1. a string large enough to hold the bitmap data, i.e. it must
6816 have a size >= (WIDTH + 7) / 8 * HEIGHT
6818 2. a bool-vector of size >= WIDTH * HEIGHT
6820 3. a vector of strings or bool-vectors, one for each line of the
6823 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6824 may not be specified in this case because they are defined in the
6827 Both the file and data forms may contain the additional entries
6828 `:background COLOR' and `:foreground COLOR'. If not present,
6829 foreground and background of the frame on which the image is
6830 displayed is used. */
6833 xbm_image_p (object
)
6836 struct image_keyword kw
[XBM_LAST
];
6838 bcopy (xbm_format
, kw
, sizeof kw
);
6839 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6842 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6844 if (kw
[XBM_FILE
].count
)
6846 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6849 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6851 /* In-memory XBM file. */
6852 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6860 /* Entries for `:width', `:height' and `:data' must be present. */
6861 if (!kw
[XBM_WIDTH
].count
6862 || !kw
[XBM_HEIGHT
].count
6863 || !kw
[XBM_DATA
].count
)
6866 data
= kw
[XBM_DATA
].value
;
6867 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6868 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6870 /* Check type of data, and width and height against contents of
6876 /* Number of elements of the vector must be >= height. */
6877 if (XVECTOR (data
)->size
< height
)
6880 /* Each string or bool-vector in data must be large enough
6881 for one line of the image. */
6882 for (i
= 0; i
< height
; ++i
)
6884 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6888 if (XSTRING (elt
)->size
6889 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6892 else if (BOOL_VECTOR_P (elt
))
6894 if (XBOOL_VECTOR (elt
)->size
< width
)
6901 else if (STRINGP (data
))
6903 if (XSTRING (data
)->size
6904 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6907 else if (BOOL_VECTOR_P (data
))
6909 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6920 /* Scan a bitmap file. FP is the stream to read from. Value is
6921 either an enumerator from enum xbm_token, or a character for a
6922 single-character token, or 0 at end of file. If scanning an
6923 identifier, store the lexeme of the identifier in SVAL. If
6924 scanning a number, store its value in *IVAL. */
6927 xbm_scan (s
, end
, sval
, ival
)
6936 /* Skip white space. */
6937 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6942 else if (isdigit (c
))
6944 int value
= 0, digit
;
6946 if (c
== '0' && *s
< end
)
6949 if (c
== 'x' || c
== 'X')
6956 else if (c
>= 'a' && c
<= 'f')
6957 digit
= c
- 'a' + 10;
6958 else if (c
>= 'A' && c
<= 'F')
6959 digit
= c
- 'A' + 10;
6962 value
= 16 * value
+ digit
;
6965 else if (isdigit (c
))
6969 && (c
= *(*s
)++, isdigit (c
)))
6970 value
= 8 * value
+ c
- '0';
6977 && (c
= *(*s
)++, isdigit (c
)))
6978 value
= 10 * value
+ c
- '0';
6986 else if (isalpha (c
) || c
== '_')
6990 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6997 else if (c
== '/' && **s
== '*')
6999 /* C-style comment. */
7001 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
7014 /* Replacement for XReadBitmapFileData which isn't available under old
7015 X versions. CONTENTS is a pointer to a buffer to parse; END is the
7016 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
7017 the image. Return in *DATA the bitmap data allocated with xmalloc.
7018 Value is non-zero if successful. DATA null means just test if
7019 CONTENTS looks like an in-memory XBM file. */
7022 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
7023 char *contents
, *end
;
7024 int *width
, *height
;
7025 unsigned char **data
;
7028 char buffer
[BUFSIZ
];
7031 int bytes_per_line
, i
, nbytes
;
7037 LA1 = xbm_scan (&s, end, buffer, &value)
7039 #define expect(TOKEN) \
7040 if (LA1 != (TOKEN)) \
7045 #define expect_ident(IDENT) \
7046 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
7051 *width
= *height
= -1;
7054 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
7056 /* Parse defines for width, height and hot-spots. */
7060 expect_ident ("define");
7061 expect (XBM_TK_IDENT
);
7063 if (LA1
== XBM_TK_NUMBER
);
7065 char *p
= strrchr (buffer
, '_');
7066 p
= p
? p
+ 1 : buffer
;
7067 if (strcmp (p
, "width") == 0)
7069 else if (strcmp (p
, "height") == 0)
7072 expect (XBM_TK_NUMBER
);
7075 if (*width
< 0 || *height
< 0)
7077 else if (data
== NULL
)
7080 /* Parse bits. Must start with `static'. */
7081 expect_ident ("static");
7082 if (LA1
== XBM_TK_IDENT
)
7084 if (strcmp (buffer
, "unsigned") == 0)
7087 expect_ident ("char");
7089 else if (strcmp (buffer
, "short") == 0)
7093 if (*width
% 16 && *width
% 16 < 9)
7096 else if (strcmp (buffer
, "char") == 0)
7104 expect (XBM_TK_IDENT
);
7110 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
7111 nbytes
= bytes_per_line
* *height
;
7112 p
= *data
= (char *) xmalloc (nbytes
);
7116 for (i
= 0; i
< nbytes
; i
+= 2)
7119 expect (XBM_TK_NUMBER
);
7122 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
7125 if (LA1
== ',' || LA1
== '}')
7133 for (i
= 0; i
< nbytes
; ++i
)
7136 expect (XBM_TK_NUMBER
);
7140 if (LA1
== ',' || LA1
== '}')
7165 /* Load XBM image IMG which will be displayed on frame F from buffer
7166 CONTENTS. END is the end of the buffer. Value is non-zero if
7170 xbm_load_image (f
, img
, contents
, end
)
7173 char *contents
, *end
;
7176 unsigned char *data
;
7179 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
7182 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7183 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7184 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7187 xassert (img
->width
> 0 && img
->height
> 0);
7189 /* Get foreground and background colors, maybe allocate colors. */
7190 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
7192 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
7193 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
7196 background
= x_alloc_image_color (f
, img
, value
, background
);
7197 img
->background
= background
;
7198 img
->background_valid
= 1;
7202 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7205 img
->width
, img
->height
,
7206 foreground
, background
,
7210 if (img
->pixmap
== None
)
7212 x_clear_image (f
, img
);
7213 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
7219 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7225 /* Value is non-zero if DATA looks like an in-memory XBM file. */
7232 return (STRINGP (data
)
7233 && xbm_read_bitmap_data (XSTRING (data
)->data
,
7234 (XSTRING (data
)->data
7235 + STRING_BYTES (XSTRING (data
))),
7240 /* Fill image IMG which is used on frame F with pixmap data. Value is
7241 non-zero if successful. */
7249 Lisp_Object file_name
;
7251 xassert (xbm_image_p (img
->spec
));
7253 /* If IMG->spec specifies a file name, create a non-file spec from it. */
7254 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
7255 if (STRINGP (file_name
))
7260 struct gcpro gcpro1
;
7262 file
= x_find_image_file (file_name
);
7264 if (!STRINGP (file
))
7266 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
7271 contents
= slurp_file (XSTRING (file
)->data
, &size
);
7272 if (contents
== NULL
)
7274 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7279 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
7284 struct image_keyword fmt
[XBM_LAST
];
7287 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7288 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7291 int in_memory_file_p
= 0;
7293 /* See if data looks like an in-memory XBM file. */
7294 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7295 in_memory_file_p
= xbm_file_p (data
);
7297 /* Parse the image specification. */
7298 bcopy (xbm_format
, fmt
, sizeof fmt
);
7299 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
7302 /* Get specified width, and height. */
7303 if (!in_memory_file_p
)
7305 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
7306 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
7307 xassert (img
->width
> 0 && img
->height
> 0);
7310 /* Get foreground and background colors, maybe allocate colors. */
7311 if (fmt
[XBM_FOREGROUND
].count
7312 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
7313 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
7315 if (fmt
[XBM_BACKGROUND
].count
7316 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
7317 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
7320 if (in_memory_file_p
)
7321 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
7322 (XSTRING (data
)->data
7323 + STRING_BYTES (XSTRING (data
))));
7330 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
7332 p
= bits
= (char *) alloca (nbytes
* img
->height
);
7333 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
7335 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
7337 bcopy (XSTRING (line
)->data
, p
, nbytes
);
7339 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
7342 else if (STRINGP (data
))
7343 bits
= XSTRING (data
)->data
;
7345 bits
= XBOOL_VECTOR (data
)->data
;
7347 /* Create the pixmap. */
7348 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7350 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7353 img
->width
, img
->height
,
7354 foreground
, background
,
7360 image_error ("Unable to create pixmap for XBM image `%s'",
7362 x_clear_image (f
, img
);
7372 /***********************************************************************
7374 ***********************************************************************/
7378 static int xpm_image_p
P_ ((Lisp_Object object
));
7379 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
7380 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
7382 #include "X11/xpm.h"
7384 /* The symbol `xpm' identifying XPM-format images. */
7388 /* Indices of image specification fields in xpm_format, below. */
7390 enum xpm_keyword_index
7406 /* Vector of image_keyword structures describing the format
7407 of valid XPM image specifications. */
7409 static struct image_keyword xpm_format
[XPM_LAST
] =
7411 {":type", IMAGE_SYMBOL_VALUE
, 1},
7412 {":file", IMAGE_STRING_VALUE
, 0},
7413 {":data", IMAGE_STRING_VALUE
, 0},
7414 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7415 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7416 {":relief", IMAGE_INTEGER_VALUE
, 0},
7417 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7418 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7419 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7420 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7421 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
7424 /* Structure describing the image type XBM. */
7426 static struct image_type xpm_type
=
7436 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7437 functions for allocating image colors. Our own functions handle
7438 color allocation failures more gracefully than the ones on the XPM
7441 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7442 #define ALLOC_XPM_COLORS
7445 #ifdef ALLOC_XPM_COLORS
7447 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7448 static void xpm_free_color_cache
P_ ((void));
7449 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7450 static int xpm_color_bucket
P_ ((char *));
7451 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7454 /* An entry in a hash table used to cache color definitions of named
7455 colors. This cache is necessary to speed up XPM image loading in
7456 case we do color allocations ourselves. Without it, we would need
7457 a call to XParseColor per pixel in the image. */
7459 struct xpm_cached_color
7461 /* Next in collision chain. */
7462 struct xpm_cached_color
*next
;
7464 /* Color definition (RGB and pixel color). */
7471 /* The hash table used for the color cache, and its bucket vector
7474 #define XPM_COLOR_CACHE_BUCKETS 1001
7475 struct xpm_cached_color
**xpm_color_cache
;
7477 /* Initialize the color cache. */
7480 xpm_init_color_cache (f
, attrs
)
7482 XpmAttributes
*attrs
;
7484 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7485 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7486 memset (xpm_color_cache
, 0, nbytes
);
7487 init_color_table ();
7489 if (attrs
->valuemask
& XpmColorSymbols
)
7494 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7495 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7496 attrs
->colorsymbols
[i
].value
, &color
))
7498 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7500 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7506 /* Free the color cache. */
7509 xpm_free_color_cache ()
7511 struct xpm_cached_color
*p
, *next
;
7514 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7515 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7521 xfree (xpm_color_cache
);
7522 xpm_color_cache
= NULL
;
7523 free_color_table ();
7527 /* Return the bucket index for color named COLOR_NAME in the color
7531 xpm_color_bucket (color_name
)
7537 for (s
= color_name
; *s
; ++s
)
7539 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7543 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7544 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7547 static struct xpm_cached_color
*
7548 xpm_cache_color (f
, color_name
, color
, bucket
)
7555 struct xpm_cached_color
*p
;
7558 bucket
= xpm_color_bucket (color_name
);
7560 nbytes
= sizeof *p
+ strlen (color_name
);
7561 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7562 strcpy (p
->name
, color_name
);
7564 p
->next
= xpm_color_cache
[bucket
];
7565 xpm_color_cache
[bucket
] = p
;
7570 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7571 return the cached definition in *COLOR. Otherwise, make a new
7572 entry in the cache and allocate the color. Value is zero if color
7573 allocation failed. */
7576 xpm_lookup_color (f
, color_name
, color
)
7581 struct xpm_cached_color
*p
;
7582 int h
= xpm_color_bucket (color_name
);
7584 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7585 if (strcmp (p
->name
, color_name
) == 0)
7590 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7593 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7595 p
= xpm_cache_color (f
, color_name
, color
, h
);
7602 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7603 CLOSURE is a pointer to the frame on which we allocate the
7604 color. Return in *COLOR the allocated color. Value is non-zero
7608 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7615 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7619 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7620 is a pointer to the frame on which we allocate the color. Value is
7621 non-zero if successful. */
7624 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7634 #endif /* ALLOC_XPM_COLORS */
7637 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7638 for XPM images. Such a list must consist of conses whose car and
7642 xpm_valid_color_symbols_p (color_symbols
)
7643 Lisp_Object color_symbols
;
7645 while (CONSP (color_symbols
))
7647 Lisp_Object sym
= XCAR (color_symbols
);
7649 || !STRINGP (XCAR (sym
))
7650 || !STRINGP (XCDR (sym
)))
7652 color_symbols
= XCDR (color_symbols
);
7655 return NILP (color_symbols
);
7659 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7662 xpm_image_p (object
)
7665 struct image_keyword fmt
[XPM_LAST
];
7666 bcopy (xpm_format
, fmt
, sizeof fmt
);
7667 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7668 /* Either `:file' or `:data' must be present. */
7669 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7670 /* Either no `:color-symbols' or it's a list of conses
7671 whose car and cdr are strings. */
7672 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7673 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7677 /* Load image IMG which will be displayed on frame F. Value is
7678 non-zero if successful. */
7686 XpmAttributes attrs
;
7687 Lisp_Object specified_file
, color_symbols
;
7689 /* Configure the XPM lib. Use the visual of frame F. Allocate
7690 close colors. Return colors allocated. */
7691 bzero (&attrs
, sizeof attrs
);
7692 attrs
.visual
= FRAME_X_VISUAL (f
);
7693 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7694 attrs
.valuemask
|= XpmVisual
;
7695 attrs
.valuemask
|= XpmColormap
;
7697 #ifdef ALLOC_XPM_COLORS
7698 /* Allocate colors with our own functions which handle
7699 failing color allocation more gracefully. */
7700 attrs
.color_closure
= f
;
7701 attrs
.alloc_color
= xpm_alloc_color
;
7702 attrs
.free_colors
= xpm_free_colors
;
7703 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7704 #else /* not ALLOC_XPM_COLORS */
7705 /* Let the XPM lib allocate colors. */
7706 attrs
.valuemask
|= XpmReturnAllocPixels
;
7707 #ifdef XpmAllocCloseColors
7708 attrs
.alloc_close_colors
= 1;
7709 attrs
.valuemask
|= XpmAllocCloseColors
;
7710 #else /* not XpmAllocCloseColors */
7711 attrs
.closeness
= 600;
7712 attrs
.valuemask
|= XpmCloseness
;
7713 #endif /* not XpmAllocCloseColors */
7714 #endif /* ALLOC_XPM_COLORS */
7716 /* If image specification contains symbolic color definitions, add
7717 these to `attrs'. */
7718 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7719 if (CONSP (color_symbols
))
7722 XpmColorSymbol
*xpm_syms
;
7725 attrs
.valuemask
|= XpmColorSymbols
;
7727 /* Count number of symbols. */
7728 attrs
.numsymbols
= 0;
7729 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7732 /* Allocate an XpmColorSymbol array. */
7733 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7734 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7735 bzero (xpm_syms
, size
);
7736 attrs
.colorsymbols
= xpm_syms
;
7738 /* Fill the color symbol array. */
7739 for (tail
= color_symbols
, i
= 0;
7741 ++i
, tail
= XCDR (tail
))
7743 Lisp_Object name
= XCAR (XCAR (tail
));
7744 Lisp_Object color
= XCDR (XCAR (tail
));
7745 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7746 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7747 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7748 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7752 /* Create a pixmap for the image, either from a file, or from a
7753 string buffer containing data in the same format as an XPM file. */
7754 #ifdef ALLOC_XPM_COLORS
7755 xpm_init_color_cache (f
, &attrs
);
7758 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7759 if (STRINGP (specified_file
))
7761 Lisp_Object file
= x_find_image_file (specified_file
);
7762 if (!STRINGP (file
))
7764 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7768 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7769 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7774 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7775 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7776 XSTRING (buffer
)->data
,
7777 &img
->pixmap
, &img
->mask
,
7781 if (rc
== XpmSuccess
)
7783 #ifdef ALLOC_XPM_COLORS
7784 img
->colors
= colors_in_color_table (&img
->ncolors
);
7785 #else /* not ALLOC_XPM_COLORS */
7788 img
->ncolors
= attrs
.nalloc_pixels
;
7789 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7790 * sizeof *img
->colors
);
7791 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7793 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7794 #ifdef DEBUG_X_COLORS
7795 register_color (img
->colors
[i
]);
7798 #endif /* not ALLOC_XPM_COLORS */
7800 img
->width
= attrs
.width
;
7801 img
->height
= attrs
.height
;
7802 xassert (img
->width
> 0 && img
->height
> 0);
7804 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7805 XpmFreeAttributes (&attrs
);
7812 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7815 case XpmFileInvalid
:
7816 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7820 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7823 case XpmColorFailed
:
7824 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7828 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7833 #ifdef ALLOC_XPM_COLORS
7834 xpm_free_color_cache ();
7836 return rc
== XpmSuccess
;
7839 #endif /* HAVE_XPM != 0 */
7842 /***********************************************************************
7844 ***********************************************************************/
7846 /* An entry in the color table mapping an RGB color to a pixel color. */
7851 unsigned long pixel
;
7853 /* Next in color table collision list. */
7854 struct ct_color
*next
;
7857 /* The bucket vector size to use. Must be prime. */
7861 /* Value is a hash of the RGB color given by R, G, and B. */
7863 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7865 /* The color hash table. */
7867 struct ct_color
**ct_table
;
7869 /* Number of entries in the color table. */
7871 int ct_colors_allocated
;
7873 /* Initialize the color table. */
7878 int size
= CT_SIZE
* sizeof (*ct_table
);
7879 ct_table
= (struct ct_color
**) xmalloc (size
);
7880 bzero (ct_table
, size
);
7881 ct_colors_allocated
= 0;
7885 /* Free memory associated with the color table. */
7891 struct ct_color
*p
, *next
;
7893 for (i
= 0; i
< CT_SIZE
; ++i
)
7894 for (p
= ct_table
[i
]; p
; p
= next
)
7905 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7906 entry for that color already is in the color table, return the
7907 pixel color of that entry. Otherwise, allocate a new color for R,
7908 G, B, and make an entry in the color table. */
7910 static unsigned long
7911 lookup_rgb_color (f
, r
, g
, b
)
7915 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7916 int i
= hash
% CT_SIZE
;
7919 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7920 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7933 cmap
= FRAME_X_COLORMAP (f
);
7934 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7938 ++ct_colors_allocated
;
7940 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7944 p
->pixel
= color
.pixel
;
7945 p
->next
= ct_table
[i
];
7949 return FRAME_FOREGROUND_PIXEL (f
);
7956 /* Look up pixel color PIXEL which is used on frame F in the color
7957 table. If not already present, allocate it. Value is PIXEL. */
7959 static unsigned long
7960 lookup_pixel_color (f
, pixel
)
7962 unsigned long pixel
;
7964 int i
= pixel
% CT_SIZE
;
7967 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7968 if (p
->pixel
== pixel
)
7977 cmap
= FRAME_X_COLORMAP (f
);
7978 color
.pixel
= pixel
;
7979 x_query_color (f
, &color
);
7980 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7984 ++ct_colors_allocated
;
7986 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7991 p
->next
= ct_table
[i
];
7995 return FRAME_FOREGROUND_PIXEL (f
);
8002 /* Value is a vector of all pixel colors contained in the color table,
8003 allocated via xmalloc. Set *N to the number of colors. */
8005 static unsigned long *
8006 colors_in_color_table (n
)
8011 unsigned long *colors
;
8013 if (ct_colors_allocated
== 0)
8020 colors
= (unsigned long *) xmalloc (ct_colors_allocated
8022 *n
= ct_colors_allocated
;
8024 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
8025 for (p
= ct_table
[i
]; p
; p
= p
->next
)
8026 colors
[j
++] = p
->pixel
;
8034 /***********************************************************************
8036 ***********************************************************************/
8038 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
8039 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
8040 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
8042 /* Non-zero means draw a cross on images having `:conversion
8045 int cross_disabled_images
;
8047 /* Edge detection matrices for different edge-detection
8050 static int emboss_matrix
[9] = {
8052 2, -1, 0, /* y - 1 */
8054 0, 1, -2 /* y + 1 */
8057 static int laplace_matrix
[9] = {
8059 1, 0, 0, /* y - 1 */
8061 0, 0, -1 /* y + 1 */
8064 /* Value is the intensity of the color whose red/green/blue values
8067 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
8070 /* On frame F, return an array of XColor structures describing image
8071 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
8072 non-zero means also fill the red/green/blue members of the XColor
8073 structures. Value is a pointer to the array of XColors structures,
8074 allocated with xmalloc; it must be freed by the caller. */
8077 x_to_xcolors (f
, img
, rgb_p
)
8086 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
8088 /* Get the X image IMG->pixmap. */
8089 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
8090 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
8092 /* Fill the `pixel' members of the XColor array. I wished there
8093 were an easy and portable way to circumvent XGetPixel. */
8095 for (y
= 0; y
< img
->height
; ++y
)
8099 for (x
= 0; x
< img
->width
; ++x
, ++p
)
8100 p
->pixel
= XGetPixel (ximg
, x
, y
);
8103 x_query_colors (f
, row
, img
->width
);
8106 XDestroyImage (ximg
);
8111 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
8112 RGB members are set. F is the frame on which this all happens.
8113 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
8116 x_from_xcolors (f
, img
, colors
)
8126 init_color_table ();
8128 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
8131 for (y
= 0; y
< img
->height
; ++y
)
8132 for (x
= 0; x
< img
->width
; ++x
, ++p
)
8134 unsigned long pixel
;
8135 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
8136 XPutPixel (oimg
, x
, y
, pixel
);
8140 x_clear_image_1 (f
, img
, 1, 0, 1);
8142 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
8143 x_destroy_x_image (oimg
);
8144 img
->pixmap
= pixmap
;
8145 img
->colors
= colors_in_color_table (&img
->ncolors
);
8146 free_color_table ();
8150 /* On frame F, perform edge-detection on image IMG.
8152 MATRIX is a nine-element array specifying the transformation
8153 matrix. See emboss_matrix for an example.
8155 COLOR_ADJUST is a color adjustment added to each pixel of the
8159 x_detect_edges (f
, img
, matrix
, color_adjust
)
8162 int matrix
[9], color_adjust
;
8164 XColor
*colors
= x_to_xcolors (f
, img
, 1);
8168 for (i
= sum
= 0; i
< 9; ++i
)
8169 sum
+= abs (matrix
[i
]);
8171 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
8173 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
8175 for (y
= 0; y
< img
->height
; ++y
)
8177 p
= COLOR (new, 0, y
);
8178 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8179 p
= COLOR (new, img
->width
- 1, y
);
8180 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8183 for (x
= 1; x
< img
->width
- 1; ++x
)
8185 p
= COLOR (new, x
, 0);
8186 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8187 p
= COLOR (new, x
, img
->height
- 1);
8188 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8191 for (y
= 1; y
< img
->height
- 1; ++y
)
8193 p
= COLOR (new, 1, y
);
8195 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
8197 int r
, g
, b
, y1
, x1
;
8200 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
8201 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
8204 XColor
*t
= COLOR (colors
, x1
, y1
);
8205 r
+= matrix
[i
] * t
->red
;
8206 g
+= matrix
[i
] * t
->green
;
8207 b
+= matrix
[i
] * t
->blue
;
8210 r
= (r
/ sum
+ color_adjust
) & 0xffff;
8211 g
= (g
/ sum
+ color_adjust
) & 0xffff;
8212 b
= (b
/ sum
+ color_adjust
) & 0xffff;
8213 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
8218 x_from_xcolors (f
, img
, new);
8224 /* Perform the pre-defined `emboss' edge-detection on image IMG
8232 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
8236 /* Perform the pre-defined `laplace' edge-detection on image IMG
8244 x_detect_edges (f
, img
, laplace_matrix
, 45000);
8248 /* Perform edge-detection on image IMG on frame F, with specified
8249 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
8251 MATRIX must be either
8253 - a list of at least 9 numbers in row-major form
8254 - a vector of at least 9 numbers
8256 COLOR_ADJUST nil means use a default; otherwise it must be a
8260 x_edge_detection (f
, img
, matrix
, color_adjust
)
8263 Lisp_Object matrix
, color_adjust
;
8271 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
8272 ++i
, matrix
= XCDR (matrix
))
8273 trans
[i
] = XFLOATINT (XCAR (matrix
));
8275 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
8277 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
8278 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
8281 if (NILP (color_adjust
))
8282 color_adjust
= make_number (0xffff / 2);
8284 if (i
== 9 && NUMBERP (color_adjust
))
8285 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
8289 /* Transform image IMG on frame F so that it looks disabled. */
8292 x_disable_image (f
, img
)
8296 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
8298 if (dpyinfo
->n_planes
>= 2)
8300 /* Color (or grayscale). Convert to gray, and equalize. Just
8301 drawing such images with a stipple can look very odd, so
8302 we're using this method instead. */
8303 XColor
*colors
= x_to_xcolors (f
, img
, 1);
8305 const int h
= 15000;
8306 const int l
= 30000;
8308 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
8312 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
8313 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
8314 p
->red
= p
->green
= p
->blue
= i2
;
8317 x_from_xcolors (f
, img
, colors
);
8320 /* Draw a cross over the disabled image, if we must or if we
8322 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
8324 Display
*dpy
= FRAME_X_DISPLAY (f
);
8327 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
8328 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
8329 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
8330 img
->width
- 1, img
->height
- 1);
8331 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
8337 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
8338 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
8339 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
8340 img
->width
- 1, img
->height
- 1);
8341 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
8349 /* Build a mask for image IMG which is used on frame F. FILE is the
8350 name of an image file, for error messages. HOW determines how to
8351 determine the background color of IMG. If it is a list '(R G B)',
8352 with R, G, and B being integers >= 0, take that as the color of the
8353 background. Otherwise, determine the background color of IMG
8354 heuristically. Value is non-zero if successful. */
8357 x_build_heuristic_mask (f
, img
, how
)
8362 Display
*dpy
= FRAME_X_DISPLAY (f
);
8363 XImage
*ximg
, *mask_img
;
8364 int x
, y
, rc
, use_img_background
;
8365 unsigned long bg
= 0;
8369 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8371 img
->background_transparent_valid
= 0;
8374 /* Create an image and pixmap serving as mask. */
8375 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
8376 &mask_img
, &img
->mask
);
8380 /* Get the X image of IMG->pixmap. */
8381 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
8384 /* Determine the background color of ximg. If HOW is `(R G B)'
8385 take that as color. Otherwise, use the image's background color. */
8386 use_img_background
= 1;
8392 for (i
= 0; i
< 3 && CONSP (how
) && NATNUMP (XCAR (how
)); ++i
)
8394 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
8398 if (i
== 3 && NILP (how
))
8400 char color_name
[30];
8401 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
8402 bg
= x_alloc_image_color (f
, img
, build_string (color_name
), 0);
8403 use_img_background
= 0;
8407 if (use_img_background
)
8408 bg
= four_corners_best (ximg
, img
->width
, img
->height
);
8410 /* Set all bits in mask_img to 1 whose color in ximg is different
8411 from the background color bg. */
8412 for (y
= 0; y
< img
->height
; ++y
)
8413 for (x
= 0; x
< img
->width
; ++x
)
8414 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8416 /* Fill in the background_transparent field while we have the mask handy. */
8417 image_background_transparent (img
, f
, mask_img
);
8419 /* Put mask_img into img->mask. */
8420 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8421 x_destroy_x_image (mask_img
);
8422 XDestroyImage (ximg
);
8429 /***********************************************************************
8430 PBM (mono, gray, color)
8431 ***********************************************************************/
8433 static int pbm_image_p
P_ ((Lisp_Object object
));
8434 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8435 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8437 /* The symbol `pbm' identifying images of this type. */
8441 /* Indices of image specification fields in gs_format, below. */
8443 enum pbm_keyword_index
8459 /* Vector of image_keyword structures describing the format
8460 of valid user-defined image specifications. */
8462 static struct image_keyword pbm_format
[PBM_LAST
] =
8464 {":type", IMAGE_SYMBOL_VALUE
, 1},
8465 {":file", IMAGE_STRING_VALUE
, 0},
8466 {":data", IMAGE_STRING_VALUE
, 0},
8467 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8468 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8469 {":relief", IMAGE_INTEGER_VALUE
, 0},
8470 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8471 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8472 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8473 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8474 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8477 /* Structure describing the image type `pbm'. */
8479 static struct image_type pbm_type
=
8489 /* Return non-zero if OBJECT is a valid PBM image specification. */
8492 pbm_image_p (object
)
8495 struct image_keyword fmt
[PBM_LAST
];
8497 bcopy (pbm_format
, fmt
, sizeof fmt
);
8499 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8502 /* Must specify either :data or :file. */
8503 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8507 /* Scan a decimal number from *S and return it. Advance *S while
8508 reading the number. END is the end of the string. Value is -1 at
8512 pbm_scan_number (s
, end
)
8513 unsigned char **s
, *end
;
8515 int c
= 0, val
= -1;
8519 /* Skip white-space. */
8520 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8525 /* Skip comment to end of line. */
8526 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8529 else if (isdigit (c
))
8531 /* Read decimal number. */
8533 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8534 val
= 10 * val
+ c
- '0';
8545 /* Load PBM image IMG for use on frame F. */
8553 int width
, height
, max_color_idx
= 0;
8555 Lisp_Object file
, specified_file
;
8556 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8557 struct gcpro gcpro1
;
8558 unsigned char *contents
= NULL
;
8559 unsigned char *end
, *p
;
8562 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8566 if (STRINGP (specified_file
))
8568 file
= x_find_image_file (specified_file
);
8569 if (!STRINGP (file
))
8571 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8576 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8577 if (contents
== NULL
)
8579 image_error ("Error reading `%s'", file
, Qnil
);
8585 end
= contents
+ size
;
8590 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8591 p
= XSTRING (data
)->data
;
8592 end
= p
+ STRING_BYTES (XSTRING (data
));
8595 /* Check magic number. */
8596 if (end
- p
< 2 || *p
++ != 'P')
8598 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8608 raw_p
= 0, type
= PBM_MONO
;
8612 raw_p
= 0, type
= PBM_GRAY
;
8616 raw_p
= 0, type
= PBM_COLOR
;
8620 raw_p
= 1, type
= PBM_MONO
;
8624 raw_p
= 1, type
= PBM_GRAY
;
8628 raw_p
= 1, type
= PBM_COLOR
;
8632 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8636 /* Read width, height, maximum color-component. Characters
8637 starting with `#' up to the end of a line are ignored. */
8638 width
= pbm_scan_number (&p
, end
);
8639 height
= pbm_scan_number (&p
, end
);
8641 if (type
!= PBM_MONO
)
8643 max_color_idx
= pbm_scan_number (&p
, end
);
8644 if (raw_p
&& max_color_idx
> 255)
8645 max_color_idx
= 255;
8650 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8653 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8654 &ximg
, &img
->pixmap
))
8657 /* Initialize the color hash table. */
8658 init_color_table ();
8660 if (type
== PBM_MONO
)
8663 struct image_keyword fmt
[PBM_LAST
];
8664 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8665 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8667 /* Parse the image specification. */
8668 bcopy (pbm_format
, fmt
, sizeof fmt
);
8669 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8671 /* Get foreground and background colors, maybe allocate colors. */
8672 if (fmt
[PBM_FOREGROUND
].count
8673 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
8674 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8675 if (fmt
[PBM_BACKGROUND
].count
8676 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
8678 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8679 img
->background
= bg
;
8680 img
->background_valid
= 1;
8683 for (y
= 0; y
< height
; ++y
)
8684 for (x
= 0; x
< width
; ++x
)
8694 g
= pbm_scan_number (&p
, end
);
8696 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8701 for (y
= 0; y
< height
; ++y
)
8702 for (x
= 0; x
< width
; ++x
)
8706 if (type
== PBM_GRAY
)
8707 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8716 r
= pbm_scan_number (&p
, end
);
8717 g
= pbm_scan_number (&p
, end
);
8718 b
= pbm_scan_number (&p
, end
);
8721 if (r
< 0 || g
< 0 || b
< 0)
8725 XDestroyImage (ximg
);
8726 image_error ("Invalid pixel value in image `%s'",
8731 /* RGB values are now in the range 0..max_color_idx.
8732 Scale this to the range 0..0xffff supported by X. */
8733 r
= (double) r
* 65535 / max_color_idx
;
8734 g
= (double) g
* 65535 / max_color_idx
;
8735 b
= (double) b
* 65535 / max_color_idx
;
8736 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8740 /* Store in IMG->colors the colors allocated for the image, and
8741 free the color table. */
8742 img
->colors
= colors_in_color_table (&img
->ncolors
);
8743 free_color_table ();
8745 /* Maybe fill in the background field while we have ximg handy. */
8746 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
8747 IMAGE_BACKGROUND (img
, f
, ximg
);
8749 /* Put the image into a pixmap. */
8750 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8751 x_destroy_x_image (ximg
);
8754 img
->height
= height
;
8763 /***********************************************************************
8765 ***********************************************************************/
8771 /* Function prototypes. */
8773 static int png_image_p
P_ ((Lisp_Object object
));
8774 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8776 /* The symbol `png' identifying images of this type. */
8780 /* Indices of image specification fields in png_format, below. */
8782 enum png_keyword_index
8797 /* Vector of image_keyword structures describing the format
8798 of valid user-defined image specifications. */
8800 static struct image_keyword png_format
[PNG_LAST
] =
8802 {":type", IMAGE_SYMBOL_VALUE
, 1},
8803 {":data", IMAGE_STRING_VALUE
, 0},
8804 {":file", IMAGE_STRING_VALUE
, 0},
8805 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8806 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8807 {":relief", IMAGE_INTEGER_VALUE
, 0},
8808 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8809 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8810 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8811 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8814 /* Structure describing the image type `png'. */
8816 static struct image_type png_type
=
8826 /* Return non-zero if OBJECT is a valid PNG image specification. */
8829 png_image_p (object
)
8832 struct image_keyword fmt
[PNG_LAST
];
8833 bcopy (png_format
, fmt
, sizeof fmt
);
8835 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8838 /* Must specify either the :data or :file keyword. */
8839 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8843 /* Error and warning handlers installed when the PNG library
8847 my_png_error (png_ptr
, msg
)
8848 png_struct
*png_ptr
;
8851 xassert (png_ptr
!= NULL
);
8852 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8853 longjmp (png_ptr
->jmpbuf
, 1);
8858 my_png_warning (png_ptr
, msg
)
8859 png_struct
*png_ptr
;
8862 xassert (png_ptr
!= NULL
);
8863 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8866 /* Memory source for PNG decoding. */
8868 struct png_memory_storage
8870 unsigned char *bytes
; /* The data */
8871 size_t len
; /* How big is it? */
8872 int index
; /* Where are we? */
8876 /* Function set as reader function when reading PNG image from memory.
8877 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8878 bytes from the input to DATA. */
8881 png_read_from_memory (png_ptr
, data
, length
)
8882 png_structp png_ptr
;
8886 struct png_memory_storage
*tbr
8887 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8889 if (length
> tbr
->len
- tbr
->index
)
8890 png_error (png_ptr
, "Read error");
8892 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8893 tbr
->index
= tbr
->index
+ length
;
8896 /* Load PNG image IMG for use on frame F. Value is non-zero if
8904 Lisp_Object file
, specified_file
;
8905 Lisp_Object specified_data
;
8907 XImage
*ximg
, *mask_img
= NULL
;
8908 struct gcpro gcpro1
;
8909 png_struct
*png_ptr
= NULL
;
8910 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8911 FILE *volatile fp
= NULL
;
8913 png_byte
* volatile pixels
= NULL
;
8914 png_byte
** volatile rows
= NULL
;
8915 png_uint_32 width
, height
;
8916 int bit_depth
, color_type
, interlace_type
;
8918 png_uint_32 row_bytes
;
8920 double screen_gamma
, image_gamma
;
8922 struct png_memory_storage tbr
; /* Data to be read */
8924 /* Find out what file to load. */
8925 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8926 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8930 if (NILP (specified_data
))
8932 file
= x_find_image_file (specified_file
);
8933 if (!STRINGP (file
))
8935 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8940 /* Open the image file. */
8941 fp
= fopen (XSTRING (file
)->data
, "rb");
8944 image_error ("Cannot open image file `%s'", file
, Qnil
);
8950 /* Check PNG signature. */
8951 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8952 || !png_check_sig (sig
, sizeof sig
))
8954 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8962 /* Read from memory. */
8963 tbr
.bytes
= XSTRING (specified_data
)->data
;
8964 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8967 /* Check PNG signature. */
8968 if (tbr
.len
< sizeof sig
8969 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8971 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8976 /* Need to skip past the signature. */
8977 tbr
.bytes
+= sizeof (sig
);
8980 /* Initialize read and info structs for PNG lib. */
8981 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8982 my_png_error
, my_png_warning
);
8985 if (fp
) fclose (fp
);
8990 info_ptr
= png_create_info_struct (png_ptr
);
8993 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8994 if (fp
) fclose (fp
);
8999 end_info
= png_create_info_struct (png_ptr
);
9002 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
9003 if (fp
) fclose (fp
);
9008 /* Set error jump-back. We come back here when the PNG library
9009 detects an error. */
9010 if (setjmp (png_ptr
->jmpbuf
))
9014 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
9017 if (fp
) fclose (fp
);
9022 /* Read image info. */
9023 if (!NILP (specified_data
))
9024 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
9026 png_init_io (png_ptr
, fp
);
9028 png_set_sig_bytes (png_ptr
, sizeof sig
);
9029 png_read_info (png_ptr
, info_ptr
);
9030 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
9031 &interlace_type
, NULL
, NULL
);
9033 /* If image contains simply transparency data, we prefer to
9034 construct a clipping mask. */
9035 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
9040 /* This function is easier to write if we only have to handle
9041 one data format: RGB or RGBA with 8 bits per channel. Let's
9042 transform other formats into that format. */
9044 /* Strip more than 8 bits per channel. */
9045 if (bit_depth
== 16)
9046 png_set_strip_16 (png_ptr
);
9048 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
9050 png_set_expand (png_ptr
);
9052 /* Convert grayscale images to RGB. */
9053 if (color_type
== PNG_COLOR_TYPE_GRAY
9054 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
9055 png_set_gray_to_rgb (png_ptr
);
9057 screen_gamma
= (f
->gamma
? 1 / f
->gamma
/ 0.45455 : 2.2);
9059 /* Tell the PNG lib to handle gamma correction for us. */
9061 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
9062 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
9063 /* The libpng documentation says this is right in this case. */
9064 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
9067 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
9068 /* Image contains gamma information. */
9069 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
9071 /* Use the standard default for the image gamma. */
9072 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
9074 /* Handle alpha channel by combining the image with a background
9075 color. Do this only if a real alpha channel is supplied. For
9076 simple transparency, we prefer a clipping mask. */
9079 png_color_16
*image_bg
;
9080 Lisp_Object specified_bg
9081 = image_spec_value (img
->spec
, QCbackground
, NULL
);
9083 if (STRINGP (specified_bg
))
9084 /* The user specified `:background', use that. */
9087 if (x_defined_color (f
, XSTRING (specified_bg
)->data
, &color
, 0))
9089 png_color_16 user_bg
;
9091 bzero (&user_bg
, sizeof user_bg
);
9092 user_bg
.red
= color
.red
;
9093 user_bg
.green
= color
.green
;
9094 user_bg
.blue
= color
.blue
;
9096 png_set_background (png_ptr
, &user_bg
,
9097 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
9100 else if (png_get_bKGD (png_ptr
, info_ptr
, &image_bg
))
9101 /* Image contains a background color with which to
9102 combine the image. */
9103 png_set_background (png_ptr
, image_bg
,
9104 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
9107 /* Image does not contain a background color with which
9108 to combine the image data via an alpha channel. Use
9109 the frame's background instead. */
9112 png_color_16 frame_background
;
9114 cmap
= FRAME_X_COLORMAP (f
);
9115 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
9116 x_query_color (f
, &color
);
9118 bzero (&frame_background
, sizeof frame_background
);
9119 frame_background
.red
= color
.red
;
9120 frame_background
.green
= color
.green
;
9121 frame_background
.blue
= color
.blue
;
9123 png_set_background (png_ptr
, &frame_background
,
9124 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
9128 /* Update info structure. */
9129 png_read_update_info (png_ptr
, info_ptr
);
9131 /* Get number of channels. Valid values are 1 for grayscale images
9132 and images with a palette, 2 for grayscale images with transparency
9133 information (alpha channel), 3 for RGB images, and 4 for RGB
9134 images with alpha channel, i.e. RGBA. If conversions above were
9135 sufficient we should only have 3 or 4 channels here. */
9136 channels
= png_get_channels (png_ptr
, info_ptr
);
9137 xassert (channels
== 3 || channels
== 4);
9139 /* Number of bytes needed for one row of the image. */
9140 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
9142 /* Allocate memory for the image. */
9143 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
9144 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
9145 for (i
= 0; i
< height
; ++i
)
9146 rows
[i
] = pixels
+ i
* row_bytes
;
9148 /* Read the entire image. */
9149 png_read_image (png_ptr
, rows
);
9150 png_read_end (png_ptr
, info_ptr
);
9157 /* Create the X image and pixmap. */
9158 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
9162 /* Create an image and pixmap serving as mask if the PNG image
9163 contains an alpha channel. */
9166 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
9167 &mask_img
, &img
->mask
))
9169 x_destroy_x_image (ximg
);
9170 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
9175 /* Fill the X image and mask from PNG data. */
9176 init_color_table ();
9178 for (y
= 0; y
< height
; ++y
)
9180 png_byte
*p
= rows
[y
];
9182 for (x
= 0; x
< width
; ++x
)
9189 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
9191 /* An alpha channel, aka mask channel, associates variable
9192 transparency with an image. Where other image formats
9193 support binary transparency---fully transparent or fully
9194 opaque---PNG allows up to 254 levels of partial transparency.
9195 The PNG library implements partial transparency by combining
9196 the image with a specified background color.
9198 I'm not sure how to handle this here nicely: because the
9199 background on which the image is displayed may change, for
9200 real alpha channel support, it would be necessary to create
9201 a new image for each possible background.
9203 What I'm doing now is that a mask is created if we have
9204 boolean transparency information. Otherwise I'm using
9205 the frame's background color to combine the image with. */
9210 XPutPixel (mask_img
, x
, y
, *p
> 0);
9216 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9217 /* Set IMG's background color from the PNG image, unless the user
9221 if (png_get_bKGD (png_ptr
, info_ptr
, &bg
))
9223 img
->background
= lookup_rgb_color (f
, bg
->red
, bg
->green
, bg
->blue
);
9224 img
->background_valid
= 1;
9228 /* Remember colors allocated for this image. */
9229 img
->colors
= colors_in_color_table (&img
->ncolors
);
9230 free_color_table ();
9233 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
9238 img
->height
= height
;
9240 /* Maybe fill in the background field while we have ximg handy. */
9241 IMAGE_BACKGROUND (img
, f
, ximg
);
9243 /* Put the image into the pixmap, then free the X image and its buffer. */
9244 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9245 x_destroy_x_image (ximg
);
9247 /* Same for the mask. */
9250 /* Fill in the background_transparent field while we have the mask
9252 image_background_transparent (img
, f
, mask_img
);
9254 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
9255 x_destroy_x_image (mask_img
);
9262 #endif /* HAVE_PNG != 0 */
9266 /***********************************************************************
9268 ***********************************************************************/
9272 /* Work around a warning about HAVE_STDLIB_H being redefined in
9274 #ifdef HAVE_STDLIB_H
9275 #define HAVE_STDLIB_H_1
9276 #undef HAVE_STDLIB_H
9277 #endif /* HAVE_STLIB_H */
9279 #include <jpeglib.h>
9283 #ifdef HAVE_STLIB_H_1
9284 #define HAVE_STDLIB_H 1
9287 static int jpeg_image_p
P_ ((Lisp_Object object
));
9288 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
9290 /* The symbol `jpeg' identifying images of this type. */
9294 /* Indices of image specification fields in gs_format, below. */
9296 enum jpeg_keyword_index
9305 JPEG_HEURISTIC_MASK
,
9311 /* Vector of image_keyword structures describing the format
9312 of valid user-defined image specifications. */
9314 static struct image_keyword jpeg_format
[JPEG_LAST
] =
9316 {":type", IMAGE_SYMBOL_VALUE
, 1},
9317 {":data", IMAGE_STRING_VALUE
, 0},
9318 {":file", IMAGE_STRING_VALUE
, 0},
9319 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9320 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9321 {":relief", IMAGE_INTEGER_VALUE
, 0},
9322 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9323 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9324 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9325 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9328 /* Structure describing the image type `jpeg'. */
9330 static struct image_type jpeg_type
=
9340 /* Return non-zero if OBJECT is a valid JPEG image specification. */
9343 jpeg_image_p (object
)
9346 struct image_keyword fmt
[JPEG_LAST
];
9348 bcopy (jpeg_format
, fmt
, sizeof fmt
);
9350 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
9353 /* Must specify either the :data or :file keyword. */
9354 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
9358 struct my_jpeg_error_mgr
9360 struct jpeg_error_mgr pub
;
9361 jmp_buf setjmp_buffer
;
9366 my_error_exit (cinfo
)
9369 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
9370 longjmp (mgr
->setjmp_buffer
, 1);
9374 /* Init source method for JPEG data source manager. Called by
9375 jpeg_read_header() before any data is actually read. See
9376 libjpeg.doc from the JPEG lib distribution. */
9379 our_init_source (cinfo
)
9380 j_decompress_ptr cinfo
;
9385 /* Fill input buffer method for JPEG data source manager. Called
9386 whenever more data is needed. We read the whole image in one step,
9387 so this only adds a fake end of input marker at the end. */
9390 our_fill_input_buffer (cinfo
)
9391 j_decompress_ptr cinfo
;
9393 /* Insert a fake EOI marker. */
9394 struct jpeg_source_mgr
*src
= cinfo
->src
;
9395 static JOCTET buffer
[2];
9397 buffer
[0] = (JOCTET
) 0xFF;
9398 buffer
[1] = (JOCTET
) JPEG_EOI
;
9400 src
->next_input_byte
= buffer
;
9401 src
->bytes_in_buffer
= 2;
9406 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9407 is the JPEG data source manager. */
9410 our_skip_input_data (cinfo
, num_bytes
)
9411 j_decompress_ptr cinfo
;
9414 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9418 if (num_bytes
> src
->bytes_in_buffer
)
9419 ERREXIT (cinfo
, JERR_INPUT_EOF
);
9421 src
->bytes_in_buffer
-= num_bytes
;
9422 src
->next_input_byte
+= num_bytes
;
9427 /* Method to terminate data source. Called by
9428 jpeg_finish_decompress() after all data has been processed. */
9431 our_term_source (cinfo
)
9432 j_decompress_ptr cinfo
;
9437 /* Set up the JPEG lib for reading an image from DATA which contains
9438 LEN bytes. CINFO is the decompression info structure created for
9439 reading the image. */
9442 jpeg_memory_src (cinfo
, data
, len
)
9443 j_decompress_ptr cinfo
;
9447 struct jpeg_source_mgr
*src
;
9449 if (cinfo
->src
== NULL
)
9451 /* First time for this JPEG object? */
9452 cinfo
->src
= (struct jpeg_source_mgr
*)
9453 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9454 sizeof (struct jpeg_source_mgr
));
9455 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9456 src
->next_input_byte
= data
;
9459 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9460 src
->init_source
= our_init_source
;
9461 src
->fill_input_buffer
= our_fill_input_buffer
;
9462 src
->skip_input_data
= our_skip_input_data
;
9463 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9464 src
->term_source
= our_term_source
;
9465 src
->bytes_in_buffer
= len
;
9466 src
->next_input_byte
= data
;
9470 /* Load image IMG for use on frame F. Patterned after example.c
9471 from the JPEG lib. */
9478 struct jpeg_decompress_struct cinfo
;
9479 struct my_jpeg_error_mgr mgr
;
9480 Lisp_Object file
, specified_file
;
9481 Lisp_Object specified_data
;
9482 FILE * volatile fp
= NULL
;
9484 int row_stride
, x
, y
;
9485 XImage
*ximg
= NULL
;
9487 unsigned long *colors
;
9489 struct gcpro gcpro1
;
9491 /* Open the JPEG file. */
9492 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9493 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9497 if (NILP (specified_data
))
9499 file
= x_find_image_file (specified_file
);
9500 if (!STRINGP (file
))
9502 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9507 fp
= fopen (XSTRING (file
)->data
, "r");
9510 image_error ("Cannot open `%s'", file
, Qnil
);
9516 /* Customize libjpeg's error handling to call my_error_exit when an
9517 error is detected. This function will perform a longjmp. */
9518 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9519 mgr
.pub
.error_exit
= my_error_exit
;
9521 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9525 /* Called from my_error_exit. Display a JPEG error. */
9526 char buffer
[JMSG_LENGTH_MAX
];
9527 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9528 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9529 build_string (buffer
));
9532 /* Close the input file and destroy the JPEG object. */
9534 fclose ((FILE *) fp
);
9535 jpeg_destroy_decompress (&cinfo
);
9537 /* If we already have an XImage, free that. */
9538 x_destroy_x_image (ximg
);
9540 /* Free pixmap and colors. */
9541 x_clear_image (f
, img
);
9547 /* Create the JPEG decompression object. Let it read from fp.
9548 Read the JPEG image header. */
9549 jpeg_create_decompress (&cinfo
);
9551 if (NILP (specified_data
))
9552 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9554 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9555 STRING_BYTES (XSTRING (specified_data
)));
9557 jpeg_read_header (&cinfo
, TRUE
);
9559 /* Customize decompression so that color quantization will be used.
9560 Start decompression. */
9561 cinfo
.quantize_colors
= TRUE
;
9562 jpeg_start_decompress (&cinfo
);
9563 width
= img
->width
= cinfo
.output_width
;
9564 height
= img
->height
= cinfo
.output_height
;
9566 /* Create X image and pixmap. */
9567 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9568 longjmp (mgr
.setjmp_buffer
, 2);
9570 /* Allocate colors. When color quantization is used,
9571 cinfo.actual_number_of_colors has been set with the number of
9572 colors generated, and cinfo.colormap is a two-dimensional array
9573 of color indices in the range 0..cinfo.actual_number_of_colors.
9574 No more than 255 colors will be generated. */
9578 if (cinfo
.out_color_components
> 2)
9579 ir
= 0, ig
= 1, ib
= 2;
9580 else if (cinfo
.out_color_components
> 1)
9581 ir
= 0, ig
= 1, ib
= 0;
9583 ir
= 0, ig
= 0, ib
= 0;
9585 /* Use the color table mechanism because it handles colors that
9586 cannot be allocated nicely. Such colors will be replaced with
9587 a default color, and we don't have to care about which colors
9588 can be freed safely, and which can't. */
9589 init_color_table ();
9590 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9593 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9595 /* Multiply RGB values with 255 because X expects RGB values
9596 in the range 0..0xffff. */
9597 int r
= cinfo
.colormap
[ir
][i
] << 8;
9598 int g
= cinfo
.colormap
[ig
][i
] << 8;
9599 int b
= cinfo
.colormap
[ib
][i
] << 8;
9600 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9603 /* Remember those colors actually allocated. */
9604 img
->colors
= colors_in_color_table (&img
->ncolors
);
9605 free_color_table ();
9609 row_stride
= width
* cinfo
.output_components
;
9610 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9612 for (y
= 0; y
< height
; ++y
)
9614 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9615 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9616 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9620 jpeg_finish_decompress (&cinfo
);
9621 jpeg_destroy_decompress (&cinfo
);
9623 fclose ((FILE *) fp
);
9625 /* Maybe fill in the background field while we have ximg handy. */
9626 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9627 IMAGE_BACKGROUND (img
, f
, ximg
);
9629 /* Put the image into the pixmap. */
9630 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9631 x_destroy_x_image (ximg
);
9636 #endif /* HAVE_JPEG */
9640 /***********************************************************************
9642 ***********************************************************************/
9648 static int tiff_image_p
P_ ((Lisp_Object object
));
9649 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9651 /* The symbol `tiff' identifying images of this type. */
9655 /* Indices of image specification fields in tiff_format, below. */
9657 enum tiff_keyword_index
9666 TIFF_HEURISTIC_MASK
,
9672 /* Vector of image_keyword structures describing the format
9673 of valid user-defined image specifications. */
9675 static struct image_keyword tiff_format
[TIFF_LAST
] =
9677 {":type", IMAGE_SYMBOL_VALUE
, 1},
9678 {":data", IMAGE_STRING_VALUE
, 0},
9679 {":file", IMAGE_STRING_VALUE
, 0},
9680 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9681 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9682 {":relief", IMAGE_INTEGER_VALUE
, 0},
9683 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9684 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9685 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9686 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9689 /* Structure describing the image type `tiff'. */
9691 static struct image_type tiff_type
=
9701 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9704 tiff_image_p (object
)
9707 struct image_keyword fmt
[TIFF_LAST
];
9708 bcopy (tiff_format
, fmt
, sizeof fmt
);
9710 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9713 /* Must specify either the :data or :file keyword. */
9714 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9718 /* Reading from a memory buffer for TIFF images Based on the PNG
9719 memory source, but we have to provide a lot of extra functions.
9722 We really only need to implement read and seek, but I am not
9723 convinced that the TIFF library is smart enough not to destroy
9724 itself if we only hand it the function pointers we need to
9729 unsigned char *bytes
;
9737 tiff_read_from_memory (data
, buf
, size
)
9742 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9744 if (size
> src
->len
- src
->index
)
9746 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9753 tiff_write_from_memory (data
, buf
, size
)
9763 tiff_seek_in_memory (data
, off
, whence
)
9768 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9773 case SEEK_SET
: /* Go from beginning of source. */
9777 case SEEK_END
: /* Go from end of source. */
9778 idx
= src
->len
+ off
;
9781 case SEEK_CUR
: /* Go from current position. */
9782 idx
= src
->index
+ off
;
9785 default: /* Invalid `whence'. */
9789 if (idx
> src
->len
|| idx
< 0)
9798 tiff_close_memory (data
)
9807 tiff_mmap_memory (data
, pbase
, psize
)
9812 /* It is already _IN_ memory. */
9818 tiff_unmap_memory (data
, base
, size
)
9823 /* We don't need to do this. */
9828 tiff_size_of_memory (data
)
9831 return ((tiff_memory_source
*) data
)->len
;
9836 tiff_error_handler (title
, format
, ap
)
9837 const char *title
, *format
;
9843 len
= sprintf (buf
, "TIFF error: %s ", title
);
9844 vsprintf (buf
+ len
, format
, ap
);
9845 add_to_log (buf
, Qnil
, Qnil
);
9850 tiff_warning_handler (title
, format
, ap
)
9851 const char *title
, *format
;
9857 len
= sprintf (buf
, "TIFF warning: %s ", title
);
9858 vsprintf (buf
+ len
, format
, ap
);
9859 add_to_log (buf
, Qnil
, Qnil
);
9863 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9871 Lisp_Object file
, specified_file
;
9872 Lisp_Object specified_data
;
9874 int width
, height
, x
, y
;
9878 struct gcpro gcpro1
;
9879 tiff_memory_source memsrc
;
9881 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9882 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9886 TIFFSetErrorHandler (tiff_error_handler
);
9887 TIFFSetWarningHandler (tiff_warning_handler
);
9889 if (NILP (specified_data
))
9891 /* Read from a file */
9892 file
= x_find_image_file (specified_file
);
9893 if (!STRINGP (file
))
9895 image_error ("Cannot find image file `%s'", file
, Qnil
);
9900 /* Try to open the image file. */
9901 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9904 image_error ("Cannot open `%s'", file
, Qnil
);
9911 /* Memory source! */
9912 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9913 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9916 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9917 (TIFFReadWriteProc
) tiff_read_from_memory
,
9918 (TIFFReadWriteProc
) tiff_write_from_memory
,
9919 tiff_seek_in_memory
,
9921 tiff_size_of_memory
,
9927 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9933 /* Get width and height of the image, and allocate a raster buffer
9934 of width x height 32-bit values. */
9935 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9936 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9937 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9939 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9943 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9949 /* Create the X image and pixmap. */
9950 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9957 /* Initialize the color table. */
9958 init_color_table ();
9960 /* Process the pixel raster. Origin is in the lower-left corner. */
9961 for (y
= 0; y
< height
; ++y
)
9963 uint32
*row
= buf
+ y
* width
;
9965 for (x
= 0; x
< width
; ++x
)
9967 uint32 abgr
= row
[x
];
9968 int r
= TIFFGetR (abgr
) << 8;
9969 int g
= TIFFGetG (abgr
) << 8;
9970 int b
= TIFFGetB (abgr
) << 8;
9971 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9975 /* Remember the colors allocated for the image. Free the color table. */
9976 img
->colors
= colors_in_color_table (&img
->ncolors
);
9977 free_color_table ();
9980 img
->height
= height
;
9982 /* Maybe fill in the background field while we have ximg handy. */
9983 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9984 IMAGE_BACKGROUND (img
, f
, ximg
);
9986 /* Put the image into the pixmap, then free the X image and its buffer. */
9987 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9988 x_destroy_x_image (ximg
);
9995 #endif /* HAVE_TIFF != 0 */
9999 /***********************************************************************
10001 ***********************************************************************/
10005 #include <gif_lib.h>
10007 static int gif_image_p
P_ ((Lisp_Object object
));
10008 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
10010 /* The symbol `gif' identifying images of this type. */
10014 /* Indices of image specification fields in gif_format, below. */
10016 enum gif_keyword_index
10025 GIF_HEURISTIC_MASK
,
10032 /* Vector of image_keyword structures describing the format
10033 of valid user-defined image specifications. */
10035 static struct image_keyword gif_format
[GIF_LAST
] =
10037 {":type", IMAGE_SYMBOL_VALUE
, 1},
10038 {":data", IMAGE_STRING_VALUE
, 0},
10039 {":file", IMAGE_STRING_VALUE
, 0},
10040 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10041 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10042 {":relief", IMAGE_INTEGER_VALUE
, 0},
10043 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10044 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10045 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10046 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
10047 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10050 /* Structure describing the image type `gif'. */
10052 static struct image_type gif_type
=
10062 /* Return non-zero if OBJECT is a valid GIF image specification. */
10065 gif_image_p (object
)
10066 Lisp_Object object
;
10068 struct image_keyword fmt
[GIF_LAST
];
10069 bcopy (gif_format
, fmt
, sizeof fmt
);
10071 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
10074 /* Must specify either the :data or :file keyword. */
10075 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
10079 /* Reading a GIF image from memory
10080 Based on the PNG memory stuff to a certain extent. */
10084 unsigned char *bytes
;
10091 /* Make the current memory source available to gif_read_from_memory.
10092 It's done this way because not all versions of libungif support
10093 a UserData field in the GifFileType structure. */
10094 static gif_memory_source
*current_gif_memory_src
;
10097 gif_read_from_memory (file
, buf
, len
)
10102 gif_memory_source
*src
= current_gif_memory_src
;
10104 if (len
> src
->len
- src
->index
)
10107 bcopy (src
->bytes
+ src
->index
, buf
, len
);
10113 /* Load GIF image IMG for use on frame F. Value is non-zero if
10121 Lisp_Object file
, specified_file
;
10122 Lisp_Object specified_data
;
10123 int rc
, width
, height
, x
, y
, i
;
10125 ColorMapObject
*gif_color_map
;
10126 unsigned long pixel_colors
[256];
10128 struct gcpro gcpro1
;
10130 int ino
, image_left
, image_top
, image_width
, image_height
;
10131 gif_memory_source memsrc
;
10132 unsigned char *raster
;
10134 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10135 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10139 if (NILP (specified_data
))
10141 file
= x_find_image_file (specified_file
);
10142 if (!STRINGP (file
))
10144 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10149 /* Open the GIF file. */
10150 gif
= DGifOpenFileName (XSTRING (file
)->data
);
10153 image_error ("Cannot open `%s'", file
, Qnil
);
10160 /* Read from memory! */
10161 current_gif_memory_src
= &memsrc
;
10162 memsrc
.bytes
= XSTRING (specified_data
)->data
;
10163 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
10166 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
10169 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
10175 /* Read entire contents. */
10176 rc
= DGifSlurp (gif
);
10177 if (rc
== GIF_ERROR
)
10179 image_error ("Error reading `%s'", img
->spec
, Qnil
);
10180 DGifCloseFile (gif
);
10185 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
10186 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
10187 if (ino
>= gif
->ImageCount
)
10189 image_error ("Invalid image number `%s' in image `%s'",
10191 DGifCloseFile (gif
);
10196 width
= img
->width
= max (gif
->SWidth
, gif
->Image
.Left
+ gif
->Image
.Width
);
10197 height
= img
->height
= max (gif
->SHeight
, gif
->Image
.Top
+ gif
->Image
.Height
);
10199 /* Create the X image and pixmap. */
10200 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
10202 DGifCloseFile (gif
);
10207 /* Allocate colors. */
10208 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
10209 if (!gif_color_map
)
10210 gif_color_map
= gif
->SColorMap
;
10211 init_color_table ();
10212 bzero (pixel_colors
, sizeof pixel_colors
);
10214 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
10216 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
10217 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
10218 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
10219 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
10222 img
->colors
= colors_in_color_table (&img
->ncolors
);
10223 free_color_table ();
10225 /* Clear the part of the screen image that are not covered by
10226 the image from the GIF file. Full animated GIF support
10227 requires more than can be done here (see the gif89 spec,
10228 disposal methods). Let's simply assume that the part
10229 not covered by a sub-image is in the frame's background color. */
10230 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
10231 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
10232 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
10233 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
10235 for (y
= 0; y
< image_top
; ++y
)
10236 for (x
= 0; x
< width
; ++x
)
10237 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10239 for (y
= image_top
+ image_height
; y
< height
; ++y
)
10240 for (x
= 0; x
< width
; ++x
)
10241 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10243 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
10245 for (x
= 0; x
< image_left
; ++x
)
10246 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10247 for (x
= image_left
+ image_width
; x
< width
; ++x
)
10248 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10251 /* Read the GIF image into the X image. We use a local variable
10252 `raster' here because RasterBits below is a char *, and invites
10253 problems with bytes >= 0x80. */
10254 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
10256 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
10258 static int interlace_start
[] = {0, 4, 2, 1};
10259 static int interlace_increment
[] = {8, 8, 4, 2};
10261 int row
= interlace_start
[0];
10265 for (y
= 0; y
< image_height
; y
++)
10267 if (row
>= image_height
)
10269 row
= interlace_start
[++pass
];
10270 while (row
>= image_height
)
10271 row
= interlace_start
[++pass
];
10274 for (x
= 0; x
< image_width
; x
++)
10276 int i
= raster
[(y
* image_width
) + x
];
10277 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
10281 row
+= interlace_increment
[pass
];
10286 for (y
= 0; y
< image_height
; ++y
)
10287 for (x
= 0; x
< image_width
; ++x
)
10289 int i
= raster
[y
* image_width
+ x
];
10290 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
10294 DGifCloseFile (gif
);
10296 /* Maybe fill in the background field while we have ximg handy. */
10297 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10298 IMAGE_BACKGROUND (img
, f
, ximg
);
10300 /* Put the image into the pixmap, then free the X image and its buffer. */
10301 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10302 x_destroy_x_image (ximg
);
10308 #endif /* HAVE_GIF != 0 */
10312 /***********************************************************************
10314 ***********************************************************************/
10316 static int gs_image_p
P_ ((Lisp_Object object
));
10317 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
10318 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
10320 /* The symbol `postscript' identifying images of this type. */
10322 Lisp_Object Qpostscript
;
10324 /* Keyword symbols. */
10326 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
10328 /* Indices of image specification fields in gs_format, below. */
10330 enum gs_keyword_index
10348 /* Vector of image_keyword structures describing the format
10349 of valid user-defined image specifications. */
10351 static struct image_keyword gs_format
[GS_LAST
] =
10353 {":type", IMAGE_SYMBOL_VALUE
, 1},
10354 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10355 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10356 {":file", IMAGE_STRING_VALUE
, 1},
10357 {":loader", IMAGE_FUNCTION_VALUE
, 0},
10358 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
10359 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10360 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10361 {":relief", IMAGE_INTEGER_VALUE
, 0},
10362 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10363 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10364 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10365 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10368 /* Structure describing the image type `ghostscript'. */
10370 static struct image_type gs_type
=
10380 /* Free X resources of Ghostscript image IMG which is used on frame F. */
10383 gs_clear_image (f
, img
)
10387 /* IMG->data.ptr_val may contain a recorded colormap. */
10388 xfree (img
->data
.ptr_val
);
10389 x_clear_image (f
, img
);
10393 /* Return non-zero if OBJECT is a valid Ghostscript image
10397 gs_image_p (object
)
10398 Lisp_Object object
;
10400 struct image_keyword fmt
[GS_LAST
];
10404 bcopy (gs_format
, fmt
, sizeof fmt
);
10406 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
10409 /* Bounding box must be a list or vector containing 4 integers. */
10410 tem
= fmt
[GS_BOUNDING_BOX
].value
;
10413 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
10414 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
10419 else if (VECTORP (tem
))
10421 if (XVECTOR (tem
)->size
!= 4)
10423 for (i
= 0; i
< 4; ++i
)
10424 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
10434 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
10443 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
10444 struct gcpro gcpro1
, gcpro2
;
10446 double in_width
, in_height
;
10447 Lisp_Object pixel_colors
= Qnil
;
10449 /* Compute pixel size of pixmap needed from the given size in the
10450 image specification. Sizes in the specification are in pt. 1 pt
10451 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10453 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
10454 in_width
= XFASTINT (pt_width
) / 72.0;
10455 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
10456 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
10457 in_height
= XFASTINT (pt_height
) / 72.0;
10458 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
10460 /* Create the pixmap. */
10461 xassert (img
->pixmap
== None
);
10462 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10463 img
->width
, img
->height
,
10464 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
10468 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
10472 /* Call the loader to fill the pixmap. It returns a process object
10473 if successful. We do not record_unwind_protect here because
10474 other places in redisplay like calling window scroll functions
10475 don't either. Let the Lisp loader use `unwind-protect' instead. */
10476 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
10478 sprintf (buffer
, "%lu %lu",
10479 (unsigned long) FRAME_X_WINDOW (f
),
10480 (unsigned long) img
->pixmap
);
10481 window_and_pixmap_id
= build_string (buffer
);
10483 sprintf (buffer
, "%lu %lu",
10484 FRAME_FOREGROUND_PIXEL (f
),
10485 FRAME_BACKGROUND_PIXEL (f
));
10486 pixel_colors
= build_string (buffer
);
10488 XSETFRAME (frame
, f
);
10489 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
10491 loader
= intern ("gs-load-image");
10493 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10494 make_number (img
->width
),
10495 make_number (img
->height
),
10496 window_and_pixmap_id
,
10499 return PROCESSP (img
->data
.lisp_val
);
10503 /* Kill the Ghostscript process that was started to fill PIXMAP on
10504 frame F. Called from XTread_socket when receiving an event
10505 telling Emacs that Ghostscript has finished drawing. */
10508 x_kill_gs_process (pixmap
, f
)
10512 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10516 /* Find the image containing PIXMAP. */
10517 for (i
= 0; i
< c
->used
; ++i
)
10518 if (c
->images
[i
]->pixmap
== pixmap
)
10521 /* Should someone in between have cleared the image cache, for
10522 instance, give up. */
10526 /* Kill the GS process. We should have found PIXMAP in the image
10527 cache and its image should contain a process object. */
10528 img
= c
->images
[i
];
10529 xassert (PROCESSP (img
->data
.lisp_val
));
10530 Fkill_process (img
->data
.lisp_val
, Qnil
);
10531 img
->data
.lisp_val
= Qnil
;
10533 /* On displays with a mutable colormap, figure out the colors
10534 allocated for the image by looking at the pixels of an XImage for
10536 class = FRAME_X_VISUAL (f
)->class;
10537 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10543 /* Try to get an XImage for img->pixmep. */
10544 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10545 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10550 /* Initialize the color table. */
10551 init_color_table ();
10553 /* For each pixel of the image, look its color up in the
10554 color table. After having done so, the color table will
10555 contain an entry for each color used by the image. */
10556 for (y
= 0; y
< img
->height
; ++y
)
10557 for (x
= 0; x
< img
->width
; ++x
)
10559 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10560 lookup_pixel_color (f
, pixel
);
10563 /* Record colors in the image. Free color table and XImage. */
10564 img
->colors
= colors_in_color_table (&img
->ncolors
);
10565 free_color_table ();
10566 XDestroyImage (ximg
);
10568 #if 0 /* This doesn't seem to be the case. If we free the colors
10569 here, we get a BadAccess later in x_clear_image when
10570 freeing the colors. */
10571 /* We have allocated colors once, but Ghostscript has also
10572 allocated colors on behalf of us. So, to get the
10573 reference counts right, free them once. */
10575 x_free_colors (f
, img
->colors
, img
->ncolors
);
10579 image_error ("Cannot get X image of `%s'; colors will not be freed",
10585 /* Now that we have the pixmap, compute mask and transform the
10586 image if requested. */
10588 postprocess_image (f
, img
);
10594 /***********************************************************************
10596 ***********************************************************************/
10598 DEFUN ("x-change-window-property", Fx_change_window_property
,
10599 Sx_change_window_property
, 2, 3, 0,
10600 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
10601 PROP and VALUE must be strings. FRAME nil or omitted means use the
10602 selected frame. Value is VALUE. */)
10603 (prop
, value
, frame
)
10604 Lisp_Object frame
, prop
, value
;
10606 struct frame
*f
= check_x_frame (frame
);
10609 CHECK_STRING (prop
);
10610 CHECK_STRING (value
);
10613 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10614 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10615 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10616 XSTRING (value
)->data
, XSTRING (value
)->size
);
10618 /* Make sure the property is set when we return. */
10619 XFlush (FRAME_X_DISPLAY (f
));
10626 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10627 Sx_delete_window_property
, 1, 2, 0,
10628 doc
: /* Remove window property PROP from X window of FRAME.
10629 FRAME nil or omitted means use the selected frame. Value is PROP. */)
10631 Lisp_Object prop
, frame
;
10633 struct frame
*f
= check_x_frame (frame
);
10636 CHECK_STRING (prop
);
10638 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10639 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10641 /* Make sure the property is removed when we return. */
10642 XFlush (FRAME_X_DISPLAY (f
));
10649 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10651 doc
: /* Value is the value of window property PROP on FRAME.
10652 If FRAME is nil or omitted, use the selected frame. Value is nil
10653 if FRAME hasn't a property with name PROP or if PROP has no string
10656 Lisp_Object prop
, frame
;
10658 struct frame
*f
= check_x_frame (frame
);
10661 Lisp_Object prop_value
= Qnil
;
10662 char *tmp_data
= NULL
;
10665 unsigned long actual_size
, bytes_remaining
;
10667 CHECK_STRING (prop
);
10669 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10670 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10671 prop_atom
, 0, 0, False
, XA_STRING
,
10672 &actual_type
, &actual_format
, &actual_size
,
10673 &bytes_remaining
, (unsigned char **) &tmp_data
);
10676 int size
= bytes_remaining
;
10681 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10682 prop_atom
, 0, bytes_remaining
,
10684 &actual_type
, &actual_format
,
10685 &actual_size
, &bytes_remaining
,
10686 (unsigned char **) &tmp_data
);
10687 if (rc
== Success
&& tmp_data
)
10688 prop_value
= make_string (tmp_data
, size
);
10699 /***********************************************************************
10701 ***********************************************************************/
10703 /* If non-null, an asynchronous timer that, when it expires, displays
10704 an hourglass cursor on all frames. */
10706 static struct atimer
*hourglass_atimer
;
10708 /* Non-zero means an hourglass cursor is currently shown. */
10710 static int hourglass_shown_p
;
10712 /* Number of seconds to wait before displaying an hourglass cursor. */
10714 static Lisp_Object Vhourglass_delay
;
10716 /* Default number of seconds to wait before displaying an hourglass
10719 #define DEFAULT_HOURGLASS_DELAY 1
10721 /* Function prototypes. */
10723 static void show_hourglass
P_ ((struct atimer
*));
10724 static void hide_hourglass
P_ ((void));
10727 /* Cancel a currently active hourglass timer, and start a new one. */
10733 int secs
, usecs
= 0;
10735 cancel_hourglass ();
10737 if (INTEGERP (Vhourglass_delay
)
10738 && XINT (Vhourglass_delay
) > 0)
10739 secs
= XFASTINT (Vhourglass_delay
);
10740 else if (FLOATP (Vhourglass_delay
)
10741 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10744 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10745 secs
= XFASTINT (tem
);
10746 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10749 secs
= DEFAULT_HOURGLASS_DELAY
;
10751 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10752 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10753 show_hourglass
, NULL
);
10757 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10761 cancel_hourglass ()
10763 if (hourglass_atimer
)
10765 cancel_atimer (hourglass_atimer
);
10766 hourglass_atimer
= NULL
;
10769 if (hourglass_shown_p
)
10774 /* Timer function of hourglass_atimer. TIMER is equal to
10777 Display an hourglass pointer on all frames by mapping the frames'
10778 hourglass_window. Set the hourglass_p flag in the frames'
10779 output_data.x structure to indicate that an hourglass cursor is
10780 shown on the frames. */
10783 show_hourglass (timer
)
10784 struct atimer
*timer
;
10786 /* The timer implementation will cancel this timer automatically
10787 after this function has run. Set hourglass_atimer to null
10788 so that we know the timer doesn't have to be canceled. */
10789 hourglass_atimer
= NULL
;
10791 if (!hourglass_shown_p
)
10793 Lisp_Object rest
, frame
;
10797 FOR_EACH_FRAME (rest
, frame
)
10799 struct frame
*f
= XFRAME (frame
);
10801 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10803 Display
*dpy
= FRAME_X_DISPLAY (f
);
10805 #ifdef USE_X_TOOLKIT
10806 if (f
->output_data
.x
->widget
)
10808 if (FRAME_OUTER_WINDOW (f
))
10811 f
->output_data
.x
->hourglass_p
= 1;
10813 if (!f
->output_data
.x
->hourglass_window
)
10815 unsigned long mask
= CWCursor
;
10816 XSetWindowAttributes attrs
;
10818 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10820 f
->output_data
.x
->hourglass_window
10821 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10822 0, 0, 32000, 32000, 0, 0,
10828 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10834 hourglass_shown_p
= 1;
10840 /* Hide the hourglass pointer on all frames, if it is currently
10846 if (hourglass_shown_p
)
10848 Lisp_Object rest
, frame
;
10851 FOR_EACH_FRAME (rest
, frame
)
10853 struct frame
*f
= XFRAME (frame
);
10856 /* Watch out for newly created frames. */
10857 && f
->output_data
.x
->hourglass_window
)
10859 XUnmapWindow (FRAME_X_DISPLAY (f
),
10860 f
->output_data
.x
->hourglass_window
);
10861 /* Sync here because XTread_socket looks at the
10862 hourglass_p flag that is reset to zero below. */
10863 XSync (FRAME_X_DISPLAY (f
), False
);
10864 f
->output_data
.x
->hourglass_p
= 0;
10868 hourglass_shown_p
= 0;
10875 /***********************************************************************
10877 ***********************************************************************/
10879 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10880 Lisp_Object
, Lisp_Object
));
10881 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10882 Lisp_Object
, int, int, int *, int *));
10884 /* The frame of a currently visible tooltip. */
10886 Lisp_Object tip_frame
;
10888 /* If non-nil, a timer started that hides the last tooltip when it
10891 Lisp_Object tip_timer
;
10894 /* If non-nil, a vector of 3 elements containing the last args
10895 with which x-show-tip was called. See there. */
10897 Lisp_Object last_show_tip_args
;
10899 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
10901 Lisp_Object Vx_max_tooltip_size
;
10905 unwind_create_tip_frame (frame
)
10908 Lisp_Object deleted
;
10910 deleted
= unwind_create_frame (frame
);
10911 if (EQ (deleted
, Qt
))
10921 /* Create a frame for a tooltip on the display described by DPYINFO.
10922 PARMS is a list of frame parameters. TEXT is the string to
10923 display in the tip frame. Value is the frame.
10925 Note that functions called here, esp. x_default_parameter can
10926 signal errors, for instance when a specified color name is
10927 undefined. We have to make sure that we're in a consistent state
10928 when this happens. */
10931 x_create_tip_frame (dpyinfo
, parms
, text
)
10932 struct x_display_info
*dpyinfo
;
10933 Lisp_Object parms
, text
;
10936 Lisp_Object frame
, tem
;
10938 long window_prompting
= 0;
10940 int count
= BINDING_STACK_SIZE ();
10941 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10943 int face_change_count_before
= face_change_count
;
10944 Lisp_Object buffer
;
10945 struct buffer
*old_buffer
;
10949 /* Use this general default value to start with until we know if
10950 this frame has a specified name. */
10951 Vx_resource_name
= Vinvocation_name
;
10953 #ifdef MULTI_KBOARD
10954 kb
= dpyinfo
->kboard
;
10956 kb
= &the_only_kboard
;
10959 /* Get the name of the frame to use for resource lookup. */
10960 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10961 if (!STRINGP (name
)
10962 && !EQ (name
, Qunbound
)
10964 error ("Invalid frame name--not a string or nil");
10965 Vx_resource_name
= name
;
10968 GCPRO3 (parms
, name
, frame
);
10969 f
= make_frame (1);
10970 XSETFRAME (frame
, f
);
10972 buffer
= Fget_buffer_create (build_string (" *tip*"));
10973 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10974 old_buffer
= current_buffer
;
10975 set_buffer_internal_1 (XBUFFER (buffer
));
10976 current_buffer
->truncate_lines
= Qnil
;
10978 Finsert (1, &text
);
10979 set_buffer_internal_1 (old_buffer
);
10981 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10982 record_unwind_protect (unwind_create_tip_frame
, frame
);
10984 /* By setting the output method, we're essentially saying that
10985 the frame is live, as per FRAME_LIVE_P. If we get a signal
10986 from this point on, x_destroy_window might screw up reference
10988 f
->output_method
= output_x_window
;
10989 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10990 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10991 f
->output_data
.x
->icon_bitmap
= -1;
10992 f
->output_data
.x
->fontset
= -1;
10993 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10994 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10995 #ifdef USE_TOOLKIT_SCROLL_BARS
10996 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
10997 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
10998 #endif /* USE_TOOLKIT_SCROLL_BARS */
10999 f
->icon_name
= Qnil
;
11000 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
11002 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
11003 dpyinfo_refcount
= dpyinfo
->reference_count
;
11004 #endif /* GLYPH_DEBUG */
11005 #ifdef MULTI_KBOARD
11006 FRAME_KBOARD (f
) = kb
;
11008 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
11009 f
->output_data
.x
->explicit_parent
= 0;
11011 /* These colors will be set anyway later, but it's important
11012 to get the color reference counts right, so initialize them! */
11015 struct gcpro gcpro1
;
11017 black
= build_string ("black");
11019 f
->output_data
.x
->foreground_pixel
11020 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11021 f
->output_data
.x
->background_pixel
11022 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11023 f
->output_data
.x
->cursor_pixel
11024 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11025 f
->output_data
.x
->cursor_foreground_pixel
11026 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11027 f
->output_data
.x
->border_pixel
11028 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11029 f
->output_data
.x
->mouse_pixel
11030 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11034 /* Set the name; the functions to which we pass f expect the name to
11036 if (EQ (name
, Qunbound
) || NILP (name
))
11038 f
->name
= build_string (dpyinfo
->x_id_name
);
11039 f
->explicit_name
= 0;
11044 f
->explicit_name
= 1;
11045 /* use the frame's title when getting resources for this frame. */
11046 specbind (Qx_resource_name
, name
);
11049 /* Extract the window parameters from the supplied values that are
11050 needed to determine window geometry. */
11054 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
11057 /* First, try whatever font the caller has specified. */
11058 if (STRINGP (font
))
11060 tem
= Fquery_fontset (font
, Qnil
);
11062 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
11064 font
= x_new_font (f
, XSTRING (font
)->data
);
11067 /* Try out a font which we hope has bold and italic variations. */
11068 if (!STRINGP (font
))
11069 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
11070 if (!STRINGP (font
))
11071 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11072 if (! STRINGP (font
))
11073 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11074 if (! STRINGP (font
))
11075 /* This was formerly the first thing tried, but it finds too many fonts
11076 and takes too long. */
11077 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
11078 /* If those didn't work, look for something which will at least work. */
11079 if (! STRINGP (font
))
11080 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
11082 if (! STRINGP (font
))
11083 font
= build_string ("fixed");
11085 x_default_parameter (f
, parms
, Qfont
, font
,
11086 "font", "Font", RES_TYPE_STRING
);
11089 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
11090 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
11092 /* This defaults to 2 in order to match xterm. We recognize either
11093 internalBorderWidth or internalBorder (which is what xterm calls
11095 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11099 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
11100 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
11101 if (! EQ (value
, Qunbound
))
11102 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
11106 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
11107 "internalBorderWidth", "internalBorderWidth",
11110 /* Also do the stuff which must be set before the window exists. */
11111 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
11112 "foreground", "Foreground", RES_TYPE_STRING
);
11113 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
11114 "background", "Background", RES_TYPE_STRING
);
11115 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
11116 "pointerColor", "Foreground", RES_TYPE_STRING
);
11117 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
11118 "cursorColor", "Foreground", RES_TYPE_STRING
);
11119 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
11120 "borderColor", "BorderColor", RES_TYPE_STRING
);
11122 /* Init faces before x_default_parameter is called for scroll-bar
11123 parameters because that function calls x_set_scroll_bar_width,
11124 which calls change_frame_size, which calls Fset_window_buffer,
11125 which runs hooks, which call Fvertical_motion. At the end, we
11126 end up in init_iterator with a null face cache, which should not
11128 init_frame_faces (f
);
11130 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
11131 window_prompting
= x_figure_window_size (f
, parms
);
11133 if (window_prompting
& XNegative
)
11135 if (window_prompting
& YNegative
)
11136 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
11138 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
11142 if (window_prompting
& YNegative
)
11143 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
11145 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
11148 f
->output_data
.x
->size_hint_flags
= window_prompting
;
11150 XSetWindowAttributes attrs
;
11151 unsigned long mask
;
11154 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
11155 if (DoesSaveUnders (dpyinfo
->screen
))
11156 mask
|= CWSaveUnder
;
11158 /* Window managers look at the override-redirect flag to determine
11159 whether or net to give windows a decoration (Xlib spec, chapter
11161 attrs
.override_redirect
= True
;
11162 attrs
.save_under
= True
;
11163 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
11164 /* Arrange for getting MapNotify and UnmapNotify events. */
11165 attrs
.event_mask
= StructureNotifyMask
;
11167 = FRAME_X_WINDOW (f
)
11168 = XCreateWindow (FRAME_X_DISPLAY (f
),
11169 FRAME_X_DISPLAY_INFO (f
)->root_window
,
11170 /* x, y, width, height */
11174 CopyFromParent
, InputOutput
, CopyFromParent
,
11181 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
11182 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
11183 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
11184 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
11185 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
11186 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
11188 /* Dimensions, especially f->height, must be done via change_frame_size.
11189 Change will not be effected unless different from the current
11192 height
= f
->height
;
11194 SET_FRAME_WIDTH (f
, 0);
11195 change_frame_size (f
, height
, width
, 1, 0, 0);
11197 /* Set up faces after all frame parameters are known. This call
11198 also merges in face attributes specified for new frames.
11200 Frame parameters may be changed if .Xdefaults contains
11201 specifications for the default font. For example, if there is an
11202 `Emacs.default.attributeBackground: pink', the `background-color'
11203 attribute of the frame get's set, which let's the internal border
11204 of the tooltip frame appear in pink. Prevent this. */
11206 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
11208 /* Set tip_frame here, so that */
11210 call1 (Qface_set_after_frame_default
, frame
);
11212 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
11213 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
11221 /* It is now ok to make the frame official even if we get an error
11222 below. And the frame needs to be on Vframe_list or making it
11223 visible won't work. */
11224 Vframe_list
= Fcons (frame
, Vframe_list
);
11226 /* Now that the frame is official, it counts as a reference to
11228 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
11230 /* Setting attributes of faces of the tooltip frame from resources
11231 and similar will increment face_change_count, which leads to the
11232 clearing of all current matrices. Since this isn't necessary
11233 here, avoid it by resetting face_change_count to the value it
11234 had before we created the tip frame. */
11235 face_change_count
= face_change_count_before
;
11237 /* Discard the unwind_protect. */
11238 return unbind_to (count
, frame
);
11242 /* Compute where to display tip frame F. PARMS is the list of frame
11243 parameters for F. DX and DY are specified offsets from the current
11244 location of the mouse. WIDTH and HEIGHT are the width and height
11245 of the tooltip. Return coordinates relative to the root window of
11246 the display in *ROOT_X, and *ROOT_Y. */
11249 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
11251 Lisp_Object parms
, dx
, dy
;
11253 int *root_x
, *root_y
;
11255 Lisp_Object left
, top
;
11257 Window root
, child
;
11260 /* User-specified position? */
11261 left
= Fcdr (Fassq (Qleft
, parms
));
11262 top
= Fcdr (Fassq (Qtop
, parms
));
11264 /* Move the tooltip window where the mouse pointer is. Resize and
11266 if (!INTEGERP (left
) || !INTEGERP (top
))
11269 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
11270 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
11274 if (INTEGERP (top
))
11275 *root_y
= XINT (top
);
11276 else if (*root_y
+ XINT (dy
) - height
< 0)
11277 *root_y
-= XINT (dy
);
11281 *root_y
+= XINT (dy
);
11284 if (INTEGERP (left
))
11285 *root_x
= XINT (left
);
11286 else if (*root_x
+ XINT (dx
) + width
<= FRAME_X_DISPLAY_INFO (f
)->width
)
11287 /* It fits to the right of the pointer. */
11288 *root_x
+= XINT (dx
);
11289 else if (width
+ XINT (dx
) <= *root_x
)
11290 /* It fits to the left of the pointer. */
11291 *root_x
-= width
+ XINT (dx
);
11293 /* Put it left-justified on the screen--it ought to fit that way. */
11298 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
11299 doc
: /* Show STRING in a "tooltip" window on frame FRAME.
11300 A tooltip window is a small X window displaying a string.
11302 FRAME nil or omitted means use the selected frame.
11304 PARMS is an optional list of frame parameters which can be used to
11305 change the tooltip's appearance.
11307 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
11308 means use the default timeout of 5 seconds.
11310 If the list of frame parameters PARAMS contains a `left' parameters,
11311 the tooltip is displayed at that x-position. Otherwise it is
11312 displayed at the mouse position, with offset DX added (default is 5 if
11313 DX isn't specified). Likewise for the y-position; if a `top' frame
11314 parameter is specified, it determines the y-position of the tooltip
11315 window, otherwise it is displayed at the mouse position, with offset
11316 DY added (default is -10).
11318 A tooltip's maximum size is specified by `x-max-tooltip-size'.
11319 Text larger than the specified size is clipped. */)
11320 (string
, frame
, parms
, timeout
, dx
, dy
)
11321 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
11325 int root_x
, root_y
;
11326 struct buffer
*old_buffer
;
11327 struct text_pos pos
;
11328 int i
, width
, height
;
11329 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
11330 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
11331 int count
= BINDING_STACK_SIZE ();
11333 specbind (Qinhibit_redisplay
, Qt
);
11335 GCPRO4 (string
, parms
, frame
, timeout
);
11337 CHECK_STRING (string
);
11338 f
= check_x_frame (frame
);
11339 if (NILP (timeout
))
11340 timeout
= make_number (5);
11342 CHECK_NATNUM (timeout
);
11345 dx
= make_number (5);
11350 dy
= make_number (-10);
11354 if (NILP (last_show_tip_args
))
11355 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
11357 if (!NILP (tip_frame
))
11359 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
11360 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
11361 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
11363 if (EQ (frame
, last_frame
)
11364 && !NILP (Fequal (last_string
, string
))
11365 && !NILP (Fequal (last_parms
, parms
)))
11367 struct frame
*f
= XFRAME (tip_frame
);
11369 /* Only DX and DY have changed. */
11370 if (!NILP (tip_timer
))
11372 Lisp_Object timer
= tip_timer
;
11374 call1 (Qcancel_timer
, timer
);
11378 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
11379 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
11380 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11387 /* Hide a previous tip, if any. */
11390 ASET (last_show_tip_args
, 0, string
);
11391 ASET (last_show_tip_args
, 1, frame
);
11392 ASET (last_show_tip_args
, 2, parms
);
11394 /* Add default values to frame parameters. */
11395 if (NILP (Fassq (Qname
, parms
)))
11396 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
11397 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11398 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
11399 if (NILP (Fassq (Qborder_width
, parms
)))
11400 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
11401 if (NILP (Fassq (Qborder_color
, parms
)))
11402 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
11403 if (NILP (Fassq (Qbackground_color
, parms
)))
11404 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
11407 /* Create a frame for the tooltip, and record it in the global
11408 variable tip_frame. */
11409 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
, string
);
11410 f
= XFRAME (frame
);
11412 /* Set up the frame's root window. */
11413 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
11414 w
->left
= w
->top
= make_number (0);
11416 if (CONSP (Vx_max_tooltip_size
)
11417 && INTEGERP (XCAR (Vx_max_tooltip_size
))
11418 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
11419 && INTEGERP (XCDR (Vx_max_tooltip_size
))
11420 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
11422 w
->width
= XCAR (Vx_max_tooltip_size
);
11423 w
->height
= XCDR (Vx_max_tooltip_size
);
11427 w
->width
= make_number (80);
11428 w
->height
= make_number (40);
11431 f
->window_width
= XINT (w
->width
);
11433 w
->pseudo_window_p
= 1;
11435 /* Display the tooltip text in a temporary buffer. */
11436 old_buffer
= current_buffer
;
11437 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
11438 current_buffer
->truncate_lines
= Qnil
;
11439 clear_glyph_matrix (w
->desired_matrix
);
11440 clear_glyph_matrix (w
->current_matrix
);
11441 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
11442 try_window (FRAME_ROOT_WINDOW (f
), pos
);
11444 /* Compute width and height of the tooltip. */
11445 width
= height
= 0;
11446 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
11448 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
11449 struct glyph
*last
;
11452 /* Stop at the first empty row at the end. */
11453 if (!row
->enabled_p
|| !row
->displays_text_p
)
11456 /* Let the row go over the full width of the frame. */
11457 row
->full_width_p
= 1;
11459 /* There's a glyph at the end of rows that is used to place
11460 the cursor there. Don't include the width of this glyph. */
11461 if (row
->used
[TEXT_AREA
])
11463 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
11464 row_width
= row
->pixel_width
- last
->pixel_width
;
11467 row_width
= row
->pixel_width
;
11469 height
+= row
->height
;
11470 width
= max (width
, row_width
);
11473 /* Add the frame's internal border to the width and height the X
11474 window should have. */
11475 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11476 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11478 /* Move the tooltip window where the mouse pointer is. Resize and
11480 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
11483 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11484 root_x
, root_y
, width
, height
);
11485 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
11488 /* Draw into the window. */
11489 w
->must_be_updated_p
= 1;
11490 update_single_window (w
, 1);
11492 /* Restore original current buffer. */
11493 set_buffer_internal_1 (old_buffer
);
11494 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
11497 /* Let the tip disappear after timeout seconds. */
11498 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
11499 intern ("x-hide-tip"));
11502 return unbind_to (count
, Qnil
);
11506 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
11507 doc
: /* Hide the current tooltip window, if there is any.
11508 Value is t if tooltip was open, nil otherwise. */)
11512 Lisp_Object deleted
, frame
, timer
;
11513 struct gcpro gcpro1
, gcpro2
;
11515 /* Return quickly if nothing to do. */
11516 if (NILP (tip_timer
) && NILP (tip_frame
))
11521 GCPRO2 (frame
, timer
);
11522 tip_frame
= tip_timer
= deleted
= Qnil
;
11524 count
= BINDING_STACK_SIZE ();
11525 specbind (Qinhibit_redisplay
, Qt
);
11526 specbind (Qinhibit_quit
, Qt
);
11529 call1 (Qcancel_timer
, timer
);
11531 if (FRAMEP (frame
))
11533 Fdelete_frame (frame
, Qnil
);
11537 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11538 redisplay procedure is not called when a tip frame over menu
11539 items is unmapped. Redisplay the menu manually... */
11541 struct frame
*f
= SELECTED_FRAME ();
11542 Widget w
= f
->output_data
.x
->menubar_widget
;
11543 extern void xlwmenu_redisplay
P_ ((Widget
));
11545 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
11549 xlwmenu_redisplay (w
);
11553 #endif /* USE_LUCID */
11557 return unbind_to (count
, deleted
);
11562 /***********************************************************************
11563 File selection dialog
11564 ***********************************************************************/
11568 /* Callback for "OK" and "Cancel" on file selection dialog. */
11571 file_dialog_cb (widget
, client_data
, call_data
)
11573 XtPointer call_data
, client_data
;
11575 int *result
= (int *) client_data
;
11576 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11577 *result
= cb
->reason
;
11581 /* Callback for unmapping a file selection dialog. This is used to
11582 capture the case where a dialog is closed via a window manager's
11583 closer button, for example. Using a XmNdestroyCallback didn't work
11587 file_dialog_unmap_cb (widget
, client_data
, call_data
)
11589 XtPointer call_data
, client_data
;
11591 int *result
= (int *) client_data
;
11592 *result
= XmCR_CANCEL
;
11596 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11597 doc
: /* Read file name, prompting with PROMPT in directory DIR.
11598 Use a file selection dialog.
11599 Select DEFAULT-FILENAME in the dialog's file selection box, if
11600 specified. Don't let the user enter a file name in the file
11601 selection dialog's entry field, if MUSTMATCH is non-nil. */)
11602 (prompt
, dir
, default_filename
, mustmatch
)
11603 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11606 struct frame
*f
= SELECTED_FRAME ();
11607 Lisp_Object file
= Qnil
;
11608 Widget dialog
, text
, list
, help
;
11611 extern XtAppContext Xt_app_con
;
11612 XmString dir_xmstring
, pattern_xmstring
;
11613 int count
= specpdl_ptr
- specpdl
;
11614 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11616 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11617 CHECK_STRING (prompt
);
11618 CHECK_STRING (dir
);
11620 /* Prevent redisplay. */
11621 specbind (Qinhibit_redisplay
, Qt
);
11625 /* Create the dialog with PROMPT as title, using DIR as initial
11626 directory and using "*" as pattern. */
11627 dir
= Fexpand_file_name (dir
, Qnil
);
11628 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11629 pattern_xmstring
= XmStringCreateLocalized ("*");
11631 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11632 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11633 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11634 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11635 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11636 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11638 XmStringFree (dir_xmstring
);
11639 XmStringFree (pattern_xmstring
);
11641 /* Add callbacks for OK and Cancel. */
11642 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11643 (XtPointer
) &result
);
11644 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11645 (XtPointer
) &result
);
11646 XtAddCallback (dialog
, XmNunmapCallback
, file_dialog_unmap_cb
,
11647 (XtPointer
) &result
);
11649 /* Disable the help button since we can't display help. */
11650 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11651 XtSetSensitive (help
, False
);
11653 /* Mark OK button as default. */
11654 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11655 XmNshowAsDefault
, True
, NULL
);
11657 /* If MUSTMATCH is non-nil, disable the file entry field of the
11658 dialog, so that the user must select a file from the files list
11659 box. We can't remove it because we wouldn't have a way to get at
11660 the result file name, then. */
11661 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11662 if (!NILP (mustmatch
))
11665 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11666 XtSetSensitive (text
, False
);
11667 XtSetSensitive (label
, False
);
11670 /* Manage the dialog, so that list boxes get filled. */
11671 XtManageChild (dialog
);
11673 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11674 must include the path for this to work. */
11675 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11676 if (STRINGP (default_filename
))
11678 XmString default_xmstring
;
11682 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11684 if (!XmListItemExists (list
, default_xmstring
))
11686 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11687 XmListAddItem (list
, default_xmstring
, 0);
11691 item_pos
= XmListItemPos (list
, default_xmstring
);
11692 XmStringFree (default_xmstring
);
11694 /* Select the item and scroll it into view. */
11695 XmListSelectPos (list
, item_pos
, True
);
11696 XmListSetPos (list
, item_pos
);
11699 /* Process events until the user presses Cancel or OK. Block
11700 and unblock input here so that we get a chance of processing
11704 while (result
== 0)
11707 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11712 /* Get the result. */
11713 if (result
== XmCR_OK
)
11718 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11719 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11720 XmStringFree (text
);
11721 file
= build_string (data
);
11728 XtUnmanageChild (dialog
);
11729 XtDestroyWidget (dialog
);
11733 /* Make "Cancel" equivalent to C-g. */
11735 Fsignal (Qquit
, Qnil
);
11737 return unbind_to (count
, file
);
11740 #endif /* USE_MOTIF */
11744 /***********************************************************************
11746 ***********************************************************************/
11748 #ifdef HAVE_XKBGETKEYBOARD
11749 #include <X11/XKBlib.h>
11750 #include <X11/keysym.h>
11753 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11754 Sx_backspace_delete_keys_p
, 0, 1, 0,
11755 doc
: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
11756 FRAME nil means use the selected frame.
11757 Value is t if we know that both keys are present, and are mapped to the
11758 usual X keysyms. */)
11762 #ifdef HAVE_XKBGETKEYBOARD
11764 struct frame
*f
= check_x_frame (frame
);
11765 Display
*dpy
= FRAME_X_DISPLAY (f
);
11766 Lisp_Object have_keys
;
11767 int major
, minor
, op
, event
, error
;
11771 /* Check library version in case we're dynamically linked. */
11772 major
= XkbMajorVersion
;
11773 minor
= XkbMinorVersion
;
11774 if (!XkbLibraryVersion (&major
, &minor
))
11780 /* Check that the server supports XKB. */
11781 major
= XkbMajorVersion
;
11782 minor
= XkbMinorVersion
;
11783 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11790 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11793 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11795 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11797 for (i
= kb
->min_key_code
;
11798 (i
< kb
->max_key_code
11799 && (delete_keycode
== 0 || backspace_keycode
== 0));
11802 /* The XKB symbolic key names can be seen most easily in
11803 the PS file generated by `xkbprint -label name
11805 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11806 delete_keycode
= i
;
11807 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11808 backspace_keycode
= i
;
11811 XkbFreeNames (kb
, 0, True
);
11814 XkbFreeClientMap (kb
, 0, True
);
11817 && backspace_keycode
11818 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11819 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11824 #else /* not HAVE_XKBGETKEYBOARD */
11826 #endif /* not HAVE_XKBGETKEYBOARD */
11831 /***********************************************************************
11833 ***********************************************************************/
11838 /* This is zero if not using X windows. */
11841 /* The section below is built by the lisp expression at the top of the file,
11842 just above where these variables are declared. */
11843 /*&&& init symbols here &&&*/
11844 Qauto_raise
= intern ("auto-raise");
11845 staticpro (&Qauto_raise
);
11846 Qauto_lower
= intern ("auto-lower");
11847 staticpro (&Qauto_lower
);
11848 Qbar
= intern ("bar");
11850 Qhbar
= intern ("hbar");
11851 staticpro (&Qhbar
);
11852 Qborder_color
= intern ("border-color");
11853 staticpro (&Qborder_color
);
11854 Qborder_width
= intern ("border-width");
11855 staticpro (&Qborder_width
);
11856 Qbox
= intern ("box");
11858 Qcursor_color
= intern ("cursor-color");
11859 staticpro (&Qcursor_color
);
11860 Qcursor_type
= intern ("cursor-type");
11861 staticpro (&Qcursor_type
);
11862 Qgeometry
= intern ("geometry");
11863 staticpro (&Qgeometry
);
11864 Qicon_left
= intern ("icon-left");
11865 staticpro (&Qicon_left
);
11866 Qicon_top
= intern ("icon-top");
11867 staticpro (&Qicon_top
);
11868 Qicon_type
= intern ("icon-type");
11869 staticpro (&Qicon_type
);
11870 Qicon_name
= intern ("icon-name");
11871 staticpro (&Qicon_name
);
11872 Qinternal_border_width
= intern ("internal-border-width");
11873 staticpro (&Qinternal_border_width
);
11874 Qleft
= intern ("left");
11875 staticpro (&Qleft
);
11876 Qright
= intern ("right");
11877 staticpro (&Qright
);
11878 Qmouse_color
= intern ("mouse-color");
11879 staticpro (&Qmouse_color
);
11880 Qnone
= intern ("none");
11881 staticpro (&Qnone
);
11882 Qparent_id
= intern ("parent-id");
11883 staticpro (&Qparent_id
);
11884 Qscroll_bar_width
= intern ("scroll-bar-width");
11885 staticpro (&Qscroll_bar_width
);
11886 Qsuppress_icon
= intern ("suppress-icon");
11887 staticpro (&Qsuppress_icon
);
11888 Qundefined_color
= intern ("undefined-color");
11889 staticpro (&Qundefined_color
);
11890 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11891 staticpro (&Qvertical_scroll_bars
);
11892 Qvisibility
= intern ("visibility");
11893 staticpro (&Qvisibility
);
11894 Qwindow_id
= intern ("window-id");
11895 staticpro (&Qwindow_id
);
11896 Qouter_window_id
= intern ("outer-window-id");
11897 staticpro (&Qouter_window_id
);
11898 Qx_frame_parameter
= intern ("x-frame-parameter");
11899 staticpro (&Qx_frame_parameter
);
11900 Qx_resource_name
= intern ("x-resource-name");
11901 staticpro (&Qx_resource_name
);
11902 Quser_position
= intern ("user-position");
11903 staticpro (&Quser_position
);
11904 Quser_size
= intern ("user-size");
11905 staticpro (&Quser_size
);
11906 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11907 staticpro (&Qscroll_bar_foreground
);
11908 Qscroll_bar_background
= intern ("scroll-bar-background");
11909 staticpro (&Qscroll_bar_background
);
11910 Qscreen_gamma
= intern ("screen-gamma");
11911 staticpro (&Qscreen_gamma
);
11912 Qline_spacing
= intern ("line-spacing");
11913 staticpro (&Qline_spacing
);
11914 Qcenter
= intern ("center");
11915 staticpro (&Qcenter
);
11916 Qcompound_text
= intern ("compound-text");
11917 staticpro (&Qcompound_text
);
11918 Qcancel_timer
= intern ("cancel-timer");
11919 staticpro (&Qcancel_timer
);
11920 Qwait_for_wm
= intern ("wait-for-wm");
11921 staticpro (&Qwait_for_wm
);
11922 Qfullscreen
= intern ("fullscreen");
11923 staticpro (&Qfullscreen
);
11924 Qfullwidth
= intern ("fullwidth");
11925 staticpro (&Qfullwidth
);
11926 Qfullheight
= intern ("fullheight");
11927 staticpro (&Qfullheight
);
11928 Qfullboth
= intern ("fullboth");
11929 staticpro (&Qfullboth
);
11930 /* This is the end of symbol initialization. */
11932 /* Text property `display' should be nonsticky by default. */
11933 Vtext_property_default_nonsticky
11934 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11937 Qlaplace
= intern ("laplace");
11938 staticpro (&Qlaplace
);
11939 Qemboss
= intern ("emboss");
11940 staticpro (&Qemboss
);
11941 Qedge_detection
= intern ("edge-detection");
11942 staticpro (&Qedge_detection
);
11943 Qheuristic
= intern ("heuristic");
11944 staticpro (&Qheuristic
);
11945 QCmatrix
= intern (":matrix");
11946 staticpro (&QCmatrix
);
11947 QCcolor_adjustment
= intern (":color-adjustment");
11948 staticpro (&QCcolor_adjustment
);
11949 QCmask
= intern (":mask");
11950 staticpro (&QCmask
);
11952 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11953 staticpro (&Qface_set_after_frame_default
);
11955 Fput (Qundefined_color
, Qerror_conditions
,
11956 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11957 Fput (Qundefined_color
, Qerror_message
,
11958 build_string ("Undefined color"));
11960 init_x_parm_symbols ();
11962 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11963 doc
: /* Non-nil means always draw a cross over disabled images.
11964 Disabled images are those having an `:conversion disabled' property.
11965 A cross is always drawn on black & white displays. */);
11966 cross_disabled_images
= 0;
11968 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11969 doc
: /* List of directories to search for bitmap files for X. */);
11970 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11972 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11973 doc
: /* The shape of the pointer when over text.
11974 Changing the value does not affect existing frames
11975 unless you set the mouse color. */);
11976 Vx_pointer_shape
= Qnil
;
11978 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11979 doc
: /* The name Emacs uses to look up X resources.
11980 `x-get-resource' uses this as the first component of the instance name
11981 when requesting resource values.
11982 Emacs initially sets `x-resource-name' to the name under which Emacs
11983 was invoked, or to the value specified with the `-name' or `-rn'
11984 switches, if present.
11986 It may be useful to bind this variable locally around a call
11987 to `x-get-resource'. See also the variable `x-resource-class'. */);
11988 Vx_resource_name
= Qnil
;
11990 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11991 doc
: /* The class Emacs uses to look up X resources.
11992 `x-get-resource' uses this as the first component of the instance class
11993 when requesting resource values.
11995 Emacs initially sets `x-resource-class' to "Emacs".
11997 Setting this variable permanently is not a reasonable thing to do,
11998 but binding this variable locally around a call to `x-get-resource'
11999 is a reasonable practice. See also the variable `x-resource-name'. */);
12000 Vx_resource_class
= build_string (EMACS_CLASS
);
12002 #if 0 /* This doesn't really do anything. */
12003 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
12004 doc
: /* The shape of the pointer when not over text.
12005 This variable takes effect when you create a new frame
12006 or when you set the mouse color. */);
12008 Vx_nontext_pointer_shape
= Qnil
;
12010 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
12011 doc
: /* The shape of the pointer when Emacs is busy.
12012 This variable takes effect when you create a new frame
12013 or when you set the mouse color. */);
12014 Vx_hourglass_pointer_shape
= Qnil
;
12016 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
12017 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
12018 display_hourglass_p
= 1;
12020 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
12021 doc
: /* *Seconds to wait before displaying an hourglass pointer.
12022 Value must be an integer or float. */);
12023 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
12025 #if 0 /* This doesn't really do anything. */
12026 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
12027 doc
: /* The shape of the pointer when over the mode line.
12028 This variable takes effect when you create a new frame
12029 or when you set the mouse color. */);
12031 Vx_mode_pointer_shape
= Qnil
;
12033 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
12034 &Vx_sensitive_text_pointer_shape
,
12035 doc
: /* The shape of the pointer when over mouse-sensitive text.
12036 This variable takes effect when you create a new frame
12037 or when you set the mouse color. */);
12038 Vx_sensitive_text_pointer_shape
= Qnil
;
12040 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
12041 &Vx_window_horizontal_drag_shape
,
12042 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
12043 This variable takes effect when you create a new frame
12044 or when you set the mouse color. */);
12045 Vx_window_horizontal_drag_shape
= Qnil
;
12047 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
12048 doc
: /* A string indicating the foreground color of the cursor box. */);
12049 Vx_cursor_fore_pixel
= Qnil
;
12051 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
12052 doc
: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
12053 Text larger than this is clipped. */);
12054 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
12056 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
12057 doc
: /* Non-nil if no X window manager is in use.
12058 Emacs doesn't try to figure this out; this is always nil
12059 unless you set it to something else. */);
12060 /* We don't have any way to find this out, so set it to nil
12061 and maybe the user would like to set it to t. */
12062 Vx_no_window_manager
= Qnil
;
12064 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
12065 &Vx_pixel_size_width_font_regexp
,
12066 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
12068 Since Emacs gets width of a font matching with this regexp from
12069 PIXEL_SIZE field of the name, font finding mechanism gets faster for
12070 such a font. This is especially effective for such large fonts as
12071 Chinese, Japanese, and Korean. */);
12072 Vx_pixel_size_width_font_regexp
= Qnil
;
12074 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
12075 doc
: /* Time after which cached images are removed from the cache.
12076 When an image has not been displayed this many seconds, remove it
12077 from the image cache. Value must be an integer or nil with nil
12078 meaning don't clear the cache. */);
12079 Vimage_cache_eviction_delay
= make_number (30 * 60);
12081 #ifdef USE_X_TOOLKIT
12082 Fprovide (intern ("x-toolkit"), Qnil
);
12084 Fprovide (intern ("motif"), Qnil
);
12086 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string
,
12087 doc
: /* Version info for LessTif/Motif. */);
12088 Vmotif_version_string
= build_string (XmVERSION_STRING
);
12089 #endif /* USE_MOTIF */
12090 #endif /* USE_X_TOOLKIT */
12092 defsubr (&Sx_get_resource
);
12094 /* X window properties. */
12095 defsubr (&Sx_change_window_property
);
12096 defsubr (&Sx_delete_window_property
);
12097 defsubr (&Sx_window_property
);
12099 defsubr (&Sxw_display_color_p
);
12100 defsubr (&Sx_display_grayscale_p
);
12101 defsubr (&Sxw_color_defined_p
);
12102 defsubr (&Sxw_color_values
);
12103 defsubr (&Sx_server_max_request_size
);
12104 defsubr (&Sx_server_vendor
);
12105 defsubr (&Sx_server_version
);
12106 defsubr (&Sx_display_pixel_width
);
12107 defsubr (&Sx_display_pixel_height
);
12108 defsubr (&Sx_display_mm_width
);
12109 defsubr (&Sx_display_mm_height
);
12110 defsubr (&Sx_display_screens
);
12111 defsubr (&Sx_display_planes
);
12112 defsubr (&Sx_display_color_cells
);
12113 defsubr (&Sx_display_visual_class
);
12114 defsubr (&Sx_display_backing_store
);
12115 defsubr (&Sx_display_save_under
);
12116 defsubr (&Sx_parse_geometry
);
12117 defsubr (&Sx_create_frame
);
12118 defsubr (&Sx_open_connection
);
12119 defsubr (&Sx_close_connection
);
12120 defsubr (&Sx_display_list
);
12121 defsubr (&Sx_synchronize
);
12122 defsubr (&Sx_focus_frame
);
12123 defsubr (&Sx_backspace_delete_keys_p
);
12125 /* Setting callback functions for fontset handler. */
12126 get_font_info_func
= x_get_font_info
;
12128 #if 0 /* This function pointer doesn't seem to be used anywhere.
12129 And the pointer assigned has the wrong type, anyway. */
12130 list_fonts_func
= x_list_fonts
;
12133 load_font_func
= x_load_font
;
12134 find_ccl_program_func
= x_find_ccl_program
;
12135 query_font_func
= x_query_font
;
12136 set_frame_fontset_func
= x_set_font
;
12137 check_window_system_func
= check_x
;
12140 Qxbm
= intern ("xbm");
12142 QCconversion
= intern (":conversion");
12143 staticpro (&QCconversion
);
12144 QCheuristic_mask
= intern (":heuristic-mask");
12145 staticpro (&QCheuristic_mask
);
12146 QCcolor_symbols
= intern (":color-symbols");
12147 staticpro (&QCcolor_symbols
);
12148 QCascent
= intern (":ascent");
12149 staticpro (&QCascent
);
12150 QCmargin
= intern (":margin");
12151 staticpro (&QCmargin
);
12152 QCrelief
= intern (":relief");
12153 staticpro (&QCrelief
);
12154 Qpostscript
= intern ("postscript");
12155 staticpro (&Qpostscript
);
12156 QCloader
= intern (":loader");
12157 staticpro (&QCloader
);
12158 QCbounding_box
= intern (":bounding-box");
12159 staticpro (&QCbounding_box
);
12160 QCpt_width
= intern (":pt-width");
12161 staticpro (&QCpt_width
);
12162 QCpt_height
= intern (":pt-height");
12163 staticpro (&QCpt_height
);
12164 QCindex
= intern (":index");
12165 staticpro (&QCindex
);
12166 Qpbm
= intern ("pbm");
12170 Qxpm
= intern ("xpm");
12175 Qjpeg
= intern ("jpeg");
12176 staticpro (&Qjpeg
);
12180 Qtiff
= intern ("tiff");
12181 staticpro (&Qtiff
);
12185 Qgif
= intern ("gif");
12190 Qpng
= intern ("png");
12194 defsubr (&Sclear_image_cache
);
12195 defsubr (&Simage_size
);
12196 defsubr (&Simage_mask_p
);
12198 hourglass_atimer
= NULL
;
12199 hourglass_shown_p
= 0;
12201 defsubr (&Sx_show_tip
);
12202 defsubr (&Sx_hide_tip
);
12204 staticpro (&tip_timer
);
12206 staticpro (&tip_frame
);
12208 last_show_tip_args
= Qnil
;
12209 staticpro (&last_show_tip_args
);
12212 defsubr (&Sx_file_dialog
);
12220 image_types
= NULL
;
12221 Vimage_types
= Qnil
;
12223 define_image_type (&xbm_type
);
12224 define_image_type (&gs_type
);
12225 define_image_type (&pbm_type
);
12228 define_image_type (&xpm_type
);
12232 define_image_type (&jpeg_type
);
12236 define_image_type (&tiff_type
);
12240 define_image_type (&gif_type
);
12244 define_image_type (&png_type
);
12248 #endif /* HAVE_X_WINDOWS */