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"
73 #include <X11/Shell.h>
76 #include <X11/Xaw/Paned.h>
77 #include <X11/Xaw/Label.h>
78 #endif /* USE_MOTIF */
81 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
90 #include "../lwlib/lwlib.h"
94 #include <Xm/DialogS.h>
95 #include <Xm/FileSB.h>
98 /* Do the EDITRES protocol if running X11R5
99 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
101 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
103 extern void _XEditResCheckMessages ();
104 #endif /* R5 + Athena */
106 /* Unique id counter for widgets created by the Lucid Widget Library. */
108 extern LWLIB_ID widget_id_tick
;
111 /* This is part of a kludge--see lwlib/xlwmenu.c. */
112 extern XFontStruct
*xlwmenu_default_font
;
115 extern void free_frame_menubar ();
116 extern double atof ();
120 /* LessTif/Motif version info. */
122 static Lisp_Object Vmotif_version_string
;
124 #endif /* USE_MOTIF */
126 #endif /* USE_X_TOOLKIT */
129 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
131 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
134 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
135 it, and including `bitmaps/gray' more than once is a problem when
136 config.h defines `static' as an empty replacement string. */
138 int gray_bitmap_width
= gray_width
;
139 int gray_bitmap_height
= gray_height
;
140 char *gray_bitmap_bits
= gray_bits
;
142 /* The name we're using in resource queries. Most often "emacs". */
144 Lisp_Object Vx_resource_name
;
146 /* The application class we're using in resource queries.
149 Lisp_Object Vx_resource_class
;
151 /* Non-zero means we're allowed to display an hourglass cursor. */
153 int display_hourglass_p
;
155 /* The background and shape of the mouse pointer, and shape when not
156 over text or in the modeline. */
158 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
159 Lisp_Object Vx_hourglass_pointer_shape
;
161 /* The shape when over mouse-sensitive text. */
163 Lisp_Object Vx_sensitive_text_pointer_shape
;
165 /* If non-nil, the pointer shape to indicate that windows can be
166 dragged horizontally. */
168 Lisp_Object Vx_window_horizontal_drag_shape
;
170 /* Color of chars displayed in cursor box. */
172 Lisp_Object Vx_cursor_fore_pixel
;
174 /* Nonzero if using X. */
178 /* Non nil if no window manager is in use. */
180 Lisp_Object Vx_no_window_manager
;
182 /* Search path for bitmap files. */
184 Lisp_Object Vx_bitmap_file_path
;
186 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
188 Lisp_Object Vx_pixel_size_width_font_regexp
;
190 Lisp_Object Qauto_raise
;
191 Lisp_Object Qauto_lower
;
192 Lisp_Object Qborder_color
;
193 Lisp_Object Qborder_width
;
194 extern Lisp_Object Qbox
;
195 Lisp_Object Qcursor_color
;
196 Lisp_Object Qcursor_type
;
197 Lisp_Object Qgeometry
;
198 Lisp_Object Qicon_left
;
199 Lisp_Object Qicon_top
;
200 Lisp_Object Qicon_type
;
201 Lisp_Object Qicon_name
;
202 Lisp_Object Qinternal_border_width
;
205 Lisp_Object Qmouse_color
;
207 Lisp_Object Qouter_window_id
;
208 Lisp_Object Qparent_id
;
209 Lisp_Object Qscroll_bar_width
;
210 Lisp_Object Qsuppress_icon
;
211 extern Lisp_Object Qtop
;
212 Lisp_Object Qundefined_color
;
213 Lisp_Object Qvertical_scroll_bars
;
214 Lisp_Object Qvisibility
;
215 Lisp_Object Qwindow_id
;
216 Lisp_Object Qx_frame_parameter
;
217 Lisp_Object Qx_resource_name
;
218 Lisp_Object Quser_position
;
219 Lisp_Object Quser_size
;
220 extern Lisp_Object Qdisplay
;
221 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
222 Lisp_Object Qscreen_gamma
, Qline_spacing
, Qcenter
;
223 Lisp_Object Qcompound_text
, Qcancel_timer
;
224 Lisp_Object Qwait_for_wm
;
225 Lisp_Object Qfullscreen
;
226 Lisp_Object Qfullwidth
;
227 Lisp_Object Qfullheight
;
228 Lisp_Object Qfullboth
;
230 /* The below are defined in frame.c. */
232 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
233 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
234 extern Lisp_Object Qtool_bar_lines
;
236 extern Lisp_Object Vwindow_system_version
;
238 Lisp_Object Qface_set_after_frame_default
;
241 int image_cache_refcount
, dpyinfo_refcount
;
246 /* Error if we are not connected to X. */
252 error ("X windows are not in use or not initialized");
255 /* Nonzero if we can use mouse menus.
256 You should not call this unless HAVE_MENUS is defined. */
264 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
265 and checking validity for X. */
268 check_x_frame (frame
)
274 frame
= selected_frame
;
275 CHECK_LIVE_FRAME (frame
);
278 error ("Non-X frame used");
282 /* Let the user specify an X display with a frame.
283 nil stands for the selected frame--or, if that is not an X frame,
284 the first X display on the list. */
286 static struct x_display_info
*
287 check_x_display_info (frame
)
290 struct x_display_info
*dpyinfo
= NULL
;
294 struct frame
*sf
= XFRAME (selected_frame
);
296 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
297 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
298 else if (x_display_list
!= 0)
299 dpyinfo
= x_display_list
;
301 error ("X windows are not in use or not initialized");
303 else if (STRINGP (frame
))
304 dpyinfo
= x_display_info_for_name (frame
);
307 FRAME_PTR f
= check_x_frame (frame
);
308 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
315 /* Return the Emacs frame-object corresponding to an X window.
316 It could be the frame's main window or an icon window. */
318 /* This function can be called during GC, so use GC_xxx type test macros. */
321 x_window_to_frame (dpyinfo
, wdesc
)
322 struct x_display_info
*dpyinfo
;
325 Lisp_Object tail
, frame
;
328 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
331 if (!GC_FRAMEP (frame
))
334 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
336 if (f
->output_data
.x
->hourglass_window
== wdesc
)
339 if ((f
->output_data
.x
->edit_widget
340 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
341 /* A tooltip frame? */
342 || (!f
->output_data
.x
->edit_widget
343 && FRAME_X_WINDOW (f
) == wdesc
)
344 || f
->output_data
.x
->icon_desc
== wdesc
)
346 #else /* not USE_X_TOOLKIT */
348 if (f
->output_data
.x
->edit_widget
)
350 GtkWidget
*gwdesc
= xg_win_to_widget (wdesc
);
351 struct x_output
*x
= f
->output_data
.x
;
352 if (gwdesc
!= 0 && gwdesc
== x
->edit_widget
)
356 if (FRAME_X_WINDOW (f
) == wdesc
357 || f
->output_data
.x
->icon_desc
== wdesc
)
359 #endif /* not USE_X_TOOLKIT */
364 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
365 /* Like x_window_to_frame but also compares the window with the widget's
369 x_any_window_to_frame (dpyinfo
, wdesc
)
370 struct x_display_info
*dpyinfo
;
373 Lisp_Object tail
, frame
;
374 struct frame
*f
, *found
;
378 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
381 if (!GC_FRAMEP (frame
))
385 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
387 /* This frame matches if the window is any of its widgets. */
388 x
= f
->output_data
.x
;
389 if (x
->hourglass_window
== wdesc
)
394 GtkWidget
*gwdesc
= xg_win_to_widget (wdesc
);
396 && (gwdesc
== x
->widget
397 || gwdesc
== x
->edit_widget
398 || gwdesc
== x
->vbox_widget
399 || gwdesc
== x
->menubar_widget
))
402 if (wdesc
== XtWindow (x
->widget
)
403 || wdesc
== XtWindow (x
->column_widget
)
404 || wdesc
== XtWindow (x
->edit_widget
))
406 /* Match if the window is this frame's menubar. */
407 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
411 else if (FRAME_X_WINDOW (f
) == wdesc
)
412 /* A tooltip frame. */
420 /* Likewise, but exclude the menu bar widget. */
423 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
424 struct x_display_info
*dpyinfo
;
427 Lisp_Object tail
, frame
;
431 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
434 if (!GC_FRAMEP (frame
))
437 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
439 x
= f
->output_data
.x
;
440 /* This frame matches if the window is any of its widgets. */
441 if (x
->hourglass_window
== wdesc
)
446 GtkWidget
*gwdesc
= xg_win_to_widget (wdesc
);
448 && (gwdesc
== x
->widget
449 || gwdesc
== x
->edit_widget
450 || gwdesc
== x
->vbox_widget
))
453 if (wdesc
== XtWindow (x
->widget
)
454 || wdesc
== XtWindow (x
->column_widget
)
455 || wdesc
== XtWindow (x
->edit_widget
))
459 else if (FRAME_X_WINDOW (f
) == wdesc
)
460 /* A tooltip frame. */
466 /* Likewise, but consider only the menu bar widget. */
469 x_menubar_window_to_frame (dpyinfo
, wdesc
)
470 struct x_display_info
*dpyinfo
;
473 Lisp_Object tail
, frame
;
477 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
480 if (!GC_FRAMEP (frame
))
483 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
485 x
= f
->output_data
.x
;
486 /* Match if the window is this frame's menubar. */
488 if (x
->menubar_widget
)
490 GtkWidget
*gwdesc
= xg_win_to_widget (wdesc
);
495 && (gwdesc
== x
->menubar_widget
496 || gtk_widget_get_parent (gwdesc
) == x
->menubar_widget
))
502 if (x
->menubar_widget
503 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
510 /* Return the frame whose principal (outermost) window is WDESC.
511 If WDESC is some other (smaller) window, we return 0. */
514 x_top_window_to_frame (dpyinfo
, wdesc
)
515 struct x_display_info
*dpyinfo
;
518 Lisp_Object tail
, frame
;
522 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
525 if (!GC_FRAMEP (frame
))
528 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
530 x
= f
->output_data
.x
;
534 /* This frame matches if the window is its topmost widget. */
536 GtkWidget
*gwdesc
= xg_win_to_widget (wdesc
);
537 if (gwdesc
== x
->widget
)
540 if (wdesc
== XtWindow (x
->widget
))
542 #if 0 /* I don't know why it did this,
543 but it seems logically wrong,
544 and it causes trouble for MapNotify events. */
545 /* Match if the window is this frame's menubar. */
546 if (x
->menubar_widget
547 && wdesc
== XtWindow (x
->menubar_widget
))
552 else if (FRAME_X_WINDOW (f
) == wdesc
)
558 #endif /* USE_X_TOOLKIT || USE_GTK */
562 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
563 id, which is just an int that this section returns. Bitmaps are
564 reference counted so they can be shared among frames.
566 Bitmap indices are guaranteed to be > 0, so a negative number can
567 be used to indicate no bitmap.
569 If you use x_create_bitmap_from_data, then you must keep track of
570 the bitmaps yourself. That is, creating a bitmap from the same
571 data more than once will not be caught. */
574 /* Functions to access the contents of a bitmap, given an id. */
577 x_bitmap_height (f
, id
)
581 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
585 x_bitmap_width (f
, id
)
589 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
593 x_bitmap_pixmap (f
, id
)
597 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
601 /* Allocate a new bitmap record. Returns index of new record. */
604 x_allocate_bitmap_record (f
)
607 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
610 if (dpyinfo
->bitmaps
== NULL
)
612 dpyinfo
->bitmaps_size
= 10;
614 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
615 dpyinfo
->bitmaps_last
= 1;
619 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
620 return ++dpyinfo
->bitmaps_last
;
622 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
623 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
626 dpyinfo
->bitmaps_size
*= 2;
628 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
629 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
630 return ++dpyinfo
->bitmaps_last
;
633 /* Add one reference to the reference count of the bitmap with id ID. */
636 x_reference_bitmap (f
, id
)
640 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
643 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
646 x_create_bitmap_from_data (f
, bits
, width
, height
)
649 unsigned int width
, height
;
651 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
655 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
656 bits
, width
, height
);
661 id
= x_allocate_bitmap_record (f
);
662 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
663 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
664 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
665 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
666 dpyinfo
->bitmaps
[id
- 1].height
= height
;
667 dpyinfo
->bitmaps
[id
- 1].width
= width
;
672 /* Create bitmap from file FILE for frame F. */
675 x_create_bitmap_from_file (f
, file
)
679 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
680 unsigned int width
, height
;
682 int xhot
, yhot
, result
, id
;
687 /* Look for an existing bitmap with the same name. */
688 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
690 if (dpyinfo
->bitmaps
[id
].refcount
691 && dpyinfo
->bitmaps
[id
].file
692 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) SDATA (file
)))
694 ++dpyinfo
->bitmaps
[id
].refcount
;
699 /* Search bitmap-file-path for the file, if appropriate. */
700 fd
= openp (Vx_bitmap_file_path
, file
, Qnil
, &found
, Qnil
);
705 filename
= (char *) SDATA (found
);
707 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
708 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
709 if (result
!= BitmapSuccess
)
712 id
= x_allocate_bitmap_record (f
);
713 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
714 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
715 dpyinfo
->bitmaps
[id
- 1].file
716 = (char *) xmalloc (SBYTES (file
) + 1);
717 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
718 dpyinfo
->bitmaps
[id
- 1].height
= height
;
719 dpyinfo
->bitmaps
[id
- 1].width
= width
;
720 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, SDATA (file
));
725 /* Remove reference to bitmap with id number ID. */
728 x_destroy_bitmap (f
, id
)
732 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
736 --dpyinfo
->bitmaps
[id
- 1].refcount
;
737 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
740 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
741 if (dpyinfo
->bitmaps
[id
- 1].file
)
743 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
744 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
751 /* Free all the bitmaps for the display specified by DPYINFO. */
754 x_destroy_all_bitmaps (dpyinfo
)
755 struct x_display_info
*dpyinfo
;
758 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
759 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
761 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
762 if (dpyinfo
->bitmaps
[i
].file
)
763 xfree (dpyinfo
->bitmaps
[i
].file
);
765 dpyinfo
->bitmaps_last
= 0;
768 /* Connect the frame-parameter names for X frames
769 to the ways of passing the parameter values to the window system.
771 The name of a parameter, as a Lisp symbol,
772 has an `x-frame-parameter' property which is an integer in Lisp
773 that is an index in this table. */
775 struct x_frame_parm_table
778 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
781 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
782 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
783 static void x_change_window_heights
P_ ((Lisp_Object
, int));
784 static void x_disable_image
P_ ((struct frame
*, struct image
*));
785 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
786 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
787 static void x_set_wait_for_wm
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
788 static void x_set_fullscreen
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
789 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
790 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
791 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
792 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
793 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
794 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
795 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
796 static void x_set_fringe_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
797 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
798 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
799 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
801 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
802 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
803 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
804 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
806 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
807 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
808 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
809 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
810 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
811 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
812 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
814 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
816 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
821 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
822 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
824 static void init_color_table
P_ ((void));
825 static void free_color_table
P_ ((void));
826 static unsigned long *colors_in_color_table
P_ ((int *n
));
827 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
828 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
832 static struct x_frame_parm_table x_frame_parms
[] =
834 {"auto-raise", x_set_autoraise
},
835 {"auto-lower", x_set_autolower
},
836 {"background-color", x_set_background_color
},
837 {"border-color", x_set_border_color
},
838 {"border-width", x_set_border_width
},
839 {"cursor-color", x_set_cursor_color
},
840 {"cursor-type", x_set_cursor_type
},
841 {"font", x_set_font
},
842 {"foreground-color", x_set_foreground_color
},
843 {"icon-name", x_set_icon_name
},
844 {"icon-type", x_set_icon_type
},
845 {"internal-border-width", x_set_internal_border_width
},
846 {"menu-bar-lines", x_set_menu_bar_lines
},
847 {"mouse-color", x_set_mouse_color
},
848 {"name", x_explicitly_set_name
},
849 {"scroll-bar-width", x_set_scroll_bar_width
},
850 {"title", x_set_title
},
851 {"unsplittable", x_set_unsplittable
},
852 {"vertical-scroll-bars", x_set_vertical_scroll_bars
},
853 {"visibility", x_set_visibility
},
854 {"tool-bar-lines", x_set_tool_bar_lines
},
855 {"scroll-bar-foreground", x_set_scroll_bar_foreground
},
856 {"scroll-bar-background", x_set_scroll_bar_background
},
857 {"screen-gamma", x_set_screen_gamma
},
858 {"line-spacing", x_set_line_spacing
},
859 {"left-fringe", x_set_fringe_width
},
860 {"right-fringe", x_set_fringe_width
},
861 {"wait-for-wm", x_set_wait_for_wm
},
862 {"fullscreen", x_set_fullscreen
},
866 /* Attach the `x-frame-parameter' properties to
867 the Lisp symbol names of parameters relevant to X. */
870 init_x_parm_symbols ()
874 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
875 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
880 /* Really try to move where we want to be in case of fullscreen. Some WMs
881 moves the window where we tell them. Some (mwm, twm) moves the outer
882 window manager window there instead.
883 Try to compensate for those WM here. */
885 x_fullscreen_move (f
, new_top
, new_left
)
890 if (new_top
!= f
->output_data
.x
->top_pos
891 || new_left
!= f
->output_data
.x
->left_pos
)
893 int move_x
= new_left
+ f
->output_data
.x
->x_pixels_outer_diff
;
894 int move_y
= new_top
+ f
->output_data
.x
->y_pixels_outer_diff
;
896 f
->output_data
.x
->want_fullscreen
|= FULLSCREEN_MOVE_WAIT
;
897 x_set_offset (f
, move_x
, move_y
, 1);
901 /* Change the parameters of frame F as specified by ALIST.
902 If a parameter is not specially recognized, do nothing special;
903 otherwise call the `x_set_...' function for that parameter.
904 Except for certain geometry properties, always call store_frame_param
905 to store the new value in the parameter alist. */
908 x_set_frame_parameters (f
, alist
)
914 /* If both of these parameters are present, it's more efficient to
915 set them both at once. So we wait until we've looked at the
916 entire list before we set them. */
920 Lisp_Object left
, top
;
922 /* Same with these. */
923 Lisp_Object icon_left
, icon_top
;
925 /* Record in these vectors all the parms specified. */
929 int left_no_change
= 0, top_no_change
= 0;
930 int icon_left_no_change
= 0, icon_top_no_change
= 0;
931 int fullscreen_is_being_set
= 0;
933 struct gcpro gcpro1
, gcpro2
;
936 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
939 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
940 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
942 /* Extract parm names and values into those vectors. */
945 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
950 parms
[i
] = Fcar (elt
);
951 values
[i
] = Fcdr (elt
);
954 /* TAIL and ALIST are not used again below here. */
957 GCPRO2 (*parms
, *values
);
961 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
962 because their values appear in VALUES and strings are not valid. */
963 top
= left
= Qunbound
;
964 icon_left
= icon_top
= Qunbound
;
966 /* Provide default values for HEIGHT and WIDTH. */
967 if (FRAME_NEW_WIDTH (f
))
968 width
= FRAME_NEW_WIDTH (f
);
970 width
= FRAME_WIDTH (f
);
972 if (FRAME_NEW_HEIGHT (f
))
973 height
= FRAME_NEW_HEIGHT (f
);
975 height
= FRAME_HEIGHT (f
);
977 /* Process foreground_color and background_color before anything else.
978 They are independent of other properties, but other properties (e.g.,
979 cursor_color) are dependent upon them. */
980 /* Process default font as well, since fringe widths depends on it. */
981 /* Also, process fullscreen, width and height depend upon that */
982 for (p
= 0; p
< i
; p
++)
984 Lisp_Object prop
, val
;
988 if (EQ (prop
, Qforeground_color
)
989 || EQ (prop
, Qbackground_color
)
991 || EQ (prop
, Qfullscreen
))
993 register Lisp_Object param_index
, old_value
;
995 old_value
= get_frame_param (f
, prop
);
996 fullscreen_is_being_set
|= EQ (prop
, Qfullscreen
);
998 if (NILP (Fequal (val
, old_value
)))
1000 store_frame_param (f
, prop
, val
);
1002 param_index
= Fget (prop
, Qx_frame_parameter
);
1003 if (NATNUMP (param_index
)
1004 && (XFASTINT (param_index
)
1005 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
1006 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
1011 /* Now process them in reverse of specified order. */
1012 for (i
--; i
>= 0; i
--)
1014 Lisp_Object prop
, val
;
1019 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
1020 width
= XFASTINT (val
);
1021 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
1022 height
= XFASTINT (val
);
1023 else if (EQ (prop
, Qtop
))
1025 else if (EQ (prop
, Qleft
))
1027 else if (EQ (prop
, Qicon_top
))
1029 else if (EQ (prop
, Qicon_left
))
1031 else if (EQ (prop
, Qforeground_color
)
1032 || EQ (prop
, Qbackground_color
)
1034 || EQ (prop
, Qfullscreen
))
1035 /* Processed above. */
1039 register Lisp_Object param_index
, old_value
;
1041 old_value
= get_frame_param (f
, prop
);
1043 store_frame_param (f
, prop
, val
);
1045 param_index
= Fget (prop
, Qx_frame_parameter
);
1046 if (NATNUMP (param_index
)
1047 && (XFASTINT (param_index
)
1048 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
1049 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
1053 /* Don't die if just one of these was set. */
1054 if (EQ (left
, Qunbound
))
1057 if (f
->output_data
.x
->left_pos
< 0)
1058 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
1060 XSETINT (left
, f
->output_data
.x
->left_pos
);
1062 if (EQ (top
, Qunbound
))
1065 if (f
->output_data
.x
->top_pos
< 0)
1066 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
1068 XSETINT (top
, f
->output_data
.x
->top_pos
);
1071 /* If one of the icon positions was not set, preserve or default it. */
1072 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
1074 icon_left_no_change
= 1;
1075 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
1076 if (NILP (icon_left
))
1077 XSETINT (icon_left
, 0);
1079 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
1081 icon_top_no_change
= 1;
1082 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
1083 if (NILP (icon_top
))
1084 XSETINT (icon_top
, 0);
1087 if (FRAME_VISIBLE_P (f
) && fullscreen_is_being_set
)
1089 /* If the frame is visible already and the fullscreen parameter is
1090 being set, it is too late to set WM manager hints to specify
1092 Here we first get the width, height and position that applies to
1093 fullscreen. We then move the frame to the appropriate
1094 position. Resize of the frame is taken care of in the code after
1095 this if-statement. */
1096 int new_left
, new_top
;
1098 x_fullscreen_adjust (f
, &width
, &height
, &new_top
, &new_left
);
1099 x_fullscreen_move (f
, new_top
, new_left
);
1102 /* Don't set these parameters unless they've been explicitly
1103 specified. The window might be mapped or resized while we're in
1104 this function, and we don't want to override that unless the lisp
1105 code has asked for it.
1107 Don't set these parameters unless they actually differ from the
1108 window's current parameters; the window may not actually exist
1113 check_frame_size (f
, &height
, &width
);
1115 XSETFRAME (frame
, f
);
1117 if (width
!= FRAME_WIDTH (f
)
1118 || height
!= FRAME_HEIGHT (f
)
1119 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1120 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1122 if ((!NILP (left
) || !NILP (top
))
1123 && ! (left_no_change
&& top_no_change
)
1124 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1125 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1130 /* Record the signs. */
1131 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1132 if (EQ (left
, Qminus
))
1133 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1134 else if (INTEGERP (left
))
1136 leftpos
= XINT (left
);
1138 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1140 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1141 && CONSP (XCDR (left
))
1142 && INTEGERP (XCAR (XCDR (left
))))
1144 leftpos
= - XINT (XCAR (XCDR (left
)));
1145 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1147 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1148 && CONSP (XCDR (left
))
1149 && INTEGERP (XCAR (XCDR (left
))))
1151 leftpos
= XINT (XCAR (XCDR (left
)));
1154 if (EQ (top
, Qminus
))
1155 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1156 else if (INTEGERP (top
))
1158 toppos
= XINT (top
);
1160 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1162 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1163 && CONSP (XCDR (top
))
1164 && INTEGERP (XCAR (XCDR (top
))))
1166 toppos
= - XINT (XCAR (XCDR (top
)));
1167 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1169 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1170 && CONSP (XCDR (top
))
1171 && INTEGERP (XCAR (XCDR (top
))))
1173 toppos
= XINT (XCAR (XCDR (top
)));
1177 /* Store the numeric value of the position. */
1178 f
->output_data
.x
->top_pos
= toppos
;
1179 f
->output_data
.x
->left_pos
= leftpos
;
1181 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1183 /* Actually set that position, and convert to absolute. */
1184 x_set_offset (f
, leftpos
, toppos
, -1);
1187 if ((!NILP (icon_left
) || !NILP (icon_top
))
1188 && ! (icon_left_no_change
&& icon_top_no_change
))
1189 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1195 /* Store the screen positions of frame F into XPTR and YPTR.
1196 These are the positions of the containing window manager window,
1197 not Emacs's own window. */
1200 x_real_positions (f
, xptr
, yptr
)
1204 int win_x
, win_y
, outer_x
, outer_y
;
1205 int real_x
= 0, real_y
= 0;
1207 Window win
= f
->output_data
.x
->parent_desc
;
1213 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1215 if (win
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1216 win
= FRAME_OUTER_WINDOW (f
);
1218 /* This loop traverses up the containment tree until we hit the root
1219 window. Window managers may intersect many windows between our window
1220 and the root window. The window we find just before the root window
1221 should be the outer WM window. */
1224 Window wm_window
, rootw
;
1225 Window
*tmp_children
;
1226 unsigned int tmp_nchildren
;
1229 success
= XQueryTree (FRAME_X_DISPLAY (f
), win
, &rootw
,
1230 &wm_window
, &tmp_children
, &tmp_nchildren
);
1232 had_errors
= x_had_errors_p (FRAME_X_DISPLAY (f
));
1234 /* Don't free tmp_children if XQueryTree failed. */
1238 XFree ((char *) tmp_children
);
1240 if (wm_window
== rootw
|| had_errors
)
1249 Window child
, rootw
;
1251 /* Get the real coordinates for the WM window upper left corner */
1252 XGetGeometry (FRAME_X_DISPLAY (f
), win
,
1253 &rootw
, &real_x
, &real_y
, &ign
, &ign
, &ign
, &ign
);
1255 /* Translate real coordinates to coordinates relative to our
1256 window. For our window, the upper left corner is 0, 0.
1257 Since the upper left corner of the WM window is outside
1258 our window, win_x and win_y will be negative:
1260 ------------------ ---> x
1262 | ----------------- v y
1265 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1267 /* From-window, to-window. */
1268 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1271 /* From-position, to-position. */
1272 real_x
, real_y
, &win_x
, &win_y
,
1277 if (FRAME_X_WINDOW (f
) == FRAME_OUTER_WINDOW (f
))
1284 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1286 /* From-window, to-window. */
1287 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1288 FRAME_OUTER_WINDOW (f
),
1290 /* From-position, to-position. */
1291 real_x
, real_y
, &outer_x
, &outer_y
,
1297 had_errors
= x_had_errors_p (FRAME_X_DISPLAY (f
));
1300 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1304 if (had_errors
) return;
1306 f
->output_data
.x
->x_pixels_diff
= -win_x
;
1307 f
->output_data
.x
->y_pixels_diff
= -win_y
;
1308 f
->output_data
.x
->x_pixels_outer_diff
= -outer_x
;
1309 f
->output_data
.x
->y_pixels_outer_diff
= -outer_y
;
1315 /* Insert a description of internally-recorded parameters of frame X
1316 into the parameter alist *ALISTPTR that is to be given to the user.
1317 Only parameters that are specific to the X window system
1318 and whose values are not correctly recorded in the frame's
1319 param_alist need to be considered here. */
1322 x_report_frame_params (f
, alistptr
)
1324 Lisp_Object
*alistptr
;
1329 /* Represent negative positions (off the top or left screen edge)
1330 in a way that Fmodify_frame_parameters will understand correctly. */
1331 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1332 if (f
->output_data
.x
->left_pos
>= 0)
1333 store_in_alist (alistptr
, Qleft
, tem
);
1335 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1337 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1338 if (f
->output_data
.x
->top_pos
>= 0)
1339 store_in_alist (alistptr
, Qtop
, tem
);
1341 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1343 store_in_alist (alistptr
, Qborder_width
,
1344 make_number (f
->output_data
.x
->border_width
));
1345 store_in_alist (alistptr
, Qinternal_border_width
,
1346 make_number (f
->output_data
.x
->internal_border_width
));
1347 store_in_alist (alistptr
, Qleft_fringe
,
1348 make_number (f
->output_data
.x
->left_fringe_width
));
1349 store_in_alist (alistptr
, Qright_fringe
,
1350 make_number (f
->output_data
.x
->right_fringe_width
));
1351 store_in_alist (alistptr
, Qscroll_bar_width
,
1352 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1354 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
1355 ? make_number (FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
1356 /* nil means "use default width"
1357 for non-toolkit scroll bar.
1358 ruler-mode.el depends on this. */
1360 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1361 store_in_alist (alistptr
, Qwindow_id
,
1362 build_string (buf
));
1363 #ifdef USE_X_TOOLKIT
1364 /* Tooltip frame may not have this widget. */
1365 if (f
->output_data
.x
->widget
)
1367 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1368 store_in_alist (alistptr
, Qouter_window_id
,
1369 build_string (buf
));
1370 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1371 FRAME_SAMPLE_VISIBILITY (f
);
1372 store_in_alist (alistptr
, Qvisibility
,
1373 (FRAME_VISIBLE_P (f
) ? Qt
1374 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1375 store_in_alist (alistptr
, Qdisplay
,
1376 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1378 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1381 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1382 store_in_alist (alistptr
, Qparent_id
, tem
);
1387 /* Gamma-correct COLOR on frame F. */
1390 gamma_correct (f
, color
)
1396 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1397 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1398 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1403 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1404 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1405 allocate the color. Value is zero if COLOR_NAME is invalid, or
1406 no color could be allocated. */
1409 x_defined_color (f
, color_name
, color
, alloc_p
)
1416 Display
*dpy
= FRAME_X_DISPLAY (f
);
1417 Colormap cmap
= FRAME_X_COLORMAP (f
);
1420 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1421 if (success_p
&& alloc_p
)
1422 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1429 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1430 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1431 Signal an error if color can't be allocated. */
1434 x_decode_color (f
, color_name
, mono_color
)
1436 Lisp_Object color_name
;
1441 CHECK_STRING (color_name
);
1443 #if 0 /* Don't do this. It's wrong when we're not using the default
1444 colormap, it makes freeing difficult, and it's probably not
1445 an important optimization. */
1446 if (strcmp (SDATA (color_name
), "black") == 0)
1447 return BLACK_PIX_DEFAULT (f
);
1448 else if (strcmp (SDATA (color_name
), "white") == 0)
1449 return WHITE_PIX_DEFAULT (f
);
1452 /* Return MONO_COLOR for monochrome frames. */
1453 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1456 /* x_defined_color is responsible for coping with failures
1457 by looking for a near-miss. */
1458 if (x_defined_color (f
, SDATA (color_name
), &cdef
, 1))
1461 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1462 Fcons (color_name
, Qnil
)));
1468 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1469 the previous value of that parameter, NEW_VALUE is the new value. */
1472 x_set_line_spacing (f
, new_value
, old_value
)
1474 Lisp_Object new_value
, old_value
;
1476 if (NILP (new_value
))
1477 f
->extra_line_spacing
= 0;
1478 else if (NATNUMP (new_value
))
1479 f
->extra_line_spacing
= XFASTINT (new_value
);
1481 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1482 Fcons (new_value
, Qnil
)));
1483 if (FRAME_VISIBLE_P (f
))
1488 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1489 the previous value of that parameter, NEW_VALUE is the new value.
1490 See also the comment of wait_for_wm in struct x_output. */
1493 x_set_wait_for_wm (f
, new_value
, old_value
)
1495 Lisp_Object new_value
, old_value
;
1497 f
->output_data
.x
->wait_for_wm
= !NILP (new_value
);
1501 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
1502 the previous value of that parameter, NEW_VALUE is the new value. */
1505 x_set_fullscreen (f
, new_value
, old_value
)
1507 Lisp_Object new_value
, old_value
;
1509 if (NILP (new_value
))
1510 f
->output_data
.x
->want_fullscreen
= FULLSCREEN_NONE
;
1511 else if (EQ (new_value
, Qfullboth
))
1512 f
->output_data
.x
->want_fullscreen
= FULLSCREEN_BOTH
;
1513 else if (EQ (new_value
, Qfullwidth
))
1514 f
->output_data
.x
->want_fullscreen
= FULLSCREEN_WIDTH
;
1515 else if (EQ (new_value
, Qfullheight
))
1516 f
->output_data
.x
->want_fullscreen
= FULLSCREEN_HEIGHT
;
1520 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1521 the previous value of that parameter, NEW_VALUE is the new
1525 x_set_screen_gamma (f
, new_value
, old_value
)
1527 Lisp_Object new_value
, old_value
;
1529 if (NILP (new_value
))
1531 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1532 /* The value 0.4545 is the normal viewing gamma. */
1533 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1535 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1536 Fcons (new_value
, Qnil
)));
1538 clear_face_cache (0);
1542 /* Functions called only from `x_set_frame_param'
1543 to set individual parameters.
1545 If FRAME_X_WINDOW (f) is 0,
1546 the frame is being created and its X-window does not exist yet.
1547 In that case, just record the parameter's new value
1548 in the standard place; do not attempt to change the window. */
1551 x_set_foreground_color (f
, arg
, oldval
)
1553 Lisp_Object arg
, oldval
;
1555 struct x_output
*x
= f
->output_data
.x
;
1556 unsigned long fg
, old_fg
;
1558 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1559 old_fg
= x
->foreground_pixel
;
1560 x
->foreground_pixel
= fg
;
1562 if (FRAME_X_WINDOW (f
) != 0)
1564 Display
*dpy
= FRAME_X_DISPLAY (f
);
1567 XSetForeground (dpy
, x
->normal_gc
, fg
);
1568 XSetBackground (dpy
, x
->reverse_gc
, fg
);
1570 if (x
->cursor_pixel
== old_fg
)
1572 unload_color (f
, x
->cursor_pixel
);
1573 x
->cursor_pixel
= x_copy_color (f
, fg
);
1574 XSetBackground (dpy
, x
->cursor_gc
, x
->cursor_pixel
);
1579 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1581 if (FRAME_VISIBLE_P (f
))
1585 unload_color (f
, old_fg
);
1589 x_set_background_color (f
, arg
, oldval
)
1591 Lisp_Object arg
, oldval
;
1593 struct x_output
*x
= f
->output_data
.x
;
1596 bg
= x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1597 unload_color (f
, x
->background_pixel
);
1598 x
->background_pixel
= bg
;
1600 if (FRAME_X_WINDOW (f
) != 0)
1602 Display
*dpy
= FRAME_X_DISPLAY (f
);
1605 XSetBackground (dpy
, x
->normal_gc
, bg
);
1606 XSetForeground (dpy
, x
->reverse_gc
, bg
);
1607 XSetWindowBackground (dpy
, FRAME_X_WINDOW (f
), bg
);
1608 XSetForeground (dpy
, x
->cursor_gc
, bg
);
1611 xg_set_background_color (f
, bg
);
1614 #ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1615 toolkit scroll bars. */
1618 for (bar
= FRAME_SCROLL_BARS (f
);
1620 bar
= XSCROLL_BAR (bar
)->next
)
1622 Window window
= SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
));
1623 XSetWindowBackground (dpy
, window
, bg
);
1626 #endif /* USE_TOOLKIT_SCROLL_BARS */
1629 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1631 if (FRAME_VISIBLE_P (f
))
1637 x_set_mouse_color (f
, arg
, oldval
)
1639 Lisp_Object arg
, oldval
;
1641 struct x_output
*x
= f
->output_data
.x
;
1642 Display
*dpy
= FRAME_X_DISPLAY (f
);
1643 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1644 Cursor hourglass_cursor
, horizontal_drag_cursor
;
1646 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1647 unsigned long mask_color
= x
->background_pixel
;
1649 /* Don't let pointers be invisible. */
1650 if (mask_color
== pixel
)
1652 x_free_colors (f
, &pixel
, 1);
1653 pixel
= x_copy_color (f
, x
->foreground_pixel
);
1656 unload_color (f
, x
->mouse_pixel
);
1657 x
->mouse_pixel
= pixel
;
1661 /* It's not okay to crash if the user selects a screwy cursor. */
1662 count
= x_catch_errors (dpy
);
1664 if (!NILP (Vx_pointer_shape
))
1666 CHECK_NUMBER (Vx_pointer_shape
);
1667 cursor
= XCreateFontCursor (dpy
, XINT (Vx_pointer_shape
));
1670 cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1671 x_check_errors (dpy
, "bad text pointer cursor: %s");
1673 if (!NILP (Vx_nontext_pointer_shape
))
1675 CHECK_NUMBER (Vx_nontext_pointer_shape
);
1677 = XCreateFontCursor (dpy
, XINT (Vx_nontext_pointer_shape
));
1680 nontext_cursor
= XCreateFontCursor (dpy
, XC_left_ptr
);
1681 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1683 if (!NILP (Vx_hourglass_pointer_shape
))
1685 CHECK_NUMBER (Vx_hourglass_pointer_shape
);
1687 = XCreateFontCursor (dpy
, XINT (Vx_hourglass_pointer_shape
));
1690 hourglass_cursor
= XCreateFontCursor (dpy
, XC_watch
);
1691 x_check_errors (dpy
, "bad hourglass pointer cursor: %s");
1693 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1694 if (!NILP (Vx_mode_pointer_shape
))
1696 CHECK_NUMBER (Vx_mode_pointer_shape
);
1697 mode_cursor
= XCreateFontCursor (dpy
, XINT (Vx_mode_pointer_shape
));
1700 mode_cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1701 x_check_errors (dpy
, "bad modeline pointer cursor: %s");
1703 if (!NILP (Vx_sensitive_text_pointer_shape
))
1705 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
);
1707 = XCreateFontCursor (dpy
, XINT (Vx_sensitive_text_pointer_shape
));
1710 cross_cursor
= XCreateFontCursor (dpy
, XC_hand2
);
1712 if (!NILP (Vx_window_horizontal_drag_shape
))
1714 CHECK_NUMBER (Vx_window_horizontal_drag_shape
);
1715 horizontal_drag_cursor
1716 = XCreateFontCursor (dpy
, XINT (Vx_window_horizontal_drag_shape
));
1719 horizontal_drag_cursor
1720 = XCreateFontCursor (dpy
, XC_sb_h_double_arrow
);
1722 /* Check and report errors with the above calls. */
1723 x_check_errors (dpy
, "can't set cursor shape: %s");
1724 x_uncatch_errors (dpy
, count
);
1727 XColor fore_color
, back_color
;
1729 fore_color
.pixel
= x
->mouse_pixel
;
1730 x_query_color (f
, &fore_color
);
1731 back_color
.pixel
= mask_color
;
1732 x_query_color (f
, &back_color
);
1734 XRecolorCursor (dpy
, cursor
, &fore_color
, &back_color
);
1735 XRecolorCursor (dpy
, nontext_cursor
, &fore_color
, &back_color
);
1736 XRecolorCursor (dpy
, mode_cursor
, &fore_color
, &back_color
);
1737 XRecolorCursor (dpy
, cross_cursor
, &fore_color
, &back_color
);
1738 XRecolorCursor (dpy
, hourglass_cursor
, &fore_color
, &back_color
);
1739 XRecolorCursor (dpy
, horizontal_drag_cursor
, &fore_color
, &back_color
);
1742 if (FRAME_X_WINDOW (f
) != 0)
1743 XDefineCursor (dpy
, FRAME_X_WINDOW (f
), cursor
);
1745 if (cursor
!= x
->text_cursor
1746 && x
->text_cursor
!= 0)
1747 XFreeCursor (dpy
, x
->text_cursor
);
1748 x
->text_cursor
= cursor
;
1750 if (nontext_cursor
!= x
->nontext_cursor
1751 && x
->nontext_cursor
!= 0)
1752 XFreeCursor (dpy
, x
->nontext_cursor
);
1753 x
->nontext_cursor
= nontext_cursor
;
1755 if (hourglass_cursor
!= x
->hourglass_cursor
1756 && x
->hourglass_cursor
!= 0)
1757 XFreeCursor (dpy
, x
->hourglass_cursor
);
1758 x
->hourglass_cursor
= hourglass_cursor
;
1760 if (mode_cursor
!= x
->modeline_cursor
1761 && x
->modeline_cursor
!= 0)
1762 XFreeCursor (dpy
, f
->output_data
.x
->modeline_cursor
);
1763 x
->modeline_cursor
= mode_cursor
;
1765 if (cross_cursor
!= x
->cross_cursor
1766 && x
->cross_cursor
!= 0)
1767 XFreeCursor (dpy
, x
->cross_cursor
);
1768 x
->cross_cursor
= cross_cursor
;
1770 if (horizontal_drag_cursor
!= x
->horizontal_drag_cursor
1771 && x
->horizontal_drag_cursor
!= 0)
1772 XFreeCursor (dpy
, x
->horizontal_drag_cursor
);
1773 x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1778 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1782 x_set_cursor_color (f
, arg
, oldval
)
1784 Lisp_Object arg
, oldval
;
1786 unsigned long fore_pixel
, pixel
;
1787 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1788 struct x_output
*x
= f
->output_data
.x
;
1790 if (!NILP (Vx_cursor_fore_pixel
))
1792 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1793 WHITE_PIX_DEFAULT (f
));
1794 fore_pixel_allocated_p
= 1;
1797 fore_pixel
= x
->background_pixel
;
1799 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1800 pixel_allocated_p
= 1;
1802 /* Make sure that the cursor color differs from the background color. */
1803 if (pixel
== x
->background_pixel
)
1805 if (pixel_allocated_p
)
1807 x_free_colors (f
, &pixel
, 1);
1808 pixel_allocated_p
= 0;
1811 pixel
= x
->mouse_pixel
;
1812 if (pixel
== fore_pixel
)
1814 if (fore_pixel_allocated_p
)
1816 x_free_colors (f
, &fore_pixel
, 1);
1817 fore_pixel_allocated_p
= 0;
1819 fore_pixel
= x
->background_pixel
;
1823 unload_color (f
, x
->cursor_foreground_pixel
);
1824 if (!fore_pixel_allocated_p
)
1825 fore_pixel
= x_copy_color (f
, fore_pixel
);
1826 x
->cursor_foreground_pixel
= fore_pixel
;
1828 unload_color (f
, x
->cursor_pixel
);
1829 if (!pixel_allocated_p
)
1830 pixel
= x_copy_color (f
, pixel
);
1831 x
->cursor_pixel
= pixel
;
1833 if (FRAME_X_WINDOW (f
) != 0)
1836 XSetBackground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, x
->cursor_pixel
);
1837 XSetForeground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, fore_pixel
);
1840 if (FRAME_VISIBLE_P (f
))
1842 x_update_cursor (f
, 0);
1843 x_update_cursor (f
, 1);
1847 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1850 /* Set the border-color of frame F to value described by ARG.
1851 ARG can be a string naming a color.
1852 The border-color is used for the border that is drawn by the X server.
1853 Note that this does not fully take effect if done before
1854 F has an x-window; it must be redone when the window is created.
1856 Note: this is done in two routines because of the way X10 works.
1858 Note: under X11, this is normally the province of the window manager,
1859 and so emacs' border colors may be overridden. */
1862 x_set_border_color (f
, arg
, oldval
)
1864 Lisp_Object arg
, oldval
;
1869 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1870 x_set_border_pixel (f
, pix
);
1871 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1874 /* Set the border-color of frame F to pixel value PIX.
1875 Note that this does not fully take effect if done before
1876 F has an x-window. */
1879 x_set_border_pixel (f
, pix
)
1883 unload_color (f
, f
->output_data
.x
->border_pixel
);
1884 f
->output_data
.x
->border_pixel
= pix
;
1886 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1889 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1890 (unsigned long)pix
);
1893 if (FRAME_VISIBLE_P (f
))
1901 x_set_cursor_type (f
, arg
, oldval
)
1903 Lisp_Object arg
, oldval
;
1905 set_frame_cursor_types (f
, arg
);
1907 /* Make sure the cursor gets redrawn. */
1908 cursor_type_changed
= 1;
1912 x_set_icon_type (f
, arg
, oldval
)
1914 Lisp_Object arg
, oldval
;
1920 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1923 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1928 result
= x_text_icon (f
,
1929 (char *) SDATA ((!NILP (f
->icon_name
)
1933 result
= x_bitmap_icon (f
, arg
);
1938 error ("No icon window available");
1941 XFlush (FRAME_X_DISPLAY (f
));
1945 /* Return non-nil if frame F wants a bitmap icon. */
1953 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1961 x_set_icon_name (f
, arg
, oldval
)
1963 Lisp_Object arg
, oldval
;
1969 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1972 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1977 if (f
->output_data
.x
->icon_bitmap
!= 0)
1982 result
= x_text_icon (f
,
1983 (char *) SDATA ((!NILP (f
->icon_name
)
1992 error ("No icon window available");
1995 XFlush (FRAME_X_DISPLAY (f
));
2000 x_set_font (f
, arg
, oldval
)
2002 Lisp_Object arg
, oldval
;
2005 Lisp_Object fontset_name
;
2007 int old_fontset
= f
->output_data
.x
->fontset
;
2011 fontset_name
= Fquery_fontset (arg
, Qnil
);
2014 result
= (STRINGP (fontset_name
)
2015 ? x_new_fontset (f
, SDATA (fontset_name
))
2016 : x_new_font (f
, SDATA (arg
)));
2019 if (EQ (result
, Qnil
))
2020 error ("Font `%s' is not defined", SDATA (arg
));
2021 else if (EQ (result
, Qt
))
2022 error ("The characters of the given font have varying widths");
2023 else if (STRINGP (result
))
2025 if (STRINGP (fontset_name
))
2027 /* Fontset names are built from ASCII font names, so the
2028 names may be equal despite there was a change. */
2029 if (old_fontset
== f
->output_data
.x
->fontset
)
2032 else if (!NILP (Fequal (result
, oldval
)))
2035 store_frame_param (f
, Qfont
, result
);
2036 recompute_basic_faces (f
);
2041 do_pending_window_change (0);
2043 /* Don't call `face-set-after-frame-default' when faces haven't been
2044 initialized yet. This is the case when called from
2045 Fx_create_frame. In that case, the X widget or window doesn't
2046 exist either, and we can end up in x_report_frame_params with a
2047 null widget which gives a segfault. */
2048 if (FRAME_FACE_CACHE (f
))
2050 XSETFRAME (frame
, f
);
2051 call1 (Qface_set_after_frame_default
, frame
);
2056 x_set_fringe_width (f
, new_value
, old_value
)
2058 Lisp_Object new_value
, old_value
;
2060 x_compute_fringe_widths (f
, 1);
2064 x_set_border_width (f
, arg
, oldval
)
2066 Lisp_Object arg
, oldval
;
2070 if (XINT (arg
) == f
->output_data
.x
->border_width
)
2073 if (FRAME_X_WINDOW (f
) != 0)
2074 error ("Cannot change the border width of a window");
2076 f
->output_data
.x
->border_width
= XINT (arg
);
2080 x_set_internal_border_width (f
, arg
, oldval
)
2082 Lisp_Object arg
, oldval
;
2084 int old
= f
->output_data
.x
->internal_border_width
;
2087 f
->output_data
.x
->internal_border_width
= XINT (arg
);
2088 if (f
->output_data
.x
->internal_border_width
< 0)
2089 f
->output_data
.x
->internal_border_width
= 0;
2091 #ifdef USE_X_TOOLKIT
2092 if (f
->output_data
.x
->edit_widget
)
2093 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
2096 if (f
->output_data
.x
->internal_border_width
== old
)
2099 if (FRAME_X_WINDOW (f
) != 0)
2101 x_set_window_size (f
, 0, f
->width
, f
->height
);
2102 SET_FRAME_GARBAGED (f
);
2103 do_pending_window_change (0);
2106 SET_FRAME_GARBAGED (f
);
2110 x_set_visibility (f
, value
, oldval
)
2112 Lisp_Object value
, oldval
;
2115 XSETFRAME (frame
, f
);
2118 Fmake_frame_invisible (frame
, Qt
);
2119 else if (EQ (value
, Qicon
))
2120 Ficonify_frame (frame
);
2122 Fmake_frame_visible (frame
);
2126 /* Change window heights in windows rooted in WINDOW by N lines. */
2129 x_change_window_heights (window
, n
)
2133 struct window
*w
= XWINDOW (window
);
2135 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
2136 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
2138 if (INTEGERP (w
->orig_top
))
2139 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
2140 if (INTEGERP (w
->orig_height
))
2141 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
2143 /* Handle just the top child in a vertical split. */
2144 if (!NILP (w
->vchild
))
2145 x_change_window_heights (w
->vchild
, n
);
2147 /* Adjust all children in a horizontal split. */
2148 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
2150 w
= XWINDOW (window
);
2151 x_change_window_heights (window
, n
);
2156 x_set_menu_bar_lines (f
, value
, oldval
)
2158 Lisp_Object value
, oldval
;
2161 #ifndef USE_X_TOOLKIT
2162 int olines
= FRAME_MENU_BAR_LINES (f
);
2165 /* Right now, menu bars don't work properly in minibuf-only frames;
2166 most of the commands try to apply themselves to the minibuffer
2167 frame itself, and get an error because you can't switch buffers
2168 in or split the minibuffer window. */
2169 if (FRAME_MINIBUF_ONLY_P (f
))
2172 if (INTEGERP (value
))
2173 nlines
= XINT (value
);
2177 /* Make sure we redisplay all windows in this frame. */
2178 windows_or_buffers_changed
++;
2180 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
2181 FRAME_MENU_BAR_LINES (f
) = 0;
2184 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2185 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
2186 /* Make sure next redisplay shows the menu bar. */
2187 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2191 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2192 free_frame_menubar (f
);
2193 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2195 f
->output_data
.x
->menubar_widget
= 0;
2197 #else /* not USE_X_TOOLKIT && not USE_GTK */
2198 FRAME_MENU_BAR_LINES (f
) = nlines
;
2199 x_change_window_heights (f
->root_window
, nlines
- olines
);
2200 #endif /* not USE_X_TOOLKIT */
2205 /* Set the number of lines used for the tool bar of frame F to VALUE.
2206 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2207 is the old number of tool bar lines. This function changes the
2208 height of all windows on frame F to match the new tool bar height.
2209 The frame's height doesn't change. */
2212 x_set_tool_bar_lines (f
, value
, oldval
)
2214 Lisp_Object value
, oldval
;
2216 int delta
, nlines
, root_height
;
2217 Lisp_Object root_window
;
2219 /* Treat tool bars like menu bars. */
2220 if (FRAME_MINIBUF_ONLY_P (f
))
2223 /* Use VALUE only if an integer >= 0. */
2224 if (INTEGERP (value
) && XINT (value
) >= 0)
2225 nlines
= XFASTINT (value
);
2230 FRAME_TOOL_BAR_LINES (f
) = 0;
2233 FRAME_EXTERNAL_TOOL_BAR (f
) = 1;
2234 if (FRAME_X_P (f
) && f
->output_data
.x
->toolbar_widget
== 0)
2235 /* Make sure next redisplay shows the tool bar. */
2236 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2237 update_frame_tool_bar (f
);
2241 if (FRAME_EXTERNAL_TOOL_BAR (f
))
2242 free_frame_tool_bar (f
);
2243 FRAME_EXTERNAL_TOOL_BAR (f
) = 0;
2249 /* Make sure we redisplay all windows in this frame. */
2250 ++windows_or_buffers_changed
;
2252 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2254 /* Don't resize the tool-bar to more than we have room for. */
2255 root_window
= FRAME_ROOT_WINDOW (f
);
2256 root_height
= XINT (XWINDOW (root_window
)->height
);
2257 if (root_height
- delta
< 1)
2259 delta
= root_height
- 1;
2260 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2263 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2264 x_change_window_heights (root_window
, delta
);
2267 /* We also have to make sure that the internal border at the top of
2268 the frame, below the menu bar or tool bar, is redrawn when the
2269 tool bar disappears. This is so because the internal border is
2270 below the tool bar if one is displayed, but is below the menu bar
2271 if there isn't a tool bar. The tool bar draws into the area
2272 below the menu bar. */
2273 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2277 clear_current_matrices (f
);
2278 updating_frame
= NULL
;
2281 /* If the tool bar gets smaller, the internal border below it
2282 has to be cleared. It was formerly part of the display
2283 of the larger tool bar, and updating windows won't clear it. */
2286 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2287 int width
= PIXEL_WIDTH (f
);
2288 int y
= nlines
* CANON_Y_UNIT (f
);
2291 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2292 0, y
, width
, height
, False
);
2295 if (WINDOWP (f
->tool_bar_window
))
2296 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2301 /* Set the foreground color for scroll bars on frame F to VALUE.
2302 VALUE should be a string, a color name. If it isn't a string or
2303 isn't a valid color name, do nothing. OLDVAL is the old value of
2304 the frame parameter. */
2307 x_set_scroll_bar_foreground (f
, value
, oldval
)
2309 Lisp_Object value
, oldval
;
2311 unsigned long pixel
;
2313 if (STRINGP (value
))
2314 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2318 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2319 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2321 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2322 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2324 /* Remove all scroll bars because they have wrong colors. */
2325 if (condemn_scroll_bars_hook
)
2326 (*condemn_scroll_bars_hook
) (f
);
2327 if (judge_scroll_bars_hook
)
2328 (*judge_scroll_bars_hook
) (f
);
2330 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2336 /* Set the background color for scroll bars on frame F to VALUE VALUE
2337 should be a string, a color name. If it isn't a string or isn't a
2338 valid color name, do nothing. OLDVAL is the old value of the frame
2342 x_set_scroll_bar_background (f
, value
, oldval
)
2344 Lisp_Object value
, oldval
;
2346 unsigned long pixel
;
2348 if (STRINGP (value
))
2349 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2353 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2354 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2356 #ifdef USE_TOOLKIT_SCROLL_BARS
2357 /* Scrollbar shadow colors. */
2358 if (f
->output_data
.x
->scroll_bar_top_shadow_pixel
!= -1)
2360 unload_color (f
, f
->output_data
.x
->scroll_bar_top_shadow_pixel
);
2361 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
2363 if (f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
!= -1)
2365 unload_color (f
, f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
);
2366 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
2368 #endif /* USE_TOOLKIT_SCROLL_BARS */
2370 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2371 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2373 /* Remove all scroll bars because they have wrong colors. */
2374 if (condemn_scroll_bars_hook
)
2375 (*condemn_scroll_bars_hook
) (f
);
2376 if (judge_scroll_bars_hook
)
2377 (*judge_scroll_bars_hook
) (f
);
2379 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2385 /* Encode Lisp string STRING as a text in a format appropriate for
2386 XICCC (X Inter Client Communication Conventions).
2388 If STRING contains only ASCII characters, do no conversion and
2389 return the string data of STRING. Otherwise, encode the text by
2390 CODING_SYSTEM, and return a newly allocated memory area which
2391 should be freed by `xfree' by a caller.
2393 SELECTIONP non-zero means the string is being encoded for an X
2394 selection, so it is safe to run pre-write conversions (which
2397 Store the byte length of resulting text in *TEXT_BYTES.
2399 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2400 which means that the `encoding' of the result can be `STRING'.
2401 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2402 the result should be `COMPOUND_TEXT'. */
2405 x_encode_text (string
, coding_system
, selectionp
, text_bytes
, stringp
)
2406 Lisp_Object string
, coding_system
;
2407 int *text_bytes
, *stringp
;
2410 unsigned char *str
= SDATA (string
);
2411 int chars
= SCHARS (string
);
2412 int bytes
= SBYTES (string
);
2416 struct coding_system coding
;
2417 extern Lisp_Object Qcompound_text_with_extensions
;
2419 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2420 if (charset_info
== 0)
2422 /* No multibyte character in OBJ. We need not encode it. */
2423 *text_bytes
= bytes
;
2428 setup_coding_system (coding_system
, &coding
);
2430 && SYMBOLP (coding
.pre_write_conversion
)
2431 && !NILP (Ffboundp (coding
.pre_write_conversion
)))
2433 string
= run_pre_post_conversion_on_str (string
, &coding
, 1);
2434 str
= SDATA (string
);
2435 chars
= SCHARS (string
);
2436 bytes
= SBYTES (string
);
2438 coding
.src_multibyte
= 1;
2439 coding
.dst_multibyte
= 0;
2440 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2441 if (coding
.type
== coding_type_iso2022
)
2442 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2443 /* We suppress producing escape sequences for composition. */
2444 coding
.composing
= COMPOSITION_DISABLED
;
2445 bufsize
= encoding_buffer_size (&coding
, bytes
);
2446 buf
= (unsigned char *) xmalloc (bufsize
);
2447 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2448 *text_bytes
= coding
.produced
;
2449 *stringp
= (charset_info
== 1
2450 || (!EQ (coding_system
, Qcompound_text
)
2451 && !EQ (coding_system
, Qcompound_text_with_extensions
)));
2456 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2459 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2460 name; if NAME is a string, set F's name to NAME and set
2461 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2463 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2464 suggesting a new name, which lisp code should override; if
2465 F->explicit_name is set, ignore the new name; otherwise, set it. */
2468 x_set_name (f
, name
, explicit)
2473 /* Make sure that requests from lisp code override requests from
2474 Emacs redisplay code. */
2477 /* If we're switching from explicit to implicit, we had better
2478 update the mode lines and thereby update the title. */
2479 if (f
->explicit_name
&& NILP (name
))
2480 update_mode_lines
= 1;
2482 f
->explicit_name
= ! NILP (name
);
2484 else if (f
->explicit_name
)
2487 /* If NAME is nil, set the name to the x_id_name. */
2490 /* Check for no change needed in this very common case
2491 before we do any consing. */
2492 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2495 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2498 CHECK_STRING (name
);
2500 /* Don't change the name if it's already NAME. */
2501 if (! NILP (Fstring_equal (name
, f
->name
)))
2506 /* For setting the frame title, the title parameter should override
2507 the name parameter. */
2508 if (! NILP (f
->title
))
2511 if (FRAME_X_WINDOW (f
))
2516 XTextProperty text
, icon
;
2518 Lisp_Object coding_system
;
2520 coding_system
= Qcompound_text
;
2521 text
.value
= x_encode_text (name
, coding_system
, 0, &bytes
, &stringp
);
2522 text
.encoding
= (stringp
? XA_STRING
2523 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2525 text
.nitems
= bytes
;
2527 if (NILP (f
->icon_name
))
2533 icon
.value
= x_encode_text (f
->icon_name
, coding_system
, 0,
2535 icon
.encoding
= (stringp
? XA_STRING
2536 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2538 icon
.nitems
= bytes
;
2540 #ifdef USE_X_TOOLKIT
2541 XSetWMName (FRAME_X_DISPLAY (f
),
2542 XtWindow (f
->output_data
.x
->widget
), &text
);
2543 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2545 #else /* not USE_X_TOOLKIT */
2547 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f
)),
2549 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_OUTER_WINDOW (f
),
2551 #else /* not USE_GTK */
2552 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2553 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2554 #endif /* not USE_GTK */
2555 #endif /* not USE_X_TOOLKIT */
2556 if (!NILP (f
->icon_name
)
2557 && icon
.value
!= (unsigned char *) SDATA (f
->icon_name
))
2559 if (text
.value
!= (unsigned char *) SDATA (name
))
2562 #else /* not HAVE_X11R4 */
2563 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2565 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2567 #endif /* not HAVE_X11R4 */
2572 /* This function should be called when the user's lisp code has
2573 specified a name for the frame; the name will override any set by the
2576 x_explicitly_set_name (f
, arg
, oldval
)
2578 Lisp_Object arg
, oldval
;
2580 x_set_name (f
, arg
, 1);
2583 /* This function should be called by Emacs redisplay code to set the
2584 name; names set this way will never override names set by the user's
2587 x_implicitly_set_name (f
, arg
, oldval
)
2589 Lisp_Object arg
, oldval
;
2591 x_set_name (f
, arg
, 0);
2594 /* Change the title of frame F to NAME.
2595 If NAME is nil, use the frame name as the title.
2597 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2598 name; if NAME is a string, set F's name to NAME and set
2599 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2601 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2602 suggesting a new name, which lisp code should override; if
2603 F->explicit_name is set, ignore the new name; otherwise, set it. */
2606 x_set_title (f
, name
, old_name
)
2608 Lisp_Object name
, old_name
;
2610 /* Don't change the title if it's already NAME. */
2611 if (EQ (name
, f
->title
))
2614 update_mode_lines
= 1;
2621 CHECK_STRING (name
);
2623 if (FRAME_X_WINDOW (f
))
2628 XTextProperty text
, icon
;
2630 Lisp_Object coding_system
;
2632 coding_system
= Qcompound_text
;
2633 text
.value
= x_encode_text (name
, coding_system
, 0, &bytes
, &stringp
);
2634 text
.encoding
= (stringp
? XA_STRING
2635 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2637 text
.nitems
= bytes
;
2639 if (NILP (f
->icon_name
))
2645 icon
.value
= x_encode_text (f
->icon_name
, coding_system
, 0,
2647 icon
.encoding
= (stringp
? XA_STRING
2648 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2650 icon
.nitems
= bytes
;
2652 #ifdef USE_X_TOOLKIT
2653 XSetWMName (FRAME_X_DISPLAY (f
),
2654 XtWindow (f
->output_data
.x
->widget
), &text
);
2655 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2657 #else /* not USE_X_TOOLKIT */
2659 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f
)),
2661 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_OUTER_WINDOW (f
),
2663 #else /* not USE_GTK */
2664 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2665 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2666 #endif /* not USE_GTK */
2667 #endif /* not USE_X_TOOLKIT */
2668 if (!NILP (f
->icon_name
)
2669 && icon
.value
!= (unsigned char *) SDATA (f
->icon_name
))
2671 if (text
.value
!= (unsigned char *) SDATA (name
))
2674 #else /* not HAVE_X11R4 */
2675 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2677 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2679 #endif /* not HAVE_X11R4 */
2685 x_set_autoraise (f
, arg
, oldval
)
2687 Lisp_Object arg
, oldval
;
2689 f
->auto_raise
= !EQ (Qnil
, arg
);
2693 x_set_autolower (f
, arg
, oldval
)
2695 Lisp_Object arg
, oldval
;
2697 f
->auto_lower
= !EQ (Qnil
, arg
);
2701 x_set_unsplittable (f
, arg
, oldval
)
2703 Lisp_Object arg
, oldval
;
2705 f
->no_split
= !NILP (arg
);
2709 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2711 Lisp_Object arg
, oldval
;
2713 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2714 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2715 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2716 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2718 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2720 ? vertical_scroll_bar_none
2722 ? vertical_scroll_bar_right
2723 : vertical_scroll_bar_left
);
2725 /* We set this parameter before creating the X window for the
2726 frame, so we can get the geometry right from the start.
2727 However, if the window hasn't been created yet, we shouldn't
2728 call x_set_window_size. */
2729 if (FRAME_X_WINDOW (f
))
2730 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2731 do_pending_window_change (0);
2736 x_set_scroll_bar_width (f
, arg
, oldval
)
2738 Lisp_Object arg
, oldval
;
2740 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2744 #ifdef USE_TOOLKIT_SCROLL_BARS
2745 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2746 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2747 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2748 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2750 /* Make the actual width at least 14 pixels and a multiple of a
2752 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2754 /* Use all of that space (aside from required margins) for the
2756 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2759 if (FRAME_X_WINDOW (f
))
2760 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2761 do_pending_window_change (0);
2763 else if (INTEGERP (arg
) && XINT (arg
) > 0
2764 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2766 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2767 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2769 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2770 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2771 if (FRAME_X_WINDOW (f
))
2772 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2775 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2776 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2777 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2782 /* Subroutines of creating an X frame. */
2784 /* Make sure that Vx_resource_name is set to a reasonable value.
2785 Fix it up, or set it to `emacs' if it is too hopeless. */
2788 validate_x_resource_name ()
2791 /* Number of valid characters in the resource name. */
2793 /* Number of invalid characters in the resource name. */
2798 if (!STRINGP (Vx_resource_class
))
2799 Vx_resource_class
= build_string (EMACS_CLASS
);
2801 if (STRINGP (Vx_resource_name
))
2803 unsigned char *p
= SDATA (Vx_resource_name
);
2806 len
= SBYTES (Vx_resource_name
);
2808 /* Only letters, digits, - and _ are valid in resource names.
2809 Count the valid characters and count the invalid ones. */
2810 for (i
= 0; i
< len
; i
++)
2813 if (! ((c
>= 'a' && c
<= 'z')
2814 || (c
>= 'A' && c
<= 'Z')
2815 || (c
>= '0' && c
<= '9')
2816 || c
== '-' || c
== '_'))
2823 /* Not a string => completely invalid. */
2824 bad_count
= 5, good_count
= 0;
2826 /* If name is valid already, return. */
2830 /* If name is entirely invalid, or nearly so, use `emacs'. */
2832 || (good_count
== 1 && bad_count
> 0))
2834 Vx_resource_name
= build_string ("emacs");
2838 /* Name is partly valid. Copy it and replace the invalid characters
2839 with underscores. */
2841 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2843 for (i
= 0; i
< len
; i
++)
2845 int c
= SREF (new, i
);
2846 if (! ((c
>= 'a' && c
<= 'z')
2847 || (c
>= 'A' && c
<= 'Z')
2848 || (c
>= '0' && c
<= '9')
2849 || c
== '-' || c
== '_'))
2855 extern char *x_get_string_resource ();
2857 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2858 doc
: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
2859 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
2860 class, where INSTANCE is the name under which Emacs was invoked, or
2861 the name specified by the `-name' or `-rn' command-line arguments.
2863 The optional arguments COMPONENT and SUBCLASS add to the key and the
2864 class, respectively. You must specify both of them or neither.
2865 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
2866 and the class is `Emacs.CLASS.SUBCLASS'. */)
2867 (attribute
, class, component
, subclass
)
2868 Lisp_Object attribute
, class, component
, subclass
;
2870 register char *value
;
2876 CHECK_STRING (attribute
);
2877 CHECK_STRING (class);
2879 if (!NILP (component
))
2880 CHECK_STRING (component
);
2881 if (!NILP (subclass
))
2882 CHECK_STRING (subclass
);
2883 if (NILP (component
) != NILP (subclass
))
2884 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2886 validate_x_resource_name ();
2888 /* Allocate space for the components, the dots which separate them,
2889 and the final '\0'. Make them big enough for the worst case. */
2890 name_key
= (char *) alloca (SBYTES (Vx_resource_name
)
2891 + (STRINGP (component
)
2892 ? SBYTES (component
) : 0)
2893 + SBYTES (attribute
)
2896 class_key
= (char *) alloca (SBYTES (Vx_resource_class
)
2898 + (STRINGP (subclass
)
2899 ? SBYTES (subclass
) : 0)
2902 /* Start with emacs.FRAMENAME for the name (the specific one)
2903 and with `Emacs' for the class key (the general one). */
2904 strcpy (name_key
, SDATA (Vx_resource_name
));
2905 strcpy (class_key
, SDATA (Vx_resource_class
));
2907 strcat (class_key
, ".");
2908 strcat (class_key
, SDATA (class));
2910 if (!NILP (component
))
2912 strcat (class_key
, ".");
2913 strcat (class_key
, SDATA (subclass
));
2915 strcat (name_key
, ".");
2916 strcat (name_key
, SDATA (component
));
2919 strcat (name_key
, ".");
2920 strcat (name_key
, SDATA (attribute
));
2922 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2923 name_key
, class_key
);
2925 if (value
!= (char *) 0)
2926 return build_string (value
);
2931 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2934 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2935 struct x_display_info
*dpyinfo
;
2936 Lisp_Object attribute
, class, component
, subclass
;
2938 register char *value
;
2942 CHECK_STRING (attribute
);
2943 CHECK_STRING (class);
2945 if (!NILP (component
))
2946 CHECK_STRING (component
);
2947 if (!NILP (subclass
))
2948 CHECK_STRING (subclass
);
2949 if (NILP (component
) != NILP (subclass
))
2950 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2952 validate_x_resource_name ();
2954 /* Allocate space for the components, the dots which separate them,
2955 and the final '\0'. Make them big enough for the worst case. */
2956 name_key
= (char *) alloca (SBYTES (Vx_resource_name
)
2957 + (STRINGP (component
)
2958 ? SBYTES (component
) : 0)
2959 + SBYTES (attribute
)
2962 class_key
= (char *) alloca (SBYTES (Vx_resource_class
)
2964 + (STRINGP (subclass
)
2965 ? SBYTES (subclass
) : 0)
2968 /* Start with emacs.FRAMENAME for the name (the specific one)
2969 and with `Emacs' for the class key (the general one). */
2970 strcpy (name_key
, SDATA (Vx_resource_name
));
2971 strcpy (class_key
, SDATA (Vx_resource_class
));
2973 strcat (class_key
, ".");
2974 strcat (class_key
, SDATA (class));
2976 if (!NILP (component
))
2978 strcat (class_key
, ".");
2979 strcat (class_key
, SDATA (subclass
));
2981 strcat (name_key
, ".");
2982 strcat (name_key
, SDATA (component
));
2985 strcat (name_key
, ".");
2986 strcat (name_key
, SDATA (attribute
));
2988 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2990 if (value
!= (char *) 0)
2991 return build_string (value
);
2996 /* Used when C code wants a resource value. */
2999 x_get_resource_string (attribute
, class)
3000 char *attribute
, *class;
3004 struct frame
*sf
= SELECTED_FRAME ();
3006 /* Allocate space for the components, the dots which separate them,
3007 and the final '\0'. */
3008 name_key
= (char *) alloca (SBYTES (Vinvocation_name
)
3009 + strlen (attribute
) + 2);
3010 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
3011 + strlen (class) + 2);
3013 sprintf (name_key
, "%s.%s",
3014 SDATA (Vinvocation_name
),
3016 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
3018 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
3019 name_key
, class_key
);
3022 /* Types we might convert a resource string into. */
3032 /* Return the value of parameter PARAM.
3034 First search ALIST, then Vdefault_frame_alist, then the X defaults
3035 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3037 Convert the resource to the type specified by desired_type.
3039 If no default is specified, return Qunbound. If you call
3040 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3041 and don't let it get stored in any Lisp-visible variables! */
3044 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
3045 struct x_display_info
*dpyinfo
;
3046 Lisp_Object alist
, param
;
3049 enum resource_types type
;
3051 register Lisp_Object tem
;
3053 tem
= Fassq (param
, alist
);
3055 tem
= Fassq (param
, Vdefault_frame_alist
);
3061 tem
= display_x_get_resource (dpyinfo
,
3062 build_string (attribute
),
3063 build_string (class),
3071 case RES_TYPE_NUMBER
:
3072 return make_number (atoi (SDATA (tem
)));
3074 case RES_TYPE_FLOAT
:
3075 return make_float (atof (SDATA (tem
)));
3077 case RES_TYPE_BOOLEAN
:
3078 tem
= Fdowncase (tem
);
3079 if (!strcmp (SDATA (tem
), "on")
3080 || !strcmp (SDATA (tem
), "true"))
3085 case RES_TYPE_STRING
:
3088 case RES_TYPE_SYMBOL
:
3089 /* As a special case, we map the values `true' and `on'
3090 to Qt, and `false' and `off' to Qnil. */
3093 lower
= Fdowncase (tem
);
3094 if (!strcmp (SDATA (lower
), "on")
3095 || !strcmp (SDATA (lower
), "true"))
3097 else if (!strcmp (SDATA (lower
), "off")
3098 || !strcmp (SDATA (lower
), "false"))
3101 return Fintern (tem
, Qnil
);
3114 /* Like x_get_arg, but also record the value in f->param_alist. */
3117 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
3119 Lisp_Object alist
, param
;
3122 enum resource_types type
;
3126 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
3127 attribute
, class, type
);
3129 store_frame_param (f
, param
, value
);
3134 /* Record in frame F the specified or default value according to ALIST
3135 of the parameter named PROP (a Lisp symbol).
3136 If no value is specified for PROP, look for an X default for XPROP
3137 on the frame named NAME.
3138 If that is not found either, use the value DEFLT. */
3141 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
3148 enum resource_types type
;
3152 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
3153 if (EQ (tem
, Qunbound
))
3155 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3160 /* Record in frame F the specified or default value according to ALIST
3161 of the parameter named PROP (a Lisp symbol). If no value is
3162 specified for PROP, look for an X default for XPROP on the frame
3163 named NAME. If that is not found either, use the value DEFLT. */
3166 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
3175 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3178 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
3179 if (EQ (tem
, Qunbound
))
3181 #ifdef USE_TOOLKIT_SCROLL_BARS
3183 /* See if an X resource for the scroll bar color has been
3185 tem
= display_x_get_resource (dpyinfo
,
3186 build_string (foreground_p
3190 build_string ("verticalScrollBar"),
3194 /* If nothing has been specified, scroll bars will use a
3195 toolkit-dependent default. Because these defaults are
3196 difficult to get at without actually creating a scroll
3197 bar, use nil to indicate that no color has been
3202 #else /* not USE_TOOLKIT_SCROLL_BARS */
3206 #endif /* not USE_TOOLKIT_SCROLL_BARS */
3209 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3215 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3216 doc
: /* Parse an X-style geometry string STRING.
3217 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3218 The properties returned may include `top', `left', `height', and `width'.
3219 The value of `left' or `top' may be an integer,
3220 or a list (+ N) meaning N pixels relative to top/left corner,
3221 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3226 unsigned int width
, height
;
3229 CHECK_STRING (string
);
3231 geometry
= XParseGeometry ((char *) SDATA (string
),
3232 &x
, &y
, &width
, &height
);
3235 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
3236 error ("Must specify both x and y position, or neither");
3240 if (geometry
& XValue
)
3242 Lisp_Object element
;
3244 if (x
>= 0 && (geometry
& XNegative
))
3245 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3246 else if (x
< 0 && ! (geometry
& XNegative
))
3247 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3249 element
= Fcons (Qleft
, make_number (x
));
3250 result
= Fcons (element
, result
);
3253 if (geometry
& YValue
)
3255 Lisp_Object element
;
3257 if (y
>= 0 && (geometry
& YNegative
))
3258 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3259 else if (y
< 0 && ! (geometry
& YNegative
))
3260 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3262 element
= Fcons (Qtop
, make_number (y
));
3263 result
= Fcons (element
, result
);
3266 if (geometry
& WidthValue
)
3267 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3268 if (geometry
& HeightValue
)
3269 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3274 /* Calculate the desired size and position of this window,
3275 and return the flags saying which aspects were specified.
3277 This function does not make the coordinates positive. */
3279 #define DEFAULT_ROWS 40
3280 #define DEFAULT_COLS 80
3283 x_figure_window_size (f
, parms
)
3287 register Lisp_Object tem0
, tem1
, tem2
;
3288 long window_prompting
= 0;
3289 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3291 /* Default values if we fall through.
3292 Actually, if that happens we should get
3293 window manager prompting. */
3294 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3295 f
->height
= DEFAULT_ROWS
;
3296 /* Window managers expect that if program-specified
3297 positions are not (0,0), they're intentional, not defaults. */
3298 f
->output_data
.x
->top_pos
= 0;
3299 f
->output_data
.x
->left_pos
= 0;
3301 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3302 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3303 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3304 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3306 if (!EQ (tem0
, Qunbound
))
3308 CHECK_NUMBER (tem0
);
3309 f
->height
= XINT (tem0
);
3311 if (!EQ (tem1
, Qunbound
))
3313 CHECK_NUMBER (tem1
);
3314 SET_FRAME_WIDTH (f
, XINT (tem1
));
3316 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3317 window_prompting
|= USSize
;
3319 window_prompting
|= PSize
;
3322 f
->output_data
.x
->vertical_scroll_bar_extra
3323 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3325 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3327 x_compute_fringe_widths (f
, 0);
3329 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3330 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3332 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3333 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3334 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3335 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3337 if (EQ (tem0
, Qminus
))
3339 f
->output_data
.x
->top_pos
= 0;
3340 window_prompting
|= YNegative
;
3342 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3343 && CONSP (XCDR (tem0
))
3344 && INTEGERP (XCAR (XCDR (tem0
))))
3346 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3347 window_prompting
|= YNegative
;
3349 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3350 && CONSP (XCDR (tem0
))
3351 && INTEGERP (XCAR (XCDR (tem0
))))
3353 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3355 else if (EQ (tem0
, Qunbound
))
3356 f
->output_data
.x
->top_pos
= 0;
3359 CHECK_NUMBER (tem0
);
3360 f
->output_data
.x
->top_pos
= XINT (tem0
);
3361 if (f
->output_data
.x
->top_pos
< 0)
3362 window_prompting
|= YNegative
;
3365 if (EQ (tem1
, Qminus
))
3367 f
->output_data
.x
->left_pos
= 0;
3368 window_prompting
|= XNegative
;
3370 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3371 && CONSP (XCDR (tem1
))
3372 && INTEGERP (XCAR (XCDR (tem1
))))
3374 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3375 window_prompting
|= XNegative
;
3377 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3378 && CONSP (XCDR (tem1
))
3379 && INTEGERP (XCAR (XCDR (tem1
))))
3381 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3383 else if (EQ (tem1
, Qunbound
))
3384 f
->output_data
.x
->left_pos
= 0;
3387 CHECK_NUMBER (tem1
);
3388 f
->output_data
.x
->left_pos
= XINT (tem1
);
3389 if (f
->output_data
.x
->left_pos
< 0)
3390 window_prompting
|= XNegative
;
3393 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3394 window_prompting
|= USPosition
;
3396 window_prompting
|= PPosition
;
3399 if (f
->output_data
.x
->want_fullscreen
!= FULLSCREEN_NONE
)
3404 /* It takes both for some WM:s to place it where we want */
3405 window_prompting
= USPosition
| PPosition
;
3406 x_fullscreen_adjust (f
, &width
, &height
, &top
, &left
);
3409 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3410 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3411 f
->output_data
.x
->left_pos
= left
;
3412 f
->output_data
.x
->top_pos
= top
;
3415 return window_prompting
;
3418 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3421 XSetWMProtocols (dpy
, w
, protocols
, count
)
3428 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3429 if (prop
== None
) return False
;
3430 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3431 (unsigned char *) protocols
, count
);
3434 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3436 #ifdef USE_X_TOOLKIT
3438 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3439 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3440 already be present because of the toolkit (Motif adds some of them,
3441 for example, but Xt doesn't). */
3444 hack_wm_protocols (f
, widget
)
3448 Display
*dpy
= XtDisplay (widget
);
3449 Window w
= XtWindow (widget
);
3450 int need_delete
= 1;
3456 Atom type
, *atoms
= 0;
3458 unsigned long nitems
= 0;
3459 unsigned long bytes_after
;
3461 if ((XGetWindowProperty (dpy
, w
,
3462 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3463 (long)0, (long)100, False
, XA_ATOM
,
3464 &type
, &format
, &nitems
, &bytes_after
,
3465 (unsigned char **) &atoms
)
3467 && format
== 32 && type
== XA_ATOM
)
3471 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3473 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3475 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3478 if (atoms
) XFree ((char *) atoms
);
3484 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3486 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3488 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3490 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3491 XA_ATOM
, 32, PropModeAppend
,
3492 (unsigned char *) props
, count
);
3500 /* Support routines for XIC (X Input Context). */
3504 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3505 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3508 /* Supported XIM styles, ordered by preferenc. */
3510 static XIMStyle supported_xim_styles
[] =
3512 XIMPreeditPosition
| XIMStatusArea
,
3513 XIMPreeditPosition
| XIMStatusNothing
,
3514 XIMPreeditPosition
| XIMStatusNone
,
3515 XIMPreeditNothing
| XIMStatusArea
,
3516 XIMPreeditNothing
| XIMStatusNothing
,
3517 XIMPreeditNothing
| XIMStatusNone
,
3518 XIMPreeditNone
| XIMStatusArea
,
3519 XIMPreeditNone
| XIMStatusNothing
,
3520 XIMPreeditNone
| XIMStatusNone
,
3525 /* Create an X fontset on frame F with base font name
3529 xic_create_xfontset (f
, base_fontname
)
3531 char *base_fontname
;
3534 char **missing_list
;
3538 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3539 base_fontname
, &missing_list
,
3540 &missing_count
, &def_string
);
3542 XFreeStringList (missing_list
);
3544 /* No need to free def_string. */
3549 /* Value is the best input style, given user preferences USER (already
3550 checked to be supported by Emacs), and styles supported by the
3551 input method XIM. */
3554 best_xim_style (user
, xim
)
3560 for (i
= 0; i
< user
->count_styles
; ++i
)
3561 for (j
= 0; j
< xim
->count_styles
; ++j
)
3562 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3563 return user
->supported_styles
[i
];
3565 /* Return the default style. */
3566 return XIMPreeditNothing
| XIMStatusNothing
;
3569 /* Create XIC for frame F. */
3571 static XIMStyle xic_style
;
3574 create_frame_xic (f
)
3579 XFontSet xfs
= NULL
;
3584 xim
= FRAME_X_XIM (f
);
3589 XVaNestedList preedit_attr
;
3590 XVaNestedList status_attr
;
3591 char *base_fontname
;
3594 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3595 spot
.x
= 0; spot
.y
= 1;
3596 /* Create X fontset. */
3597 fontset
= FRAME_FONTSET (f
);
3599 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3602 /* Determine the base fontname from the ASCII font name of
3604 char *ascii_font
= (char *) SDATA (fontset_ascii (fontset
));
3605 char *p
= ascii_font
;
3608 for (i
= 0; *p
; p
++)
3611 /* As the font name doesn't conform to XLFD, we can't
3612 modify it to get a suitable base fontname for the
3614 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3617 int len
= strlen (ascii_font
) + 1;
3620 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3629 base_fontname
= (char *) alloca (len
);
3630 bzero (base_fontname
, len
);
3631 strcpy (base_fontname
, "-*-*-");
3632 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3633 strcat (base_fontname
, "*-*-*-*-*-*-*");
3636 xfs
= xic_create_xfontset (f
, base_fontname
);
3638 /* Determine XIC style. */
3641 XIMStyles supported_list
;
3642 supported_list
.count_styles
= (sizeof supported_xim_styles
3643 / sizeof supported_xim_styles
[0]);
3644 supported_list
.supported_styles
= supported_xim_styles
;
3645 xic_style
= best_xim_style (&supported_list
,
3646 FRAME_X_XIM_STYLES (f
));
3649 preedit_attr
= XVaCreateNestedList (0,
3652 FRAME_FOREGROUND_PIXEL (f
),
3654 FRAME_BACKGROUND_PIXEL (f
),
3655 (xic_style
& XIMPreeditPosition
3660 status_attr
= XVaCreateNestedList (0,
3666 FRAME_FOREGROUND_PIXEL (f
),
3668 FRAME_BACKGROUND_PIXEL (f
),
3671 xic
= XCreateIC (xim
,
3672 XNInputStyle
, xic_style
,
3673 XNClientWindow
, FRAME_X_WINDOW(f
),
3674 XNFocusWindow
, FRAME_X_WINDOW(f
),
3675 XNStatusAttributes
, status_attr
,
3676 XNPreeditAttributes
, preedit_attr
,
3678 XFree (preedit_attr
);
3679 XFree (status_attr
);
3682 FRAME_XIC (f
) = xic
;
3683 FRAME_XIC_STYLE (f
) = xic_style
;
3684 FRAME_XIC_FONTSET (f
) = xfs
;
3688 /* Destroy XIC and free XIC fontset of frame F, if any. */
3694 if (FRAME_XIC (f
) == NULL
)
3697 XDestroyIC (FRAME_XIC (f
));
3698 if (FRAME_XIC_FONTSET (f
))
3699 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3701 FRAME_XIC (f
) = NULL
;
3702 FRAME_XIC_FONTSET (f
) = NULL
;
3706 /* Place preedit area for XIC of window W's frame to specified
3707 pixel position X/Y. X and Y are relative to window W. */
3710 xic_set_preeditarea (w
, x
, y
)
3714 struct frame
*f
= XFRAME (w
->frame
);
3718 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3719 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3720 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3721 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3726 /* Place status area for XIC in bottom right corner of frame F.. */
3729 xic_set_statusarea (f
)
3732 XIC xic
= FRAME_XIC (f
);
3737 /* Negotiate geometry of status area. If input method has existing
3738 status area, use its current size. */
3739 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3740 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3741 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3744 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3745 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3748 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3750 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3751 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3755 area
.width
= needed
->width
;
3756 area
.height
= needed
->height
;
3757 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3758 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3759 - FRAME_MENUBAR_HEIGHT (f
)
3760 - FRAME_TOOLBAR_HEIGHT (f
)
3761 - FRAME_INTERNAL_BORDER_WIDTH (f
));
3764 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3765 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3770 /* Set X fontset for XIC of frame F, using base font name
3771 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3774 xic_set_xfontset (f
, base_fontname
)
3776 char *base_fontname
;
3781 xfs
= xic_create_xfontset (f
, base_fontname
);
3783 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3784 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3785 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3786 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3787 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3790 if (FRAME_XIC_FONTSET (f
))
3791 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3792 FRAME_XIC_FONTSET (f
) = xfs
;
3795 #endif /* HAVE_X_I18N */
3799 #ifdef USE_X_TOOLKIT
3801 /* Create and set up the X widget for frame F. */
3804 x_window (f
, window_prompting
, minibuffer_only
)
3806 long window_prompting
;
3807 int minibuffer_only
;
3809 XClassHint class_hints
;
3810 XSetWindowAttributes attributes
;
3811 unsigned long attribute_mask
;
3812 Widget shell_widget
;
3814 Widget frame_widget
;
3820 /* Use the resource name as the top-level widget name
3821 for looking up resources. Make a non-Lisp copy
3822 for the window manager, so GC relocation won't bother it.
3824 Elsewhere we specify the window name for the window manager. */
3827 char *str
= (char *) SDATA (Vx_resource_name
);
3828 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3829 strcpy (f
->namebuf
, str
);
3833 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3834 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3835 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3836 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3837 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3838 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3839 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3840 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3841 applicationShellWidgetClass
,
3842 FRAME_X_DISPLAY (f
), al
, ac
);
3844 f
->output_data
.x
->widget
= shell_widget
;
3845 /* maybe_set_screen_title_format (shell_widget); */
3847 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3848 (widget_value
*) NULL
,
3849 shell_widget
, False
,
3853 (lw_callback
) NULL
);
3856 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3857 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3858 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3859 XtSetValues (pane_widget
, al
, ac
);
3860 f
->output_data
.x
->column_widget
= pane_widget
;
3862 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3863 the emacs screen when changing menubar. This reduces flickering. */
3866 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3867 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3868 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3869 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3870 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3871 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3872 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3873 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3874 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3877 f
->output_data
.x
->edit_widget
= frame_widget
;
3879 XtManageChild (frame_widget
);
3881 /* Do some needed geometry management. */
3884 char *tem
, shell_position
[32];
3887 int extra_borders
= 0;
3889 = (f
->output_data
.x
->menubar_widget
3890 ? (f
->output_data
.x
->menubar_widget
->core
.height
3891 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3894 #if 0 /* Experimentally, we now get the right results
3895 for -geometry -0-0 without this. 24 Aug 96, rms. */
3896 if (FRAME_EXTERNAL_MENU_BAR (f
))
3899 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3900 menubar_size
+= ibw
;
3904 f
->output_data
.x
->menubar_height
= menubar_size
;
3907 /* Motif seems to need this amount added to the sizes
3908 specified for the shell widget. The Athena/Lucid widgets don't.
3909 Both conclusions reached experimentally. -- rms. */
3910 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3911 &extra_borders
, NULL
);
3915 /* Convert our geometry parameters into a geometry string
3917 Note that we do not specify here whether the position
3918 is a user-specified or program-specified one.
3919 We pass that information later, in x_wm_set_size_hints. */
3921 int left
= f
->output_data
.x
->left_pos
;
3922 int xneg
= window_prompting
& XNegative
;
3923 int top
= f
->output_data
.x
->top_pos
;
3924 int yneg
= window_prompting
& YNegative
;
3930 if (window_prompting
& USPosition
)
3931 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3932 PIXEL_WIDTH (f
) + extra_borders
,
3933 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3934 (xneg
? '-' : '+'), left
,
3935 (yneg
? '-' : '+'), top
);
3937 sprintf (shell_position
, "=%dx%d",
3938 PIXEL_WIDTH (f
) + extra_borders
,
3939 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3942 len
= strlen (shell_position
) + 1;
3943 /* We don't free this because we don't know whether
3944 it is safe to free it while the frame exists.
3945 It isn't worth the trouble of arranging to free it
3946 when the frame is deleted. */
3947 tem
= (char *) xmalloc (len
);
3948 strncpy (tem
, shell_position
, len
);
3949 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3950 XtSetValues (shell_widget
, al
, ac
);
3953 XtManageChild (pane_widget
);
3954 XtRealizeWidget (shell_widget
);
3956 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3958 validate_x_resource_name ();
3960 class_hints
.res_name
= (char *) SDATA (Vx_resource_name
);
3961 class_hints
.res_class
= (char *) SDATA (Vx_resource_class
);
3962 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3965 FRAME_XIC (f
) = NULL
;
3967 create_frame_xic (f
);
3971 f
->output_data
.x
->wm_hints
.input
= True
;
3972 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3973 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3974 &f
->output_data
.x
->wm_hints
);
3976 hack_wm_protocols (f
, shell_widget
);
3979 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3982 /* Do a stupid property change to force the server to generate a
3983 PropertyNotify event so that the event_stream server timestamp will
3984 be initialized to something relevant to the time we created the window.
3986 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3987 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3988 XA_ATOM
, 32, PropModeAppend
,
3989 (unsigned char*) NULL
, 0);
3991 /* Make all the standard events reach the Emacs frame. */
3992 attributes
.event_mask
= STANDARD_EVENT_SET
;
3997 /* XIM server might require some X events. */
3998 unsigned long fevent
= NoEventMask
;
3999 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
4000 attributes
.event_mask
|= fevent
;
4002 #endif /* HAVE_X_I18N */
4004 attribute_mask
= CWEventMask
;
4005 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
4006 attribute_mask
, &attributes
);
4008 XtMapWidget (frame_widget
);
4010 /* x_set_name normally ignores requests to set the name if the
4011 requested name is the same as the current name. This is the one
4012 place where that assumption isn't correct; f->name is set, but
4013 the X server hasn't been told. */
4016 int explicit = f
->explicit_name
;
4018 f
->explicit_name
= 0;
4021 x_set_name (f
, name
, explicit);
4024 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4025 f
->output_data
.x
->text_cursor
);
4029 /* This is a no-op, except under Motif. Make sure main areas are
4030 set to something reasonable, in case we get an error later. */
4031 lw_set_main_areas (pane_widget
, 0, frame_widget
);
4034 #else /* not USE_X_TOOLKIT */
4040 if (! xg_create_frame_widgets (f
))
4041 error ("Unable to create window");
4044 FRAME_XIC (f
) = NULL
;
4047 create_frame_xic (f
);
4050 /* XIM server might require some X events. */
4051 unsigned long fevent
= NoEventMask
;
4052 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
4054 if (fevent
!= NoEventMask
)
4056 XSetWindowAttributes attributes
;
4057 XWindowAttributes wattr
;
4058 unsigned long attribute_mask
;
4060 XGetWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4062 attributes
.event_mask
= wattr
.your_event_mask
| fevent
;
4063 attribute_mask
= CWEventMask
;
4064 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4065 attribute_mask
, &attributes
);
4073 #else /*! USE_GTK */
4074 /* Create and set up the X window for frame F. */
4081 XClassHint class_hints
;
4082 XSetWindowAttributes attributes
;
4083 unsigned long attribute_mask
;
4085 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
4086 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
4087 attributes
.bit_gravity
= StaticGravity
;
4088 attributes
.backing_store
= NotUseful
;
4089 attributes
.save_under
= True
;
4090 attributes
.event_mask
= STANDARD_EVENT_SET
;
4091 attributes
.colormap
= FRAME_X_COLORMAP (f
);
4092 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
4097 = XCreateWindow (FRAME_X_DISPLAY (f
),
4098 f
->output_data
.x
->parent_desc
,
4099 f
->output_data
.x
->left_pos
,
4100 f
->output_data
.x
->top_pos
,
4101 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
4102 f
->output_data
.x
->border_width
,
4103 CopyFromParent
, /* depth */
4104 InputOutput
, /* class */
4106 attribute_mask
, &attributes
);
4110 create_frame_xic (f
);
4113 /* XIM server might require some X events. */
4114 unsigned long fevent
= NoEventMask
;
4115 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
4116 attributes
.event_mask
|= fevent
;
4117 attribute_mask
= CWEventMask
;
4118 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4119 attribute_mask
, &attributes
);
4122 #endif /* HAVE_X_I18N */
4124 validate_x_resource_name ();
4126 class_hints
.res_name
= (char *) SDATA (Vx_resource_name
);
4127 class_hints
.res_class
= (char *) SDATA (Vx_resource_class
);
4128 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
4130 /* The menubar is part of the ordinary display;
4131 it does not count in addition to the height of the window. */
4132 f
->output_data
.x
->menubar_height
= 0;
4134 /* This indicates that we use the "Passive Input" input model.
4135 Unless we do this, we don't get the Focus{In,Out} events that we
4136 need to draw the cursor correctly. Accursed bureaucrats.
4137 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
4139 f
->output_data
.x
->wm_hints
.input
= True
;
4140 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
4141 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4142 &f
->output_data
.x
->wm_hints
);
4143 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
4145 /* Request "save yourself" and "delete window" commands from wm. */
4148 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
4149 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
4150 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
4153 /* x_set_name normally ignores requests to set the name if the
4154 requested name is the same as the current name. This is the one
4155 place where that assumption isn't correct; f->name is set, but
4156 the X server hasn't been told. */
4159 int explicit = f
->explicit_name
;
4161 f
->explicit_name
= 0;
4164 x_set_name (f
, name
, explicit);
4167 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4168 f
->output_data
.x
->text_cursor
);
4172 if (FRAME_X_WINDOW (f
) == 0)
4173 error ("Unable to create window");
4176 #endif /* not USE_GTK */
4177 #endif /* not USE_X_TOOLKIT */
4179 /* Handle the icon stuff for this window. Perhaps later we might
4180 want an x_set_icon_position which can be called interactively as
4188 Lisp_Object icon_x
, icon_y
;
4189 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4191 /* Set the position of the icon. Note that twm groups all
4192 icons in an icon window. */
4193 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
4194 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
4195 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
4197 CHECK_NUMBER (icon_x
);
4198 CHECK_NUMBER (icon_y
);
4200 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
4201 error ("Both left and top icon corners of icon must be specified");
4205 if (! EQ (icon_x
, Qunbound
))
4206 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
4208 /* Start up iconic or window? */
4209 x_wm_set_window_state
4210 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
4215 x_text_icon (f
, (char *) SDATA ((!NILP (f
->icon_name
)
4222 /* Make the GCs needed for this window, setting the
4223 background, border and mouse colors; also create the
4224 mouse cursor and the gray border tile. */
4226 static char cursor_bits
[] =
4228 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4229 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4230 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4231 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
4238 XGCValues gc_values
;
4242 /* Create the GCs of this frame.
4243 Note that many default values are used. */
4246 gc_values
.font
= f
->output_data
.x
->font
->fid
;
4247 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
4248 gc_values
.background
= f
->output_data
.x
->background_pixel
;
4249 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
4250 f
->output_data
.x
->normal_gc
4251 = XCreateGC (FRAME_X_DISPLAY (f
),
4253 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
4256 /* Reverse video style. */
4257 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4258 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
4259 f
->output_data
.x
->reverse_gc
4260 = XCreateGC (FRAME_X_DISPLAY (f
),
4262 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
4265 /* Cursor has cursor-color background, background-color foreground. */
4266 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4267 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
4268 gc_values
.fill_style
= FillOpaqueStippled
;
4270 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
4271 FRAME_X_DISPLAY_INFO (f
)->root_window
,
4272 cursor_bits
, 16, 16);
4273 f
->output_data
.x
->cursor_gc
4274 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4275 (GCFont
| GCForeground
| GCBackground
4276 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
4280 f
->output_data
.x
->white_relief
.gc
= 0;
4281 f
->output_data
.x
->black_relief
.gc
= 0;
4283 /* Create the gray border tile used when the pointer is not in
4284 the frame. Since this depends on the frame's pixel values,
4285 this must be done on a per-frame basis. */
4286 f
->output_data
.x
->border_tile
4287 = (XCreatePixmapFromBitmapData
4288 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
4289 gray_bits
, gray_width
, gray_height
,
4290 f
->output_data
.x
->foreground_pixel
,
4291 f
->output_data
.x
->background_pixel
,
4292 DefaultDepth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
))));
4298 /* Free what was was allocated in x_make_gc. */
4304 Display
*dpy
= FRAME_X_DISPLAY (f
);
4308 if (f
->output_data
.x
->normal_gc
)
4310 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
4311 f
->output_data
.x
->normal_gc
= 0;
4314 if (f
->output_data
.x
->reverse_gc
)
4316 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4317 f
->output_data
.x
->reverse_gc
= 0;
4320 if (f
->output_data
.x
->cursor_gc
)
4322 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4323 f
->output_data
.x
->cursor_gc
= 0;
4326 if (f
->output_data
.x
->border_tile
)
4328 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4329 f
->output_data
.x
->border_tile
= 0;
4336 /* Handler for signals raised during x_create_frame and
4337 x_create_top_frame. FRAME is the frame which is partially
4341 unwind_create_frame (frame
)
4344 struct frame
*f
= XFRAME (frame
);
4346 /* If frame is ``official'', nothing to do. */
4347 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4350 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4353 x_free_frame_resources (f
);
4355 /* Check that reference counts are indeed correct. */
4356 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4357 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4365 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4367 doc
: /* Make a new X window, which is called a "frame" in Emacs terms.
4368 Returns an Emacs frame object.
4369 ALIST is an alist of frame parameters.
4370 If the parameters specify that the frame should not have a minibuffer,
4371 and do not specify a specific minibuffer window to use,
4372 then `default-minibuffer-frame' must be a frame whose minibuffer can
4373 be shared by the new frame.
4375 This function is an internal primitive--use `make-frame' instead. */)
4380 Lisp_Object frame
, tem
;
4382 int minibuffer_only
= 0;
4383 long window_prompting
= 0;
4385 int count
= SPECPDL_INDEX ();
4386 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4387 Lisp_Object display
;
4388 struct x_display_info
*dpyinfo
= NULL
;
4394 /* Use this general default value to start with
4395 until we know if this frame has a specified name. */
4396 Vx_resource_name
= Vinvocation_name
;
4398 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4399 if (EQ (display
, Qunbound
))
4401 dpyinfo
= check_x_display_info (display
);
4403 kb
= dpyinfo
->kboard
;
4405 kb
= &the_only_kboard
;
4408 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4410 && ! EQ (name
, Qunbound
)
4412 error ("Invalid frame name--not a string or nil");
4415 Vx_resource_name
= name
;
4417 /* See if parent window is specified. */
4418 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4419 if (EQ (parent
, Qunbound
))
4421 if (! NILP (parent
))
4422 CHECK_NUMBER (parent
);
4424 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4425 /* No need to protect DISPLAY because that's not used after passing
4426 it to make_frame_without_minibuffer. */
4428 GCPRO4 (parms
, parent
, name
, frame
);
4429 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4431 if (EQ (tem
, Qnone
) || NILP (tem
))
4432 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4433 else if (EQ (tem
, Qonly
))
4435 f
= make_minibuffer_frame ();
4436 minibuffer_only
= 1;
4438 else if (WINDOWP (tem
))
4439 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4443 XSETFRAME (frame
, f
);
4445 /* Note that X Windows does support scroll bars. */
4446 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4448 f
->output_method
= output_x_window
;
4449 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4450 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4451 f
->output_data
.x
->icon_bitmap
= -1;
4452 f
->output_data
.x
->fontset
= -1;
4453 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4454 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4455 #ifdef USE_TOOLKIT_SCROLL_BARS
4456 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
4457 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
4458 #endif /* USE_TOOLKIT_SCROLL_BARS */
4459 record_unwind_protect (unwind_create_frame
, frame
);
4462 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4464 if (! STRINGP (f
->icon_name
))
4465 f
->icon_name
= Qnil
;
4467 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4469 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4470 dpyinfo_refcount
= dpyinfo
->reference_count
;
4471 #endif /* GLYPH_DEBUG */
4473 FRAME_KBOARD (f
) = kb
;
4476 /* These colors will be set anyway later, but it's important
4477 to get the color reference counts right, so initialize them! */
4480 struct gcpro gcpro1
;
4482 /* Function x_decode_color can signal an error. Make
4483 sure to initialize color slots so that we won't try
4484 to free colors we haven't allocated. */
4485 f
->output_data
.x
->foreground_pixel
= -1;
4486 f
->output_data
.x
->background_pixel
= -1;
4487 f
->output_data
.x
->cursor_pixel
= -1;
4488 f
->output_data
.x
->cursor_foreground_pixel
= -1;
4489 f
->output_data
.x
->border_pixel
= -1;
4490 f
->output_data
.x
->mouse_pixel
= -1;
4492 black
= build_string ("black");
4494 f
->output_data
.x
->foreground_pixel
4495 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4496 f
->output_data
.x
->background_pixel
4497 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4498 f
->output_data
.x
->cursor_pixel
4499 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4500 f
->output_data
.x
->cursor_foreground_pixel
4501 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4502 f
->output_data
.x
->border_pixel
4503 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4504 f
->output_data
.x
->mouse_pixel
4505 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4509 /* Specify the parent under which to make this X window. */
4513 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4514 f
->output_data
.x
->explicit_parent
= 1;
4518 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4519 f
->output_data
.x
->explicit_parent
= 0;
4522 /* Set the name; the functions to which we pass f expect the name to
4524 if (EQ (name
, Qunbound
) || NILP (name
))
4526 f
->name
= build_string (dpyinfo
->x_id_name
);
4527 f
->explicit_name
= 0;
4532 f
->explicit_name
= 1;
4533 /* use the frame's title when getting resources for this frame. */
4534 specbind (Qx_resource_name
, name
);
4537 /* Extract the window parameters from the supplied values
4538 that are needed to determine window geometry. */
4542 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4545 /* First, try whatever font the caller has specified. */
4548 tem
= Fquery_fontset (font
, Qnil
);
4550 font
= x_new_fontset (f
, SDATA (tem
));
4552 font
= x_new_font (f
, SDATA (font
));
4555 /* Try out a font which we hope has bold and italic variations. */
4556 if (!STRINGP (font
))
4557 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4558 if (!STRINGP (font
))
4559 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4560 if (! STRINGP (font
))
4561 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4562 if (! STRINGP (font
))
4563 /* This was formerly the first thing tried, but it finds too many fonts
4564 and takes too long. */
4565 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4566 /* If those didn't work, look for something which will at least work. */
4567 if (! STRINGP (font
))
4568 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4570 if (! STRINGP (font
))
4571 font
= build_string ("fixed");
4573 x_default_parameter (f
, parms
, Qfont
, font
,
4574 "font", "Font", RES_TYPE_STRING
);
4578 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4579 whereby it fails to get any font. */
4580 xlwmenu_default_font
= f
->output_data
.x
->font
;
4583 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4584 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4586 /* This defaults to 1 in order to match xterm. We recognize either
4587 internalBorderWidth or internalBorder (which is what xterm calls
4589 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4593 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4594 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4595 if (! EQ (value
, Qunbound
))
4596 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4599 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4600 "internalBorderWidth", "internalBorderWidth",
4602 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4603 "verticalScrollBars", "ScrollBars",
4606 /* Also do the stuff which must be set before the window exists. */
4607 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4608 "foreground", "Foreground", RES_TYPE_STRING
);
4609 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4610 "background", "Background", RES_TYPE_STRING
);
4611 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4612 "pointerColor", "Foreground", RES_TYPE_STRING
);
4613 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4614 "cursorColor", "Foreground", RES_TYPE_STRING
);
4615 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4616 "borderColor", "BorderColor", RES_TYPE_STRING
);
4617 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4618 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4619 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4620 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4621 x_default_parameter (f
, parms
, Qleft_fringe
, Qnil
,
4622 "leftFringe", "LeftFringe", RES_TYPE_NUMBER
);
4623 x_default_parameter (f
, parms
, Qright_fringe
, Qnil
,
4624 "rightFringe", "RightFringe", RES_TYPE_NUMBER
);
4626 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4627 "scrollBarForeground",
4628 "ScrollBarForeground", 1);
4629 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4630 "scrollBarBackground",
4631 "ScrollBarBackground", 0);
4633 /* Init faces before x_default_parameter is called for scroll-bar
4634 parameters because that function calls x_set_scroll_bar_width,
4635 which calls change_frame_size, which calls Fset_window_buffer,
4636 which runs hooks, which call Fvertical_motion. At the end, we
4637 end up in init_iterator with a null face cache, which should not
4639 init_frame_faces (f
);
4641 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4642 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4643 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4644 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4645 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4646 "bufferPredicate", "BufferPredicate",
4648 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4649 "title", "Title", RES_TYPE_STRING
);
4650 x_default_parameter (f
, parms
, Qwait_for_wm
, Qt
,
4651 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN
);
4652 x_default_parameter (f
, parms
, Qfullscreen
, Qnil
,
4653 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL
);
4655 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4657 /* Add the tool-bar height to the initial frame height so that the
4658 user gets a text display area of the size he specified with -g or
4659 via .Xdefaults. Later changes of the tool-bar height don't
4660 change the frame size. This is done so that users can create
4661 tall Emacs frames without having to guess how tall the tool-bar
4663 if (FRAME_TOOL_BAR_LINES (f
))
4665 int margin
, relief
, bar_height
;
4667 relief
= (tool_bar_button_relief
>= 0
4668 ? tool_bar_button_relief
4669 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4671 if (INTEGERP (Vtool_bar_button_margin
)
4672 && XINT (Vtool_bar_button_margin
) > 0)
4673 margin
= XFASTINT (Vtool_bar_button_margin
);
4674 else if (CONSP (Vtool_bar_button_margin
)
4675 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4676 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4677 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4681 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4682 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4685 /* Compute the size of the X window. */
4686 window_prompting
= x_figure_window_size (f
, parms
);
4688 if (window_prompting
& XNegative
)
4690 if (window_prompting
& YNegative
)
4691 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4693 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4697 if (window_prompting
& YNegative
)
4698 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4700 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4703 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4705 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4706 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4708 /* Create the X widget or window. */
4709 #ifdef USE_X_TOOLKIT
4710 x_window (f
, window_prompting
, minibuffer_only
);
4718 /* Now consider the frame official. */
4719 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4720 Vframe_list
= Fcons (frame
, Vframe_list
);
4722 /* We need to do this after creating the X window, so that the
4723 icon-creation functions can say whose icon they're describing. */
4724 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4725 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4727 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4728 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4729 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4730 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4731 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4732 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4733 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4734 "scrollBarWidth", "ScrollBarWidth",
4737 /* Dimensions, especially f->height, must be done via change_frame_size.
4738 Change will not be effected unless different from the current
4744 SET_FRAME_WIDTH (f
, 0);
4745 change_frame_size (f
, height
, width
, 1, 0, 0);
4747 /* Set up faces after all frame parameters are known. This call
4748 also merges in face attributes specified for new frames. If we
4749 don't do this, the `menu' face for instance won't have the right
4750 colors, and the menu bar won't appear in the specified colors for
4752 call1 (Qface_set_after_frame_default
, frame
);
4754 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
4755 /* Create the menu bar. */
4756 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4758 /* If this signals an error, we haven't set size hints for the
4759 frame and we didn't make it visible. */
4760 initialize_frame_menubar (f
);
4763 /* This is a no-op, except under Motif where it arranges the
4764 main window for the widgets on it. */
4765 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4766 f
->output_data
.x
->menubar_widget
,
4767 f
->output_data
.x
->edit_widget
);
4768 #endif /* not USE_GTK */
4770 #endif /* USE_X_TOOLKIT || USE_GTK */
4772 /* Tell the server what size and position, etc, we want, and how
4773 badly we want them. This should be done after we have the menu
4774 bar so that its size can be taken into account. */
4776 x_wm_set_size_hint (f
, window_prompting
, 0);
4779 /* Make the window appear on the frame and enable display, unless
4780 the caller says not to. However, with explicit parent, Emacs
4781 cannot control visibility, so don't try. */
4782 if (! f
->output_data
.x
->explicit_parent
)
4784 Lisp_Object visibility
;
4786 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4788 if (EQ (visibility
, Qunbound
))
4791 if (EQ (visibility
, Qicon
))
4792 x_iconify_frame (f
);
4793 else if (! NILP (visibility
))
4794 x_make_frame_visible (f
);
4796 /* Must have been Qnil. */
4802 /* Make sure windows on this frame appear in calls to next-window
4803 and similar functions. */
4804 Vwindow_list
= Qnil
;
4806 return unbind_to (count
, frame
);
4810 /* FRAME is used only to get a handle on the X display. We don't pass the
4811 display info directly because we're called from frame.c, which doesn't
4812 know about that structure. */
4815 x_get_focus_frame (frame
)
4816 struct frame
*frame
;
4818 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4820 if (! dpyinfo
->x_focus_frame
)
4823 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4828 /* In certain situations, when the window manager follows a
4829 click-to-focus policy, there seems to be no way around calling
4830 XSetInputFocus to give another frame the input focus .
4832 In an ideal world, XSetInputFocus should generally be avoided so
4833 that applications don't interfere with the window manager's focus
4834 policy. But I think it's okay to use when it's clearly done
4835 following a user-command. */
4837 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4838 doc
: /* Set the input focus to FRAME.
4839 FRAME nil means use the selected frame. */)
4843 struct frame
*f
= check_x_frame (frame
);
4844 Display
*dpy
= FRAME_X_DISPLAY (f
);
4848 count
= x_catch_errors (dpy
);
4849 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4850 RevertToParent
, CurrentTime
);
4851 x_uncatch_errors (dpy
, count
);
4858 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4859 doc
: /* Internal function called by `color-defined-p', which see. */)
4861 Lisp_Object color
, frame
;
4864 FRAME_PTR f
= check_x_frame (frame
);
4866 CHECK_STRING (color
);
4868 if (x_defined_color (f
, SDATA (color
), &foo
, 0))
4874 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4875 doc
: /* Internal function called by `color-values', which see. */)
4877 Lisp_Object color
, frame
;
4880 FRAME_PTR f
= check_x_frame (frame
);
4882 CHECK_STRING (color
);
4884 if (x_defined_color (f
, SDATA (color
), &foo
, 0))
4888 rgb
[0] = make_number (foo
.red
);
4889 rgb
[1] = make_number (foo
.green
);
4890 rgb
[2] = make_number (foo
.blue
);
4891 return Flist (3, rgb
);
4897 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4898 doc
: /* Internal function called by `display-color-p', which see. */)
4900 Lisp_Object display
;
4902 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4904 if (dpyinfo
->n_planes
<= 2)
4907 switch (dpyinfo
->visual
->class)
4920 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4922 doc
: /* Return t if the X display supports shades of gray.
4923 Note that color displays do support shades of gray.
4924 The optional argument DISPLAY specifies which display to ask about.
4925 DISPLAY should be either a frame or a display name (a string).
4926 If omitted or nil, that stands for the selected frame's display. */)
4928 Lisp_Object display
;
4930 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4932 if (dpyinfo
->n_planes
<= 1)
4935 switch (dpyinfo
->visual
->class)
4950 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4952 doc
: /* Returns the width in pixels of the X display DISPLAY.
4953 The optional argument DISPLAY specifies which display to ask about.
4954 DISPLAY should be either a frame or a display name (a string).
4955 If omitted or nil, that stands for the selected frame's display. */)
4957 Lisp_Object display
;
4959 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4961 return make_number (dpyinfo
->width
);
4964 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4965 Sx_display_pixel_height
, 0, 1, 0,
4966 doc
: /* Returns the height in pixels of the X display DISPLAY.
4967 The optional argument DISPLAY specifies which display to ask about.
4968 DISPLAY should be either a frame or a display name (a string).
4969 If omitted or nil, that stands for the selected frame's display. */)
4971 Lisp_Object display
;
4973 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4975 return make_number (dpyinfo
->height
);
4978 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4980 doc
: /* Returns the number of bitplanes of the X display DISPLAY.
4981 The optional argument DISPLAY specifies which display to ask about.
4982 DISPLAY should be either a frame or a display name (a string).
4983 If omitted or nil, that stands for the selected frame's display. */)
4985 Lisp_Object display
;
4987 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4989 return make_number (dpyinfo
->n_planes
);
4992 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4994 doc
: /* Returns the number of color cells of the X display DISPLAY.
4995 The optional argument DISPLAY specifies which display to ask about.
4996 DISPLAY should be either a frame or a display name (a string).
4997 If omitted or nil, that stands for the selected frame's display. */)
4999 Lisp_Object display
;
5001 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5003 return make_number (DisplayCells (dpyinfo
->display
,
5004 XScreenNumberOfScreen (dpyinfo
->screen
)));
5007 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
5008 Sx_server_max_request_size
,
5010 doc
: /* Returns the maximum request size of the X server of display DISPLAY.
5011 The optional argument DISPLAY specifies which display to ask about.
5012 DISPLAY should be either a frame or a display name (a string).
5013 If omitted or nil, that stands for the selected frame's display. */)
5015 Lisp_Object display
;
5017 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5019 return make_number (MAXREQUEST (dpyinfo
->display
));
5022 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
5023 doc
: /* Returns the vendor ID string of the X server of display DISPLAY.
5024 The optional argument DISPLAY specifies which display to ask about.
5025 DISPLAY should be either a frame or a display name (a string).
5026 If omitted or nil, that stands for the selected frame's display. */)
5028 Lisp_Object display
;
5030 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5031 char *vendor
= ServerVendor (dpyinfo
->display
);
5033 if (! vendor
) vendor
= "";
5034 return build_string (vendor
);
5037 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
5038 doc
: /* Returns the version numbers of the X server of display DISPLAY.
5039 The value is a list of three integers: the major and minor
5040 version numbers of the X Protocol in use, and the vendor-specific release
5041 number. See also the function `x-server-vendor'.
5043 The optional argument DISPLAY specifies which display to ask about.
5044 DISPLAY should be either a frame or a display name (a string).
5045 If omitted or nil, that stands for the selected frame's display. */)
5047 Lisp_Object display
;
5049 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5050 Display
*dpy
= dpyinfo
->display
;
5052 return Fcons (make_number (ProtocolVersion (dpy
)),
5053 Fcons (make_number (ProtocolRevision (dpy
)),
5054 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
5057 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
5058 doc
: /* Return the number of screens on the X server of display DISPLAY.
5059 The optional argument DISPLAY specifies which display to ask about.
5060 DISPLAY should be either a frame or a display name (a string).
5061 If omitted or nil, that stands for the selected frame's display. */)
5063 Lisp_Object display
;
5065 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5067 return make_number (ScreenCount (dpyinfo
->display
));
5070 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
5071 doc
: /* Return the height in millimeters of the X display DISPLAY.
5072 The optional argument DISPLAY specifies which display to ask about.
5073 DISPLAY should be either a frame or a display name (a string).
5074 If omitted or nil, that stands for the selected frame's display. */)
5076 Lisp_Object display
;
5078 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5080 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
5083 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
5084 doc
: /* Return the width in millimeters of the X display DISPLAY.
5085 The optional argument DISPLAY specifies which display to ask about.
5086 DISPLAY should be either a frame or a display name (a string).
5087 If omitted or nil, that stands for the selected frame's display. */)
5089 Lisp_Object display
;
5091 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5093 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
5096 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
5097 Sx_display_backing_store
, 0, 1, 0,
5098 doc
: /* Returns an indication of whether X display DISPLAY does backing store.
5099 The value may be `always', `when-mapped', or `not-useful'.
5100 The optional argument DISPLAY specifies which display to ask about.
5101 DISPLAY should be either a frame or a display name (a string).
5102 If omitted or nil, that stands for the selected frame's display. */)
5104 Lisp_Object display
;
5106 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5109 switch (DoesBackingStore (dpyinfo
->screen
))
5112 result
= intern ("always");
5116 result
= intern ("when-mapped");
5120 result
= intern ("not-useful");
5124 error ("Strange value for BackingStore parameter of screen");
5131 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
5132 Sx_display_visual_class
, 0, 1, 0,
5133 doc
: /* Return the visual class of the X display DISPLAY.
5134 The value is one of the symbols `static-gray', `gray-scale',
5135 `static-color', `pseudo-color', `true-color', or `direct-color'.
5137 The optional argument DISPLAY specifies which display to ask about.
5138 DISPLAY should be either a frame or a display name (a string).
5139 If omitted or nil, that stands for the selected frame's display. */)
5141 Lisp_Object display
;
5143 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5146 switch (dpyinfo
->visual
->class)
5149 result
= intern ("static-gray");
5152 result
= intern ("gray-scale");
5155 result
= intern ("static-color");
5158 result
= intern ("pseudo-color");
5161 result
= intern ("true-color");
5164 result
= intern ("direct-color");
5167 error ("Display has an unknown visual class");
5174 DEFUN ("x-display-save-under", Fx_display_save_under
,
5175 Sx_display_save_under
, 0, 1, 0,
5176 doc
: /* Returns t if the X display DISPLAY supports the save-under feature.
5177 The optional argument DISPLAY specifies which display to ask about.
5178 DISPLAY should be either a frame or a display name (a string).
5179 If omitted or nil, that stands for the selected frame's display. */)
5181 Lisp_Object display
;
5183 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5185 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
5193 register struct frame
*f
;
5195 return PIXEL_WIDTH (f
);
5200 register struct frame
*f
;
5202 return PIXEL_HEIGHT (f
);
5207 register struct frame
*f
;
5209 return FONT_WIDTH (f
->output_data
.x
->font
);
5214 register struct frame
*f
;
5216 return f
->output_data
.x
->line_height
;
5221 register struct frame
*f
;
5223 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
5228 /************************************************************************
5230 ************************************************************************/
5233 /* Mapping visual names to visuals. */
5235 static struct visual_class
5242 {"StaticGray", StaticGray
},
5243 {"GrayScale", GrayScale
},
5244 {"StaticColor", StaticColor
},
5245 {"PseudoColor", PseudoColor
},
5246 {"TrueColor", TrueColor
},
5247 {"DirectColor", DirectColor
},
5252 #ifndef HAVE_XSCREENNUMBEROFSCREEN
5254 /* Value is the screen number of screen SCR. This is a substitute for
5255 the X function with the same name when that doesn't exist. */
5258 XScreenNumberOfScreen (scr
)
5259 register Screen
*scr
;
5261 Display
*dpy
= scr
->display
;
5264 for (i
= 0; i
< dpy
->nscreens
; ++i
)
5265 if (scr
== dpy
->screens
+ i
)
5271 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5274 /* Select the visual that should be used on display DPYINFO. Set
5275 members of DPYINFO appropriately. Called from x_term_init. */
5278 select_visual (dpyinfo
)
5279 struct x_display_info
*dpyinfo
;
5281 Display
*dpy
= dpyinfo
->display
;
5282 Screen
*screen
= dpyinfo
->screen
;
5285 /* See if a visual is specified. */
5286 value
= display_x_get_resource (dpyinfo
,
5287 build_string ("visualClass"),
5288 build_string ("VisualClass"),
5290 if (STRINGP (value
))
5292 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
5293 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
5294 depth, a decimal number. NAME is compared with case ignored. */
5295 char *s
= (char *) alloca (SBYTES (value
) + 1);
5300 strcpy (s
, SDATA (value
));
5301 dash
= index (s
, '-');
5304 dpyinfo
->n_planes
= atoi (dash
+ 1);
5308 /* We won't find a matching visual with depth 0, so that
5309 an error will be printed below. */
5310 dpyinfo
->n_planes
= 0;
5312 /* Determine the visual class. */
5313 for (i
= 0; visual_classes
[i
].name
; ++i
)
5314 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
5316 class = visual_classes
[i
].class;
5320 /* Look up a matching visual for the specified class. */
5322 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
5323 dpyinfo
->n_planes
, class, &vinfo
))
5324 fatal ("Invalid visual specification `%s'", SDATA (value
));
5326 dpyinfo
->visual
= vinfo
.visual
;
5331 XVisualInfo
*vinfo
, vinfo_template
;
5333 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
5336 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
5338 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
5340 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5341 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
5342 &vinfo_template
, &n_visuals
);
5344 fatal ("Can't get proper X visual info");
5346 dpyinfo
->n_planes
= vinfo
->depth
;
5347 XFree ((char *) vinfo
);
5352 /* Return the X display structure for the display named NAME.
5353 Open a new connection if necessary. */
5355 struct x_display_info
*
5356 x_display_info_for_name (name
)
5360 struct x_display_info
*dpyinfo
;
5362 CHECK_STRING (name
);
5364 if (! EQ (Vwindow_system
, intern ("x")))
5365 error ("Not using X Windows");
5367 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5369 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5372 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5377 /* Use this general default value to start with. */
5378 Vx_resource_name
= Vinvocation_name
;
5380 validate_x_resource_name ();
5382 dpyinfo
= x_term_init (name
, (char *)0,
5383 (char *) SDATA (Vx_resource_name
));
5386 error ("Cannot connect to X server %s", SDATA (name
));
5389 XSETFASTINT (Vwindow_system_version
, 11);
5395 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5397 doc
: /* Open a connection to an X server.
5398 DISPLAY is the name of the display to connect to.
5399 Optional second arg XRM-STRING is a string of resources in xrdb format.
5400 If the optional third arg MUST-SUCCEED is non-nil,
5401 terminate Emacs if we can't open the connection. */)
5402 (display
, xrm_string
, must_succeed
)
5403 Lisp_Object display
, xrm_string
, must_succeed
;
5405 unsigned char *xrm_option
;
5406 struct x_display_info
*dpyinfo
;
5408 CHECK_STRING (display
);
5409 if (! NILP (xrm_string
))
5410 CHECK_STRING (xrm_string
);
5412 if (! EQ (Vwindow_system
, intern ("x")))
5413 error ("Not using X Windows");
5415 if (! NILP (xrm_string
))
5416 xrm_option
= (unsigned char *) SDATA (xrm_string
);
5418 xrm_option
= (unsigned char *) 0;
5420 validate_x_resource_name ();
5422 /* This is what opens the connection and sets x_current_display.
5423 This also initializes many symbols, such as those used for input. */
5424 dpyinfo
= x_term_init (display
, xrm_option
,
5425 (char *) SDATA (Vx_resource_name
));
5429 if (!NILP (must_succeed
))
5430 fatal ("Cannot connect to X server %s.\n\
5431 Check the DISPLAY environment variable or use `-d'.\n\
5432 Also use the `xauth' program to verify that you have the proper\n\
5433 authorization information needed to connect the X server.\n\
5434 An insecure way to solve the problem may be to use `xhost'.\n",
5437 error ("Cannot connect to X server %s", SDATA (display
));
5442 XSETFASTINT (Vwindow_system_version
, 11);
5446 DEFUN ("x-close-connection", Fx_close_connection
,
5447 Sx_close_connection
, 1, 1, 0,
5448 doc
: /* Close the connection to DISPLAY's X server.
5449 For DISPLAY, specify either a frame or a display name (a string).
5450 If DISPLAY is nil, that stands for the selected frame's display. */)
5452 Lisp_Object display
;
5454 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5457 if (dpyinfo
->reference_count
> 0)
5458 error ("Display still has frames on it");
5461 /* Free the fonts in the font table. */
5462 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5463 if (dpyinfo
->font_table
[i
].name
)
5465 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5466 xfree (dpyinfo
->font_table
[i
].full_name
);
5467 xfree (dpyinfo
->font_table
[i
].name
);
5468 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5471 x_destroy_all_bitmaps (dpyinfo
);
5472 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5474 #ifdef USE_X_TOOLKIT
5475 XtCloseDisplay (dpyinfo
->display
);
5477 XCloseDisplay (dpyinfo
->display
);
5480 x_delete_display (dpyinfo
);
5486 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5487 doc
: /* Return the list of display names that Emacs has connections to. */)
5490 Lisp_Object tail
, result
;
5493 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5494 result
= Fcons (XCAR (XCAR (tail
)), result
);
5499 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5500 doc
: /* If ON is non-nil, report X errors as soon as the erring request is made.
5501 If ON is nil, allow buffering of requests.
5502 Turning on synchronization prohibits the Xlib routines from buffering
5503 requests and seriously degrades performance, but makes debugging much
5505 The optional second argument DISPLAY specifies which display to act on.
5506 DISPLAY should be either a frame or a display name (a string).
5507 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
5509 Lisp_Object display
, on
;
5511 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5513 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5518 /* Wait for responses to all X commands issued so far for frame F. */
5525 XSync (FRAME_X_DISPLAY (f
), False
);
5530 /***********************************************************************
5532 ***********************************************************************/
5534 /* Value is the number of elements of vector VECTOR. */
5536 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5538 /* List of supported image types. Use define_image_type to add new
5539 types. Use lookup_image_type to find a type for a given symbol. */
5541 static struct image_type
*image_types
;
5543 /* The symbol `image' which is the car of the lists used to represent
5546 extern Lisp_Object Qimage
;
5548 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5554 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5555 extern Lisp_Object QCdata
, QCtype
;
5556 Lisp_Object QCascent
, QCmargin
, QCrelief
;
5557 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5558 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5560 /* Other symbols. */
5562 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5564 /* Time in seconds after which images should be removed from the cache
5565 if not displayed. */
5567 Lisp_Object Vimage_cache_eviction_delay
;
5569 /* Function prototypes. */
5571 static void define_image_type
P_ ((struct image_type
*type
));
5572 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5573 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5574 static void x_laplace
P_ ((struct frame
*, struct image
*));
5575 static void x_emboss
P_ ((struct frame
*, struct image
*));
5576 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5580 /* Define a new image type from TYPE. This adds a copy of TYPE to
5581 image_types and adds the symbol *TYPE->type to Vimage_types. */
5584 define_image_type (type
)
5585 struct image_type
*type
;
5587 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5588 The initialized data segment is read-only. */
5589 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5590 bcopy (type
, p
, sizeof *p
);
5591 p
->next
= image_types
;
5593 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5597 /* Look up image type SYMBOL, and return a pointer to its image_type
5598 structure. Value is null if SYMBOL is not a known image type. */
5600 static INLINE
struct image_type
*
5601 lookup_image_type (symbol
)
5604 struct image_type
*type
;
5606 for (type
= image_types
; type
; type
= type
->next
)
5607 if (EQ (symbol
, *type
->type
))
5614 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5615 valid image specification is a list whose car is the symbol
5616 `image', and whose rest is a property list. The property list must
5617 contain a value for key `:type'. That value must be the name of a
5618 supported image type. The rest of the property list depends on the
5622 valid_image_p (object
)
5627 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5631 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
5632 if (EQ (XCAR (tem
), QCtype
))
5635 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
5637 struct image_type
*type
;
5638 type
= lookup_image_type (XCAR (tem
));
5640 valid_p
= type
->valid_p (object
);
5651 /* Log error message with format string FORMAT and argument ARG.
5652 Signaling an error, e.g. when an image cannot be loaded, is not a
5653 good idea because this would interrupt redisplay, and the error
5654 message display would lead to another redisplay. This function
5655 therefore simply displays a message. */
5658 image_error (format
, arg1
, arg2
)
5660 Lisp_Object arg1
, arg2
;
5662 add_to_log (format
, arg1
, arg2
);
5667 /***********************************************************************
5668 Image specifications
5669 ***********************************************************************/
5671 enum image_value_type
5673 IMAGE_DONT_CHECK_VALUE_TYPE
,
5675 IMAGE_STRING_OR_NIL_VALUE
,
5677 IMAGE_POSITIVE_INTEGER_VALUE
,
5678 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5679 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5681 IMAGE_INTEGER_VALUE
,
5682 IMAGE_FUNCTION_VALUE
,
5687 /* Structure used when parsing image specifications. */
5689 struct image_keyword
5691 /* Name of keyword. */
5694 /* The type of value allowed. */
5695 enum image_value_type type
;
5697 /* Non-zero means key must be present. */
5700 /* Used to recognize duplicate keywords in a property list. */
5703 /* The value that was found. */
5708 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5710 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5713 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5714 has the format (image KEYWORD VALUE ...). One of the keyword/
5715 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5716 image_keywords structures of size NKEYWORDS describing other
5717 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5720 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5722 struct image_keyword
*keywords
;
5729 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5732 plist
= XCDR (spec
);
5733 while (CONSP (plist
))
5735 Lisp_Object key
, value
;
5737 /* First element of a pair must be a symbol. */
5739 plist
= XCDR (plist
);
5743 /* There must follow a value. */
5746 value
= XCAR (plist
);
5747 plist
= XCDR (plist
);
5749 /* Find key in KEYWORDS. Error if not found. */
5750 for (i
= 0; i
< nkeywords
; ++i
)
5751 if (strcmp (keywords
[i
].name
, SDATA (SYMBOL_NAME (key
))) == 0)
5757 /* Record that we recognized the keyword. If a keywords
5758 was found more than once, it's an error. */
5759 keywords
[i
].value
= value
;
5760 ++keywords
[i
].count
;
5762 if (keywords
[i
].count
> 1)
5765 /* Check type of value against allowed type. */
5766 switch (keywords
[i
].type
)
5768 case IMAGE_STRING_VALUE
:
5769 if (!STRINGP (value
))
5773 case IMAGE_STRING_OR_NIL_VALUE
:
5774 if (!STRINGP (value
) && !NILP (value
))
5778 case IMAGE_SYMBOL_VALUE
:
5779 if (!SYMBOLP (value
))
5783 case IMAGE_POSITIVE_INTEGER_VALUE
:
5784 if (!INTEGERP (value
) || XINT (value
) <= 0)
5788 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5789 if (INTEGERP (value
) && XINT (value
) >= 0)
5792 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5793 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5797 case IMAGE_ASCENT_VALUE
:
5798 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5800 else if (INTEGERP (value
)
5801 && XINT (value
) >= 0
5802 && XINT (value
) <= 100)
5806 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5807 if (!INTEGERP (value
) || XINT (value
) < 0)
5811 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5814 case IMAGE_FUNCTION_VALUE
:
5815 value
= indirect_function (value
);
5817 || COMPILEDP (value
)
5818 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5822 case IMAGE_NUMBER_VALUE
:
5823 if (!INTEGERP (value
) && !FLOATP (value
))
5827 case IMAGE_INTEGER_VALUE
:
5828 if (!INTEGERP (value
))
5832 case IMAGE_BOOL_VALUE
:
5833 if (!NILP (value
) && !EQ (value
, Qt
))
5842 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5846 /* Check that all mandatory fields are present. */
5847 for (i
= 0; i
< nkeywords
; ++i
)
5848 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5851 return NILP (plist
);
5855 /* Return the value of KEY in image specification SPEC. Value is nil
5856 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5857 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5860 image_spec_value (spec
, key
, found
)
5861 Lisp_Object spec
, key
;
5866 xassert (valid_image_p (spec
));
5868 for (tail
= XCDR (spec
);
5869 CONSP (tail
) && CONSP (XCDR (tail
));
5870 tail
= XCDR (XCDR (tail
)))
5872 if (EQ (XCAR (tail
), key
))
5876 return XCAR (XCDR (tail
));
5886 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5887 doc
: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
5888 PIXELS non-nil means return the size in pixels, otherwise return the
5889 size in canonical character units.
5890 FRAME is the frame on which the image will be displayed. FRAME nil
5891 or omitted means use the selected frame. */)
5892 (spec
, pixels
, frame
)
5893 Lisp_Object spec
, pixels
, frame
;
5898 if (valid_image_p (spec
))
5900 struct frame
*f
= check_x_frame (frame
);
5901 int id
= lookup_image (f
, spec
);
5902 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5903 int width
= img
->width
+ 2 * img
->hmargin
;
5904 int height
= img
->height
+ 2 * img
->vmargin
;
5907 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5908 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5910 size
= Fcons (make_number (width
), make_number (height
));
5913 error ("Invalid image specification");
5919 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5920 doc
: /* Return t if image SPEC has a mask bitmap.
5921 FRAME is the frame on which the image will be displayed. FRAME nil
5922 or omitted means use the selected frame. */)
5924 Lisp_Object spec
, frame
;
5929 if (valid_image_p (spec
))
5931 struct frame
*f
= check_x_frame (frame
);
5932 int id
= lookup_image (f
, spec
);
5933 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5938 error ("Invalid image specification");
5945 /***********************************************************************
5946 Image type independent image structures
5947 ***********************************************************************/
5949 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5950 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5953 /* Allocate and return a new image structure for image specification
5954 SPEC. SPEC has a hash value of HASH. */
5956 static struct image
*
5957 make_image (spec
, hash
)
5961 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5963 xassert (valid_image_p (spec
));
5964 bzero (img
, sizeof *img
);
5965 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5966 xassert (img
->type
!= NULL
);
5968 img
->data
.lisp_val
= Qnil
;
5969 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5975 /* Free image IMG which was used on frame F, including its resources. */
5984 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5986 /* Remove IMG from the hash table of its cache. */
5988 img
->prev
->next
= img
->next
;
5990 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5993 img
->next
->prev
= img
->prev
;
5995 c
->images
[img
->id
] = NULL
;
5997 /* Free resources, then free IMG. */
5998 img
->type
->free (f
, img
);
6004 /* Prepare image IMG for display on frame F. Must be called before
6005 drawing an image. */
6008 prepare_image_for_display (f
, img
)
6014 /* We're about to display IMG, so set its timestamp to `now'. */
6016 img
->timestamp
= EMACS_SECS (t
);
6018 /* If IMG doesn't have a pixmap yet, load it now, using the image
6019 type dependent loader function. */
6020 if (img
->pixmap
== None
&& !img
->load_failed_p
)
6021 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6025 /* Value is the number of pixels for the ascent of image IMG when
6026 drawn in face FACE. */
6029 image_ascent (img
, face
)
6033 int height
= img
->height
+ img
->vmargin
;
6036 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
6039 /* This expression is arranged so that if the image can't be
6040 exactly centered, it will be moved slightly up. This is
6041 because a typical font is `top-heavy' (due to the presence
6042 uppercase letters), so the image placement should err towards
6043 being top-heavy too. It also just generally looks better. */
6044 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
6046 ascent
= height
/ 2;
6049 ascent
= height
* img
->ascent
/ 100.0;
6055 /* Image background colors. */
6057 static unsigned long
6058 four_corners_best (ximg
, width
, height
)
6060 unsigned long width
, height
;
6062 unsigned long corners
[4], best
;
6065 /* Get the colors at the corners of ximg. */
6066 corners
[0] = XGetPixel (ximg
, 0, 0);
6067 corners
[1] = XGetPixel (ximg
, width
- 1, 0);
6068 corners
[2] = XGetPixel (ximg
, width
- 1, height
- 1);
6069 corners
[3] = XGetPixel (ximg
, 0, height
- 1);
6071 /* Choose the most frequently found color as background. */
6072 for (i
= best_count
= 0; i
< 4; ++i
)
6076 for (j
= n
= 0; j
< 4; ++j
)
6077 if (corners
[i
] == corners
[j
])
6081 best
= corners
[i
], best_count
= n
;
6087 /* Return the `background' field of IMG. If IMG doesn't have one yet,
6088 it is guessed heuristically. If non-zero, XIMG is an existing XImage
6089 object to use for the heuristic. */
6092 image_background (img
, f
, ximg
)
6097 if (! img
->background_valid
)
6098 /* IMG doesn't have a background yet, try to guess a reasonable value. */
6100 int free_ximg
= !ximg
;
6103 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
6104 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
6106 img
->background
= four_corners_best (ximg
, img
->width
, img
->height
);
6109 XDestroyImage (ximg
);
6111 img
->background_valid
= 1;
6114 return img
->background
;
6117 /* Return the `background_transparent' field of IMG. If IMG doesn't
6118 have one yet, it is guessed heuristically. If non-zero, MASK is an
6119 existing XImage object to use for the heuristic. */
6122 image_background_transparent (img
, f
, mask
)
6127 if (! img
->background_transparent_valid
)
6128 /* IMG doesn't have a background yet, try to guess a reasonable value. */
6132 int free_mask
= !mask
;
6135 mask
= XGetImage (FRAME_X_DISPLAY (f
), img
->mask
,
6136 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
6138 img
->background_transparent
6139 = !four_corners_best (mask
, img
->width
, img
->height
);
6142 XDestroyImage (mask
);
6145 img
->background_transparent
= 0;
6147 img
->background_transparent_valid
= 1;
6150 return img
->background_transparent
;
6154 /***********************************************************************
6155 Helper functions for X image types
6156 ***********************************************************************/
6158 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
6160 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
6161 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
6163 Lisp_Object color_name
,
6164 unsigned long dflt
));
6167 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
6168 free the pixmap if any. MASK_P non-zero means clear the mask
6169 pixmap if any. COLORS_P non-zero means free colors allocated for
6170 the image, if any. */
6173 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
6176 int pixmap_p
, mask_p
, colors_p
;
6178 if (pixmap_p
&& img
->pixmap
)
6180 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
6182 img
->background_valid
= 0;
6185 if (mask_p
&& img
->mask
)
6187 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6189 img
->background_transparent_valid
= 0;
6192 if (colors_p
&& img
->ncolors
)
6194 x_free_colors (f
, img
->colors
, img
->ncolors
);
6195 xfree (img
->colors
);
6201 /* Free X resources of image IMG which is used on frame F. */
6204 x_clear_image (f
, img
)
6209 x_clear_image_1 (f
, img
, 1, 1, 1);
6214 /* Allocate color COLOR_NAME for image IMG on frame F. If color
6215 cannot be allocated, use DFLT. Add a newly allocated color to
6216 IMG->colors, so that it can be freed again. Value is the pixel
6219 static unsigned long
6220 x_alloc_image_color (f
, img
, color_name
, dflt
)
6223 Lisp_Object color_name
;
6227 unsigned long result
;
6229 xassert (STRINGP (color_name
));
6231 if (x_defined_color (f
, SDATA (color_name
), &color
, 1))
6233 /* This isn't called frequently so we get away with simply
6234 reallocating the color vector to the needed size, here. */
6237 (unsigned long *) xrealloc (img
->colors
,
6238 img
->ncolors
* sizeof *img
->colors
);
6239 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
6240 result
= color
.pixel
;
6250 /***********************************************************************
6252 ***********************************************************************/
6254 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
6255 static void postprocess_image
P_ ((struct frame
*, struct image
*));
6258 /* Return a new, initialized image cache that is allocated from the
6259 heap. Call free_image_cache to free an image cache. */
6261 struct image_cache
*
6264 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
6267 bzero (c
, sizeof *c
);
6269 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
6270 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
6271 c
->buckets
= (struct image
**) xmalloc (size
);
6272 bzero (c
->buckets
, size
);
6277 /* Free image cache of frame F. Be aware that X frames share images
6281 free_image_cache (f
)
6284 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6289 /* Cache should not be referenced by any frame when freed. */
6290 xassert (c
->refcount
== 0);
6292 for (i
= 0; i
< c
->used
; ++i
)
6293 free_image (f
, c
->images
[i
]);
6297 FRAME_X_IMAGE_CACHE (f
) = NULL
;
6302 /* Clear image cache of frame F. FORCE_P non-zero means free all
6303 images. FORCE_P zero means clear only images that haven't been
6304 displayed for some time. Should be called from time to time to
6305 reduce the number of loaded images. If image-eviction-seconds is
6306 non-nil, this frees images in the cache which weren't displayed for
6307 at least that many seconds. */
6310 clear_image_cache (f
, force_p
)
6314 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6316 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
6323 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
6325 /* Block input so that we won't be interrupted by a SIGIO
6326 while being in an inconsistent state. */
6329 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
6331 struct image
*img
= c
->images
[i
];
6333 && (force_p
|| img
->timestamp
< old
))
6335 free_image (f
, img
);
6340 /* We may be clearing the image cache because, for example,
6341 Emacs was iconified for a longer period of time. In that
6342 case, current matrices may still contain references to
6343 images freed above. So, clear these matrices. */
6346 Lisp_Object tail
, frame
;
6348 FOR_EACH_FRAME (tail
, frame
)
6350 struct frame
*f
= XFRAME (frame
);
6352 && FRAME_X_IMAGE_CACHE (f
) == c
)
6353 clear_current_matrices (f
);
6356 ++windows_or_buffers_changed
;
6364 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
6366 doc
: /* Clear the image cache of FRAME.
6367 FRAME nil or omitted means use the selected frame.
6368 FRAME t means clear the image caches of all frames. */)
6376 FOR_EACH_FRAME (tail
, frame
)
6377 if (FRAME_X_P (XFRAME (frame
)))
6378 clear_image_cache (XFRAME (frame
), 1);
6381 clear_image_cache (check_x_frame (frame
), 1);
6387 /* Compute masks and transform image IMG on frame F, as specified
6388 by the image's specification, */
6391 postprocess_image (f
, img
)
6395 /* Manipulation of the image's mask. */
6398 Lisp_Object conversion
, spec
;
6403 /* `:heuristic-mask t'
6405 means build a mask heuristically.
6406 `:heuristic-mask (R G B)'
6407 `:mask (heuristic (R G B))'
6408 means build a mask from color (R G B) in the
6411 means remove a mask, if any. */
6413 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6415 x_build_heuristic_mask (f
, img
, mask
);
6420 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6422 if (EQ (mask
, Qheuristic
))
6423 x_build_heuristic_mask (f
, img
, Qt
);
6424 else if (CONSP (mask
)
6425 && EQ (XCAR (mask
), Qheuristic
))
6427 if (CONSP (XCDR (mask
)))
6428 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6430 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6432 else if (NILP (mask
) && found_p
&& img
->mask
)
6434 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6440 /* Should we apply an image transformation algorithm? */
6441 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6442 if (EQ (conversion
, Qdisabled
))
6443 x_disable_image (f
, img
);
6444 else if (EQ (conversion
, Qlaplace
))
6446 else if (EQ (conversion
, Qemboss
))
6448 else if (CONSP (conversion
)
6449 && EQ (XCAR (conversion
), Qedge_detection
))
6452 tem
= XCDR (conversion
);
6454 x_edge_detection (f
, img
,
6455 Fplist_get (tem
, QCmatrix
),
6456 Fplist_get (tem
, QCcolor_adjustment
));
6462 /* Return the id of image with Lisp specification SPEC on frame F.
6463 SPEC must be a valid Lisp image specification (see valid_image_p). */
6466 lookup_image (f
, spec
)
6470 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6474 struct gcpro gcpro1
;
6477 /* F must be a window-system frame, and SPEC must be a valid image
6479 xassert (FRAME_WINDOW_P (f
));
6480 xassert (valid_image_p (spec
));
6484 /* Look up SPEC in the hash table of the image cache. */
6485 hash
= sxhash (spec
, 0);
6486 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6488 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6489 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6492 /* If not found, create a new image and cache it. */
6495 extern Lisp_Object Qpostscript
;
6498 img
= make_image (spec
, hash
);
6499 cache_image (f
, img
);
6500 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6502 /* If we can't load the image, and we don't have a width and
6503 height, use some arbitrary width and height so that we can
6504 draw a rectangle for it. */
6505 if (img
->load_failed_p
)
6509 value
= image_spec_value (spec
, QCwidth
, NULL
);
6510 img
->width
= (INTEGERP (value
)
6511 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6512 value
= image_spec_value (spec
, QCheight
, NULL
);
6513 img
->height
= (INTEGERP (value
)
6514 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6518 /* Handle image type independent image attributes
6519 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
6520 `:background COLOR'. */
6521 Lisp_Object ascent
, margin
, relief
, bg
;
6523 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6524 if (INTEGERP (ascent
))
6525 img
->ascent
= XFASTINT (ascent
);
6526 else if (EQ (ascent
, Qcenter
))
6527 img
->ascent
= CENTERED_IMAGE_ASCENT
;
6529 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6530 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6531 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
6532 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
6533 && INTEGERP (XCDR (margin
)))
6535 if (XINT (XCAR (margin
)) > 0)
6536 img
->hmargin
= XFASTINT (XCAR (margin
));
6537 if (XINT (XCDR (margin
)) > 0)
6538 img
->vmargin
= XFASTINT (XCDR (margin
));
6541 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6542 if (INTEGERP (relief
))
6544 img
->relief
= XINT (relief
);
6545 img
->hmargin
+= abs (img
->relief
);
6546 img
->vmargin
+= abs (img
->relief
);
6549 if (! img
->background_valid
)
6551 bg
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6555 = x_alloc_image_color (f
, img
, bg
,
6556 FRAME_BACKGROUND_PIXEL (f
));
6557 img
->background_valid
= 1;
6561 /* Do image transformations and compute masks, unless we
6562 don't have the image yet. */
6563 if (!EQ (*img
->type
->type
, Qpostscript
))
6564 postprocess_image (f
, img
);
6568 xassert (!interrupt_input_blocked
);
6571 /* We're using IMG, so set its timestamp to `now'. */
6572 EMACS_GET_TIME (now
);
6573 img
->timestamp
= EMACS_SECS (now
);
6577 /* Value is the image id. */
6582 /* Cache image IMG in the image cache of frame F. */
6585 cache_image (f
, img
)
6589 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6592 /* Find a free slot in c->images. */
6593 for (i
= 0; i
< c
->used
; ++i
)
6594 if (c
->images
[i
] == NULL
)
6597 /* If no free slot found, maybe enlarge c->images. */
6598 if (i
== c
->used
&& c
->used
== c
->size
)
6601 c
->images
= (struct image
**) xrealloc (c
->images
,
6602 c
->size
* sizeof *c
->images
);
6605 /* Add IMG to c->images, and assign IMG an id. */
6611 /* Add IMG to the cache's hash table. */
6612 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6613 img
->next
= c
->buckets
[i
];
6615 img
->next
->prev
= img
;
6617 c
->buckets
[i
] = img
;
6621 /* Call FN on every image in the image cache of frame F. Used to mark
6622 Lisp Objects in the image cache. */
6625 forall_images_in_image_cache (f
, fn
)
6627 void (*fn
) P_ ((struct image
*img
));
6629 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6631 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6635 for (i
= 0; i
< c
->used
; ++i
)
6644 /***********************************************************************
6646 ***********************************************************************/
6648 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6649 XImage
**, Pixmap
*));
6650 static void x_destroy_x_image
P_ ((XImage
*));
6651 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6654 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6655 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6656 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6657 via xmalloc. Print error messages via image_error if an error
6658 occurs. Value is non-zero if successful. */
6661 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6663 int width
, height
, depth
;
6667 Display
*display
= FRAME_X_DISPLAY (f
);
6668 Screen
*screen
= FRAME_X_SCREEN (f
);
6669 Window window
= FRAME_X_WINDOW (f
);
6671 xassert (interrupt_input_blocked
);
6674 depth
= DefaultDepthOfScreen (screen
);
6675 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6676 depth
, ZPixmap
, 0, NULL
, width
, height
,
6677 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6680 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6684 /* Allocate image raster. */
6685 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6687 /* Allocate a pixmap of the same size. */
6688 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6689 if (*pixmap
== None
)
6691 x_destroy_x_image (*ximg
);
6693 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6701 /* Destroy XImage XIMG. Free XIMG->data. */
6704 x_destroy_x_image (ximg
)
6707 xassert (interrupt_input_blocked
);
6712 XDestroyImage (ximg
);
6717 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6718 are width and height of both the image and pixmap. */
6721 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6729 xassert (interrupt_input_blocked
);
6730 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6731 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6732 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6737 /***********************************************************************
6739 ***********************************************************************/
6741 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6742 static char *slurp_file
P_ ((char *, int *));
6745 /* Find image file FILE. Look in data-directory, then
6746 x-bitmap-file-path. Value is the full name of the file found, or
6747 nil if not found. */
6750 x_find_image_file (file
)
6753 Lisp_Object file_found
, search_path
;
6754 struct gcpro gcpro1
, gcpro2
;
6758 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6759 GCPRO2 (file_found
, search_path
);
6761 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6762 fd
= openp (search_path
, file
, Qnil
, &file_found
, Qnil
);
6774 /* Read FILE into memory. Value is a pointer to a buffer allocated
6775 with xmalloc holding FILE's contents. Value is null if an error
6776 occurred. *SIZE is set to the size of the file. */
6779 slurp_file (file
, size
)
6787 if (stat (file
, &st
) == 0
6788 && (fp
= fopen (file
, "r")) != NULL
6789 && (buf
= (char *) xmalloc (st
.st_size
),
6790 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6811 /***********************************************************************
6813 ***********************************************************************/
6815 static int xbm_scan
P_ ((char **, char *, char *, int *));
6816 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6817 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6819 static int xbm_image_p
P_ ((Lisp_Object object
));
6820 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6822 static int xbm_file_p
P_ ((Lisp_Object
));
6825 /* Indices of image specification fields in xbm_format, below. */
6827 enum xbm_keyword_index
6845 /* Vector of image_keyword structures describing the format
6846 of valid XBM image specifications. */
6848 static struct image_keyword xbm_format
[XBM_LAST
] =
6850 {":type", IMAGE_SYMBOL_VALUE
, 1},
6851 {":file", IMAGE_STRING_VALUE
, 0},
6852 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6853 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6854 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6855 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
6856 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
6857 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6858 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6859 {":relief", IMAGE_INTEGER_VALUE
, 0},
6860 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6861 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6862 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6865 /* Structure describing the image type XBM. */
6867 static struct image_type xbm_type
=
6876 /* Tokens returned from xbm_scan. */
6885 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6886 A valid specification is a list starting with the symbol `image'
6887 The rest of the list is a property list which must contain an
6890 If the specification specifies a file to load, it must contain
6891 an entry `:file FILENAME' where FILENAME is a string.
6893 If the specification is for a bitmap loaded from memory it must
6894 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6895 WIDTH and HEIGHT are integers > 0. DATA may be:
6897 1. a string large enough to hold the bitmap data, i.e. it must
6898 have a size >= (WIDTH + 7) / 8 * HEIGHT
6900 2. a bool-vector of size >= WIDTH * HEIGHT
6902 3. a vector of strings or bool-vectors, one for each line of the
6905 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6906 may not be specified in this case because they are defined in the
6909 Both the file and data forms may contain the additional entries
6910 `:background COLOR' and `:foreground COLOR'. If not present,
6911 foreground and background of the frame on which the image is
6912 displayed is used. */
6915 xbm_image_p (object
)
6918 struct image_keyword kw
[XBM_LAST
];
6920 bcopy (xbm_format
, kw
, sizeof kw
);
6921 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6924 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6926 if (kw
[XBM_FILE
].count
)
6928 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6931 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6933 /* In-memory XBM file. */
6934 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6942 /* Entries for `:width', `:height' and `:data' must be present. */
6943 if (!kw
[XBM_WIDTH
].count
6944 || !kw
[XBM_HEIGHT
].count
6945 || !kw
[XBM_DATA
].count
)
6948 data
= kw
[XBM_DATA
].value
;
6949 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6950 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6952 /* Check type of data, and width and height against contents of
6958 /* Number of elements of the vector must be >= height. */
6959 if (XVECTOR (data
)->size
< height
)
6962 /* Each string or bool-vector in data must be large enough
6963 for one line of the image. */
6964 for (i
= 0; i
< height
; ++i
)
6966 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6971 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6974 else if (BOOL_VECTOR_P (elt
))
6976 if (XBOOL_VECTOR (elt
)->size
< width
)
6983 else if (STRINGP (data
))
6986 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6989 else if (BOOL_VECTOR_P (data
))
6991 if (XBOOL_VECTOR (data
)->size
< width
* height
)
7002 /* Scan a bitmap file. FP is the stream to read from. Value is
7003 either an enumerator from enum xbm_token, or a character for a
7004 single-character token, or 0 at end of file. If scanning an
7005 identifier, store the lexeme of the identifier in SVAL. If
7006 scanning a number, store its value in *IVAL. */
7009 xbm_scan (s
, end
, sval
, ival
)
7018 /* Skip white space. */
7019 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
7024 else if (isdigit (c
))
7026 int value
= 0, digit
;
7028 if (c
== '0' && *s
< end
)
7031 if (c
== 'x' || c
== 'X')
7038 else if (c
>= 'a' && c
<= 'f')
7039 digit
= c
- 'a' + 10;
7040 else if (c
>= 'A' && c
<= 'F')
7041 digit
= c
- 'A' + 10;
7044 value
= 16 * value
+ digit
;
7047 else if (isdigit (c
))
7051 && (c
= *(*s
)++, isdigit (c
)))
7052 value
= 8 * value
+ c
- '0';
7059 && (c
= *(*s
)++, isdigit (c
)))
7060 value
= 10 * value
+ c
- '0';
7068 else if (isalpha (c
) || c
== '_')
7072 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
7079 else if (c
== '/' && **s
== '*')
7081 /* C-style comment. */
7083 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
7096 /* Replacement for XReadBitmapFileData which isn't available under old
7097 X versions. CONTENTS is a pointer to a buffer to parse; END is the
7098 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
7099 the image. Return in *DATA the bitmap data allocated with xmalloc.
7100 Value is non-zero if successful. DATA null means just test if
7101 CONTENTS looks like an in-memory XBM file. */
7104 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
7105 char *contents
, *end
;
7106 int *width
, *height
;
7107 unsigned char **data
;
7110 char buffer
[BUFSIZ
];
7113 int bytes_per_line
, i
, nbytes
;
7119 LA1 = xbm_scan (&s, end, buffer, &value)
7121 #define expect(TOKEN) \
7122 if (LA1 != (TOKEN)) \
7127 #define expect_ident(IDENT) \
7128 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
7133 *width
= *height
= -1;
7136 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
7138 /* Parse defines for width, height and hot-spots. */
7142 expect_ident ("define");
7143 expect (XBM_TK_IDENT
);
7145 if (LA1
== XBM_TK_NUMBER
);
7147 char *p
= strrchr (buffer
, '_');
7148 p
= p
? p
+ 1 : buffer
;
7149 if (strcmp (p
, "width") == 0)
7151 else if (strcmp (p
, "height") == 0)
7154 expect (XBM_TK_NUMBER
);
7157 if (*width
< 0 || *height
< 0)
7159 else if (data
== NULL
)
7162 /* Parse bits. Must start with `static'. */
7163 expect_ident ("static");
7164 if (LA1
== XBM_TK_IDENT
)
7166 if (strcmp (buffer
, "unsigned") == 0)
7169 expect_ident ("char");
7171 else if (strcmp (buffer
, "short") == 0)
7175 if (*width
% 16 && *width
% 16 < 9)
7178 else if (strcmp (buffer
, "char") == 0)
7186 expect (XBM_TK_IDENT
);
7192 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
7193 nbytes
= bytes_per_line
* *height
;
7194 p
= *data
= (char *) xmalloc (nbytes
);
7198 for (i
= 0; i
< nbytes
; i
+= 2)
7201 expect (XBM_TK_NUMBER
);
7204 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
7207 if (LA1
== ',' || LA1
== '}')
7215 for (i
= 0; i
< nbytes
; ++i
)
7218 expect (XBM_TK_NUMBER
);
7222 if (LA1
== ',' || LA1
== '}')
7247 /* Load XBM image IMG which will be displayed on frame F from buffer
7248 CONTENTS. END is the end of the buffer. Value is non-zero if
7252 xbm_load_image (f
, img
, contents
, end
)
7255 char *contents
, *end
;
7258 unsigned char *data
;
7261 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
7264 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7265 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7266 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7269 xassert (img
->width
> 0 && img
->height
> 0);
7271 /* Get foreground and background colors, maybe allocate colors. */
7272 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
7274 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
7275 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
7278 background
= x_alloc_image_color (f
, img
, value
, background
);
7279 img
->background
= background
;
7280 img
->background_valid
= 1;
7284 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7287 img
->width
, img
->height
,
7288 foreground
, background
,
7292 if (img
->pixmap
== None
)
7294 x_clear_image (f
, img
);
7295 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
7301 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7307 /* Value is non-zero if DATA looks like an in-memory XBM file. */
7314 return (STRINGP (data
)
7315 && xbm_read_bitmap_data (SDATA (data
),
7322 /* Fill image IMG which is used on frame F with pixmap data. Value is
7323 non-zero if successful. */
7331 Lisp_Object file_name
;
7333 xassert (xbm_image_p (img
->spec
));
7335 /* If IMG->spec specifies a file name, create a non-file spec from it. */
7336 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
7337 if (STRINGP (file_name
))
7342 struct gcpro gcpro1
;
7344 file
= x_find_image_file (file_name
);
7346 if (!STRINGP (file
))
7348 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
7353 contents
= slurp_file (SDATA (file
), &size
);
7354 if (contents
== NULL
)
7356 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7361 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
7366 struct image_keyword fmt
[XBM_LAST
];
7369 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7370 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7373 int in_memory_file_p
= 0;
7375 /* See if data looks like an in-memory XBM file. */
7376 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7377 in_memory_file_p
= xbm_file_p (data
);
7379 /* Parse the image specification. */
7380 bcopy (xbm_format
, fmt
, sizeof fmt
);
7381 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
7384 /* Get specified width, and height. */
7385 if (!in_memory_file_p
)
7387 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
7388 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
7389 xassert (img
->width
> 0 && img
->height
> 0);
7392 /* Get foreground and background colors, maybe allocate colors. */
7393 if (fmt
[XBM_FOREGROUND
].count
7394 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
7395 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
7397 if (fmt
[XBM_BACKGROUND
].count
7398 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
7399 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
7402 if (in_memory_file_p
)
7403 success_p
= xbm_load_image (f
, img
, SDATA (data
),
7412 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
7414 p
= bits
= (char *) alloca (nbytes
* img
->height
);
7415 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
7417 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
7419 bcopy (SDATA (line
), p
, nbytes
);
7421 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
7424 else if (STRINGP (data
))
7425 bits
= SDATA (data
);
7427 bits
= XBOOL_VECTOR (data
)->data
;
7429 /* Create the pixmap. */
7430 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7432 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7435 img
->width
, img
->height
,
7436 foreground
, background
,
7442 image_error ("Unable to create pixmap for XBM image `%s'",
7444 x_clear_image (f
, img
);
7454 /***********************************************************************
7456 ***********************************************************************/
7460 static int xpm_image_p
P_ ((Lisp_Object object
));
7461 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
7462 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
7464 #include "X11/xpm.h"
7466 /* The symbol `xpm' identifying XPM-format images. */
7470 /* Indices of image specification fields in xpm_format, below. */
7472 enum xpm_keyword_index
7488 /* Vector of image_keyword structures describing the format
7489 of valid XPM image specifications. */
7491 static struct image_keyword xpm_format
[XPM_LAST
] =
7493 {":type", IMAGE_SYMBOL_VALUE
, 1},
7494 {":file", IMAGE_STRING_VALUE
, 0},
7495 {":data", IMAGE_STRING_VALUE
, 0},
7496 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7497 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7498 {":relief", IMAGE_INTEGER_VALUE
, 0},
7499 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7500 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7501 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7502 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7503 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
7506 /* Structure describing the image type XBM. */
7508 static struct image_type xpm_type
=
7518 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7519 functions for allocating image colors. Our own functions handle
7520 color allocation failures more gracefully than the ones on the XPM
7523 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7524 #define ALLOC_XPM_COLORS
7527 #ifdef ALLOC_XPM_COLORS
7529 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7530 static void xpm_free_color_cache
P_ ((void));
7531 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7532 static int xpm_color_bucket
P_ ((char *));
7533 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7536 /* An entry in a hash table used to cache color definitions of named
7537 colors. This cache is necessary to speed up XPM image loading in
7538 case we do color allocations ourselves. Without it, we would need
7539 a call to XParseColor per pixel in the image. */
7541 struct xpm_cached_color
7543 /* Next in collision chain. */
7544 struct xpm_cached_color
*next
;
7546 /* Color definition (RGB and pixel color). */
7553 /* The hash table used for the color cache, and its bucket vector
7556 #define XPM_COLOR_CACHE_BUCKETS 1001
7557 struct xpm_cached_color
**xpm_color_cache
;
7559 /* Initialize the color cache. */
7562 xpm_init_color_cache (f
, attrs
)
7564 XpmAttributes
*attrs
;
7566 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7567 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7568 memset (xpm_color_cache
, 0, nbytes
);
7569 init_color_table ();
7571 if (attrs
->valuemask
& XpmColorSymbols
)
7576 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7577 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7578 attrs
->colorsymbols
[i
].value
, &color
))
7580 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7582 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7588 /* Free the color cache. */
7591 xpm_free_color_cache ()
7593 struct xpm_cached_color
*p
, *next
;
7596 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7597 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7603 xfree (xpm_color_cache
);
7604 xpm_color_cache
= NULL
;
7605 free_color_table ();
7609 /* Return the bucket index for color named COLOR_NAME in the color
7613 xpm_color_bucket (color_name
)
7619 for (s
= color_name
; *s
; ++s
)
7621 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7625 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7626 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7629 static struct xpm_cached_color
*
7630 xpm_cache_color (f
, color_name
, color
, bucket
)
7637 struct xpm_cached_color
*p
;
7640 bucket
= xpm_color_bucket (color_name
);
7642 nbytes
= sizeof *p
+ strlen (color_name
);
7643 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7644 strcpy (p
->name
, color_name
);
7646 p
->next
= xpm_color_cache
[bucket
];
7647 xpm_color_cache
[bucket
] = p
;
7652 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7653 return the cached definition in *COLOR. Otherwise, make a new
7654 entry in the cache and allocate the color. Value is zero if color
7655 allocation failed. */
7658 xpm_lookup_color (f
, color_name
, color
)
7663 struct xpm_cached_color
*p
;
7664 int h
= xpm_color_bucket (color_name
);
7666 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7667 if (strcmp (p
->name
, color_name
) == 0)
7672 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7675 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7677 p
= xpm_cache_color (f
, color_name
, color
, h
);
7684 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7685 CLOSURE is a pointer to the frame on which we allocate the
7686 color. Return in *COLOR the allocated color. Value is non-zero
7690 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7697 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7701 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7702 is a pointer to the frame on which we allocate the color. Value is
7703 non-zero if successful. */
7706 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7716 #endif /* ALLOC_XPM_COLORS */
7719 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7720 for XPM images. Such a list must consist of conses whose car and
7724 xpm_valid_color_symbols_p (color_symbols
)
7725 Lisp_Object color_symbols
;
7727 while (CONSP (color_symbols
))
7729 Lisp_Object sym
= XCAR (color_symbols
);
7731 || !STRINGP (XCAR (sym
))
7732 || !STRINGP (XCDR (sym
)))
7734 color_symbols
= XCDR (color_symbols
);
7737 return NILP (color_symbols
);
7741 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7744 xpm_image_p (object
)
7747 struct image_keyword fmt
[XPM_LAST
];
7748 bcopy (xpm_format
, fmt
, sizeof fmt
);
7749 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7750 /* Either `:file' or `:data' must be present. */
7751 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7752 /* Either no `:color-symbols' or it's a list of conses
7753 whose car and cdr are strings. */
7754 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7755 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7759 /* Load image IMG which will be displayed on frame F. Value is
7760 non-zero if successful. */
7768 XpmAttributes attrs
;
7769 Lisp_Object specified_file
, color_symbols
;
7771 /* Configure the XPM lib. Use the visual of frame F. Allocate
7772 close colors. Return colors allocated. */
7773 bzero (&attrs
, sizeof attrs
);
7774 attrs
.visual
= FRAME_X_VISUAL (f
);
7775 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7776 attrs
.valuemask
|= XpmVisual
;
7777 attrs
.valuemask
|= XpmColormap
;
7779 #ifdef ALLOC_XPM_COLORS
7780 /* Allocate colors with our own functions which handle
7781 failing color allocation more gracefully. */
7782 attrs
.color_closure
= f
;
7783 attrs
.alloc_color
= xpm_alloc_color
;
7784 attrs
.free_colors
= xpm_free_colors
;
7785 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7786 #else /* not ALLOC_XPM_COLORS */
7787 /* Let the XPM lib allocate colors. */
7788 attrs
.valuemask
|= XpmReturnAllocPixels
;
7789 #ifdef XpmAllocCloseColors
7790 attrs
.alloc_close_colors
= 1;
7791 attrs
.valuemask
|= XpmAllocCloseColors
;
7792 #else /* not XpmAllocCloseColors */
7793 attrs
.closeness
= 600;
7794 attrs
.valuemask
|= XpmCloseness
;
7795 #endif /* not XpmAllocCloseColors */
7796 #endif /* ALLOC_XPM_COLORS */
7798 /* If image specification contains symbolic color definitions, add
7799 these to `attrs'. */
7800 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7801 if (CONSP (color_symbols
))
7804 XpmColorSymbol
*xpm_syms
;
7807 attrs
.valuemask
|= XpmColorSymbols
;
7809 /* Count number of symbols. */
7810 attrs
.numsymbols
= 0;
7811 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7814 /* Allocate an XpmColorSymbol array. */
7815 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7816 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7817 bzero (xpm_syms
, size
);
7818 attrs
.colorsymbols
= xpm_syms
;
7820 /* Fill the color symbol array. */
7821 for (tail
= color_symbols
, i
= 0;
7823 ++i
, tail
= XCDR (tail
))
7825 Lisp_Object name
= XCAR (XCAR (tail
));
7826 Lisp_Object color
= XCDR (XCAR (tail
));
7827 xpm_syms
[i
].name
= (char *) alloca (SCHARS (name
) + 1);
7828 strcpy (xpm_syms
[i
].name
, SDATA (name
));
7829 xpm_syms
[i
].value
= (char *) alloca (SCHARS (color
) + 1);
7830 strcpy (xpm_syms
[i
].value
, SDATA (color
));
7834 /* Create a pixmap for the image, either from a file, or from a
7835 string buffer containing data in the same format as an XPM file. */
7836 #ifdef ALLOC_XPM_COLORS
7837 xpm_init_color_cache (f
, &attrs
);
7840 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7841 if (STRINGP (specified_file
))
7843 Lisp_Object file
= x_find_image_file (specified_file
);
7844 if (!STRINGP (file
))
7846 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7850 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7851 SDATA (file
), &img
->pixmap
, &img
->mask
,
7856 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7857 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7859 &img
->pixmap
, &img
->mask
,
7863 if (rc
== XpmSuccess
)
7865 #ifdef ALLOC_XPM_COLORS
7866 img
->colors
= colors_in_color_table (&img
->ncolors
);
7867 #else /* not ALLOC_XPM_COLORS */
7870 img
->ncolors
= attrs
.nalloc_pixels
;
7871 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7872 * sizeof *img
->colors
);
7873 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7875 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7876 #ifdef DEBUG_X_COLORS
7877 register_color (img
->colors
[i
]);
7880 #endif /* not ALLOC_XPM_COLORS */
7882 img
->width
= attrs
.width
;
7883 img
->height
= attrs
.height
;
7884 xassert (img
->width
> 0 && img
->height
> 0);
7886 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7887 XpmFreeAttributes (&attrs
);
7894 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7897 case XpmFileInvalid
:
7898 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7902 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7905 case XpmColorFailed
:
7906 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7910 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7915 #ifdef ALLOC_XPM_COLORS
7916 xpm_free_color_cache ();
7918 return rc
== XpmSuccess
;
7921 #endif /* HAVE_XPM != 0 */
7924 /***********************************************************************
7926 ***********************************************************************/
7928 /* An entry in the color table mapping an RGB color to a pixel color. */
7933 unsigned long pixel
;
7935 /* Next in color table collision list. */
7936 struct ct_color
*next
;
7939 /* The bucket vector size to use. Must be prime. */
7943 /* Value is a hash of the RGB color given by R, G, and B. */
7945 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7947 /* The color hash table. */
7949 struct ct_color
**ct_table
;
7951 /* Number of entries in the color table. */
7953 int ct_colors_allocated
;
7955 /* Initialize the color table. */
7960 int size
= CT_SIZE
* sizeof (*ct_table
);
7961 ct_table
= (struct ct_color
**) xmalloc (size
);
7962 bzero (ct_table
, size
);
7963 ct_colors_allocated
= 0;
7967 /* Free memory associated with the color table. */
7973 struct ct_color
*p
, *next
;
7975 for (i
= 0; i
< CT_SIZE
; ++i
)
7976 for (p
= ct_table
[i
]; p
; p
= next
)
7987 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7988 entry for that color already is in the color table, return the
7989 pixel color of that entry. Otherwise, allocate a new color for R,
7990 G, B, and make an entry in the color table. */
7992 static unsigned long
7993 lookup_rgb_color (f
, r
, g
, b
)
7997 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7998 int i
= hash
% CT_SIZE
;
8001 for (p
= ct_table
[i
]; p
; p
= p
->next
)
8002 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
8015 cmap
= FRAME_X_COLORMAP (f
);
8016 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
8020 ++ct_colors_allocated
;
8022 p
= (struct ct_color
*) xmalloc (sizeof *p
);
8026 p
->pixel
= color
.pixel
;
8027 p
->next
= ct_table
[i
];
8031 return FRAME_FOREGROUND_PIXEL (f
);
8038 /* Look up pixel color PIXEL which is used on frame F in the color
8039 table. If not already present, allocate it. Value is PIXEL. */
8041 static unsigned long
8042 lookup_pixel_color (f
, pixel
)
8044 unsigned long pixel
;
8046 int i
= pixel
% CT_SIZE
;
8049 for (p
= ct_table
[i
]; p
; p
= p
->next
)
8050 if (p
->pixel
== pixel
)
8059 cmap
= FRAME_X_COLORMAP (f
);
8060 color
.pixel
= pixel
;
8061 x_query_color (f
, &color
);
8062 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
8066 ++ct_colors_allocated
;
8068 p
= (struct ct_color
*) xmalloc (sizeof *p
);
8073 p
->next
= ct_table
[i
];
8077 return FRAME_FOREGROUND_PIXEL (f
);
8084 /* Value is a vector of all pixel colors contained in the color table,
8085 allocated via xmalloc. Set *N to the number of colors. */
8087 static unsigned long *
8088 colors_in_color_table (n
)
8093 unsigned long *colors
;
8095 if (ct_colors_allocated
== 0)
8102 colors
= (unsigned long *) xmalloc (ct_colors_allocated
8104 *n
= ct_colors_allocated
;
8106 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
8107 for (p
= ct_table
[i
]; p
; p
= p
->next
)
8108 colors
[j
++] = p
->pixel
;
8116 /***********************************************************************
8118 ***********************************************************************/
8120 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
8121 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
8122 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
8124 /* Non-zero means draw a cross on images having `:conversion
8127 int cross_disabled_images
;
8129 /* Edge detection matrices for different edge-detection
8132 static int emboss_matrix
[9] = {
8134 2, -1, 0, /* y - 1 */
8136 0, 1, -2 /* y + 1 */
8139 static int laplace_matrix
[9] = {
8141 1, 0, 0, /* y - 1 */
8143 0, 0, -1 /* y + 1 */
8146 /* Value is the intensity of the color whose red/green/blue values
8149 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
8152 /* On frame F, return an array of XColor structures describing image
8153 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
8154 non-zero means also fill the red/green/blue members of the XColor
8155 structures. Value is a pointer to the array of XColors structures,
8156 allocated with xmalloc; it must be freed by the caller. */
8159 x_to_xcolors (f
, img
, rgb_p
)
8168 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
8170 /* Get the X image IMG->pixmap. */
8171 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
8172 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
8174 /* Fill the `pixel' members of the XColor array. I wished there
8175 were an easy and portable way to circumvent XGetPixel. */
8177 for (y
= 0; y
< img
->height
; ++y
)
8181 for (x
= 0; x
< img
->width
; ++x
, ++p
)
8182 p
->pixel
= XGetPixel (ximg
, x
, y
);
8185 x_query_colors (f
, row
, img
->width
);
8188 XDestroyImage (ximg
);
8193 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
8194 RGB members are set. F is the frame on which this all happens.
8195 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
8198 x_from_xcolors (f
, img
, colors
)
8208 init_color_table ();
8210 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
8213 for (y
= 0; y
< img
->height
; ++y
)
8214 for (x
= 0; x
< img
->width
; ++x
, ++p
)
8216 unsigned long pixel
;
8217 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
8218 XPutPixel (oimg
, x
, y
, pixel
);
8222 x_clear_image_1 (f
, img
, 1, 0, 1);
8224 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
8225 x_destroy_x_image (oimg
);
8226 img
->pixmap
= pixmap
;
8227 img
->colors
= colors_in_color_table (&img
->ncolors
);
8228 free_color_table ();
8232 /* On frame F, perform edge-detection on image IMG.
8234 MATRIX is a nine-element array specifying the transformation
8235 matrix. See emboss_matrix for an example.
8237 COLOR_ADJUST is a color adjustment added to each pixel of the
8241 x_detect_edges (f
, img
, matrix
, color_adjust
)
8244 int matrix
[9], color_adjust
;
8246 XColor
*colors
= x_to_xcolors (f
, img
, 1);
8250 for (i
= sum
= 0; i
< 9; ++i
)
8251 sum
+= abs (matrix
[i
]);
8253 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
8255 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
8257 for (y
= 0; y
< img
->height
; ++y
)
8259 p
= COLOR (new, 0, y
);
8260 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8261 p
= COLOR (new, img
->width
- 1, y
);
8262 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8265 for (x
= 1; x
< img
->width
- 1; ++x
)
8267 p
= COLOR (new, x
, 0);
8268 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8269 p
= COLOR (new, x
, img
->height
- 1);
8270 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8273 for (y
= 1; y
< img
->height
- 1; ++y
)
8275 p
= COLOR (new, 1, y
);
8277 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
8279 int r
, g
, b
, y1
, x1
;
8282 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
8283 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
8286 XColor
*t
= COLOR (colors
, x1
, y1
);
8287 r
+= matrix
[i
] * t
->red
;
8288 g
+= matrix
[i
] * t
->green
;
8289 b
+= matrix
[i
] * t
->blue
;
8292 r
= (r
/ sum
+ color_adjust
) & 0xffff;
8293 g
= (g
/ sum
+ color_adjust
) & 0xffff;
8294 b
= (b
/ sum
+ color_adjust
) & 0xffff;
8295 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
8300 x_from_xcolors (f
, img
, new);
8306 /* Perform the pre-defined `emboss' edge-detection on image IMG
8314 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
8318 /* Perform the pre-defined `laplace' edge-detection on image IMG
8326 x_detect_edges (f
, img
, laplace_matrix
, 45000);
8330 /* Perform edge-detection on image IMG on frame F, with specified
8331 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
8333 MATRIX must be either
8335 - a list of at least 9 numbers in row-major form
8336 - a vector of at least 9 numbers
8338 COLOR_ADJUST nil means use a default; otherwise it must be a
8342 x_edge_detection (f
, img
, matrix
, color_adjust
)
8345 Lisp_Object matrix
, color_adjust
;
8353 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
8354 ++i
, matrix
= XCDR (matrix
))
8355 trans
[i
] = XFLOATINT (XCAR (matrix
));
8357 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
8359 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
8360 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
8363 if (NILP (color_adjust
))
8364 color_adjust
= make_number (0xffff / 2);
8366 if (i
== 9 && NUMBERP (color_adjust
))
8367 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
8371 /* Transform image IMG on frame F so that it looks disabled. */
8374 x_disable_image (f
, img
)
8378 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
8380 if (dpyinfo
->n_planes
>= 2)
8382 /* Color (or grayscale). Convert to gray, and equalize. Just
8383 drawing such images with a stipple can look very odd, so
8384 we're using this method instead. */
8385 XColor
*colors
= x_to_xcolors (f
, img
, 1);
8387 const int h
= 15000;
8388 const int l
= 30000;
8390 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
8394 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
8395 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
8396 p
->red
= p
->green
= p
->blue
= i2
;
8399 x_from_xcolors (f
, img
, colors
);
8402 /* Draw a cross over the disabled image, if we must or if we
8404 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
8406 Display
*dpy
= FRAME_X_DISPLAY (f
);
8409 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
8410 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
8411 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
8412 img
->width
- 1, img
->height
- 1);
8413 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
8419 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
8420 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
8421 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
8422 img
->width
- 1, img
->height
- 1);
8423 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
8431 /* Build a mask for image IMG which is used on frame F. FILE is the
8432 name of an image file, for error messages. HOW determines how to
8433 determine the background color of IMG. If it is a list '(R G B)',
8434 with R, G, and B being integers >= 0, take that as the color of the
8435 background. Otherwise, determine the background color of IMG
8436 heuristically. Value is non-zero if successful. */
8439 x_build_heuristic_mask (f
, img
, how
)
8444 Display
*dpy
= FRAME_X_DISPLAY (f
);
8445 XImage
*ximg
, *mask_img
;
8446 int x
, y
, rc
, use_img_background
;
8447 unsigned long bg
= 0;
8451 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8453 img
->background_transparent_valid
= 0;
8456 /* Create an image and pixmap serving as mask. */
8457 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
8458 &mask_img
, &img
->mask
);
8462 /* Get the X image of IMG->pixmap. */
8463 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
8466 /* Determine the background color of ximg. If HOW is `(R G B)'
8467 take that as color. Otherwise, use the image's background color. */
8468 use_img_background
= 1;
8474 for (i
= 0; i
< 3 && CONSP (how
) && NATNUMP (XCAR (how
)); ++i
)
8476 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
8480 if (i
== 3 && NILP (how
))
8482 char color_name
[30];
8483 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
8484 bg
= x_alloc_image_color (f
, img
, build_string (color_name
), 0);
8485 use_img_background
= 0;
8489 if (use_img_background
)
8490 bg
= four_corners_best (ximg
, img
->width
, img
->height
);
8492 /* Set all bits in mask_img to 1 whose color in ximg is different
8493 from the background color bg. */
8494 for (y
= 0; y
< img
->height
; ++y
)
8495 for (x
= 0; x
< img
->width
; ++x
)
8496 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8498 /* Fill in the background_transparent field while we have the mask handy. */
8499 image_background_transparent (img
, f
, mask_img
);
8501 /* Put mask_img into img->mask. */
8502 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8503 x_destroy_x_image (mask_img
);
8504 XDestroyImage (ximg
);
8511 /***********************************************************************
8512 PBM (mono, gray, color)
8513 ***********************************************************************/
8515 static int pbm_image_p
P_ ((Lisp_Object object
));
8516 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8517 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8519 /* The symbol `pbm' identifying images of this type. */
8523 /* Indices of image specification fields in gs_format, below. */
8525 enum pbm_keyword_index
8541 /* Vector of image_keyword structures describing the format
8542 of valid user-defined image specifications. */
8544 static struct image_keyword pbm_format
[PBM_LAST
] =
8546 {":type", IMAGE_SYMBOL_VALUE
, 1},
8547 {":file", IMAGE_STRING_VALUE
, 0},
8548 {":data", IMAGE_STRING_VALUE
, 0},
8549 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8550 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8551 {":relief", IMAGE_INTEGER_VALUE
, 0},
8552 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8553 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8554 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8555 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8556 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8559 /* Structure describing the image type `pbm'. */
8561 static struct image_type pbm_type
=
8571 /* Return non-zero if OBJECT is a valid PBM image specification. */
8574 pbm_image_p (object
)
8577 struct image_keyword fmt
[PBM_LAST
];
8579 bcopy (pbm_format
, fmt
, sizeof fmt
);
8581 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8584 /* Must specify either :data or :file. */
8585 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8589 /* Scan a decimal number from *S and return it. Advance *S while
8590 reading the number. END is the end of the string. Value is -1 at
8594 pbm_scan_number (s
, end
)
8595 unsigned char **s
, *end
;
8597 int c
= 0, val
= -1;
8601 /* Skip white-space. */
8602 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8607 /* Skip comment to end of line. */
8608 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8611 else if (isdigit (c
))
8613 /* Read decimal number. */
8615 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8616 val
= 10 * val
+ c
- '0';
8627 /* Load PBM image IMG for use on frame F. */
8635 int width
, height
, max_color_idx
= 0;
8637 Lisp_Object file
, specified_file
;
8638 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8639 struct gcpro gcpro1
;
8640 unsigned char *contents
= NULL
;
8641 unsigned char *end
, *p
;
8644 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8648 if (STRINGP (specified_file
))
8650 file
= x_find_image_file (specified_file
);
8651 if (!STRINGP (file
))
8653 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8658 contents
= slurp_file (SDATA (file
), &size
);
8659 if (contents
== NULL
)
8661 image_error ("Error reading `%s'", file
, Qnil
);
8667 end
= contents
+ size
;
8672 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8674 end
= p
+ SBYTES (data
);
8677 /* Check magic number. */
8678 if (end
- p
< 2 || *p
++ != 'P')
8680 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8690 raw_p
= 0, type
= PBM_MONO
;
8694 raw_p
= 0, type
= PBM_GRAY
;
8698 raw_p
= 0, type
= PBM_COLOR
;
8702 raw_p
= 1, type
= PBM_MONO
;
8706 raw_p
= 1, type
= PBM_GRAY
;
8710 raw_p
= 1, type
= PBM_COLOR
;
8714 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8718 /* Read width, height, maximum color-component. Characters
8719 starting with `#' up to the end of a line are ignored. */
8720 width
= pbm_scan_number (&p
, end
);
8721 height
= pbm_scan_number (&p
, end
);
8723 if (type
!= PBM_MONO
)
8725 max_color_idx
= pbm_scan_number (&p
, end
);
8726 if (raw_p
&& max_color_idx
> 255)
8727 max_color_idx
= 255;
8732 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8735 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8736 &ximg
, &img
->pixmap
))
8739 /* Initialize the color hash table. */
8740 init_color_table ();
8742 if (type
== PBM_MONO
)
8745 struct image_keyword fmt
[PBM_LAST
];
8746 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8747 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8749 /* Parse the image specification. */
8750 bcopy (pbm_format
, fmt
, sizeof fmt
);
8751 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8753 /* Get foreground and background colors, maybe allocate colors. */
8754 if (fmt
[PBM_FOREGROUND
].count
8755 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
8756 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8757 if (fmt
[PBM_BACKGROUND
].count
8758 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
8760 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8761 img
->background
= bg
;
8762 img
->background_valid
= 1;
8765 for (y
= 0; y
< height
; ++y
)
8766 for (x
= 0; x
< width
; ++x
)
8776 g
= pbm_scan_number (&p
, end
);
8778 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8783 for (y
= 0; y
< height
; ++y
)
8784 for (x
= 0; x
< width
; ++x
)
8788 if (type
== PBM_GRAY
)
8789 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8798 r
= pbm_scan_number (&p
, end
);
8799 g
= pbm_scan_number (&p
, end
);
8800 b
= pbm_scan_number (&p
, end
);
8803 if (r
< 0 || g
< 0 || b
< 0)
8807 XDestroyImage (ximg
);
8808 image_error ("Invalid pixel value in image `%s'",
8813 /* RGB values are now in the range 0..max_color_idx.
8814 Scale this to the range 0..0xffff supported by X. */
8815 r
= (double) r
* 65535 / max_color_idx
;
8816 g
= (double) g
* 65535 / max_color_idx
;
8817 b
= (double) b
* 65535 / max_color_idx
;
8818 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8822 /* Store in IMG->colors the colors allocated for the image, and
8823 free the color table. */
8824 img
->colors
= colors_in_color_table (&img
->ncolors
);
8825 free_color_table ();
8827 /* Maybe fill in the background field while we have ximg handy. */
8828 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
8829 IMAGE_BACKGROUND (img
, f
, ximg
);
8831 /* Put the image into a pixmap. */
8832 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8833 x_destroy_x_image (ximg
);
8836 img
->height
= height
;
8845 /***********************************************************************
8847 ***********************************************************************/
8853 /* Function prototypes. */
8855 static int png_image_p
P_ ((Lisp_Object object
));
8856 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8858 /* The symbol `png' identifying images of this type. */
8862 /* Indices of image specification fields in png_format, below. */
8864 enum png_keyword_index
8879 /* Vector of image_keyword structures describing the format
8880 of valid user-defined image specifications. */
8882 static struct image_keyword png_format
[PNG_LAST
] =
8884 {":type", IMAGE_SYMBOL_VALUE
, 1},
8885 {":data", IMAGE_STRING_VALUE
, 0},
8886 {":file", IMAGE_STRING_VALUE
, 0},
8887 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8888 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8889 {":relief", IMAGE_INTEGER_VALUE
, 0},
8890 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8891 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8892 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8893 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8896 /* Structure describing the image type `png'. */
8898 static struct image_type png_type
=
8908 /* Return non-zero if OBJECT is a valid PNG image specification. */
8911 png_image_p (object
)
8914 struct image_keyword fmt
[PNG_LAST
];
8915 bcopy (png_format
, fmt
, sizeof fmt
);
8917 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8920 /* Must specify either the :data or :file keyword. */
8921 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8925 /* Error and warning handlers installed when the PNG library
8929 my_png_error (png_ptr
, msg
)
8930 png_struct
*png_ptr
;
8933 xassert (png_ptr
!= NULL
);
8934 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8935 longjmp (png_ptr
->jmpbuf
, 1);
8940 my_png_warning (png_ptr
, msg
)
8941 png_struct
*png_ptr
;
8944 xassert (png_ptr
!= NULL
);
8945 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8948 /* Memory source for PNG decoding. */
8950 struct png_memory_storage
8952 unsigned char *bytes
; /* The data */
8953 size_t len
; /* How big is it? */
8954 int index
; /* Where are we? */
8958 /* Function set as reader function when reading PNG image from memory.
8959 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8960 bytes from the input to DATA. */
8963 png_read_from_memory (png_ptr
, data
, length
)
8964 png_structp png_ptr
;
8968 struct png_memory_storage
*tbr
8969 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8971 if (length
> tbr
->len
- tbr
->index
)
8972 png_error (png_ptr
, "Read error");
8974 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8975 tbr
->index
= tbr
->index
+ length
;
8978 /* Load PNG image IMG for use on frame F. Value is non-zero if
8986 Lisp_Object file
, specified_file
;
8987 Lisp_Object specified_data
;
8989 XImage
*ximg
, *mask_img
= NULL
;
8990 struct gcpro gcpro1
;
8991 png_struct
*png_ptr
= NULL
;
8992 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8993 FILE *volatile fp
= NULL
;
8995 png_byte
* volatile pixels
= NULL
;
8996 png_byte
** volatile rows
= NULL
;
8997 png_uint_32 width
, height
;
8998 int bit_depth
, color_type
, interlace_type
;
9000 png_uint_32 row_bytes
;
9002 double screen_gamma
, image_gamma
;
9004 struct png_memory_storage tbr
; /* Data to be read */
9006 /* Find out what file to load. */
9007 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9008 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9012 if (NILP (specified_data
))
9014 file
= x_find_image_file (specified_file
);
9015 if (!STRINGP (file
))
9017 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9022 /* Open the image file. */
9023 fp
= fopen (SDATA (file
), "rb");
9026 image_error ("Cannot open image file `%s'", file
, Qnil
);
9032 /* Check PNG signature. */
9033 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
9034 || !png_check_sig (sig
, sizeof sig
))
9036 image_error ("Not a PNG file: `%s'", file
, Qnil
);
9044 /* Read from memory. */
9045 tbr
.bytes
= SDATA (specified_data
);
9046 tbr
.len
= SBYTES (specified_data
);
9049 /* Check PNG signature. */
9050 if (tbr
.len
< sizeof sig
9051 || !png_check_sig (tbr
.bytes
, sizeof sig
))
9053 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
9058 /* Need to skip past the signature. */
9059 tbr
.bytes
+= sizeof (sig
);
9062 /* Initialize read and info structs for PNG lib. */
9063 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
9064 my_png_error
, my_png_warning
);
9067 if (fp
) fclose (fp
);
9072 info_ptr
= png_create_info_struct (png_ptr
);
9075 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
9076 if (fp
) fclose (fp
);
9081 end_info
= png_create_info_struct (png_ptr
);
9084 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
9085 if (fp
) fclose (fp
);
9090 /* Set error jump-back. We come back here when the PNG library
9091 detects an error. */
9092 if (setjmp (png_ptr
->jmpbuf
))
9096 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
9099 if (fp
) fclose (fp
);
9104 /* Read image info. */
9105 if (!NILP (specified_data
))
9106 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
9108 png_init_io (png_ptr
, fp
);
9110 png_set_sig_bytes (png_ptr
, sizeof sig
);
9111 png_read_info (png_ptr
, info_ptr
);
9112 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
9113 &interlace_type
, NULL
, NULL
);
9115 /* If image contains simply transparency data, we prefer to
9116 construct a clipping mask. */
9117 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
9122 /* This function is easier to write if we only have to handle
9123 one data format: RGB or RGBA with 8 bits per channel. Let's
9124 transform other formats into that format. */
9126 /* Strip more than 8 bits per channel. */
9127 if (bit_depth
== 16)
9128 png_set_strip_16 (png_ptr
);
9130 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
9132 png_set_expand (png_ptr
);
9134 /* Convert grayscale images to RGB. */
9135 if (color_type
== PNG_COLOR_TYPE_GRAY
9136 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
9137 png_set_gray_to_rgb (png_ptr
);
9139 screen_gamma
= (f
->gamma
? 1 / f
->gamma
/ 0.45455 : 2.2);
9141 #if 0 /* Avoid double gamma correction for PNG images. */
9142 /* Tell the PNG lib to handle gamma correction for us. */
9143 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
9144 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
9145 /* The libpng documentation says this is right in this case. */
9146 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
9149 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
9150 /* Image contains gamma information. */
9151 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
9153 /* Use the standard default for the image gamma. */
9154 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
9157 /* Handle alpha channel by combining the image with a background
9158 color. Do this only if a real alpha channel is supplied. For
9159 simple transparency, we prefer a clipping mask. */
9162 png_color_16
*image_bg
;
9163 Lisp_Object specified_bg
9164 = image_spec_value (img
->spec
, QCbackground
, NULL
);
9166 if (STRINGP (specified_bg
))
9167 /* The user specified `:background', use that. */
9170 if (x_defined_color (f
, SDATA (specified_bg
), &color
, 0))
9172 png_color_16 user_bg
;
9174 bzero (&user_bg
, sizeof user_bg
);
9175 user_bg
.red
= color
.red
;
9176 user_bg
.green
= color
.green
;
9177 user_bg
.blue
= color
.blue
;
9179 png_set_background (png_ptr
, &user_bg
,
9180 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
9183 else if (png_get_bKGD (png_ptr
, info_ptr
, &image_bg
))
9184 /* Image contains a background color with which to
9185 combine the image. */
9186 png_set_background (png_ptr
, image_bg
,
9187 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
9190 /* Image does not contain a background color with which
9191 to combine the image data via an alpha channel. Use
9192 the frame's background instead. */
9195 png_color_16 frame_background
;
9197 cmap
= FRAME_X_COLORMAP (f
);
9198 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
9199 x_query_color (f
, &color
);
9201 bzero (&frame_background
, sizeof frame_background
);
9202 frame_background
.red
= color
.red
;
9203 frame_background
.green
= color
.green
;
9204 frame_background
.blue
= color
.blue
;
9206 png_set_background (png_ptr
, &frame_background
,
9207 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
9211 /* Update info structure. */
9212 png_read_update_info (png_ptr
, info_ptr
);
9214 /* Get number of channels. Valid values are 1 for grayscale images
9215 and images with a palette, 2 for grayscale images with transparency
9216 information (alpha channel), 3 for RGB images, and 4 for RGB
9217 images with alpha channel, i.e. RGBA. If conversions above were
9218 sufficient we should only have 3 or 4 channels here. */
9219 channels
= png_get_channels (png_ptr
, info_ptr
);
9220 xassert (channels
== 3 || channels
== 4);
9222 /* Number of bytes needed for one row of the image. */
9223 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
9225 /* Allocate memory for the image. */
9226 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
9227 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
9228 for (i
= 0; i
< height
; ++i
)
9229 rows
[i
] = pixels
+ i
* row_bytes
;
9231 /* Read the entire image. */
9232 png_read_image (png_ptr
, rows
);
9233 png_read_end (png_ptr
, info_ptr
);
9240 /* Create the X image and pixmap. */
9241 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
9245 /* Create an image and pixmap serving as mask if the PNG image
9246 contains an alpha channel. */
9249 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
9250 &mask_img
, &img
->mask
))
9252 x_destroy_x_image (ximg
);
9253 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
9258 /* Fill the X image and mask from PNG data. */
9259 init_color_table ();
9261 for (y
= 0; y
< height
; ++y
)
9263 png_byte
*p
= rows
[y
];
9265 for (x
= 0; x
< width
; ++x
)
9272 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
9274 /* An alpha channel, aka mask channel, associates variable
9275 transparency with an image. Where other image formats
9276 support binary transparency---fully transparent or fully
9277 opaque---PNG allows up to 254 levels of partial transparency.
9278 The PNG library implements partial transparency by combining
9279 the image with a specified background color.
9281 I'm not sure how to handle this here nicely: because the
9282 background on which the image is displayed may change, for
9283 real alpha channel support, it would be necessary to create
9284 a new image for each possible background.
9286 What I'm doing now is that a mask is created if we have
9287 boolean transparency information. Otherwise I'm using
9288 the frame's background color to combine the image with. */
9293 XPutPixel (mask_img
, x
, y
, *p
> 0);
9299 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9300 /* Set IMG's background color from the PNG image, unless the user
9304 if (png_get_bKGD (png_ptr
, info_ptr
, &bg
))
9306 img
->background
= lookup_rgb_color (f
, bg
->red
, bg
->green
, bg
->blue
);
9307 img
->background_valid
= 1;
9311 /* Remember colors allocated for this image. */
9312 img
->colors
= colors_in_color_table (&img
->ncolors
);
9313 free_color_table ();
9316 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
9321 img
->height
= height
;
9323 /* Maybe fill in the background field while we have ximg handy. */
9324 IMAGE_BACKGROUND (img
, f
, ximg
);
9326 /* Put the image into the pixmap, then free the X image and its buffer. */
9327 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9328 x_destroy_x_image (ximg
);
9330 /* Same for the mask. */
9333 /* Fill in the background_transparent field while we have the mask
9335 image_background_transparent (img
, f
, mask_img
);
9337 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
9338 x_destroy_x_image (mask_img
);
9345 #endif /* HAVE_PNG != 0 */
9349 /***********************************************************************
9351 ***********************************************************************/
9355 /* Work around a warning about HAVE_STDLIB_H being redefined in
9357 #ifdef HAVE_STDLIB_H
9358 #define HAVE_STDLIB_H_1
9359 #undef HAVE_STDLIB_H
9360 #endif /* HAVE_STLIB_H */
9362 #include <jpeglib.h>
9366 #ifdef HAVE_STLIB_H_1
9367 #define HAVE_STDLIB_H 1
9370 static int jpeg_image_p
P_ ((Lisp_Object object
));
9371 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
9373 /* The symbol `jpeg' identifying images of this type. */
9377 /* Indices of image specification fields in gs_format, below. */
9379 enum jpeg_keyword_index
9388 JPEG_HEURISTIC_MASK
,
9394 /* Vector of image_keyword structures describing the format
9395 of valid user-defined image specifications. */
9397 static struct image_keyword jpeg_format
[JPEG_LAST
] =
9399 {":type", IMAGE_SYMBOL_VALUE
, 1},
9400 {":data", IMAGE_STRING_VALUE
, 0},
9401 {":file", IMAGE_STRING_VALUE
, 0},
9402 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9403 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9404 {":relief", IMAGE_INTEGER_VALUE
, 0},
9405 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9406 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9407 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9408 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9411 /* Structure describing the image type `jpeg'. */
9413 static struct image_type jpeg_type
=
9423 /* Return non-zero if OBJECT is a valid JPEG image specification. */
9426 jpeg_image_p (object
)
9429 struct image_keyword fmt
[JPEG_LAST
];
9431 bcopy (jpeg_format
, fmt
, sizeof fmt
);
9433 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
9436 /* Must specify either the :data or :file keyword. */
9437 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
9441 struct my_jpeg_error_mgr
9443 struct jpeg_error_mgr pub
;
9444 jmp_buf setjmp_buffer
;
9449 my_error_exit (cinfo
)
9452 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
9453 longjmp (mgr
->setjmp_buffer
, 1);
9457 /* Init source method for JPEG data source manager. Called by
9458 jpeg_read_header() before any data is actually read. See
9459 libjpeg.doc from the JPEG lib distribution. */
9462 our_init_source (cinfo
)
9463 j_decompress_ptr cinfo
;
9468 /* Fill input buffer method for JPEG data source manager. Called
9469 whenever more data is needed. We read the whole image in one step,
9470 so this only adds a fake end of input marker at the end. */
9473 our_fill_input_buffer (cinfo
)
9474 j_decompress_ptr cinfo
;
9476 /* Insert a fake EOI marker. */
9477 struct jpeg_source_mgr
*src
= cinfo
->src
;
9478 static JOCTET buffer
[2];
9480 buffer
[0] = (JOCTET
) 0xFF;
9481 buffer
[1] = (JOCTET
) JPEG_EOI
;
9483 src
->next_input_byte
= buffer
;
9484 src
->bytes_in_buffer
= 2;
9489 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9490 is the JPEG data source manager. */
9493 our_skip_input_data (cinfo
, num_bytes
)
9494 j_decompress_ptr cinfo
;
9497 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9501 if (num_bytes
> src
->bytes_in_buffer
)
9502 ERREXIT (cinfo
, JERR_INPUT_EOF
);
9504 src
->bytes_in_buffer
-= num_bytes
;
9505 src
->next_input_byte
+= num_bytes
;
9510 /* Method to terminate data source. Called by
9511 jpeg_finish_decompress() after all data has been processed. */
9514 our_term_source (cinfo
)
9515 j_decompress_ptr cinfo
;
9520 /* Set up the JPEG lib for reading an image from DATA which contains
9521 LEN bytes. CINFO is the decompression info structure created for
9522 reading the image. */
9525 jpeg_memory_src (cinfo
, data
, len
)
9526 j_decompress_ptr cinfo
;
9530 struct jpeg_source_mgr
*src
;
9532 if (cinfo
->src
== NULL
)
9534 /* First time for this JPEG object? */
9535 cinfo
->src
= (struct jpeg_source_mgr
*)
9536 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9537 sizeof (struct jpeg_source_mgr
));
9538 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9539 src
->next_input_byte
= data
;
9542 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9543 src
->init_source
= our_init_source
;
9544 src
->fill_input_buffer
= our_fill_input_buffer
;
9545 src
->skip_input_data
= our_skip_input_data
;
9546 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9547 src
->term_source
= our_term_source
;
9548 src
->bytes_in_buffer
= len
;
9549 src
->next_input_byte
= data
;
9553 /* Load image IMG for use on frame F. Patterned after example.c
9554 from the JPEG lib. */
9561 struct jpeg_decompress_struct cinfo
;
9562 struct my_jpeg_error_mgr mgr
;
9563 Lisp_Object file
, specified_file
;
9564 Lisp_Object specified_data
;
9565 FILE * volatile fp
= NULL
;
9567 int row_stride
, x
, y
;
9568 XImage
*ximg
= NULL
;
9570 unsigned long *colors
;
9572 struct gcpro gcpro1
;
9574 /* Open the JPEG file. */
9575 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9576 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9580 if (NILP (specified_data
))
9582 file
= x_find_image_file (specified_file
);
9583 if (!STRINGP (file
))
9585 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9590 fp
= fopen (SDATA (file
), "r");
9593 image_error ("Cannot open `%s'", file
, Qnil
);
9599 /* Customize libjpeg's error handling to call my_error_exit when an
9600 error is detected. This function will perform a longjmp. */
9601 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9602 mgr
.pub
.error_exit
= my_error_exit
;
9604 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9608 /* Called from my_error_exit. Display a JPEG error. */
9609 char buffer
[JMSG_LENGTH_MAX
];
9610 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9611 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9612 build_string (buffer
));
9615 /* Close the input file and destroy the JPEG object. */
9617 fclose ((FILE *) fp
);
9618 jpeg_destroy_decompress (&cinfo
);
9620 /* If we already have an XImage, free that. */
9621 x_destroy_x_image (ximg
);
9623 /* Free pixmap and colors. */
9624 x_clear_image (f
, img
);
9630 /* Create the JPEG decompression object. Let it read from fp.
9631 Read the JPEG image header. */
9632 jpeg_create_decompress (&cinfo
);
9634 if (NILP (specified_data
))
9635 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9637 jpeg_memory_src (&cinfo
, SDATA (specified_data
),
9638 SBYTES (specified_data
));
9640 jpeg_read_header (&cinfo
, TRUE
);
9642 /* Customize decompression so that color quantization will be used.
9643 Start decompression. */
9644 cinfo
.quantize_colors
= TRUE
;
9645 jpeg_start_decompress (&cinfo
);
9646 width
= img
->width
= cinfo
.output_width
;
9647 height
= img
->height
= cinfo
.output_height
;
9649 /* Create X image and pixmap. */
9650 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9651 longjmp (mgr
.setjmp_buffer
, 2);
9653 /* Allocate colors. When color quantization is used,
9654 cinfo.actual_number_of_colors has been set with the number of
9655 colors generated, and cinfo.colormap is a two-dimensional array
9656 of color indices in the range 0..cinfo.actual_number_of_colors.
9657 No more than 255 colors will be generated. */
9661 if (cinfo
.out_color_components
> 2)
9662 ir
= 0, ig
= 1, ib
= 2;
9663 else if (cinfo
.out_color_components
> 1)
9664 ir
= 0, ig
= 1, ib
= 0;
9666 ir
= 0, ig
= 0, ib
= 0;
9668 /* Use the color table mechanism because it handles colors that
9669 cannot be allocated nicely. Such colors will be replaced with
9670 a default color, and we don't have to care about which colors
9671 can be freed safely, and which can't. */
9672 init_color_table ();
9673 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9676 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9678 /* Multiply RGB values with 255 because X expects RGB values
9679 in the range 0..0xffff. */
9680 int r
= cinfo
.colormap
[ir
][i
] << 8;
9681 int g
= cinfo
.colormap
[ig
][i
] << 8;
9682 int b
= cinfo
.colormap
[ib
][i
] << 8;
9683 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9686 /* Remember those colors actually allocated. */
9687 img
->colors
= colors_in_color_table (&img
->ncolors
);
9688 free_color_table ();
9692 row_stride
= width
* cinfo
.output_components
;
9693 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9695 for (y
= 0; y
< height
; ++y
)
9697 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9698 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9699 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9703 jpeg_finish_decompress (&cinfo
);
9704 jpeg_destroy_decompress (&cinfo
);
9706 fclose ((FILE *) fp
);
9708 /* Maybe fill in the background field while we have ximg handy. */
9709 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9710 IMAGE_BACKGROUND (img
, f
, ximg
);
9712 /* Put the image into the pixmap. */
9713 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9714 x_destroy_x_image (ximg
);
9719 #endif /* HAVE_JPEG */
9723 /***********************************************************************
9725 ***********************************************************************/
9731 static int tiff_image_p
P_ ((Lisp_Object object
));
9732 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9734 /* The symbol `tiff' identifying images of this type. */
9738 /* Indices of image specification fields in tiff_format, below. */
9740 enum tiff_keyword_index
9749 TIFF_HEURISTIC_MASK
,
9755 /* Vector of image_keyword structures describing the format
9756 of valid user-defined image specifications. */
9758 static struct image_keyword tiff_format
[TIFF_LAST
] =
9760 {":type", IMAGE_SYMBOL_VALUE
, 1},
9761 {":data", IMAGE_STRING_VALUE
, 0},
9762 {":file", IMAGE_STRING_VALUE
, 0},
9763 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9764 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9765 {":relief", IMAGE_INTEGER_VALUE
, 0},
9766 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9767 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9768 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9769 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9772 /* Structure describing the image type `tiff'. */
9774 static struct image_type tiff_type
=
9784 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9787 tiff_image_p (object
)
9790 struct image_keyword fmt
[TIFF_LAST
];
9791 bcopy (tiff_format
, fmt
, sizeof fmt
);
9793 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9796 /* Must specify either the :data or :file keyword. */
9797 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9801 /* Reading from a memory buffer for TIFF images Based on the PNG
9802 memory source, but we have to provide a lot of extra functions.
9805 We really only need to implement read and seek, but I am not
9806 convinced that the TIFF library is smart enough not to destroy
9807 itself if we only hand it the function pointers we need to
9812 unsigned char *bytes
;
9820 tiff_read_from_memory (data
, buf
, size
)
9825 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9827 if (size
> src
->len
- src
->index
)
9829 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9836 tiff_write_from_memory (data
, buf
, size
)
9846 tiff_seek_in_memory (data
, off
, whence
)
9851 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9856 case SEEK_SET
: /* Go from beginning of source. */
9860 case SEEK_END
: /* Go from end of source. */
9861 idx
= src
->len
+ off
;
9864 case SEEK_CUR
: /* Go from current position. */
9865 idx
= src
->index
+ off
;
9868 default: /* Invalid `whence'. */
9872 if (idx
> src
->len
|| idx
< 0)
9881 tiff_close_memory (data
)
9890 tiff_mmap_memory (data
, pbase
, psize
)
9895 /* It is already _IN_ memory. */
9901 tiff_unmap_memory (data
, base
, size
)
9906 /* We don't need to do this. */
9911 tiff_size_of_memory (data
)
9914 return ((tiff_memory_source
*) data
)->len
;
9919 tiff_error_handler (title
, format
, ap
)
9920 const char *title
, *format
;
9926 len
= sprintf (buf
, "TIFF error: %s ", title
);
9927 vsprintf (buf
+ len
, format
, ap
);
9928 add_to_log (buf
, Qnil
, Qnil
);
9933 tiff_warning_handler (title
, format
, ap
)
9934 const char *title
, *format
;
9940 len
= sprintf (buf
, "TIFF warning: %s ", title
);
9941 vsprintf (buf
+ len
, format
, ap
);
9942 add_to_log (buf
, Qnil
, Qnil
);
9946 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9954 Lisp_Object file
, specified_file
;
9955 Lisp_Object specified_data
;
9957 int width
, height
, x
, y
;
9961 struct gcpro gcpro1
;
9962 tiff_memory_source memsrc
;
9964 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9965 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9969 TIFFSetErrorHandler (tiff_error_handler
);
9970 TIFFSetWarningHandler (tiff_warning_handler
);
9972 if (NILP (specified_data
))
9974 /* Read from a file */
9975 file
= x_find_image_file (specified_file
);
9976 if (!STRINGP (file
))
9978 image_error ("Cannot find image file `%s'", file
, Qnil
);
9983 /* Try to open the image file. */
9984 tiff
= TIFFOpen (SDATA (file
), "r");
9987 image_error ("Cannot open `%s'", file
, Qnil
);
9994 /* Memory source! */
9995 memsrc
.bytes
= SDATA (specified_data
);
9996 memsrc
.len
= SBYTES (specified_data
);
9999 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
10000 (TIFFReadWriteProc
) tiff_read_from_memory
,
10001 (TIFFReadWriteProc
) tiff_write_from_memory
,
10002 tiff_seek_in_memory
,
10004 tiff_size_of_memory
,
10006 tiff_unmap_memory
);
10010 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
10016 /* Get width and height of the image, and allocate a raster buffer
10017 of width x height 32-bit values. */
10018 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
10019 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
10020 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
10022 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
10026 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
10032 /* Create the X image and pixmap. */
10033 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
10040 /* Initialize the color table. */
10041 init_color_table ();
10043 /* Process the pixel raster. Origin is in the lower-left corner. */
10044 for (y
= 0; y
< height
; ++y
)
10046 uint32
*row
= buf
+ y
* width
;
10048 for (x
= 0; x
< width
; ++x
)
10050 uint32 abgr
= row
[x
];
10051 int r
= TIFFGetR (abgr
) << 8;
10052 int g
= TIFFGetG (abgr
) << 8;
10053 int b
= TIFFGetB (abgr
) << 8;
10054 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
10058 /* Remember the colors allocated for the image. Free the color table. */
10059 img
->colors
= colors_in_color_table (&img
->ncolors
);
10060 free_color_table ();
10062 img
->width
= width
;
10063 img
->height
= height
;
10065 /* Maybe fill in the background field while we have ximg handy. */
10066 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10067 IMAGE_BACKGROUND (img
, f
, ximg
);
10069 /* Put the image into the pixmap, then free the X image and its buffer. */
10070 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10071 x_destroy_x_image (ximg
);
10078 #endif /* HAVE_TIFF != 0 */
10082 /***********************************************************************
10084 ***********************************************************************/
10088 #include <gif_lib.h>
10090 static int gif_image_p
P_ ((Lisp_Object object
));
10091 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
10093 /* The symbol `gif' identifying images of this type. */
10097 /* Indices of image specification fields in gif_format, below. */
10099 enum gif_keyword_index
10108 GIF_HEURISTIC_MASK
,
10115 /* Vector of image_keyword structures describing the format
10116 of valid user-defined image specifications. */
10118 static struct image_keyword gif_format
[GIF_LAST
] =
10120 {":type", IMAGE_SYMBOL_VALUE
, 1},
10121 {":data", IMAGE_STRING_VALUE
, 0},
10122 {":file", IMAGE_STRING_VALUE
, 0},
10123 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10124 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10125 {":relief", IMAGE_INTEGER_VALUE
, 0},
10126 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10127 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10128 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10129 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
10130 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10133 /* Structure describing the image type `gif'. */
10135 static struct image_type gif_type
=
10145 /* Return non-zero if OBJECT is a valid GIF image specification. */
10148 gif_image_p (object
)
10149 Lisp_Object object
;
10151 struct image_keyword fmt
[GIF_LAST
];
10152 bcopy (gif_format
, fmt
, sizeof fmt
);
10154 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
10157 /* Must specify either the :data or :file keyword. */
10158 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
10162 /* Reading a GIF image from memory
10163 Based on the PNG memory stuff to a certain extent. */
10167 unsigned char *bytes
;
10174 /* Make the current memory source available to gif_read_from_memory.
10175 It's done this way because not all versions of libungif support
10176 a UserData field in the GifFileType structure. */
10177 static gif_memory_source
*current_gif_memory_src
;
10180 gif_read_from_memory (file
, buf
, len
)
10185 gif_memory_source
*src
= current_gif_memory_src
;
10187 if (len
> src
->len
- src
->index
)
10190 bcopy (src
->bytes
+ src
->index
, buf
, len
);
10196 /* Load GIF image IMG for use on frame F. Value is non-zero if
10204 Lisp_Object file
, specified_file
;
10205 Lisp_Object specified_data
;
10206 int rc
, width
, height
, x
, y
, i
;
10208 ColorMapObject
*gif_color_map
;
10209 unsigned long pixel_colors
[256];
10211 struct gcpro gcpro1
;
10213 int ino
, image_left
, image_top
, image_width
, image_height
;
10214 gif_memory_source memsrc
;
10215 unsigned char *raster
;
10217 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10218 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10222 if (NILP (specified_data
))
10224 file
= x_find_image_file (specified_file
);
10225 if (!STRINGP (file
))
10227 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10232 /* Open the GIF file. */
10233 gif
= DGifOpenFileName (SDATA (file
));
10236 image_error ("Cannot open `%s'", file
, Qnil
);
10243 /* Read from memory! */
10244 current_gif_memory_src
= &memsrc
;
10245 memsrc
.bytes
= SDATA (specified_data
);
10246 memsrc
.len
= SBYTES (specified_data
);
10249 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
10252 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
10258 /* Read entire contents. */
10259 rc
= DGifSlurp (gif
);
10260 if (rc
== GIF_ERROR
)
10262 image_error ("Error reading `%s'", img
->spec
, Qnil
);
10263 DGifCloseFile (gif
);
10268 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
10269 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
10270 if (ino
>= gif
->ImageCount
)
10272 image_error ("Invalid image number `%s' in image `%s'",
10274 DGifCloseFile (gif
);
10279 width
= img
->width
= max (gif
->SWidth
, gif
->Image
.Left
+ gif
->Image
.Width
);
10280 height
= img
->height
= max (gif
->SHeight
, gif
->Image
.Top
+ gif
->Image
.Height
);
10282 /* Create the X image and pixmap. */
10283 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
10285 DGifCloseFile (gif
);
10290 /* Allocate colors. */
10291 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
10292 if (!gif_color_map
)
10293 gif_color_map
= gif
->SColorMap
;
10294 init_color_table ();
10295 bzero (pixel_colors
, sizeof pixel_colors
);
10297 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
10299 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
10300 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
10301 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
10302 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
10305 img
->colors
= colors_in_color_table (&img
->ncolors
);
10306 free_color_table ();
10308 /* Clear the part of the screen image that are not covered by
10309 the image from the GIF file. Full animated GIF support
10310 requires more than can be done here (see the gif89 spec,
10311 disposal methods). Let's simply assume that the part
10312 not covered by a sub-image is in the frame's background color. */
10313 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
10314 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
10315 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
10316 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
10318 for (y
= 0; y
< image_top
; ++y
)
10319 for (x
= 0; x
< width
; ++x
)
10320 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10322 for (y
= image_top
+ image_height
; y
< height
; ++y
)
10323 for (x
= 0; x
< width
; ++x
)
10324 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10326 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
10328 for (x
= 0; x
< image_left
; ++x
)
10329 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10330 for (x
= image_left
+ image_width
; x
< width
; ++x
)
10331 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10334 /* Read the GIF image into the X image. We use a local variable
10335 `raster' here because RasterBits below is a char *, and invites
10336 problems with bytes >= 0x80. */
10337 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
10339 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
10341 static int interlace_start
[] = {0, 4, 2, 1};
10342 static int interlace_increment
[] = {8, 8, 4, 2};
10344 int row
= interlace_start
[0];
10348 for (y
= 0; y
< image_height
; y
++)
10350 if (row
>= image_height
)
10352 row
= interlace_start
[++pass
];
10353 while (row
>= image_height
)
10354 row
= interlace_start
[++pass
];
10357 for (x
= 0; x
< image_width
; x
++)
10359 int i
= raster
[(y
* image_width
) + x
];
10360 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
10364 row
+= interlace_increment
[pass
];
10369 for (y
= 0; y
< image_height
; ++y
)
10370 for (x
= 0; x
< image_width
; ++x
)
10372 int i
= raster
[y
* image_width
+ x
];
10373 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
10377 DGifCloseFile (gif
);
10379 /* Maybe fill in the background field while we have ximg handy. */
10380 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10381 IMAGE_BACKGROUND (img
, f
, ximg
);
10383 /* Put the image into the pixmap, then free the X image and its buffer. */
10384 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10385 x_destroy_x_image (ximg
);
10391 #endif /* HAVE_GIF != 0 */
10395 /***********************************************************************
10397 ***********************************************************************/
10399 static int gs_image_p
P_ ((Lisp_Object object
));
10400 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
10401 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
10403 /* The symbol `postscript' identifying images of this type. */
10405 Lisp_Object Qpostscript
;
10407 /* Keyword symbols. */
10409 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
10411 /* Indices of image specification fields in gs_format, below. */
10413 enum gs_keyword_index
10431 /* Vector of image_keyword structures describing the format
10432 of valid user-defined image specifications. */
10434 static struct image_keyword gs_format
[GS_LAST
] =
10436 {":type", IMAGE_SYMBOL_VALUE
, 1},
10437 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10438 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10439 {":file", IMAGE_STRING_VALUE
, 1},
10440 {":loader", IMAGE_FUNCTION_VALUE
, 0},
10441 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
10442 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10443 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10444 {":relief", IMAGE_INTEGER_VALUE
, 0},
10445 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10446 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10447 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10448 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10451 /* Structure describing the image type `ghostscript'. */
10453 static struct image_type gs_type
=
10463 /* Free X resources of Ghostscript image IMG which is used on frame F. */
10466 gs_clear_image (f
, img
)
10470 /* IMG->data.ptr_val may contain a recorded colormap. */
10471 xfree (img
->data
.ptr_val
);
10472 x_clear_image (f
, img
);
10476 /* Return non-zero if OBJECT is a valid Ghostscript image
10480 gs_image_p (object
)
10481 Lisp_Object object
;
10483 struct image_keyword fmt
[GS_LAST
];
10487 bcopy (gs_format
, fmt
, sizeof fmt
);
10489 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
10492 /* Bounding box must be a list or vector containing 4 integers. */
10493 tem
= fmt
[GS_BOUNDING_BOX
].value
;
10496 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
10497 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
10502 else if (VECTORP (tem
))
10504 if (XVECTOR (tem
)->size
!= 4)
10506 for (i
= 0; i
< 4; ++i
)
10507 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
10517 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
10526 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
10527 struct gcpro gcpro1
, gcpro2
;
10529 double in_width
, in_height
;
10530 Lisp_Object pixel_colors
= Qnil
;
10532 /* Compute pixel size of pixmap needed from the given size in the
10533 image specification. Sizes in the specification are in pt. 1 pt
10534 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10536 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
10537 in_width
= XFASTINT (pt_width
) / 72.0;
10538 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
10539 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
10540 in_height
= XFASTINT (pt_height
) / 72.0;
10541 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
10543 /* Create the pixmap. */
10544 xassert (img
->pixmap
== None
);
10545 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10546 img
->width
, img
->height
,
10547 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
10551 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
10555 /* Call the loader to fill the pixmap. It returns a process object
10556 if successful. We do not record_unwind_protect here because
10557 other places in redisplay like calling window scroll functions
10558 don't either. Let the Lisp loader use `unwind-protect' instead. */
10559 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
10561 sprintf (buffer
, "%lu %lu",
10562 (unsigned long) FRAME_X_WINDOW (f
),
10563 (unsigned long) img
->pixmap
);
10564 window_and_pixmap_id
= build_string (buffer
);
10566 sprintf (buffer
, "%lu %lu",
10567 FRAME_FOREGROUND_PIXEL (f
),
10568 FRAME_BACKGROUND_PIXEL (f
));
10569 pixel_colors
= build_string (buffer
);
10571 XSETFRAME (frame
, f
);
10572 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
10574 loader
= intern ("gs-load-image");
10576 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10577 make_number (img
->width
),
10578 make_number (img
->height
),
10579 window_and_pixmap_id
,
10582 return PROCESSP (img
->data
.lisp_val
);
10586 /* Kill the Ghostscript process that was started to fill PIXMAP on
10587 frame F. Called from XTread_socket when receiving an event
10588 telling Emacs that Ghostscript has finished drawing. */
10591 x_kill_gs_process (pixmap
, f
)
10595 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10599 /* Find the image containing PIXMAP. */
10600 for (i
= 0; i
< c
->used
; ++i
)
10601 if (c
->images
[i
]->pixmap
== pixmap
)
10604 /* Should someone in between have cleared the image cache, for
10605 instance, give up. */
10609 /* Kill the GS process. We should have found PIXMAP in the image
10610 cache and its image should contain a process object. */
10611 img
= c
->images
[i
];
10612 xassert (PROCESSP (img
->data
.lisp_val
));
10613 Fkill_process (img
->data
.lisp_val
, Qnil
);
10614 img
->data
.lisp_val
= Qnil
;
10616 /* On displays with a mutable colormap, figure out the colors
10617 allocated for the image by looking at the pixels of an XImage for
10619 class = FRAME_X_VISUAL (f
)->class;
10620 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10626 /* Try to get an XImage for img->pixmep. */
10627 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10628 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10633 /* Initialize the color table. */
10634 init_color_table ();
10636 /* For each pixel of the image, look its color up in the
10637 color table. After having done so, the color table will
10638 contain an entry for each color used by the image. */
10639 for (y
= 0; y
< img
->height
; ++y
)
10640 for (x
= 0; x
< img
->width
; ++x
)
10642 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10643 lookup_pixel_color (f
, pixel
);
10646 /* Record colors in the image. Free color table and XImage. */
10647 img
->colors
= colors_in_color_table (&img
->ncolors
);
10648 free_color_table ();
10649 XDestroyImage (ximg
);
10651 #if 0 /* This doesn't seem to be the case. If we free the colors
10652 here, we get a BadAccess later in x_clear_image when
10653 freeing the colors. */
10654 /* We have allocated colors once, but Ghostscript has also
10655 allocated colors on behalf of us. So, to get the
10656 reference counts right, free them once. */
10658 x_free_colors (f
, img
->colors
, img
->ncolors
);
10662 image_error ("Cannot get X image of `%s'; colors will not be freed",
10668 /* Now that we have the pixmap, compute mask and transform the
10669 image if requested. */
10671 postprocess_image (f
, img
);
10677 /***********************************************************************
10679 ***********************************************************************/
10681 DEFUN ("x-change-window-property", Fx_change_window_property
,
10682 Sx_change_window_property
, 2, 3, 0,
10683 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
10684 PROP and VALUE must be strings. FRAME nil or omitted means use the
10685 selected frame. Value is VALUE. */)
10686 (prop
, value
, frame
)
10687 Lisp_Object frame
, prop
, value
;
10689 struct frame
*f
= check_x_frame (frame
);
10692 CHECK_STRING (prop
);
10693 CHECK_STRING (value
);
10696 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SDATA (prop
), False
);
10697 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10698 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10699 SDATA (value
), SCHARS (value
));
10701 /* Make sure the property is set when we return. */
10702 XFlush (FRAME_X_DISPLAY (f
));
10709 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10710 Sx_delete_window_property
, 1, 2, 0,
10711 doc
: /* Remove window property PROP from X window of FRAME.
10712 FRAME nil or omitted means use the selected frame. Value is PROP. */)
10714 Lisp_Object prop
, frame
;
10716 struct frame
*f
= check_x_frame (frame
);
10719 CHECK_STRING (prop
);
10721 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SDATA (prop
), False
);
10722 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10724 /* Make sure the property is removed when we return. */
10725 XFlush (FRAME_X_DISPLAY (f
));
10732 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10734 doc
: /* Value is the value of window property PROP on FRAME.
10735 If FRAME is nil or omitted, use the selected frame. Value is nil
10736 if FRAME hasn't a property with name PROP or if PROP has no string
10739 Lisp_Object prop
, frame
;
10741 struct frame
*f
= check_x_frame (frame
);
10744 Lisp_Object prop_value
= Qnil
;
10745 char *tmp_data
= NULL
;
10748 unsigned long actual_size
, bytes_remaining
;
10750 CHECK_STRING (prop
);
10752 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SDATA (prop
), False
);
10753 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10754 prop_atom
, 0, 0, False
, XA_STRING
,
10755 &actual_type
, &actual_format
, &actual_size
,
10756 &bytes_remaining
, (unsigned char **) &tmp_data
);
10759 int size
= bytes_remaining
;
10764 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10765 prop_atom
, 0, bytes_remaining
,
10767 &actual_type
, &actual_format
,
10768 &actual_size
, &bytes_remaining
,
10769 (unsigned char **) &tmp_data
);
10770 if (rc
== Success
&& tmp_data
)
10771 prop_value
= make_string (tmp_data
, size
);
10782 /***********************************************************************
10784 ***********************************************************************/
10786 /* If non-null, an asynchronous timer that, when it expires, displays
10787 an hourglass cursor on all frames. */
10789 static struct atimer
*hourglass_atimer
;
10791 /* Non-zero means an hourglass cursor is currently shown. */
10793 static int hourglass_shown_p
;
10795 /* Number of seconds to wait before displaying an hourglass cursor. */
10797 static Lisp_Object Vhourglass_delay
;
10799 /* Default number of seconds to wait before displaying an hourglass
10802 #define DEFAULT_HOURGLASS_DELAY 1
10804 /* Function prototypes. */
10806 static void show_hourglass
P_ ((struct atimer
*));
10807 static void hide_hourglass
P_ ((void));
10810 /* Cancel a currently active hourglass timer, and start a new one. */
10816 int secs
, usecs
= 0;
10818 cancel_hourglass ();
10820 if (INTEGERP (Vhourglass_delay
)
10821 && XINT (Vhourglass_delay
) > 0)
10822 secs
= XFASTINT (Vhourglass_delay
);
10823 else if (FLOATP (Vhourglass_delay
)
10824 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10827 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10828 secs
= XFASTINT (tem
);
10829 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10832 secs
= DEFAULT_HOURGLASS_DELAY
;
10834 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10835 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10836 show_hourglass
, NULL
);
10840 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10844 cancel_hourglass ()
10846 if (hourglass_atimer
)
10848 cancel_atimer (hourglass_atimer
);
10849 hourglass_atimer
= NULL
;
10852 if (hourglass_shown_p
)
10857 /* Timer function of hourglass_atimer. TIMER is equal to
10860 Display an hourglass pointer on all frames by mapping the frames'
10861 hourglass_window. Set the hourglass_p flag in the frames'
10862 output_data.x structure to indicate that an hourglass cursor is
10863 shown on the frames. */
10866 show_hourglass (timer
)
10867 struct atimer
*timer
;
10869 /* The timer implementation will cancel this timer automatically
10870 after this function has run. Set hourglass_atimer to null
10871 so that we know the timer doesn't have to be canceled. */
10872 hourglass_atimer
= NULL
;
10874 if (!hourglass_shown_p
)
10876 Lisp_Object rest
, frame
;
10880 FOR_EACH_FRAME (rest
, frame
)
10882 struct frame
*f
= XFRAME (frame
);
10884 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10886 Display
*dpy
= FRAME_X_DISPLAY (f
);
10888 #ifdef USE_X_TOOLKIT
10889 if (f
->output_data
.x
->widget
)
10891 if (FRAME_OUTER_WINDOW (f
))
10894 f
->output_data
.x
->hourglass_p
= 1;
10896 if (!f
->output_data
.x
->hourglass_window
)
10898 unsigned long mask
= CWCursor
;
10899 XSetWindowAttributes attrs
;
10901 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10903 f
->output_data
.x
->hourglass_window
10904 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10905 0, 0, 32000, 32000, 0, 0,
10911 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10917 hourglass_shown_p
= 1;
10923 /* Hide the hourglass pointer on all frames, if it is currently
10929 if (hourglass_shown_p
)
10931 Lisp_Object rest
, frame
;
10934 FOR_EACH_FRAME (rest
, frame
)
10936 struct frame
*f
= XFRAME (frame
);
10939 /* Watch out for newly created frames. */
10940 && f
->output_data
.x
->hourglass_window
)
10942 XUnmapWindow (FRAME_X_DISPLAY (f
),
10943 f
->output_data
.x
->hourglass_window
);
10944 /* Sync here because XTread_socket looks at the
10945 hourglass_p flag that is reset to zero below. */
10946 XSync (FRAME_X_DISPLAY (f
), False
);
10947 f
->output_data
.x
->hourglass_p
= 0;
10951 hourglass_shown_p
= 0;
10958 /***********************************************************************
10960 ***********************************************************************/
10962 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10963 Lisp_Object
, Lisp_Object
));
10964 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10965 Lisp_Object
, int, int, int *, int *));
10967 /* The frame of a currently visible tooltip. */
10969 Lisp_Object tip_frame
;
10971 /* If non-nil, a timer started that hides the last tooltip when it
10974 Lisp_Object tip_timer
;
10977 /* If non-nil, a vector of 3 elements containing the last args
10978 with which x-show-tip was called. See there. */
10980 Lisp_Object last_show_tip_args
;
10982 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
10984 Lisp_Object Vx_max_tooltip_size
;
10988 unwind_create_tip_frame (frame
)
10991 Lisp_Object deleted
;
10993 deleted
= unwind_create_frame (frame
);
10994 if (EQ (deleted
, Qt
))
11004 /* Create a frame for a tooltip on the display described by DPYINFO.
11005 PARMS is a list of frame parameters. TEXT is the string to
11006 display in the tip frame. Value is the frame.
11008 Note that functions called here, esp. x_default_parameter can
11009 signal errors, for instance when a specified color name is
11010 undefined. We have to make sure that we're in a consistent state
11011 when this happens. */
11014 x_create_tip_frame (dpyinfo
, parms
, text
)
11015 struct x_display_info
*dpyinfo
;
11016 Lisp_Object parms
, text
;
11019 Lisp_Object frame
, tem
;
11021 long window_prompting
= 0;
11023 int count
= SPECPDL_INDEX ();
11024 struct gcpro gcpro1
, gcpro2
, gcpro3
;
11026 int face_change_count_before
= face_change_count
;
11027 Lisp_Object buffer
;
11028 struct buffer
*old_buffer
;
11032 /* Use this general default value to start with until we know if
11033 this frame has a specified name. */
11034 Vx_resource_name
= Vinvocation_name
;
11036 #ifdef MULTI_KBOARD
11037 kb
= dpyinfo
->kboard
;
11039 kb
= &the_only_kboard
;
11042 /* Get the name of the frame to use for resource lookup. */
11043 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
11044 if (!STRINGP (name
)
11045 && !EQ (name
, Qunbound
)
11047 error ("Invalid frame name--not a string or nil");
11048 Vx_resource_name
= name
;
11051 GCPRO3 (parms
, name
, frame
);
11052 f
= make_frame (1);
11053 XSETFRAME (frame
, f
);
11055 buffer
= Fget_buffer_create (build_string (" *tip*"));
11056 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
11057 old_buffer
= current_buffer
;
11058 set_buffer_internal_1 (XBUFFER (buffer
));
11059 current_buffer
->truncate_lines
= Qnil
;
11061 Finsert (1, &text
);
11062 set_buffer_internal_1 (old_buffer
);
11064 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
11065 record_unwind_protect (unwind_create_tip_frame
, frame
);
11067 /* By setting the output method, we're essentially saying that
11068 the frame is live, as per FRAME_LIVE_P. If we get a signal
11069 from this point on, x_destroy_window might screw up reference
11071 f
->output_method
= output_x_window
;
11072 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
11073 bzero (f
->output_data
.x
, sizeof (struct x_output
));
11074 f
->output_data
.x
->icon_bitmap
= -1;
11075 f
->output_data
.x
->fontset
= -1;
11076 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
11077 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
11078 #ifdef USE_TOOLKIT_SCROLL_BARS
11079 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
11080 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
11081 #endif /* USE_TOOLKIT_SCROLL_BARS */
11082 f
->icon_name
= Qnil
;
11083 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
11085 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
11086 dpyinfo_refcount
= dpyinfo
->reference_count
;
11087 #endif /* GLYPH_DEBUG */
11088 #ifdef MULTI_KBOARD
11089 FRAME_KBOARD (f
) = kb
;
11091 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
11092 f
->output_data
.x
->explicit_parent
= 0;
11094 /* These colors will be set anyway later, but it's important
11095 to get the color reference counts right, so initialize them! */
11098 struct gcpro gcpro1
;
11100 black
= build_string ("black");
11102 f
->output_data
.x
->foreground_pixel
11103 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11104 f
->output_data
.x
->background_pixel
11105 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11106 f
->output_data
.x
->cursor_pixel
11107 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11108 f
->output_data
.x
->cursor_foreground_pixel
11109 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11110 f
->output_data
.x
->border_pixel
11111 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11112 f
->output_data
.x
->mouse_pixel
11113 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11117 /* Set the name; the functions to which we pass f expect the name to
11119 if (EQ (name
, Qunbound
) || NILP (name
))
11121 f
->name
= build_string (dpyinfo
->x_id_name
);
11122 f
->explicit_name
= 0;
11127 f
->explicit_name
= 1;
11128 /* use the frame's title when getting resources for this frame. */
11129 specbind (Qx_resource_name
, name
);
11132 /* Extract the window parameters from the supplied values that are
11133 needed to determine window geometry. */
11137 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
11140 /* First, try whatever font the caller has specified. */
11141 if (STRINGP (font
))
11143 tem
= Fquery_fontset (font
, Qnil
);
11145 font
= x_new_fontset (f
, SDATA (tem
));
11147 font
= x_new_font (f
, SDATA (font
));
11150 /* Try out a font which we hope has bold and italic variations. */
11151 if (!STRINGP (font
))
11152 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
11153 if (!STRINGP (font
))
11154 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11155 if (! STRINGP (font
))
11156 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11157 if (! STRINGP (font
))
11158 /* This was formerly the first thing tried, but it finds too many fonts
11159 and takes too long. */
11160 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
11161 /* If those didn't work, look for something which will at least work. */
11162 if (! STRINGP (font
))
11163 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
11165 if (! STRINGP (font
))
11166 font
= build_string ("fixed");
11168 x_default_parameter (f
, parms
, Qfont
, font
,
11169 "font", "Font", RES_TYPE_STRING
);
11172 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
11173 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
11175 /* This defaults to 2 in order to match xterm. We recognize either
11176 internalBorderWidth or internalBorder (which is what xterm calls
11178 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11182 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
11183 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
11184 if (! EQ (value
, Qunbound
))
11185 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
11189 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
11190 "internalBorderWidth", "internalBorderWidth",
11193 /* Also do the stuff which must be set before the window exists. */
11194 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
11195 "foreground", "Foreground", RES_TYPE_STRING
);
11196 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
11197 "background", "Background", RES_TYPE_STRING
);
11198 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
11199 "pointerColor", "Foreground", RES_TYPE_STRING
);
11200 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
11201 "cursorColor", "Foreground", RES_TYPE_STRING
);
11202 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
11203 "borderColor", "BorderColor", RES_TYPE_STRING
);
11205 /* Init faces before x_default_parameter is called for scroll-bar
11206 parameters because that function calls x_set_scroll_bar_width,
11207 which calls change_frame_size, which calls Fset_window_buffer,
11208 which runs hooks, which call Fvertical_motion. At the end, we
11209 end up in init_iterator with a null face cache, which should not
11211 init_frame_faces (f
);
11213 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
11214 window_prompting
= x_figure_window_size (f
, parms
);
11216 if (window_prompting
& XNegative
)
11218 if (window_prompting
& YNegative
)
11219 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
11221 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
11225 if (window_prompting
& YNegative
)
11226 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
11228 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
11231 f
->output_data
.x
->size_hint_flags
= window_prompting
;
11233 XSetWindowAttributes attrs
;
11234 unsigned long mask
;
11237 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
11238 if (DoesSaveUnders (dpyinfo
->screen
))
11239 mask
|= CWSaveUnder
;
11241 /* Window managers look at the override-redirect flag to determine
11242 whether or net to give windows a decoration (Xlib spec, chapter
11244 attrs
.override_redirect
= True
;
11245 attrs
.save_under
= True
;
11246 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
11247 /* Arrange for getting MapNotify and UnmapNotify events. */
11248 attrs
.event_mask
= StructureNotifyMask
;
11250 = FRAME_X_WINDOW (f
)
11251 = XCreateWindow (FRAME_X_DISPLAY (f
),
11252 FRAME_X_DISPLAY_INFO (f
)->root_window
,
11253 /* x, y, width, height */
11257 CopyFromParent
, InputOutput
, CopyFromParent
,
11264 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
11265 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
11266 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
11267 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
11268 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
11269 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
11271 /* Dimensions, especially f->height, must be done via change_frame_size.
11272 Change will not be effected unless different from the current
11275 height
= f
->height
;
11277 SET_FRAME_WIDTH (f
, 0);
11278 change_frame_size (f
, height
, width
, 1, 0, 0);
11280 /* Add `tooltip' frame parameter's default value. */
11281 if (NILP (Fframe_parameter (frame
, intern ("tooltip"))))
11282 Fmodify_frame_parameters (frame
, Fcons (Fcons (intern ("tooltip"), Qt
),
11285 /* Set up faces after all frame parameters are known. This call
11286 also merges in face attributes specified for new frames.
11288 Frame parameters may be changed if .Xdefaults contains
11289 specifications for the default font. For example, if there is an
11290 `Emacs.default.attributeBackground: pink', the `background-color'
11291 attribute of the frame get's set, which let's the internal border
11292 of the tooltip frame appear in pink. Prevent this. */
11294 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
11296 /* Set tip_frame here, so that */
11298 call1 (Qface_set_after_frame_default
, frame
);
11300 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
11301 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
11309 /* It is now ok to make the frame official even if we get an error
11310 below. And the frame needs to be on Vframe_list or making it
11311 visible won't work. */
11312 Vframe_list
= Fcons (frame
, Vframe_list
);
11314 /* Now that the frame is official, it counts as a reference to
11316 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
11318 /* Setting attributes of faces of the tooltip frame from resources
11319 and similar will increment face_change_count, which leads to the
11320 clearing of all current matrices. Since this isn't necessary
11321 here, avoid it by resetting face_change_count to the value it
11322 had before we created the tip frame. */
11323 face_change_count
= face_change_count_before
;
11325 /* Discard the unwind_protect. */
11326 return unbind_to (count
, frame
);
11330 /* Compute where to display tip frame F. PARMS is the list of frame
11331 parameters for F. DX and DY are specified offsets from the current
11332 location of the mouse. WIDTH and HEIGHT are the width and height
11333 of the tooltip. Return coordinates relative to the root window of
11334 the display in *ROOT_X, and *ROOT_Y. */
11337 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
11339 Lisp_Object parms
, dx
, dy
;
11341 int *root_x
, *root_y
;
11343 Lisp_Object left
, top
;
11345 Window root
, child
;
11348 /* User-specified position? */
11349 left
= Fcdr (Fassq (Qleft
, parms
));
11350 top
= Fcdr (Fassq (Qtop
, parms
));
11352 /* Move the tooltip window where the mouse pointer is. Resize and
11354 if (!INTEGERP (left
) || !INTEGERP (top
))
11357 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
11358 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
11362 if (INTEGERP (top
))
11363 *root_y
= XINT (top
);
11364 else if (*root_y
+ XINT (dy
) - height
< 0)
11365 *root_y
-= XINT (dy
);
11369 *root_y
+= XINT (dy
);
11372 if (INTEGERP (left
))
11373 *root_x
= XINT (left
);
11374 else if (*root_x
+ XINT (dx
) + width
<= FRAME_X_DISPLAY_INFO (f
)->width
)
11375 /* It fits to the right of the pointer. */
11376 *root_x
+= XINT (dx
);
11377 else if (width
+ XINT (dx
) <= *root_x
)
11378 /* It fits to the left of the pointer. */
11379 *root_x
-= width
+ XINT (dx
);
11381 /* Put it left-justified on the screen--it ought to fit that way. */
11386 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
11387 doc
: /* Show STRING in a "tooltip" window on frame FRAME.
11388 A tooltip window is a small X window displaying a string.
11390 FRAME nil or omitted means use the selected frame.
11392 PARMS is an optional list of frame parameters which can be used to
11393 change the tooltip's appearance.
11395 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
11396 means use the default timeout of 5 seconds.
11398 If the list of frame parameters PARAMS contains a `left' parameters,
11399 the tooltip is displayed at that x-position. Otherwise it is
11400 displayed at the mouse position, with offset DX added (default is 5 if
11401 DX isn't specified). Likewise for the y-position; if a `top' frame
11402 parameter is specified, it determines the y-position of the tooltip
11403 window, otherwise it is displayed at the mouse position, with offset
11404 DY added (default is -10).
11406 A tooltip's maximum size is specified by `x-max-tooltip-size'.
11407 Text larger than the specified size is clipped. */)
11408 (string
, frame
, parms
, timeout
, dx
, dy
)
11409 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
11413 int root_x
, root_y
;
11414 struct buffer
*old_buffer
;
11415 struct text_pos pos
;
11416 int i
, width
, height
;
11417 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
11418 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
11419 int count
= SPECPDL_INDEX ();
11421 specbind (Qinhibit_redisplay
, Qt
);
11423 GCPRO4 (string
, parms
, frame
, timeout
);
11425 CHECK_STRING (string
);
11426 f
= check_x_frame (frame
);
11427 if (NILP (timeout
))
11428 timeout
= make_number (5);
11430 CHECK_NATNUM (timeout
);
11433 dx
= make_number (5);
11438 dy
= make_number (-10);
11442 if (NILP (last_show_tip_args
))
11443 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
11445 if (!NILP (tip_frame
))
11447 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
11448 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
11449 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
11451 if (EQ (frame
, last_frame
)
11452 && !NILP (Fequal (last_string
, string
))
11453 && !NILP (Fequal (last_parms
, parms
)))
11455 struct frame
*f
= XFRAME (tip_frame
);
11457 /* Only DX and DY have changed. */
11458 if (!NILP (tip_timer
))
11460 Lisp_Object timer
= tip_timer
;
11462 call1 (Qcancel_timer
, timer
);
11466 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
11467 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
11468 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11475 /* Hide a previous tip, if any. */
11478 ASET (last_show_tip_args
, 0, string
);
11479 ASET (last_show_tip_args
, 1, frame
);
11480 ASET (last_show_tip_args
, 2, parms
);
11482 /* Add default values to frame parameters. */
11483 if (NILP (Fassq (Qname
, parms
)))
11484 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
11485 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11486 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
11487 if (NILP (Fassq (Qborder_width
, parms
)))
11488 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
11489 if (NILP (Fassq (Qborder_color
, parms
)))
11490 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
11491 if (NILP (Fassq (Qbackground_color
, parms
)))
11492 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
11495 /* Create a frame for the tooltip, and record it in the global
11496 variable tip_frame. */
11497 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
, string
);
11498 f
= XFRAME (frame
);
11500 /* Set up the frame's root window. */
11501 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
11502 w
->left
= w
->top
= make_number (0);
11504 if (CONSP (Vx_max_tooltip_size
)
11505 && INTEGERP (XCAR (Vx_max_tooltip_size
))
11506 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
11507 && INTEGERP (XCDR (Vx_max_tooltip_size
))
11508 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
11510 w
->width
= XCAR (Vx_max_tooltip_size
);
11511 w
->height
= XCDR (Vx_max_tooltip_size
);
11515 w
->width
= make_number (80);
11516 w
->height
= make_number (40);
11519 f
->window_width
= XINT (w
->width
);
11521 w
->pseudo_window_p
= 1;
11523 /* Display the tooltip text in a temporary buffer. */
11524 old_buffer
= current_buffer
;
11525 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
11526 current_buffer
->truncate_lines
= Qnil
;
11527 clear_glyph_matrix (w
->desired_matrix
);
11528 clear_glyph_matrix (w
->current_matrix
);
11529 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
11530 try_window (FRAME_ROOT_WINDOW (f
), pos
);
11532 /* Compute width and height of the tooltip. */
11533 width
= height
= 0;
11534 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
11536 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
11537 struct glyph
*last
;
11540 /* Stop at the first empty row at the end. */
11541 if (!row
->enabled_p
|| !row
->displays_text_p
)
11544 /* Let the row go over the full width of the frame. */
11545 row
->full_width_p
= 1;
11547 /* There's a glyph at the end of rows that is used to place
11548 the cursor there. Don't include the width of this glyph. */
11549 if (row
->used
[TEXT_AREA
])
11551 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
11552 row_width
= row
->pixel_width
- last
->pixel_width
;
11555 row_width
= row
->pixel_width
;
11557 height
+= row
->height
;
11558 width
= max (width
, row_width
);
11561 /* Add the frame's internal border to the width and height the X
11562 window should have. */
11563 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11564 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11566 /* Move the tooltip window where the mouse pointer is. Resize and
11568 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
11571 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11572 root_x
, root_y
, width
, height
);
11573 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
11576 /* Draw into the window. */
11577 w
->must_be_updated_p
= 1;
11578 update_single_window (w
, 1);
11580 /* Restore original current buffer. */
11581 set_buffer_internal_1 (old_buffer
);
11582 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
11585 /* Let the tip disappear after timeout seconds. */
11586 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
11587 intern ("x-hide-tip"));
11590 return unbind_to (count
, Qnil
);
11594 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
11595 doc
: /* Hide the current tooltip window, if there is any.
11596 Value is t if tooltip was open, nil otherwise. */)
11600 Lisp_Object deleted
, frame
, timer
;
11601 struct gcpro gcpro1
, gcpro2
;
11603 /* Return quickly if nothing to do. */
11604 if (NILP (tip_timer
) && NILP (tip_frame
))
11609 GCPRO2 (frame
, timer
);
11610 tip_frame
= tip_timer
= deleted
= Qnil
;
11612 count
= SPECPDL_INDEX ();
11613 specbind (Qinhibit_redisplay
, Qt
);
11614 specbind (Qinhibit_quit
, Qt
);
11617 call1 (Qcancel_timer
, timer
);
11619 if (FRAMEP (frame
))
11621 Fdelete_frame (frame
, Qnil
);
11625 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11626 redisplay procedure is not called when a tip frame over menu
11627 items is unmapped. Redisplay the menu manually... */
11629 struct frame
*f
= SELECTED_FRAME ();
11630 Widget w
= f
->output_data
.x
->menubar_widget
;
11631 extern void xlwmenu_redisplay
P_ ((Widget
));
11633 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
11637 xlwmenu_redisplay (w
);
11641 #endif /* USE_LUCID */
11645 return unbind_to (count
, deleted
);
11650 /***********************************************************************
11651 File selection dialog
11652 ***********************************************************************/
11656 /* Callback for "OK" and "Cancel" on file selection dialog. */
11659 file_dialog_cb (widget
, client_data
, call_data
)
11661 XtPointer call_data
, client_data
;
11663 int *result
= (int *) client_data
;
11664 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11665 *result
= cb
->reason
;
11669 /* Callback for unmapping a file selection dialog. This is used to
11670 capture the case where a dialog is closed via a window manager's
11671 closer button, for example. Using a XmNdestroyCallback didn't work
11675 file_dialog_unmap_cb (widget
, client_data
, call_data
)
11677 XtPointer call_data
, client_data
;
11679 int *result
= (int *) client_data
;
11680 *result
= XmCR_CANCEL
;
11684 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11685 doc
: /* Read file name, prompting with PROMPT in directory DIR.
11686 Use a file selection dialog.
11687 Select DEFAULT-FILENAME in the dialog's file selection box, if
11688 specified. Don't let the user enter a file name in the file
11689 selection dialog's entry field, if MUSTMATCH is non-nil. */)
11690 (prompt
, dir
, default_filename
, mustmatch
)
11691 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11694 struct frame
*f
= SELECTED_FRAME ();
11695 Lisp_Object file
= Qnil
;
11696 Widget dialog
, text
, list
, help
;
11699 extern XtAppContext Xt_app_con
;
11700 XmString dir_xmstring
, pattern_xmstring
;
11701 int count
= SPECPDL_INDEX ();
11702 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11704 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11705 CHECK_STRING (prompt
);
11706 CHECK_STRING (dir
);
11708 /* Prevent redisplay. */
11709 specbind (Qinhibit_redisplay
, Qt
);
11713 /* Create the dialog with PROMPT as title, using DIR as initial
11714 directory and using "*" as pattern. */
11715 dir
= Fexpand_file_name (dir
, Qnil
);
11716 dir_xmstring
= XmStringCreateLocalized (SDATA (dir
));
11717 pattern_xmstring
= XmStringCreateLocalized ("*");
11719 XtSetArg (al
[ac
], XmNtitle
, SDATA (prompt
)); ++ac
;
11720 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11721 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11722 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11723 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11724 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11726 XmStringFree (dir_xmstring
);
11727 XmStringFree (pattern_xmstring
);
11729 /* Add callbacks for OK and Cancel. */
11730 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11731 (XtPointer
) &result
);
11732 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11733 (XtPointer
) &result
);
11734 XtAddCallback (dialog
, XmNunmapCallback
, file_dialog_unmap_cb
,
11735 (XtPointer
) &result
);
11737 /* Disable the help button since we can't display help. */
11738 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11739 XtSetSensitive (help
, False
);
11741 /* Mark OK button as default. */
11742 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11743 XmNshowAsDefault
, True
, NULL
);
11745 /* If MUSTMATCH is non-nil, disable the file entry field of the
11746 dialog, so that the user must select a file from the files list
11747 box. We can't remove it because we wouldn't have a way to get at
11748 the result file name, then. */
11749 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11750 if (!NILP (mustmatch
))
11753 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11754 XtSetSensitive (text
, False
);
11755 XtSetSensitive (label
, False
);
11758 /* Manage the dialog, so that list boxes get filled. */
11759 XtManageChild (dialog
);
11761 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11762 must include the path for this to work. */
11763 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11764 if (STRINGP (default_filename
))
11766 XmString default_xmstring
;
11770 = XmStringCreateLocalized (SDATA (default_filename
));
11772 if (!XmListItemExists (list
, default_xmstring
))
11774 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11775 XmListAddItem (list
, default_xmstring
, 0);
11779 item_pos
= XmListItemPos (list
, default_xmstring
);
11780 XmStringFree (default_xmstring
);
11782 /* Select the item and scroll it into view. */
11783 XmListSelectPos (list
, item_pos
, True
);
11784 XmListSetPos (list
, item_pos
);
11787 /* Process events until the user presses Cancel or OK. */
11789 while (result
== 0)
11792 XtAppNextEvent (Xt_app_con
, &event
);
11793 (void) x_dispatch_event (&event
, FRAME_X_DISPLAY (f
) );
11796 /* Get the result. */
11797 if (result
== XmCR_OK
)
11802 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11803 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11804 XmStringFree (text
);
11805 file
= build_string (data
);
11812 XtUnmanageChild (dialog
);
11813 XtDestroyWidget (dialog
);
11817 /* Make "Cancel" equivalent to C-g. */
11819 Fsignal (Qquit
, Qnil
);
11821 return unbind_to (count
, file
);
11824 #endif /* USE_MOTIF */
11828 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11829 "Read file name, prompting with PROMPT in directory DIR.\n\
11830 Use a file selection dialog.\n\
11831 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
11832 specified. Don't let the user enter a file name in the file\n\
11833 selection dialog's entry field, if MUSTMATCH is non-nil.")
11834 (prompt
, dir
, default_filename
, mustmatch
)
11835 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11837 FRAME_PTR f
= SELECTED_FRAME ();
11839 Lisp_Object file
= Qnil
;
11840 int count
= specpdl_ptr
- specpdl
;
11841 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11845 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11846 CHECK_STRING (prompt
);
11847 CHECK_STRING (dir
);
11849 /* Prevent redisplay. */
11850 specbind (Qinhibit_redisplay
, Qt
);
11854 if (STRINGP (default_filename
))
11855 cdef_file
= SDATA (default_filename
);
11857 cdef_file
= SDATA (dir
);
11859 fn
= xg_get_file_name (f
, SDATA (prompt
), cdef_file
, ! NILP (mustmatch
));
11863 file
= build_string (fn
);
11870 /* Make "Cancel" equivalent to C-g. */
11872 Fsignal (Qquit
, Qnil
);
11874 return unbind_to (count
, file
);
11877 #endif /* USE_GTK */
11880 /***********************************************************************
11882 ***********************************************************************/
11884 #ifdef HAVE_XKBGETKEYBOARD
11885 #include <X11/XKBlib.h>
11886 #include <X11/keysym.h>
11889 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11890 Sx_backspace_delete_keys_p
, 0, 1, 0,
11891 doc
: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
11892 FRAME nil means use the selected frame.
11893 Value is t if we know that both keys are present, and are mapped to the
11894 usual X keysyms. */)
11898 #ifdef HAVE_XKBGETKEYBOARD
11900 struct frame
*f
= check_x_frame (frame
);
11901 Display
*dpy
= FRAME_X_DISPLAY (f
);
11902 Lisp_Object have_keys
;
11903 int major
, minor
, op
, event
, error
;
11907 /* Check library version in case we're dynamically linked. */
11908 major
= XkbMajorVersion
;
11909 minor
= XkbMinorVersion
;
11910 if (!XkbLibraryVersion (&major
, &minor
))
11916 /* Check that the server supports XKB. */
11917 major
= XkbMajorVersion
;
11918 minor
= XkbMinorVersion
;
11919 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11926 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11929 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11931 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11933 for (i
= kb
->min_key_code
;
11934 (i
< kb
->max_key_code
11935 && (delete_keycode
== 0 || backspace_keycode
== 0));
11938 /* The XKB symbolic key names can be seen most easily in
11939 the PS file generated by `xkbprint -label name
11941 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11942 delete_keycode
= i
;
11943 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11944 backspace_keycode
= i
;
11947 XkbFreeNames (kb
, 0, True
);
11950 XkbFreeClientMap (kb
, 0, True
);
11953 && backspace_keycode
11954 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11955 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11960 #else /* not HAVE_XKBGETKEYBOARD */
11962 #endif /* not HAVE_XKBGETKEYBOARD */
11967 /***********************************************************************
11969 ***********************************************************************/
11974 /* This is zero if not using X windows. */
11977 /* The section below is built by the lisp expression at the top of the file,
11978 just above where these variables are declared. */
11979 /*&&& init symbols here &&&*/
11980 Qauto_raise
= intern ("auto-raise");
11981 staticpro (&Qauto_raise
);
11982 Qauto_lower
= intern ("auto-lower");
11983 staticpro (&Qauto_lower
);
11984 Qborder_color
= intern ("border-color");
11985 staticpro (&Qborder_color
);
11986 Qborder_width
= intern ("border-width");
11987 staticpro (&Qborder_width
);
11988 Qcursor_color
= intern ("cursor-color");
11989 staticpro (&Qcursor_color
);
11990 Qcursor_type
= intern ("cursor-type");
11991 staticpro (&Qcursor_type
);
11992 Qgeometry
= intern ("geometry");
11993 staticpro (&Qgeometry
);
11994 Qicon_left
= intern ("icon-left");
11995 staticpro (&Qicon_left
);
11996 Qicon_top
= intern ("icon-top");
11997 staticpro (&Qicon_top
);
11998 Qicon_type
= intern ("icon-type");
11999 staticpro (&Qicon_type
);
12000 Qicon_name
= intern ("icon-name");
12001 staticpro (&Qicon_name
);
12002 Qinternal_border_width
= intern ("internal-border-width");
12003 staticpro (&Qinternal_border_width
);
12004 Qleft
= intern ("left");
12005 staticpro (&Qleft
);
12006 Qright
= intern ("right");
12007 staticpro (&Qright
);
12008 Qmouse_color
= intern ("mouse-color");
12009 staticpro (&Qmouse_color
);
12010 Qnone
= intern ("none");
12011 staticpro (&Qnone
);
12012 Qparent_id
= intern ("parent-id");
12013 staticpro (&Qparent_id
);
12014 Qscroll_bar_width
= intern ("scroll-bar-width");
12015 staticpro (&Qscroll_bar_width
);
12016 Qsuppress_icon
= intern ("suppress-icon");
12017 staticpro (&Qsuppress_icon
);
12018 Qundefined_color
= intern ("undefined-color");
12019 staticpro (&Qundefined_color
);
12020 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
12021 staticpro (&Qvertical_scroll_bars
);
12022 Qvisibility
= intern ("visibility");
12023 staticpro (&Qvisibility
);
12024 Qwindow_id
= intern ("window-id");
12025 staticpro (&Qwindow_id
);
12026 Qouter_window_id
= intern ("outer-window-id");
12027 staticpro (&Qouter_window_id
);
12028 Qx_frame_parameter
= intern ("x-frame-parameter");
12029 staticpro (&Qx_frame_parameter
);
12030 Qx_resource_name
= intern ("x-resource-name");
12031 staticpro (&Qx_resource_name
);
12032 Quser_position
= intern ("user-position");
12033 staticpro (&Quser_position
);
12034 Quser_size
= intern ("user-size");
12035 staticpro (&Quser_size
);
12036 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
12037 staticpro (&Qscroll_bar_foreground
);
12038 Qscroll_bar_background
= intern ("scroll-bar-background");
12039 staticpro (&Qscroll_bar_background
);
12040 Qscreen_gamma
= intern ("screen-gamma");
12041 staticpro (&Qscreen_gamma
);
12042 Qline_spacing
= intern ("line-spacing");
12043 staticpro (&Qline_spacing
);
12044 Qcenter
= intern ("center");
12045 staticpro (&Qcenter
);
12046 Qcompound_text
= intern ("compound-text");
12047 staticpro (&Qcompound_text
);
12048 Qcancel_timer
= intern ("cancel-timer");
12049 staticpro (&Qcancel_timer
);
12050 Qwait_for_wm
= intern ("wait-for-wm");
12051 staticpro (&Qwait_for_wm
);
12052 Qfullscreen
= intern ("fullscreen");
12053 staticpro (&Qfullscreen
);
12054 Qfullwidth
= intern ("fullwidth");
12055 staticpro (&Qfullwidth
);
12056 Qfullheight
= intern ("fullheight");
12057 staticpro (&Qfullheight
);
12058 Qfullboth
= intern ("fullboth");
12059 staticpro (&Qfullboth
);
12060 /* This is the end of symbol initialization. */
12062 /* Text property `display' should be nonsticky by default. */
12063 Vtext_property_default_nonsticky
12064 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
12067 Qlaplace
= intern ("laplace");
12068 staticpro (&Qlaplace
);
12069 Qemboss
= intern ("emboss");
12070 staticpro (&Qemboss
);
12071 Qedge_detection
= intern ("edge-detection");
12072 staticpro (&Qedge_detection
);
12073 Qheuristic
= intern ("heuristic");
12074 staticpro (&Qheuristic
);
12075 QCmatrix
= intern (":matrix");
12076 staticpro (&QCmatrix
);
12077 QCcolor_adjustment
= intern (":color-adjustment");
12078 staticpro (&QCcolor_adjustment
);
12079 QCmask
= intern (":mask");
12080 staticpro (&QCmask
);
12082 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
12083 staticpro (&Qface_set_after_frame_default
);
12085 Fput (Qundefined_color
, Qerror_conditions
,
12086 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
12087 Fput (Qundefined_color
, Qerror_message
,
12088 build_string ("Undefined color"));
12090 init_x_parm_symbols ();
12092 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
12093 doc
: /* Non-nil means always draw a cross over disabled images.
12094 Disabled images are those having an `:conversion disabled' property.
12095 A cross is always drawn on black & white displays. */);
12096 cross_disabled_images
= 0;
12098 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
12099 doc
: /* List of directories to search for window system bitmap files. */);
12100 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
12102 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
12103 doc
: /* The shape of the pointer when over text.
12104 Changing the value does not affect existing frames
12105 unless you set the mouse color. */);
12106 Vx_pointer_shape
= Qnil
;
12108 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
12109 doc
: /* The name Emacs uses to look up X resources.
12110 `x-get-resource' uses this as the first component of the instance name
12111 when requesting resource values.
12112 Emacs initially sets `x-resource-name' to the name under which Emacs
12113 was invoked, or to the value specified with the `-name' or `-rn'
12114 switches, if present.
12116 It may be useful to bind this variable locally around a call
12117 to `x-get-resource'. See also the variable `x-resource-class'. */);
12118 Vx_resource_name
= Qnil
;
12120 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
12121 doc
: /* The class Emacs uses to look up X resources.
12122 `x-get-resource' uses this as the first component of the instance class
12123 when requesting resource values.
12125 Emacs initially sets `x-resource-class' to "Emacs".
12127 Setting this variable permanently is not a reasonable thing to do,
12128 but binding this variable locally around a call to `x-get-resource'
12129 is a reasonable practice. See also the variable `x-resource-name'. */);
12130 Vx_resource_class
= build_string (EMACS_CLASS
);
12132 #if 0 /* This doesn't really do anything. */
12133 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
12134 doc
: /* The shape of the pointer when not over text.
12135 This variable takes effect when you create a new frame
12136 or when you set the mouse color. */);
12138 Vx_nontext_pointer_shape
= Qnil
;
12140 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
12141 doc
: /* The shape of the pointer when Emacs is busy.
12142 This variable takes effect when you create a new frame
12143 or when you set the mouse color. */);
12144 Vx_hourglass_pointer_shape
= Qnil
;
12146 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
12147 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
12148 display_hourglass_p
= 1;
12150 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
12151 doc
: /* *Seconds to wait before displaying an hourglass pointer.
12152 Value must be an integer or float. */);
12153 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
12155 #if 0 /* This doesn't really do anything. */
12156 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
12157 doc
: /* The shape of the pointer when over the mode line.
12158 This variable takes effect when you create a new frame
12159 or when you set the mouse color. */);
12161 Vx_mode_pointer_shape
= Qnil
;
12163 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
12164 &Vx_sensitive_text_pointer_shape
,
12165 doc
: /* The shape of the pointer when over mouse-sensitive text.
12166 This variable takes effect when you create a new frame
12167 or when you set the mouse color. */);
12168 Vx_sensitive_text_pointer_shape
= Qnil
;
12170 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
12171 &Vx_window_horizontal_drag_shape
,
12172 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
12173 This variable takes effect when you create a new frame
12174 or when you set the mouse color. */);
12175 Vx_window_horizontal_drag_shape
= Qnil
;
12177 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
12178 doc
: /* A string indicating the foreground color of the cursor box. */);
12179 Vx_cursor_fore_pixel
= Qnil
;
12181 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
12182 doc
: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
12183 Text larger than this is clipped. */);
12184 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
12186 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
12187 doc
: /* Non-nil if no X window manager is in use.
12188 Emacs doesn't try to figure this out; this is always nil
12189 unless you set it to something else. */);
12190 /* We don't have any way to find this out, so set it to nil
12191 and maybe the user would like to set it to t. */
12192 Vx_no_window_manager
= Qnil
;
12194 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
12195 &Vx_pixel_size_width_font_regexp
,
12196 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
12198 Since Emacs gets width of a font matching with this regexp from
12199 PIXEL_SIZE field of the name, font finding mechanism gets faster for
12200 such a font. This is especially effective for such large fonts as
12201 Chinese, Japanese, and Korean. */);
12202 Vx_pixel_size_width_font_regexp
= Qnil
;
12204 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
12205 doc
: /* Time after which cached images are removed from the cache.
12206 When an image has not been displayed this many seconds, remove it
12207 from the image cache. Value must be an integer or nil with nil
12208 meaning don't clear the cache. */);
12209 Vimage_cache_eviction_delay
= make_number (30 * 60);
12211 #ifdef USE_X_TOOLKIT
12212 Fprovide (intern ("x-toolkit"), Qnil
);
12214 Fprovide (intern ("motif"), Qnil
);
12216 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string
,
12217 doc
: /* Version info for LessTif/Motif. */);
12218 Vmotif_version_string
= build_string (XmVERSION_STRING
);
12219 #endif /* USE_MOTIF */
12220 #endif /* USE_X_TOOLKIT */
12222 defsubr (&Sx_get_resource
);
12224 /* X window properties. */
12225 defsubr (&Sx_change_window_property
);
12226 defsubr (&Sx_delete_window_property
);
12227 defsubr (&Sx_window_property
);
12229 defsubr (&Sxw_display_color_p
);
12230 defsubr (&Sx_display_grayscale_p
);
12231 defsubr (&Sxw_color_defined_p
);
12232 defsubr (&Sxw_color_values
);
12233 defsubr (&Sx_server_max_request_size
);
12234 defsubr (&Sx_server_vendor
);
12235 defsubr (&Sx_server_version
);
12236 defsubr (&Sx_display_pixel_width
);
12237 defsubr (&Sx_display_pixel_height
);
12238 defsubr (&Sx_display_mm_width
);
12239 defsubr (&Sx_display_mm_height
);
12240 defsubr (&Sx_display_screens
);
12241 defsubr (&Sx_display_planes
);
12242 defsubr (&Sx_display_color_cells
);
12243 defsubr (&Sx_display_visual_class
);
12244 defsubr (&Sx_display_backing_store
);
12245 defsubr (&Sx_display_save_under
);
12246 defsubr (&Sx_parse_geometry
);
12247 defsubr (&Sx_create_frame
);
12248 defsubr (&Sx_open_connection
);
12249 defsubr (&Sx_close_connection
);
12250 defsubr (&Sx_display_list
);
12251 defsubr (&Sx_synchronize
);
12252 defsubr (&Sx_focus_frame
);
12253 defsubr (&Sx_backspace_delete_keys_p
);
12255 /* Setting callback functions for fontset handler. */
12256 get_font_info_func
= x_get_font_info
;
12258 #if 0 /* This function pointer doesn't seem to be used anywhere.
12259 And the pointer assigned has the wrong type, anyway. */
12260 list_fonts_func
= x_list_fonts
;
12263 load_font_func
= x_load_font
;
12264 find_ccl_program_func
= x_find_ccl_program
;
12265 query_font_func
= x_query_font
;
12266 set_frame_fontset_func
= x_set_font
;
12267 check_window_system_func
= check_x
;
12270 Qxbm
= intern ("xbm");
12272 QCconversion
= intern (":conversion");
12273 staticpro (&QCconversion
);
12274 QCheuristic_mask
= intern (":heuristic-mask");
12275 staticpro (&QCheuristic_mask
);
12276 QCcolor_symbols
= intern (":color-symbols");
12277 staticpro (&QCcolor_symbols
);
12278 QCascent
= intern (":ascent");
12279 staticpro (&QCascent
);
12280 QCmargin
= intern (":margin");
12281 staticpro (&QCmargin
);
12282 QCrelief
= intern (":relief");
12283 staticpro (&QCrelief
);
12284 Qpostscript
= intern ("postscript");
12285 staticpro (&Qpostscript
);
12286 QCloader
= intern (":loader");
12287 staticpro (&QCloader
);
12288 QCbounding_box
= intern (":bounding-box");
12289 staticpro (&QCbounding_box
);
12290 QCpt_width
= intern (":pt-width");
12291 staticpro (&QCpt_width
);
12292 QCpt_height
= intern (":pt-height");
12293 staticpro (&QCpt_height
);
12294 QCindex
= intern (":index");
12295 staticpro (&QCindex
);
12296 Qpbm
= intern ("pbm");
12300 Qxpm
= intern ("xpm");
12305 Qjpeg
= intern ("jpeg");
12306 staticpro (&Qjpeg
);
12310 Qtiff
= intern ("tiff");
12311 staticpro (&Qtiff
);
12315 Qgif
= intern ("gif");
12320 Qpng
= intern ("png");
12324 defsubr (&Sclear_image_cache
);
12325 defsubr (&Simage_size
);
12326 defsubr (&Simage_mask_p
);
12328 hourglass_atimer
= NULL
;
12329 hourglass_shown_p
= 0;
12331 defsubr (&Sx_show_tip
);
12332 defsubr (&Sx_hide_tip
);
12334 staticpro (&tip_timer
);
12336 staticpro (&tip_frame
);
12338 last_show_tip_args
= Qnil
;
12339 staticpro (&last_show_tip_args
);
12342 defsubr (&Sx_file_dialog
);
12350 image_types
= NULL
;
12351 Vimage_types
= Qnil
;
12353 define_image_type (&xbm_type
);
12354 define_image_type (&gs_type
);
12355 define_image_type (&pbm_type
);
12358 define_image_type (&xpm_type
);
12362 define_image_type (&jpeg_type
);
12366 define_image_type (&tiff_type
);
12370 define_image_type (&gif_type
);
12374 define_image_type (&png_type
);
12378 #endif /* HAVE_X_WINDOWS */