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 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 /* Note: Encoding strategy
2522 We encode NAME by compound-text and use "COMPOUND-TEXT" in
2523 text.encoding. But, there are non-internationalized window
2524 managers which don't support that encoding. So, if NAME
2525 contains only ASCII and 8859-1 characters, encode it by
2526 iso-latin-1, and use "STRING" in text.encoding hoping that
2527 such window manager at least analize this format correctly,
2528 i.e. treat 8-bit bytes as 8859-1 characters.
2530 We may also be able to use "UTF8_STRING" in text.encoding
2531 in the feature which can encode all Unicode characters.
2532 But, for the moment, there's no way to know that the
2533 current window manager supports it or not. */
2534 coding_system
= Qcompound_text
;
2535 text
.value
= x_encode_text (name
, coding_system
, 0, &bytes
, &stringp
);
2536 text
.encoding
= (stringp
? XA_STRING
2537 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2539 text
.nitems
= bytes
;
2541 if (NILP (f
->icon_name
))
2547 /* See the above comment "Note: Encoding strategy". */
2548 icon
.value
= x_encode_text (f
->icon_name
, coding_system
, 0,
2550 icon
.encoding
= (stringp
? XA_STRING
2551 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2553 icon
.nitems
= bytes
;
2556 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f
)),
2558 #else /* not USE_GTK */
2559 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_OUTER_WINDOW (f
), &text
);
2560 #endif /* not USE_GTK */
2562 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_OUTER_WINDOW (f
), &icon
);
2564 if (!NILP (f
->icon_name
)
2565 && icon
.value
!= (unsigned char *) SDATA (f
->icon_name
))
2567 if (text
.value
!= (unsigned char *) SDATA (name
))
2570 #else /* not HAVE_X11R4 */
2571 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2573 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2575 #endif /* not HAVE_X11R4 */
2580 /* This function should be called when the user's lisp code has
2581 specified a name for the frame; the name will override any set by the
2584 x_explicitly_set_name (f
, arg
, oldval
)
2586 Lisp_Object arg
, oldval
;
2588 x_set_name (f
, arg
, 1);
2591 /* This function should be called by Emacs redisplay code to set the
2592 name; names set this way will never override names set by the user's
2595 x_implicitly_set_name (f
, arg
, oldval
)
2597 Lisp_Object arg
, oldval
;
2599 x_set_name (f
, arg
, 0);
2602 /* Change the title of frame F to NAME.
2603 If NAME is nil, use the frame name as the title.
2605 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2606 name; if NAME is a string, set F's name to NAME and set
2607 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2609 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2610 suggesting a new name, which lisp code should override; if
2611 F->explicit_name is set, ignore the new name; otherwise, set it. */
2614 x_set_title (f
, name
, old_name
)
2616 Lisp_Object name
, old_name
;
2618 /* Don't change the title if it's already NAME. */
2619 if (EQ (name
, f
->title
))
2622 update_mode_lines
= 1;
2629 CHECK_STRING (name
);
2631 if (FRAME_X_WINDOW (f
))
2636 XTextProperty text
, icon
;
2638 Lisp_Object coding_system
;
2640 coding_system
= Qcompound_text
;
2641 /* See the comment "Note: Encoding strategy" in x_set_name. */
2642 text
.value
= x_encode_text (name
, coding_system
, 0, &bytes
, &stringp
);
2643 text
.encoding
= (stringp
? XA_STRING
2644 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2646 text
.nitems
= bytes
;
2648 if (NILP (f
->icon_name
))
2654 /* See the comment "Note: Encoding strategy" in x_set_name. */
2655 icon
.value
= x_encode_text (f
->icon_name
, coding_system
, 0,
2657 icon
.encoding
= (stringp
? XA_STRING
2658 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2660 icon
.nitems
= bytes
;
2664 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f
)),
2666 #else /* not USE_GTK */
2667 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_OUTER_WINDOW (f
), &text
);
2668 #endif /* not USE_GTK */
2670 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_OUTER_WINDOW (f
),
2673 if (!NILP (f
->icon_name
)
2674 && icon
.value
!= (unsigned char *) SDATA (f
->icon_name
))
2676 if (text
.value
!= (unsigned char *) SDATA (name
))
2679 #else /* not HAVE_X11R4 */
2680 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2682 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2684 #endif /* not HAVE_X11R4 */
2690 x_set_autoraise (f
, arg
, oldval
)
2692 Lisp_Object arg
, oldval
;
2694 f
->auto_raise
= !EQ (Qnil
, arg
);
2698 x_set_autolower (f
, arg
, oldval
)
2700 Lisp_Object arg
, oldval
;
2702 f
->auto_lower
= !EQ (Qnil
, arg
);
2706 x_set_unsplittable (f
, arg
, oldval
)
2708 Lisp_Object arg
, oldval
;
2710 f
->no_split
= !NILP (arg
);
2714 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2716 Lisp_Object arg
, oldval
;
2718 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2719 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2720 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2721 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2723 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2725 ? vertical_scroll_bar_none
2727 ? vertical_scroll_bar_right
2728 : vertical_scroll_bar_left
);
2730 /* We set this parameter before creating the X window for the
2731 frame, so we can get the geometry right from the start.
2732 However, if the window hasn't been created yet, we shouldn't
2733 call x_set_window_size. */
2734 if (FRAME_X_WINDOW (f
))
2735 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2736 do_pending_window_change (0);
2741 x_set_scroll_bar_width (f
, arg
, oldval
)
2743 Lisp_Object arg
, oldval
;
2745 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2749 #ifdef USE_TOOLKIT_SCROLL_BARS
2750 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2751 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2752 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2753 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2755 /* Make the actual width at least 14 pixels and a multiple of a
2757 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2759 /* Use all of that space (aside from required margins) for the
2761 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2764 if (FRAME_X_WINDOW (f
))
2765 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2766 do_pending_window_change (0);
2768 else if (INTEGERP (arg
) && XINT (arg
) > 0
2769 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2771 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2772 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2774 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2775 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2776 if (FRAME_X_WINDOW (f
))
2777 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2780 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2781 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2782 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2787 /* Subroutines of creating an X frame. */
2789 /* Make sure that Vx_resource_name is set to a reasonable value.
2790 Fix it up, or set it to `emacs' if it is too hopeless. */
2793 validate_x_resource_name ()
2796 /* Number of valid characters in the resource name. */
2798 /* Number of invalid characters in the resource name. */
2803 if (!STRINGP (Vx_resource_class
))
2804 Vx_resource_class
= build_string (EMACS_CLASS
);
2806 if (STRINGP (Vx_resource_name
))
2808 unsigned char *p
= SDATA (Vx_resource_name
);
2811 len
= SBYTES (Vx_resource_name
);
2813 /* Only letters, digits, - and _ are valid in resource names.
2814 Count the valid characters and count the invalid ones. */
2815 for (i
= 0; i
< len
; i
++)
2818 if (! ((c
>= 'a' && c
<= 'z')
2819 || (c
>= 'A' && c
<= 'Z')
2820 || (c
>= '0' && c
<= '9')
2821 || c
== '-' || c
== '_'))
2828 /* Not a string => completely invalid. */
2829 bad_count
= 5, good_count
= 0;
2831 /* If name is valid already, return. */
2835 /* If name is entirely invalid, or nearly so, use `emacs'. */
2837 || (good_count
== 1 && bad_count
> 0))
2839 Vx_resource_name
= build_string ("emacs");
2843 /* Name is partly valid. Copy it and replace the invalid characters
2844 with underscores. */
2846 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2848 for (i
= 0; i
< len
; i
++)
2850 int c
= SREF (new, i
);
2851 if (! ((c
>= 'a' && c
<= 'z')
2852 || (c
>= 'A' && c
<= 'Z')
2853 || (c
>= '0' && c
<= '9')
2854 || c
== '-' || c
== '_'))
2860 extern char *x_get_string_resource ();
2862 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2863 doc
: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
2864 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
2865 class, where INSTANCE is the name under which Emacs was invoked, or
2866 the name specified by the `-name' or `-rn' command-line arguments.
2868 The optional arguments COMPONENT and SUBCLASS add to the key and the
2869 class, respectively. You must specify both of them or neither.
2870 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
2871 and the class is `Emacs.CLASS.SUBCLASS'. */)
2872 (attribute
, class, component
, subclass
)
2873 Lisp_Object attribute
, class, component
, subclass
;
2875 register char *value
;
2881 CHECK_STRING (attribute
);
2882 CHECK_STRING (class);
2884 if (!NILP (component
))
2885 CHECK_STRING (component
);
2886 if (!NILP (subclass
))
2887 CHECK_STRING (subclass
);
2888 if (NILP (component
) != NILP (subclass
))
2889 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2891 validate_x_resource_name ();
2893 /* Allocate space for the components, the dots which separate them,
2894 and the final '\0'. Make them big enough for the worst case. */
2895 name_key
= (char *) alloca (SBYTES (Vx_resource_name
)
2896 + (STRINGP (component
)
2897 ? SBYTES (component
) : 0)
2898 + SBYTES (attribute
)
2901 class_key
= (char *) alloca (SBYTES (Vx_resource_class
)
2903 + (STRINGP (subclass
)
2904 ? SBYTES (subclass
) : 0)
2907 /* Start with emacs.FRAMENAME for the name (the specific one)
2908 and with `Emacs' for the class key (the general one). */
2909 strcpy (name_key
, SDATA (Vx_resource_name
));
2910 strcpy (class_key
, SDATA (Vx_resource_class
));
2912 strcat (class_key
, ".");
2913 strcat (class_key
, SDATA (class));
2915 if (!NILP (component
))
2917 strcat (class_key
, ".");
2918 strcat (class_key
, SDATA (subclass
));
2920 strcat (name_key
, ".");
2921 strcat (name_key
, SDATA (component
));
2924 strcat (name_key
, ".");
2925 strcat (name_key
, SDATA (attribute
));
2927 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2928 name_key
, class_key
);
2930 if (value
!= (char *) 0)
2931 return build_string (value
);
2936 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2939 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2940 struct x_display_info
*dpyinfo
;
2941 Lisp_Object attribute
, class, component
, subclass
;
2943 register char *value
;
2947 CHECK_STRING (attribute
);
2948 CHECK_STRING (class);
2950 if (!NILP (component
))
2951 CHECK_STRING (component
);
2952 if (!NILP (subclass
))
2953 CHECK_STRING (subclass
);
2954 if (NILP (component
) != NILP (subclass
))
2955 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2957 validate_x_resource_name ();
2959 /* Allocate space for the components, the dots which separate them,
2960 and the final '\0'. Make them big enough for the worst case. */
2961 name_key
= (char *) alloca (SBYTES (Vx_resource_name
)
2962 + (STRINGP (component
)
2963 ? SBYTES (component
) : 0)
2964 + SBYTES (attribute
)
2967 class_key
= (char *) alloca (SBYTES (Vx_resource_class
)
2969 + (STRINGP (subclass
)
2970 ? SBYTES (subclass
) : 0)
2973 /* Start with emacs.FRAMENAME for the name (the specific one)
2974 and with `Emacs' for the class key (the general one). */
2975 strcpy (name_key
, SDATA (Vx_resource_name
));
2976 strcpy (class_key
, SDATA (Vx_resource_class
));
2978 strcat (class_key
, ".");
2979 strcat (class_key
, SDATA (class));
2981 if (!NILP (component
))
2983 strcat (class_key
, ".");
2984 strcat (class_key
, SDATA (subclass
));
2986 strcat (name_key
, ".");
2987 strcat (name_key
, SDATA (component
));
2990 strcat (name_key
, ".");
2991 strcat (name_key
, SDATA (attribute
));
2993 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2995 if (value
!= (char *) 0)
2996 return build_string (value
);
3001 /* Used when C code wants a resource value. */
3004 x_get_resource_string (attribute
, class)
3005 char *attribute
, *class;
3009 struct frame
*sf
= SELECTED_FRAME ();
3011 /* Allocate space for the components, the dots which separate them,
3012 and the final '\0'. */
3013 name_key
= (char *) alloca (SBYTES (Vinvocation_name
)
3014 + strlen (attribute
) + 2);
3015 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
3016 + strlen (class) + 2);
3018 sprintf (name_key
, "%s.%s",
3019 SDATA (Vinvocation_name
),
3021 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
3023 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
3024 name_key
, class_key
);
3027 /* Types we might convert a resource string into. */
3037 /* Return the value of parameter PARAM.
3039 First search ALIST, then Vdefault_frame_alist, then the X defaults
3040 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3042 Convert the resource to the type specified by desired_type.
3044 If no default is specified, return Qunbound. If you call
3045 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3046 and don't let it get stored in any Lisp-visible variables! */
3049 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
3050 struct x_display_info
*dpyinfo
;
3051 Lisp_Object alist
, param
;
3054 enum resource_types type
;
3056 register Lisp_Object tem
;
3058 tem
= Fassq (param
, alist
);
3060 tem
= Fassq (param
, Vdefault_frame_alist
);
3066 tem
= display_x_get_resource (dpyinfo
,
3067 build_string (attribute
),
3068 build_string (class),
3076 case RES_TYPE_NUMBER
:
3077 return make_number (atoi (SDATA (tem
)));
3079 case RES_TYPE_FLOAT
:
3080 return make_float (atof (SDATA (tem
)));
3082 case RES_TYPE_BOOLEAN
:
3083 tem
= Fdowncase (tem
);
3084 if (!strcmp (SDATA (tem
), "on")
3085 || !strcmp (SDATA (tem
), "true"))
3090 case RES_TYPE_STRING
:
3093 case RES_TYPE_SYMBOL
:
3094 /* As a special case, we map the values `true' and `on'
3095 to Qt, and `false' and `off' to Qnil. */
3098 lower
= Fdowncase (tem
);
3099 if (!strcmp (SDATA (lower
), "on")
3100 || !strcmp (SDATA (lower
), "true"))
3102 else if (!strcmp (SDATA (lower
), "off")
3103 || !strcmp (SDATA (lower
), "false"))
3106 return Fintern (tem
, Qnil
);
3119 /* Like x_get_arg, but also record the value in f->param_alist. */
3122 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
3124 Lisp_Object alist
, param
;
3127 enum resource_types type
;
3131 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
3132 attribute
, class, type
);
3134 store_frame_param (f
, param
, value
);
3139 /* Record in frame F the specified or default value according to ALIST
3140 of the parameter named PROP (a Lisp symbol).
3141 If no value is specified for PROP, look for an X default for XPROP
3142 on the frame named NAME.
3143 If that is not found either, use the value DEFLT. */
3146 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
3153 enum resource_types type
;
3157 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
3158 if (EQ (tem
, Qunbound
))
3160 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3165 /* Record in frame F the specified or default value according to ALIST
3166 of the parameter named PROP (a Lisp symbol). If no value is
3167 specified for PROP, look for an X default for XPROP on the frame
3168 named NAME. If that is not found either, use the value DEFLT. */
3171 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
3180 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3183 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
3184 if (EQ (tem
, Qunbound
))
3186 #ifdef USE_TOOLKIT_SCROLL_BARS
3188 /* See if an X resource for the scroll bar color has been
3190 tem
= display_x_get_resource (dpyinfo
,
3191 build_string (foreground_p
3195 build_string ("verticalScrollBar"),
3199 /* If nothing has been specified, scroll bars will use a
3200 toolkit-dependent default. Because these defaults are
3201 difficult to get at without actually creating a scroll
3202 bar, use nil to indicate that no color has been
3207 #else /* not USE_TOOLKIT_SCROLL_BARS */
3211 #endif /* not USE_TOOLKIT_SCROLL_BARS */
3214 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3220 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3221 doc
: /* Parse an X-style geometry string STRING.
3222 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3223 The properties returned may include `top', `left', `height', and `width'.
3224 The value of `left' or `top' may be an integer,
3225 or a list (+ N) meaning N pixels relative to top/left corner,
3226 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3231 unsigned int width
, height
;
3234 CHECK_STRING (string
);
3236 geometry
= XParseGeometry ((char *) SDATA (string
),
3237 &x
, &y
, &width
, &height
);
3240 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
3241 error ("Must specify both x and y position, or neither");
3245 if (geometry
& XValue
)
3247 Lisp_Object element
;
3249 if (x
>= 0 && (geometry
& XNegative
))
3250 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3251 else if (x
< 0 && ! (geometry
& XNegative
))
3252 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3254 element
= Fcons (Qleft
, make_number (x
));
3255 result
= Fcons (element
, result
);
3258 if (geometry
& YValue
)
3260 Lisp_Object element
;
3262 if (y
>= 0 && (geometry
& YNegative
))
3263 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3264 else if (y
< 0 && ! (geometry
& YNegative
))
3265 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3267 element
= Fcons (Qtop
, make_number (y
));
3268 result
= Fcons (element
, result
);
3271 if (geometry
& WidthValue
)
3272 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3273 if (geometry
& HeightValue
)
3274 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3279 /* Calculate the desired size and position of this window,
3280 and return the flags saying which aspects were specified.
3282 This function does not make the coordinates positive. */
3284 #define DEFAULT_ROWS 40
3285 #define DEFAULT_COLS 80
3288 x_figure_window_size (f
, parms
)
3292 register Lisp_Object tem0
, tem1
, tem2
;
3293 long window_prompting
= 0;
3294 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3296 /* Default values if we fall through.
3297 Actually, if that happens we should get
3298 window manager prompting. */
3299 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3300 f
->height
= DEFAULT_ROWS
;
3301 /* Window managers expect that if program-specified
3302 positions are not (0,0), they're intentional, not defaults. */
3303 f
->output_data
.x
->top_pos
= 0;
3304 f
->output_data
.x
->left_pos
= 0;
3306 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3307 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3308 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3309 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3311 if (!EQ (tem0
, Qunbound
))
3313 CHECK_NUMBER (tem0
);
3314 f
->height
= XINT (tem0
);
3316 if (!EQ (tem1
, Qunbound
))
3318 CHECK_NUMBER (tem1
);
3319 SET_FRAME_WIDTH (f
, XINT (tem1
));
3321 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3322 window_prompting
|= USSize
;
3324 window_prompting
|= PSize
;
3327 f
->output_data
.x
->vertical_scroll_bar_extra
3328 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3330 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3332 compute_fringe_widths (f
, 0);
3334 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3335 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3337 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3338 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3339 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3340 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3342 if (EQ (tem0
, Qminus
))
3344 f
->output_data
.x
->top_pos
= 0;
3345 window_prompting
|= YNegative
;
3347 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3348 && CONSP (XCDR (tem0
))
3349 && INTEGERP (XCAR (XCDR (tem0
))))
3351 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3352 window_prompting
|= YNegative
;
3354 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3355 && CONSP (XCDR (tem0
))
3356 && INTEGERP (XCAR (XCDR (tem0
))))
3358 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3360 else if (EQ (tem0
, Qunbound
))
3361 f
->output_data
.x
->top_pos
= 0;
3364 CHECK_NUMBER (tem0
);
3365 f
->output_data
.x
->top_pos
= XINT (tem0
);
3366 if (f
->output_data
.x
->top_pos
< 0)
3367 window_prompting
|= YNegative
;
3370 if (EQ (tem1
, Qminus
))
3372 f
->output_data
.x
->left_pos
= 0;
3373 window_prompting
|= XNegative
;
3375 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3376 && CONSP (XCDR (tem1
))
3377 && INTEGERP (XCAR (XCDR (tem1
))))
3379 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3380 window_prompting
|= XNegative
;
3382 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3383 && CONSP (XCDR (tem1
))
3384 && INTEGERP (XCAR (XCDR (tem1
))))
3386 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3388 else if (EQ (tem1
, Qunbound
))
3389 f
->output_data
.x
->left_pos
= 0;
3392 CHECK_NUMBER (tem1
);
3393 f
->output_data
.x
->left_pos
= XINT (tem1
);
3394 if (f
->output_data
.x
->left_pos
< 0)
3395 window_prompting
|= XNegative
;
3398 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3399 window_prompting
|= USPosition
;
3401 window_prompting
|= PPosition
;
3404 if (f
->output_data
.x
->want_fullscreen
!= FULLSCREEN_NONE
)
3409 /* It takes both for some WM:s to place it where we want */
3410 window_prompting
= USPosition
| PPosition
;
3411 x_fullscreen_adjust (f
, &width
, &height
, &top
, &left
);
3414 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3415 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3416 f
->output_data
.x
->left_pos
= left
;
3417 f
->output_data
.x
->top_pos
= top
;
3420 return window_prompting
;
3423 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3426 XSetWMProtocols (dpy
, w
, protocols
, count
)
3433 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3434 if (prop
== None
) return False
;
3435 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3436 (unsigned char *) protocols
, count
);
3439 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3441 #ifdef USE_X_TOOLKIT
3443 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3444 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3445 already be present because of the toolkit (Motif adds some of them,
3446 for example, but Xt doesn't). */
3449 hack_wm_protocols (f
, widget
)
3453 Display
*dpy
= XtDisplay (widget
);
3454 Window w
= XtWindow (widget
);
3455 int need_delete
= 1;
3461 Atom type
, *atoms
= 0;
3463 unsigned long nitems
= 0;
3464 unsigned long bytes_after
;
3466 if ((XGetWindowProperty (dpy
, w
,
3467 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3468 (long)0, (long)100, False
, XA_ATOM
,
3469 &type
, &format
, &nitems
, &bytes_after
,
3470 (unsigned char **) &atoms
)
3472 && format
== 32 && type
== XA_ATOM
)
3476 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3478 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3480 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3483 if (atoms
) XFree ((char *) atoms
);
3489 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3491 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3493 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3495 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3496 XA_ATOM
, 32, PropModeAppend
,
3497 (unsigned char *) props
, count
);
3505 /* Support routines for XIC (X Input Context). */
3509 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3510 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3513 /* Supported XIM styles, ordered by preferenc. */
3515 static XIMStyle supported_xim_styles
[] =
3517 XIMPreeditPosition
| XIMStatusArea
,
3518 XIMPreeditPosition
| XIMStatusNothing
,
3519 XIMPreeditPosition
| XIMStatusNone
,
3520 XIMPreeditNothing
| XIMStatusArea
,
3521 XIMPreeditNothing
| XIMStatusNothing
,
3522 XIMPreeditNothing
| XIMStatusNone
,
3523 XIMPreeditNone
| XIMStatusArea
,
3524 XIMPreeditNone
| XIMStatusNothing
,
3525 XIMPreeditNone
| XIMStatusNone
,
3530 /* Create an X fontset on frame F with base font name
3534 xic_create_xfontset (f
, base_fontname
)
3536 char *base_fontname
;
3539 char **missing_list
;
3543 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3544 base_fontname
, &missing_list
,
3545 &missing_count
, &def_string
);
3547 XFreeStringList (missing_list
);
3549 /* No need to free def_string. */
3554 /* Value is the best input style, given user preferences USER (already
3555 checked to be supported by Emacs), and styles supported by the
3556 input method XIM. */
3559 best_xim_style (user
, xim
)
3565 for (i
= 0; i
< user
->count_styles
; ++i
)
3566 for (j
= 0; j
< xim
->count_styles
; ++j
)
3567 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3568 return user
->supported_styles
[i
];
3570 /* Return the default style. */
3571 return XIMPreeditNothing
| XIMStatusNothing
;
3574 /* Create XIC for frame F. */
3576 static XIMStyle xic_style
;
3579 create_frame_xic (f
)
3584 XFontSet xfs
= NULL
;
3589 xim
= FRAME_X_XIM (f
);
3594 XVaNestedList preedit_attr
;
3595 XVaNestedList status_attr
;
3596 char *base_fontname
;
3599 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3600 spot
.x
= 0; spot
.y
= 1;
3601 /* Create X fontset. */
3602 fontset
= FRAME_FONTSET (f
);
3604 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3607 /* Determine the base fontname from the ASCII font name of
3609 char *ascii_font
= (char *) SDATA (fontset_ascii (fontset
));
3610 char *p
= ascii_font
;
3613 for (i
= 0; *p
; p
++)
3616 /* As the font name doesn't conform to XLFD, we can't
3617 modify it to get a suitable base fontname for the
3619 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3622 int len
= strlen (ascii_font
) + 1;
3625 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3634 base_fontname
= (char *) alloca (len
);
3635 bzero (base_fontname
, len
);
3636 strcpy (base_fontname
, "-*-*-");
3637 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3638 strcat (base_fontname
, "*-*-*-*-*-*-*");
3641 xfs
= xic_create_xfontset (f
, base_fontname
);
3643 /* Determine XIC style. */
3646 XIMStyles supported_list
;
3647 supported_list
.count_styles
= (sizeof supported_xim_styles
3648 / sizeof supported_xim_styles
[0]);
3649 supported_list
.supported_styles
= supported_xim_styles
;
3650 xic_style
= best_xim_style (&supported_list
,
3651 FRAME_X_XIM_STYLES (f
));
3654 preedit_attr
= XVaCreateNestedList (0,
3657 FRAME_FOREGROUND_PIXEL (f
),
3659 FRAME_BACKGROUND_PIXEL (f
),
3660 (xic_style
& XIMPreeditPosition
3665 status_attr
= XVaCreateNestedList (0,
3671 FRAME_FOREGROUND_PIXEL (f
),
3673 FRAME_BACKGROUND_PIXEL (f
),
3676 xic
= XCreateIC (xim
,
3677 XNInputStyle
, xic_style
,
3678 XNClientWindow
, FRAME_X_WINDOW(f
),
3679 XNFocusWindow
, FRAME_X_WINDOW(f
),
3680 XNStatusAttributes
, status_attr
,
3681 XNPreeditAttributes
, preedit_attr
,
3683 XFree (preedit_attr
);
3684 XFree (status_attr
);
3687 FRAME_XIC (f
) = xic
;
3688 FRAME_XIC_STYLE (f
) = xic_style
;
3689 FRAME_XIC_FONTSET (f
) = xfs
;
3693 /* Destroy XIC and free XIC fontset of frame F, if any. */
3699 if (FRAME_XIC (f
) == NULL
)
3702 XDestroyIC (FRAME_XIC (f
));
3703 if (FRAME_XIC_FONTSET (f
))
3704 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3706 FRAME_XIC (f
) = NULL
;
3707 FRAME_XIC_FONTSET (f
) = NULL
;
3711 /* Place preedit area for XIC of window W's frame to specified
3712 pixel position X/Y. X and Y are relative to window W. */
3715 xic_set_preeditarea (w
, x
, y
)
3719 struct frame
*f
= XFRAME (w
->frame
);
3723 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3724 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3725 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3726 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3731 /* Place status area for XIC in bottom right corner of frame F.. */
3734 xic_set_statusarea (f
)
3737 XIC xic
= FRAME_XIC (f
);
3742 /* Negotiate geometry of status area. If input method has existing
3743 status area, use its current size. */
3744 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3745 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3746 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3749 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3750 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3753 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3755 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3756 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3760 area
.width
= needed
->width
;
3761 area
.height
= needed
->height
;
3762 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3763 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3764 - FRAME_MENUBAR_HEIGHT (f
)
3765 - FRAME_TOOLBAR_HEIGHT (f
)
3766 - FRAME_INTERNAL_BORDER_WIDTH (f
));
3769 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3770 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3775 /* Set X fontset for XIC of frame F, using base font name
3776 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3779 xic_set_xfontset (f
, base_fontname
)
3781 char *base_fontname
;
3786 xfs
= xic_create_xfontset (f
, base_fontname
);
3788 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3789 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3790 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3791 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3792 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3795 if (FRAME_XIC_FONTSET (f
))
3796 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3797 FRAME_XIC_FONTSET (f
) = xfs
;
3800 #endif /* HAVE_X_I18N */
3804 #ifdef USE_X_TOOLKIT
3806 /* Create and set up the X widget for frame F. */
3809 x_window (f
, window_prompting
, minibuffer_only
)
3811 long window_prompting
;
3812 int minibuffer_only
;
3814 XClassHint class_hints
;
3815 XSetWindowAttributes attributes
;
3816 unsigned long attribute_mask
;
3817 Widget shell_widget
;
3819 Widget frame_widget
;
3825 /* Use the resource name as the top-level widget name
3826 for looking up resources. Make a non-Lisp copy
3827 for the window manager, so GC relocation won't bother it.
3829 Elsewhere we specify the window name for the window manager. */
3832 char *str
= (char *) SDATA (Vx_resource_name
);
3833 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3834 strcpy (f
->namebuf
, str
);
3838 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3839 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3840 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3841 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3842 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3843 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3844 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3845 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3846 applicationShellWidgetClass
,
3847 FRAME_X_DISPLAY (f
), al
, ac
);
3849 f
->output_data
.x
->widget
= shell_widget
;
3850 /* maybe_set_screen_title_format (shell_widget); */
3852 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3853 (widget_value
*) NULL
,
3854 shell_widget
, False
,
3858 (lw_callback
) NULL
);
3861 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3862 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3863 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3864 XtSetValues (pane_widget
, al
, ac
);
3865 f
->output_data
.x
->column_widget
= pane_widget
;
3867 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3868 the emacs screen when changing menubar. This reduces flickering. */
3871 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3872 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3873 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3874 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3875 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3876 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3877 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3878 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3879 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3882 f
->output_data
.x
->edit_widget
= frame_widget
;
3884 XtManageChild (frame_widget
);
3886 /* Do some needed geometry management. */
3889 char *tem
, shell_position
[32];
3892 int extra_borders
= 0;
3894 = (f
->output_data
.x
->menubar_widget
3895 ? (f
->output_data
.x
->menubar_widget
->core
.height
3896 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3899 #if 0 /* Experimentally, we now get the right results
3900 for -geometry -0-0 without this. 24 Aug 96, rms. */
3901 if (FRAME_EXTERNAL_MENU_BAR (f
))
3904 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3905 menubar_size
+= ibw
;
3909 f
->output_data
.x
->menubar_height
= menubar_size
;
3912 /* Motif seems to need this amount added to the sizes
3913 specified for the shell widget. The Athena/Lucid widgets don't.
3914 Both conclusions reached experimentally. -- rms. */
3915 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3916 &extra_borders
, NULL
);
3920 /* Convert our geometry parameters into a geometry string
3922 Note that we do not specify here whether the position
3923 is a user-specified or program-specified one.
3924 We pass that information later, in x_wm_set_size_hints. */
3926 int left
= f
->output_data
.x
->left_pos
;
3927 int xneg
= window_prompting
& XNegative
;
3928 int top
= f
->output_data
.x
->top_pos
;
3929 int yneg
= window_prompting
& YNegative
;
3935 if (window_prompting
& USPosition
)
3936 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3937 PIXEL_WIDTH (f
) + extra_borders
,
3938 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3939 (xneg
? '-' : '+'), left
,
3940 (yneg
? '-' : '+'), top
);
3942 sprintf (shell_position
, "=%dx%d",
3943 PIXEL_WIDTH (f
) + extra_borders
,
3944 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3947 len
= strlen (shell_position
) + 1;
3948 /* We don't free this because we don't know whether
3949 it is safe to free it while the frame exists.
3950 It isn't worth the trouble of arranging to free it
3951 when the frame is deleted. */
3952 tem
= (char *) xmalloc (len
);
3953 strncpy (tem
, shell_position
, len
);
3954 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3955 XtSetValues (shell_widget
, al
, ac
);
3958 XtManageChild (pane_widget
);
3959 XtRealizeWidget (shell_widget
);
3961 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3963 validate_x_resource_name ();
3965 class_hints
.res_name
= (char *) SDATA (Vx_resource_name
);
3966 class_hints
.res_class
= (char *) SDATA (Vx_resource_class
);
3967 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3970 FRAME_XIC (f
) = NULL
;
3972 create_frame_xic (f
);
3976 f
->output_data
.x
->wm_hints
.input
= True
;
3977 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3978 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3979 &f
->output_data
.x
->wm_hints
);
3981 hack_wm_protocols (f
, shell_widget
);
3984 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3987 /* Do a stupid property change to force the server to generate a
3988 PropertyNotify event so that the event_stream server timestamp will
3989 be initialized to something relevant to the time we created the window.
3991 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3992 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3993 XA_ATOM
, 32, PropModeAppend
,
3994 (unsigned char*) NULL
, 0);
3996 /* Make all the standard events reach the Emacs frame. */
3997 attributes
.event_mask
= STANDARD_EVENT_SET
;
4002 /* XIM server might require some X events. */
4003 unsigned long fevent
= NoEventMask
;
4004 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
4005 attributes
.event_mask
|= fevent
;
4007 #endif /* HAVE_X_I18N */
4009 attribute_mask
= CWEventMask
;
4010 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
4011 attribute_mask
, &attributes
);
4013 XtMapWidget (frame_widget
);
4015 /* x_set_name normally ignores requests to set the name if the
4016 requested name is the same as the current name. This is the one
4017 place where that assumption isn't correct; f->name is set, but
4018 the X server hasn't been told. */
4021 int explicit = f
->explicit_name
;
4023 f
->explicit_name
= 0;
4026 x_set_name (f
, name
, explicit);
4029 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4030 f
->output_data
.x
->text_cursor
);
4034 /* This is a no-op, except under Motif. Make sure main areas are
4035 set to something reasonable, in case we get an error later. */
4036 lw_set_main_areas (pane_widget
, 0, frame_widget
);
4039 #else /* not USE_X_TOOLKIT */
4045 if (! xg_create_frame_widgets (f
))
4046 error ("Unable to create window");
4049 FRAME_XIC (f
) = NULL
;
4052 create_frame_xic (f
);
4055 /* XIM server might require some X events. */
4056 unsigned long fevent
= NoEventMask
;
4057 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
4059 if (fevent
!= NoEventMask
)
4061 XSetWindowAttributes attributes
;
4062 XWindowAttributes wattr
;
4063 unsigned long attribute_mask
;
4065 XGetWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4067 attributes
.event_mask
= wattr
.your_event_mask
| fevent
;
4068 attribute_mask
= CWEventMask
;
4069 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4070 attribute_mask
, &attributes
);
4078 #else /*! USE_GTK */
4079 /* Create and set up the X window for frame F. */
4086 XClassHint class_hints
;
4087 XSetWindowAttributes attributes
;
4088 unsigned long attribute_mask
;
4090 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
4091 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
4092 attributes
.bit_gravity
= StaticGravity
;
4093 attributes
.backing_store
= NotUseful
;
4094 attributes
.save_under
= True
;
4095 attributes
.event_mask
= STANDARD_EVENT_SET
;
4096 attributes
.colormap
= FRAME_X_COLORMAP (f
);
4097 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
4102 = XCreateWindow (FRAME_X_DISPLAY (f
),
4103 f
->output_data
.x
->parent_desc
,
4104 f
->output_data
.x
->left_pos
,
4105 f
->output_data
.x
->top_pos
,
4106 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
4107 f
->output_data
.x
->border_width
,
4108 CopyFromParent
, /* depth */
4109 InputOutput
, /* class */
4111 attribute_mask
, &attributes
);
4115 create_frame_xic (f
);
4118 /* XIM server might require some X events. */
4119 unsigned long fevent
= NoEventMask
;
4120 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
4121 attributes
.event_mask
|= fevent
;
4122 attribute_mask
= CWEventMask
;
4123 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4124 attribute_mask
, &attributes
);
4127 #endif /* HAVE_X_I18N */
4129 validate_x_resource_name ();
4131 class_hints
.res_name
= (char *) SDATA (Vx_resource_name
);
4132 class_hints
.res_class
= (char *) SDATA (Vx_resource_class
);
4133 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
4135 /* The menubar is part of the ordinary display;
4136 it does not count in addition to the height of the window. */
4137 f
->output_data
.x
->menubar_height
= 0;
4139 /* This indicates that we use the "Passive Input" input model.
4140 Unless we do this, we don't get the Focus{In,Out} events that we
4141 need to draw the cursor correctly. Accursed bureaucrats.
4142 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
4144 f
->output_data
.x
->wm_hints
.input
= True
;
4145 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
4146 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4147 &f
->output_data
.x
->wm_hints
);
4148 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
4150 /* Request "save yourself" and "delete window" commands from wm. */
4153 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
4154 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
4155 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
4158 /* x_set_name normally ignores requests to set the name if the
4159 requested name is the same as the current name. This is the one
4160 place where that assumption isn't correct; f->name is set, but
4161 the X server hasn't been told. */
4164 int explicit = f
->explicit_name
;
4166 f
->explicit_name
= 0;
4169 x_set_name (f
, name
, explicit);
4172 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4173 f
->output_data
.x
->text_cursor
);
4177 if (FRAME_X_WINDOW (f
) == 0)
4178 error ("Unable to create window");
4181 #endif /* not USE_GTK */
4182 #endif /* not USE_X_TOOLKIT */
4184 /* Handle the icon stuff for this window. Perhaps later we might
4185 want an x_set_icon_position which can be called interactively as
4193 Lisp_Object icon_x
, icon_y
;
4194 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4196 /* Set the position of the icon. Note that twm groups all
4197 icons in an icon window. */
4198 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
4199 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
4200 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
4202 CHECK_NUMBER (icon_x
);
4203 CHECK_NUMBER (icon_y
);
4205 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
4206 error ("Both left and top icon corners of icon must be specified");
4210 if (! EQ (icon_x
, Qunbound
))
4211 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
4213 /* Start up iconic or window? */
4214 x_wm_set_window_state
4215 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
4220 x_text_icon (f
, (char *) SDATA ((!NILP (f
->icon_name
)
4227 /* Make the GCs needed for this window, setting the
4228 background, border and mouse colors; also create the
4229 mouse cursor and the gray border tile. */
4231 static char cursor_bits
[] =
4233 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4234 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4235 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4236 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
4243 XGCValues gc_values
;
4247 /* Create the GCs of this frame.
4248 Note that many default values are used. */
4251 gc_values
.font
= f
->output_data
.x
->font
->fid
;
4252 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
4253 gc_values
.background
= f
->output_data
.x
->background_pixel
;
4254 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
4255 f
->output_data
.x
->normal_gc
4256 = XCreateGC (FRAME_X_DISPLAY (f
),
4258 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
4261 /* Reverse video style. */
4262 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4263 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
4264 f
->output_data
.x
->reverse_gc
4265 = XCreateGC (FRAME_X_DISPLAY (f
),
4267 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
4270 /* Cursor has cursor-color background, background-color foreground. */
4271 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4272 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
4273 gc_values
.fill_style
= FillOpaqueStippled
;
4275 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
4276 FRAME_X_DISPLAY_INFO (f
)->root_window
,
4277 cursor_bits
, 16, 16);
4278 f
->output_data
.x
->cursor_gc
4279 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4280 (GCFont
| GCForeground
| GCBackground
4281 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
4285 f
->output_data
.x
->white_relief
.gc
= 0;
4286 f
->output_data
.x
->black_relief
.gc
= 0;
4288 /* Create the gray border tile used when the pointer is not in
4289 the frame. Since this depends on the frame's pixel values,
4290 this must be done on a per-frame basis. */
4291 f
->output_data
.x
->border_tile
4292 = (XCreatePixmapFromBitmapData
4293 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
4294 gray_bits
, gray_width
, gray_height
,
4295 f
->output_data
.x
->foreground_pixel
,
4296 f
->output_data
.x
->background_pixel
,
4297 DefaultDepth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
))));
4303 /* Free what was was allocated in x_make_gc. */
4309 Display
*dpy
= FRAME_X_DISPLAY (f
);
4313 if (f
->output_data
.x
->normal_gc
)
4315 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
4316 f
->output_data
.x
->normal_gc
= 0;
4319 if (f
->output_data
.x
->reverse_gc
)
4321 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4322 f
->output_data
.x
->reverse_gc
= 0;
4325 if (f
->output_data
.x
->cursor_gc
)
4327 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4328 f
->output_data
.x
->cursor_gc
= 0;
4331 if (f
->output_data
.x
->border_tile
)
4333 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4334 f
->output_data
.x
->border_tile
= 0;
4341 /* Handler for signals raised during x_create_frame and
4342 x_create_top_frame. FRAME is the frame which is partially
4346 unwind_create_frame (frame
)
4349 struct frame
*f
= XFRAME (frame
);
4351 /* If frame is ``official'', nothing to do. */
4352 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4355 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4358 x_free_frame_resources (f
);
4360 /* Check that reference counts are indeed correct. */
4361 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4362 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4370 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4372 doc
: /* Make a new X window, which is called a "frame" in Emacs terms.
4373 Returns an Emacs frame object.
4374 ALIST is an alist of frame parameters.
4375 If the parameters specify that the frame should not have a minibuffer,
4376 and do not specify a specific minibuffer window to use,
4377 then `default-minibuffer-frame' must be a frame whose minibuffer can
4378 be shared by the new frame.
4380 This function is an internal primitive--use `make-frame' instead. */)
4385 Lisp_Object frame
, tem
;
4387 int minibuffer_only
= 0;
4388 long window_prompting
= 0;
4390 int count
= SPECPDL_INDEX ();
4391 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4392 Lisp_Object display
;
4393 struct x_display_info
*dpyinfo
= NULL
;
4399 /* Use this general default value to start with
4400 until we know if this frame has a specified name. */
4401 Vx_resource_name
= Vinvocation_name
;
4403 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4404 if (EQ (display
, Qunbound
))
4406 dpyinfo
= check_x_display_info (display
);
4408 kb
= dpyinfo
->kboard
;
4410 kb
= &the_only_kboard
;
4413 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4415 && ! EQ (name
, Qunbound
)
4417 error ("Invalid frame name--not a string or nil");
4420 Vx_resource_name
= name
;
4422 /* See if parent window is specified. */
4423 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4424 if (EQ (parent
, Qunbound
))
4426 if (! NILP (parent
))
4427 CHECK_NUMBER (parent
);
4429 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4430 /* No need to protect DISPLAY because that's not used after passing
4431 it to make_frame_without_minibuffer. */
4433 GCPRO4 (parms
, parent
, name
, frame
);
4434 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4436 if (EQ (tem
, Qnone
) || NILP (tem
))
4437 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4438 else if (EQ (tem
, Qonly
))
4440 f
= make_minibuffer_frame ();
4441 minibuffer_only
= 1;
4443 else if (WINDOWP (tem
))
4444 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4448 XSETFRAME (frame
, f
);
4450 /* Note that X Windows does support scroll bars. */
4451 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4453 f
->output_method
= output_x_window
;
4454 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4455 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4456 f
->output_data
.x
->icon_bitmap
= -1;
4457 f
->output_data
.x
->fontset
= -1;
4458 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4459 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4460 #ifdef USE_TOOLKIT_SCROLL_BARS
4461 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
4462 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
4463 #endif /* USE_TOOLKIT_SCROLL_BARS */
4464 record_unwind_protect (unwind_create_frame
, frame
);
4467 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4469 if (! STRINGP (f
->icon_name
))
4470 f
->icon_name
= Qnil
;
4472 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4474 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4475 dpyinfo_refcount
= dpyinfo
->reference_count
;
4476 #endif /* GLYPH_DEBUG */
4478 FRAME_KBOARD (f
) = kb
;
4481 /* These colors will be set anyway later, but it's important
4482 to get the color reference counts right, so initialize them! */
4485 struct gcpro gcpro1
;
4487 /* Function x_decode_color can signal an error. Make
4488 sure to initialize color slots so that we won't try
4489 to free colors we haven't allocated. */
4490 f
->output_data
.x
->foreground_pixel
= -1;
4491 f
->output_data
.x
->background_pixel
= -1;
4492 f
->output_data
.x
->cursor_pixel
= -1;
4493 f
->output_data
.x
->cursor_foreground_pixel
= -1;
4494 f
->output_data
.x
->border_pixel
= -1;
4495 f
->output_data
.x
->mouse_pixel
= -1;
4497 black
= build_string ("black");
4499 f
->output_data
.x
->foreground_pixel
4500 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4501 f
->output_data
.x
->background_pixel
4502 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4503 f
->output_data
.x
->cursor_pixel
4504 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4505 f
->output_data
.x
->cursor_foreground_pixel
4506 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4507 f
->output_data
.x
->border_pixel
4508 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4509 f
->output_data
.x
->mouse_pixel
4510 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4514 /* Specify the parent under which to make this X window. */
4518 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4519 f
->output_data
.x
->explicit_parent
= 1;
4523 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4524 f
->output_data
.x
->explicit_parent
= 0;
4527 /* Set the name; the functions to which we pass f expect the name to
4529 if (EQ (name
, Qunbound
) || NILP (name
))
4531 f
->name
= build_string (dpyinfo
->x_id_name
);
4532 f
->explicit_name
= 0;
4537 f
->explicit_name
= 1;
4538 /* use the frame's title when getting resources for this frame. */
4539 specbind (Qx_resource_name
, name
);
4542 /* Extract the window parameters from the supplied values
4543 that are needed to determine window geometry. */
4547 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4550 /* First, try whatever font the caller has specified. */
4553 tem
= Fquery_fontset (font
, Qnil
);
4555 font
= x_new_fontset (f
, SDATA (tem
));
4557 font
= x_new_font (f
, SDATA (font
));
4560 /* Try out a font which we hope has bold and italic variations. */
4561 if (!STRINGP (font
))
4562 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4563 if (!STRINGP (font
))
4564 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4565 if (! STRINGP (font
))
4566 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4567 if (! STRINGP (font
))
4568 /* This was formerly the first thing tried, but it finds too many fonts
4569 and takes too long. */
4570 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4571 /* If those didn't work, look for something which will at least work. */
4572 if (! STRINGP (font
))
4573 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4575 if (! STRINGP (font
))
4576 font
= build_string ("fixed");
4578 x_default_parameter (f
, parms
, Qfont
, font
,
4579 "font", "Font", RES_TYPE_STRING
);
4583 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4584 whereby it fails to get any font. */
4585 xlwmenu_default_font
= f
->output_data
.x
->font
;
4588 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4589 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4591 /* This defaults to 1 in order to match xterm. We recognize either
4592 internalBorderWidth or internalBorder (which is what xterm calls
4594 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4598 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4599 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4600 if (! EQ (value
, Qunbound
))
4601 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4604 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4605 "internalBorderWidth", "internalBorderWidth",
4607 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4608 "verticalScrollBars", "ScrollBars",
4611 /* Also do the stuff which must be set before the window exists. */
4612 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4613 "foreground", "Foreground", RES_TYPE_STRING
);
4614 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4615 "background", "Background", RES_TYPE_STRING
);
4616 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4617 "pointerColor", "Foreground", RES_TYPE_STRING
);
4618 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4619 "cursorColor", "Foreground", RES_TYPE_STRING
);
4620 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4621 "borderColor", "BorderColor", RES_TYPE_STRING
);
4622 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4623 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4624 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4625 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4626 x_default_parameter (f
, parms
, Qleft_fringe
, Qnil
,
4627 "leftFringe", "LeftFringe", RES_TYPE_NUMBER
);
4628 x_default_parameter (f
, parms
, Qright_fringe
, Qnil
,
4629 "rightFringe", "RightFringe", RES_TYPE_NUMBER
);
4631 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4632 "scrollBarForeground",
4633 "ScrollBarForeground", 1);
4634 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4635 "scrollBarBackground",
4636 "ScrollBarBackground", 0);
4638 /* Init faces before x_default_parameter is called for scroll-bar
4639 parameters because that function calls x_set_scroll_bar_width,
4640 which calls change_frame_size, which calls Fset_window_buffer,
4641 which runs hooks, which call Fvertical_motion. At the end, we
4642 end up in init_iterator with a null face cache, which should not
4644 init_frame_faces (f
);
4646 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4647 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4648 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4649 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4650 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4651 "bufferPredicate", "BufferPredicate",
4653 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4654 "title", "Title", RES_TYPE_STRING
);
4655 x_default_parameter (f
, parms
, Qwait_for_wm
, Qt
,
4656 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN
);
4657 x_default_parameter (f
, parms
, Qfullscreen
, Qnil
,
4658 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL
);
4660 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4662 /* Add the tool-bar height to the initial frame height so that the
4663 user gets a text display area of the size he specified with -g or
4664 via .Xdefaults. Later changes of the tool-bar height don't
4665 change the frame size. This is done so that users can create
4666 tall Emacs frames without having to guess how tall the tool-bar
4668 if (FRAME_TOOL_BAR_LINES (f
))
4670 int margin
, relief
, bar_height
;
4672 relief
= (tool_bar_button_relief
>= 0
4673 ? tool_bar_button_relief
4674 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4676 if (INTEGERP (Vtool_bar_button_margin
)
4677 && XINT (Vtool_bar_button_margin
) > 0)
4678 margin
= XFASTINT (Vtool_bar_button_margin
);
4679 else if (CONSP (Vtool_bar_button_margin
)
4680 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4681 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4682 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4686 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4687 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4690 /* Compute the size of the X window. */
4691 window_prompting
= x_figure_window_size (f
, parms
);
4693 if (window_prompting
& XNegative
)
4695 if (window_prompting
& YNegative
)
4696 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4698 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4702 if (window_prompting
& YNegative
)
4703 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4705 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4708 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4710 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4711 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4713 /* Create the X widget or window. */
4714 #ifdef USE_X_TOOLKIT
4715 x_window (f
, window_prompting
, minibuffer_only
);
4723 /* Now consider the frame official. */
4724 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4725 Vframe_list
= Fcons (frame
, Vframe_list
);
4727 /* We need to do this after creating the X window, so that the
4728 icon-creation functions can say whose icon they're describing. */
4729 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4730 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4732 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4733 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4734 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4735 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4736 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4737 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4738 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4739 "scrollBarWidth", "ScrollBarWidth",
4742 /* Dimensions, especially f->height, must be done via change_frame_size.
4743 Change will not be effected unless different from the current
4749 SET_FRAME_WIDTH (f
, 0);
4750 change_frame_size (f
, height
, width
, 1, 0, 0);
4752 /* Set up faces after all frame parameters are known. This call
4753 also merges in face attributes specified for new frames. If we
4754 don't do this, the `menu' face for instance won't have the right
4755 colors, and the menu bar won't appear in the specified colors for
4757 call1 (Qface_set_after_frame_default
, frame
);
4759 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
4760 /* Create the menu bar. */
4761 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4763 /* If this signals an error, we haven't set size hints for the
4764 frame and we didn't make it visible. */
4765 initialize_frame_menubar (f
);
4768 /* This is a no-op, except under Motif where it arranges the
4769 main window for the widgets on it. */
4770 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4771 f
->output_data
.x
->menubar_widget
,
4772 f
->output_data
.x
->edit_widget
);
4773 #endif /* not USE_GTK */
4775 #endif /* USE_X_TOOLKIT || USE_GTK */
4777 /* Tell the server what size and position, etc, we want, and how
4778 badly we want them. This should be done after we have the menu
4779 bar so that its size can be taken into account. */
4781 x_wm_set_size_hint (f
, window_prompting
, 0);
4784 /* Make the window appear on the frame and enable display, unless
4785 the caller says not to. However, with explicit parent, Emacs
4786 cannot control visibility, so don't try. */
4787 if (! f
->output_data
.x
->explicit_parent
)
4789 Lisp_Object visibility
;
4791 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4793 if (EQ (visibility
, Qunbound
))
4796 if (EQ (visibility
, Qicon
))
4797 x_iconify_frame (f
);
4798 else if (! NILP (visibility
))
4799 x_make_frame_visible (f
);
4801 /* Must have been Qnil. */
4807 /* Make sure windows on this frame appear in calls to next-window
4808 and similar functions. */
4809 Vwindow_list
= Qnil
;
4811 return unbind_to (count
, frame
);
4815 /* FRAME is used only to get a handle on the X display. We don't pass the
4816 display info directly because we're called from frame.c, which doesn't
4817 know about that structure. */
4820 x_get_focus_frame (frame
)
4821 struct frame
*frame
;
4823 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4825 if (! dpyinfo
->x_focus_frame
)
4828 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4833 /* In certain situations, when the window manager follows a
4834 click-to-focus policy, there seems to be no way around calling
4835 XSetInputFocus to give another frame the input focus .
4837 In an ideal world, XSetInputFocus should generally be avoided so
4838 that applications don't interfere with the window manager's focus
4839 policy. But I think it's okay to use when it's clearly done
4840 following a user-command. */
4842 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4843 doc
: /* Set the input focus to FRAME.
4844 FRAME nil means use the selected frame. */)
4848 struct frame
*f
= check_x_frame (frame
);
4849 Display
*dpy
= FRAME_X_DISPLAY (f
);
4853 count
= x_catch_errors (dpy
);
4854 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4855 RevertToParent
, CurrentTime
);
4856 x_uncatch_errors (dpy
, count
);
4863 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4864 doc
: /* Internal function called by `color-defined-p', which see. */)
4866 Lisp_Object color
, frame
;
4869 FRAME_PTR f
= check_x_frame (frame
);
4871 CHECK_STRING (color
);
4873 if (x_defined_color (f
, SDATA (color
), &foo
, 0))
4879 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4880 doc
: /* Internal function called by `color-values', which see. */)
4882 Lisp_Object color
, frame
;
4885 FRAME_PTR f
= check_x_frame (frame
);
4887 CHECK_STRING (color
);
4889 if (x_defined_color (f
, SDATA (color
), &foo
, 0))
4893 rgb
[0] = make_number (foo
.red
);
4894 rgb
[1] = make_number (foo
.green
);
4895 rgb
[2] = make_number (foo
.blue
);
4896 return Flist (3, rgb
);
4902 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4903 doc
: /* Internal function called by `display-color-p', which see. */)
4905 Lisp_Object display
;
4907 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4909 if (dpyinfo
->n_planes
<= 2)
4912 switch (dpyinfo
->visual
->class)
4925 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4927 doc
: /* Return t if the X display supports shades of gray.
4928 Note that color displays do support shades of gray.
4929 The optional argument DISPLAY specifies which display to ask about.
4930 DISPLAY should be either a frame or a display name (a string).
4931 If omitted or nil, that stands for the selected frame's display. */)
4933 Lisp_Object display
;
4935 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4937 if (dpyinfo
->n_planes
<= 1)
4940 switch (dpyinfo
->visual
->class)
4955 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4957 doc
: /* Returns the width in pixels of the X display DISPLAY.
4958 The optional argument DISPLAY specifies which display to ask about.
4959 DISPLAY should be either a frame or a display name (a string).
4960 If omitted or nil, that stands for the selected frame's display. */)
4962 Lisp_Object display
;
4964 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4966 return make_number (dpyinfo
->width
);
4969 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4970 Sx_display_pixel_height
, 0, 1, 0,
4971 doc
: /* Returns the height in pixels of the X display DISPLAY.
4972 The optional argument DISPLAY specifies which display to ask about.
4973 DISPLAY should be either a frame or a display name (a string).
4974 If omitted or nil, that stands for the selected frame's display. */)
4976 Lisp_Object display
;
4978 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4980 return make_number (dpyinfo
->height
);
4983 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4985 doc
: /* Returns the number of bitplanes of the X display DISPLAY.
4986 The optional argument DISPLAY specifies which display to ask about.
4987 DISPLAY should be either a frame or a display name (a string).
4988 If omitted or nil, that stands for the selected frame's display. */)
4990 Lisp_Object display
;
4992 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4994 return make_number (dpyinfo
->n_planes
);
4997 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4999 doc
: /* Returns the number of color cells of the X display DISPLAY.
5000 The optional argument DISPLAY specifies which display to ask about.
5001 DISPLAY should be either a frame or a display name (a string).
5002 If omitted or nil, that stands for the selected frame's display. */)
5004 Lisp_Object display
;
5006 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5008 return make_number (DisplayCells (dpyinfo
->display
,
5009 XScreenNumberOfScreen (dpyinfo
->screen
)));
5012 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
5013 Sx_server_max_request_size
,
5015 doc
: /* Returns the maximum request size of the X server of display DISPLAY.
5016 The optional argument DISPLAY specifies which display to ask about.
5017 DISPLAY should be either a frame or a display name (a string).
5018 If omitted or nil, that stands for the selected frame's display. */)
5020 Lisp_Object display
;
5022 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5024 return make_number (MAXREQUEST (dpyinfo
->display
));
5027 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
5028 doc
: /* Returns the vendor ID string of the X server of display DISPLAY.
5029 The optional argument DISPLAY specifies which display to ask about.
5030 DISPLAY should be either a frame or a display name (a string).
5031 If omitted or nil, that stands for the selected frame's display. */)
5033 Lisp_Object display
;
5035 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5036 char *vendor
= ServerVendor (dpyinfo
->display
);
5038 if (! vendor
) vendor
= "";
5039 return build_string (vendor
);
5042 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
5043 doc
: /* Returns the version numbers of the X server of display DISPLAY.
5044 The value is a list of three integers: the major and minor
5045 version numbers of the X Protocol in use, and the vendor-specific release
5046 number. See also the function `x-server-vendor'.
5048 The optional argument DISPLAY specifies which display to ask about.
5049 DISPLAY should be either a frame or a display name (a string).
5050 If omitted or nil, that stands for the selected frame's display. */)
5052 Lisp_Object display
;
5054 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5055 Display
*dpy
= dpyinfo
->display
;
5057 return Fcons (make_number (ProtocolVersion (dpy
)),
5058 Fcons (make_number (ProtocolRevision (dpy
)),
5059 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
5062 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
5063 doc
: /* Return the number of screens on the X server of display DISPLAY.
5064 The optional argument DISPLAY specifies which display to ask about.
5065 DISPLAY should be either a frame or a display name (a string).
5066 If omitted or nil, that stands for the selected frame's display. */)
5068 Lisp_Object display
;
5070 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5072 return make_number (ScreenCount (dpyinfo
->display
));
5075 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
5076 doc
: /* Return the height in millimeters of the X display DISPLAY.
5077 The optional argument DISPLAY specifies which display to ask about.
5078 DISPLAY should be either a frame or a display name (a string).
5079 If omitted or nil, that stands for the selected frame's display. */)
5081 Lisp_Object display
;
5083 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5085 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
5088 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
5089 doc
: /* Return the width in millimeters of the X display DISPLAY.
5090 The optional argument DISPLAY specifies which display to ask about.
5091 DISPLAY should be either a frame or a display name (a string).
5092 If omitted or nil, that stands for the selected frame's display. */)
5094 Lisp_Object display
;
5096 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5098 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
5101 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
5102 Sx_display_backing_store
, 0, 1, 0,
5103 doc
: /* Returns an indication of whether X display DISPLAY does backing store.
5104 The value may be `always', `when-mapped', or `not-useful'.
5105 The optional argument DISPLAY specifies which display to ask about.
5106 DISPLAY should be either a frame or a display name (a string).
5107 If omitted or nil, that stands for the selected frame's display. */)
5109 Lisp_Object display
;
5111 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5114 switch (DoesBackingStore (dpyinfo
->screen
))
5117 result
= intern ("always");
5121 result
= intern ("when-mapped");
5125 result
= intern ("not-useful");
5129 error ("Strange value for BackingStore parameter of screen");
5136 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
5137 Sx_display_visual_class
, 0, 1, 0,
5138 doc
: /* Return the visual class of the X display DISPLAY.
5139 The value is one of the symbols `static-gray', `gray-scale',
5140 `static-color', `pseudo-color', `true-color', or `direct-color'.
5142 The optional argument DISPLAY specifies which display to ask about.
5143 DISPLAY should be either a frame or a display name (a string).
5144 If omitted or nil, that stands for the selected frame's display. */)
5146 Lisp_Object display
;
5148 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5151 switch (dpyinfo
->visual
->class)
5154 result
= intern ("static-gray");
5157 result
= intern ("gray-scale");
5160 result
= intern ("static-color");
5163 result
= intern ("pseudo-color");
5166 result
= intern ("true-color");
5169 result
= intern ("direct-color");
5172 error ("Display has an unknown visual class");
5179 DEFUN ("x-display-save-under", Fx_display_save_under
,
5180 Sx_display_save_under
, 0, 1, 0,
5181 doc
: /* Returns t if the X display DISPLAY supports the save-under feature.
5182 The optional argument DISPLAY specifies which display to ask about.
5183 DISPLAY should be either a frame or a display name (a string).
5184 If omitted or nil, that stands for the selected frame's display. */)
5186 Lisp_Object display
;
5188 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5190 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
5198 register struct frame
*f
;
5200 return PIXEL_WIDTH (f
);
5205 register struct frame
*f
;
5207 return PIXEL_HEIGHT (f
);
5212 register struct frame
*f
;
5214 return FONT_WIDTH (f
->output_data
.x
->font
);
5219 register struct frame
*f
;
5221 return f
->output_data
.x
->line_height
;
5226 register struct frame
*f
;
5228 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
5233 /************************************************************************
5235 ************************************************************************/
5238 /* Mapping visual names to visuals. */
5240 static struct visual_class
5247 {"StaticGray", StaticGray
},
5248 {"GrayScale", GrayScale
},
5249 {"StaticColor", StaticColor
},
5250 {"PseudoColor", PseudoColor
},
5251 {"TrueColor", TrueColor
},
5252 {"DirectColor", DirectColor
},
5257 #ifndef HAVE_XSCREENNUMBEROFSCREEN
5259 /* Value is the screen number of screen SCR. This is a substitute for
5260 the X function with the same name when that doesn't exist. */
5263 XScreenNumberOfScreen (scr
)
5264 register Screen
*scr
;
5266 Display
*dpy
= scr
->display
;
5269 for (i
= 0; i
< dpy
->nscreens
; ++i
)
5270 if (scr
== dpy
->screens
+ i
)
5276 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5279 /* Select the visual that should be used on display DPYINFO. Set
5280 members of DPYINFO appropriately. Called from x_term_init. */
5283 select_visual (dpyinfo
)
5284 struct x_display_info
*dpyinfo
;
5286 Display
*dpy
= dpyinfo
->display
;
5287 Screen
*screen
= dpyinfo
->screen
;
5290 /* See if a visual is specified. */
5291 value
= display_x_get_resource (dpyinfo
,
5292 build_string ("visualClass"),
5293 build_string ("VisualClass"),
5295 if (STRINGP (value
))
5297 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
5298 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
5299 depth, a decimal number. NAME is compared with case ignored. */
5300 char *s
= (char *) alloca (SBYTES (value
) + 1);
5305 strcpy (s
, SDATA (value
));
5306 dash
= index (s
, '-');
5309 dpyinfo
->n_planes
= atoi (dash
+ 1);
5313 /* We won't find a matching visual with depth 0, so that
5314 an error will be printed below. */
5315 dpyinfo
->n_planes
= 0;
5317 /* Determine the visual class. */
5318 for (i
= 0; visual_classes
[i
].name
; ++i
)
5319 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
5321 class = visual_classes
[i
].class;
5325 /* Look up a matching visual for the specified class. */
5327 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
5328 dpyinfo
->n_planes
, class, &vinfo
))
5329 fatal ("Invalid visual specification `%s'", SDATA (value
));
5331 dpyinfo
->visual
= vinfo
.visual
;
5336 XVisualInfo
*vinfo
, vinfo_template
;
5338 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
5341 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
5343 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
5345 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5346 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
5347 &vinfo_template
, &n_visuals
);
5349 fatal ("Can't get proper X visual info");
5351 dpyinfo
->n_planes
= vinfo
->depth
;
5352 XFree ((char *) vinfo
);
5357 /* Return the X display structure for the display named NAME.
5358 Open a new connection if necessary. */
5360 struct x_display_info
*
5361 x_display_info_for_name (name
)
5365 struct x_display_info
*dpyinfo
;
5367 CHECK_STRING (name
);
5369 if (! EQ (Vwindow_system
, intern ("x")))
5370 error ("Not using X Windows");
5372 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5374 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5377 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5382 /* Use this general default value to start with. */
5383 Vx_resource_name
= Vinvocation_name
;
5385 validate_x_resource_name ();
5387 dpyinfo
= x_term_init (name
, (char *)0,
5388 (char *) SDATA (Vx_resource_name
));
5391 error ("Cannot connect to X server %s", SDATA (name
));
5394 XSETFASTINT (Vwindow_system_version
, 11);
5400 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5402 doc
: /* Open a connection to an X server.
5403 DISPLAY is the name of the display to connect to.
5404 Optional second arg XRM-STRING is a string of resources in xrdb format.
5405 If the optional third arg MUST-SUCCEED is non-nil,
5406 terminate Emacs if we can't open the connection. */)
5407 (display
, xrm_string
, must_succeed
)
5408 Lisp_Object display
, xrm_string
, must_succeed
;
5410 unsigned char *xrm_option
;
5411 struct x_display_info
*dpyinfo
;
5413 CHECK_STRING (display
);
5414 if (! NILP (xrm_string
))
5415 CHECK_STRING (xrm_string
);
5417 if (! EQ (Vwindow_system
, intern ("x")))
5418 error ("Not using X Windows");
5420 if (! NILP (xrm_string
))
5421 xrm_option
= (unsigned char *) SDATA (xrm_string
);
5423 xrm_option
= (unsigned char *) 0;
5425 validate_x_resource_name ();
5427 /* This is what opens the connection and sets x_current_display.
5428 This also initializes many symbols, such as those used for input. */
5429 dpyinfo
= x_term_init (display
, xrm_option
,
5430 (char *) SDATA (Vx_resource_name
));
5434 if (!NILP (must_succeed
))
5435 fatal ("Cannot connect to X server %s.\n\
5436 Check the DISPLAY environment variable or use `-d'.\n\
5437 Also use the `xauth' program to verify that you have the proper\n\
5438 authorization information needed to connect the X server.\n\
5439 An insecure way to solve the problem may be to use `xhost'.\n",
5442 error ("Cannot connect to X server %s", SDATA (display
));
5447 XSETFASTINT (Vwindow_system_version
, 11);
5451 DEFUN ("x-close-connection", Fx_close_connection
,
5452 Sx_close_connection
, 1, 1, 0,
5453 doc
: /* Close the connection to DISPLAY's X server.
5454 For DISPLAY, specify either a frame or a display name (a string).
5455 If DISPLAY is nil, that stands for the selected frame's display. */)
5457 Lisp_Object display
;
5459 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5462 if (dpyinfo
->reference_count
> 0)
5463 error ("Display still has frames on it");
5466 /* Free the fonts in the font table. */
5467 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5468 if (dpyinfo
->font_table
[i
].name
)
5470 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5471 xfree (dpyinfo
->font_table
[i
].full_name
);
5472 xfree (dpyinfo
->font_table
[i
].name
);
5473 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5476 x_destroy_all_bitmaps (dpyinfo
);
5477 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5479 #ifdef USE_X_TOOLKIT
5480 XtCloseDisplay (dpyinfo
->display
);
5482 XCloseDisplay (dpyinfo
->display
);
5485 x_delete_display (dpyinfo
);
5491 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5492 doc
: /* Return the list of display names that Emacs has connections to. */)
5495 Lisp_Object tail
, result
;
5498 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5499 result
= Fcons (XCAR (XCAR (tail
)), result
);
5504 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5505 doc
: /* If ON is non-nil, report X errors as soon as the erring request is made.
5506 If ON is nil, allow buffering of requests.
5507 Turning on synchronization prohibits the Xlib routines from buffering
5508 requests and seriously degrades performance, but makes debugging much
5510 The optional second argument DISPLAY specifies which display to act on.
5511 DISPLAY should be either a frame or a display name (a string).
5512 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
5514 Lisp_Object display
, on
;
5516 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5518 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5523 /* Wait for responses to all X commands issued so far for frame F. */
5530 XSync (FRAME_X_DISPLAY (f
), False
);
5535 /***********************************************************************
5537 ***********************************************************************/
5539 /* Value is the number of elements of vector VECTOR. */
5541 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5543 /* List of supported image types. Use define_image_type to add new
5544 types. Use lookup_image_type to find a type for a given symbol. */
5546 static struct image_type
*image_types
;
5548 /* The symbol `image' which is the car of the lists used to represent
5551 extern Lisp_Object Qimage
;
5553 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5559 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5560 extern Lisp_Object QCdata
, QCtype
;
5561 Lisp_Object QCascent
, QCmargin
, QCrelief
;
5562 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5563 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5565 /* Other symbols. */
5567 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5569 /* Time in seconds after which images should be removed from the cache
5570 if not displayed. */
5572 Lisp_Object Vimage_cache_eviction_delay
;
5574 /* Function prototypes. */
5576 static void define_image_type
P_ ((struct image_type
*type
));
5577 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5578 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5579 static void x_laplace
P_ ((struct frame
*, struct image
*));
5580 static void x_emboss
P_ ((struct frame
*, struct image
*));
5581 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5585 /* Define a new image type from TYPE. This adds a copy of TYPE to
5586 image_types and adds the symbol *TYPE->type to Vimage_types. */
5589 define_image_type (type
)
5590 struct image_type
*type
;
5592 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5593 The initialized data segment is read-only. */
5594 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5595 bcopy (type
, p
, sizeof *p
);
5596 p
->next
= image_types
;
5598 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5602 /* Look up image type SYMBOL, and return a pointer to its image_type
5603 structure. Value is null if SYMBOL is not a known image type. */
5605 static INLINE
struct image_type
*
5606 lookup_image_type (symbol
)
5609 struct image_type
*type
;
5611 for (type
= image_types
; type
; type
= type
->next
)
5612 if (EQ (symbol
, *type
->type
))
5619 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5620 valid image specification is a list whose car is the symbol
5621 `image', and whose rest is a property list. The property list must
5622 contain a value for key `:type'. That value must be the name of a
5623 supported image type. The rest of the property list depends on the
5627 valid_image_p (object
)
5632 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5636 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
5637 if (EQ (XCAR (tem
), QCtype
))
5640 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
5642 struct image_type
*type
;
5643 type
= lookup_image_type (XCAR (tem
));
5645 valid_p
= type
->valid_p (object
);
5656 /* Log error message with format string FORMAT and argument ARG.
5657 Signaling an error, e.g. when an image cannot be loaded, is not a
5658 good idea because this would interrupt redisplay, and the error
5659 message display would lead to another redisplay. This function
5660 therefore simply displays a message. */
5663 image_error (format
, arg1
, arg2
)
5665 Lisp_Object arg1
, arg2
;
5667 add_to_log (format
, arg1
, arg2
);
5672 /***********************************************************************
5673 Image specifications
5674 ***********************************************************************/
5676 enum image_value_type
5678 IMAGE_DONT_CHECK_VALUE_TYPE
,
5680 IMAGE_STRING_OR_NIL_VALUE
,
5682 IMAGE_POSITIVE_INTEGER_VALUE
,
5683 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5684 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5686 IMAGE_INTEGER_VALUE
,
5687 IMAGE_FUNCTION_VALUE
,
5692 /* Structure used when parsing image specifications. */
5694 struct image_keyword
5696 /* Name of keyword. */
5699 /* The type of value allowed. */
5700 enum image_value_type type
;
5702 /* Non-zero means key must be present. */
5705 /* Used to recognize duplicate keywords in a property list. */
5708 /* The value that was found. */
5713 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5715 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5718 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5719 has the format (image KEYWORD VALUE ...). One of the keyword/
5720 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5721 image_keywords structures of size NKEYWORDS describing other
5722 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5725 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5727 struct image_keyword
*keywords
;
5734 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5737 plist
= XCDR (spec
);
5738 while (CONSP (plist
))
5740 Lisp_Object key
, value
;
5742 /* First element of a pair must be a symbol. */
5744 plist
= XCDR (plist
);
5748 /* There must follow a value. */
5751 value
= XCAR (plist
);
5752 plist
= XCDR (plist
);
5754 /* Find key in KEYWORDS. Error if not found. */
5755 for (i
= 0; i
< nkeywords
; ++i
)
5756 if (strcmp (keywords
[i
].name
, SDATA (SYMBOL_NAME (key
))) == 0)
5762 /* Record that we recognized the keyword. If a keywords
5763 was found more than once, it's an error. */
5764 keywords
[i
].value
= value
;
5765 ++keywords
[i
].count
;
5767 if (keywords
[i
].count
> 1)
5770 /* Check type of value against allowed type. */
5771 switch (keywords
[i
].type
)
5773 case IMAGE_STRING_VALUE
:
5774 if (!STRINGP (value
))
5778 case IMAGE_STRING_OR_NIL_VALUE
:
5779 if (!STRINGP (value
) && !NILP (value
))
5783 case IMAGE_SYMBOL_VALUE
:
5784 if (!SYMBOLP (value
))
5788 case IMAGE_POSITIVE_INTEGER_VALUE
:
5789 if (!INTEGERP (value
) || XINT (value
) <= 0)
5793 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5794 if (INTEGERP (value
) && XINT (value
) >= 0)
5797 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5798 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5802 case IMAGE_ASCENT_VALUE
:
5803 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5805 else if (INTEGERP (value
)
5806 && XINT (value
) >= 0
5807 && XINT (value
) <= 100)
5811 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5812 if (!INTEGERP (value
) || XINT (value
) < 0)
5816 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5819 case IMAGE_FUNCTION_VALUE
:
5820 value
= indirect_function (value
);
5822 || COMPILEDP (value
)
5823 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5827 case IMAGE_NUMBER_VALUE
:
5828 if (!INTEGERP (value
) && !FLOATP (value
))
5832 case IMAGE_INTEGER_VALUE
:
5833 if (!INTEGERP (value
))
5837 case IMAGE_BOOL_VALUE
:
5838 if (!NILP (value
) && !EQ (value
, Qt
))
5847 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5851 /* Check that all mandatory fields are present. */
5852 for (i
= 0; i
< nkeywords
; ++i
)
5853 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5856 return NILP (plist
);
5860 /* Return the value of KEY in image specification SPEC. Value is nil
5861 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5862 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5865 image_spec_value (spec
, key
, found
)
5866 Lisp_Object spec
, key
;
5871 xassert (valid_image_p (spec
));
5873 for (tail
= XCDR (spec
);
5874 CONSP (tail
) && CONSP (XCDR (tail
));
5875 tail
= XCDR (XCDR (tail
)))
5877 if (EQ (XCAR (tail
), key
))
5881 return XCAR (XCDR (tail
));
5891 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5892 doc
: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
5893 PIXELS non-nil means return the size in pixels, otherwise return the
5894 size in canonical character units.
5895 FRAME is the frame on which the image will be displayed. FRAME nil
5896 or omitted means use the selected frame. */)
5897 (spec
, pixels
, frame
)
5898 Lisp_Object spec
, pixels
, frame
;
5903 if (valid_image_p (spec
))
5905 struct frame
*f
= check_x_frame (frame
);
5906 int id
= lookup_image (f
, spec
);
5907 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5908 int width
= img
->width
+ 2 * img
->hmargin
;
5909 int height
= img
->height
+ 2 * img
->vmargin
;
5912 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5913 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5915 size
= Fcons (make_number (width
), make_number (height
));
5918 error ("Invalid image specification");
5924 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5925 doc
: /* Return t if image SPEC has a mask bitmap.
5926 FRAME is the frame on which the image will be displayed. FRAME nil
5927 or omitted means use the selected frame. */)
5929 Lisp_Object spec
, frame
;
5934 if (valid_image_p (spec
))
5936 struct frame
*f
= check_x_frame (frame
);
5937 int id
= lookup_image (f
, spec
);
5938 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5943 error ("Invalid image specification");
5950 /***********************************************************************
5951 Image type independent image structures
5952 ***********************************************************************/
5954 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5955 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5958 /* Allocate and return a new image structure for image specification
5959 SPEC. SPEC has a hash value of HASH. */
5961 static struct image
*
5962 make_image (spec
, hash
)
5966 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5968 xassert (valid_image_p (spec
));
5969 bzero (img
, sizeof *img
);
5970 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5971 xassert (img
->type
!= NULL
);
5973 img
->data
.lisp_val
= Qnil
;
5974 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5980 /* Free image IMG which was used on frame F, including its resources. */
5989 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5991 /* Remove IMG from the hash table of its cache. */
5993 img
->prev
->next
= img
->next
;
5995 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5998 img
->next
->prev
= img
->prev
;
6000 c
->images
[img
->id
] = NULL
;
6002 /* Free resources, then free IMG. */
6003 img
->type
->free (f
, img
);
6009 /* Prepare image IMG for display on frame F. Must be called before
6010 drawing an image. */
6013 prepare_image_for_display (f
, img
)
6019 /* We're about to display IMG, so set its timestamp to `now'. */
6021 img
->timestamp
= EMACS_SECS (t
);
6023 /* If IMG doesn't have a pixmap yet, load it now, using the image
6024 type dependent loader function. */
6025 if (img
->pixmap
== None
&& !img
->load_failed_p
)
6026 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6030 /* Value is the number of pixels for the ascent of image IMG when
6031 drawn in face FACE. */
6034 image_ascent (img
, face
)
6038 int height
= img
->height
+ img
->vmargin
;
6041 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
6044 /* This expression is arranged so that if the image can't be
6045 exactly centered, it will be moved slightly up. This is
6046 because a typical font is `top-heavy' (due to the presence
6047 uppercase letters), so the image placement should err towards
6048 being top-heavy too. It also just generally looks better. */
6049 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
6051 ascent
= height
/ 2;
6054 ascent
= height
* img
->ascent
/ 100.0;
6060 /* Image background colors. */
6062 static unsigned long
6063 four_corners_best (ximg
, width
, height
)
6065 unsigned long width
, height
;
6067 unsigned long corners
[4], best
;
6070 /* Get the colors at the corners of ximg. */
6071 corners
[0] = XGetPixel (ximg
, 0, 0);
6072 corners
[1] = XGetPixel (ximg
, width
- 1, 0);
6073 corners
[2] = XGetPixel (ximg
, width
- 1, height
- 1);
6074 corners
[3] = XGetPixel (ximg
, 0, height
- 1);
6076 /* Choose the most frequently found color as background. */
6077 for (i
= best_count
= 0; i
< 4; ++i
)
6081 for (j
= n
= 0; j
< 4; ++j
)
6082 if (corners
[i
] == corners
[j
])
6086 best
= corners
[i
], best_count
= n
;
6092 /* Return the `background' field of IMG. If IMG doesn't have one yet,
6093 it is guessed heuristically. If non-zero, XIMG is an existing XImage
6094 object to use for the heuristic. */
6097 image_background (img
, f
, ximg
)
6102 if (! img
->background_valid
)
6103 /* IMG doesn't have a background yet, try to guess a reasonable value. */
6105 int free_ximg
= !ximg
;
6108 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
6109 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
6111 img
->background
= four_corners_best (ximg
, img
->width
, img
->height
);
6114 XDestroyImage (ximg
);
6116 img
->background_valid
= 1;
6119 return img
->background
;
6122 /* Return the `background_transparent' field of IMG. If IMG doesn't
6123 have one yet, it is guessed heuristically. If non-zero, MASK is an
6124 existing XImage object to use for the heuristic. */
6127 image_background_transparent (img
, f
, mask
)
6132 if (! img
->background_transparent_valid
)
6133 /* IMG doesn't have a background yet, try to guess a reasonable value. */
6137 int free_mask
= !mask
;
6140 mask
= XGetImage (FRAME_X_DISPLAY (f
), img
->mask
,
6141 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
6143 img
->background_transparent
6144 = !four_corners_best (mask
, img
->width
, img
->height
);
6147 XDestroyImage (mask
);
6150 img
->background_transparent
= 0;
6152 img
->background_transparent_valid
= 1;
6155 return img
->background_transparent
;
6159 /***********************************************************************
6160 Helper functions for X image types
6161 ***********************************************************************/
6163 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
6165 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
6166 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
6168 Lisp_Object color_name
,
6169 unsigned long dflt
));
6172 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
6173 free the pixmap if any. MASK_P non-zero means clear the mask
6174 pixmap if any. COLORS_P non-zero means free colors allocated for
6175 the image, if any. */
6178 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
6181 int pixmap_p
, mask_p
, colors_p
;
6183 if (pixmap_p
&& img
->pixmap
)
6185 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
6187 img
->background_valid
= 0;
6190 if (mask_p
&& img
->mask
)
6192 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6194 img
->background_transparent_valid
= 0;
6197 if (colors_p
&& img
->ncolors
)
6199 x_free_colors (f
, img
->colors
, img
->ncolors
);
6200 xfree (img
->colors
);
6206 /* Free X resources of image IMG which is used on frame F. */
6209 x_clear_image (f
, img
)
6214 x_clear_image_1 (f
, img
, 1, 1, 1);
6219 /* Allocate color COLOR_NAME for image IMG on frame F. If color
6220 cannot be allocated, use DFLT. Add a newly allocated color to
6221 IMG->colors, so that it can be freed again. Value is the pixel
6224 static unsigned long
6225 x_alloc_image_color (f
, img
, color_name
, dflt
)
6228 Lisp_Object color_name
;
6232 unsigned long result
;
6234 xassert (STRINGP (color_name
));
6236 if (x_defined_color (f
, SDATA (color_name
), &color
, 1))
6238 /* This isn't called frequently so we get away with simply
6239 reallocating the color vector to the needed size, here. */
6242 (unsigned long *) xrealloc (img
->colors
,
6243 img
->ncolors
* sizeof *img
->colors
);
6244 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
6245 result
= color
.pixel
;
6255 /***********************************************************************
6257 ***********************************************************************/
6259 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
6260 static void postprocess_image
P_ ((struct frame
*, struct image
*));
6263 /* Return a new, initialized image cache that is allocated from the
6264 heap. Call free_image_cache to free an image cache. */
6266 struct image_cache
*
6269 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
6272 bzero (c
, sizeof *c
);
6274 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
6275 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
6276 c
->buckets
= (struct image
**) xmalloc (size
);
6277 bzero (c
->buckets
, size
);
6282 /* Free image cache of frame F. Be aware that X frames share images
6286 free_image_cache (f
)
6289 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6294 /* Cache should not be referenced by any frame when freed. */
6295 xassert (c
->refcount
== 0);
6297 for (i
= 0; i
< c
->used
; ++i
)
6298 free_image (f
, c
->images
[i
]);
6302 FRAME_X_IMAGE_CACHE (f
) = NULL
;
6307 /* Clear image cache of frame F. FORCE_P non-zero means free all
6308 images. FORCE_P zero means clear only images that haven't been
6309 displayed for some time. Should be called from time to time to
6310 reduce the number of loaded images. If image-eviction-seconds is
6311 non-nil, this frees images in the cache which weren't displayed for
6312 at least that many seconds. */
6315 clear_image_cache (f
, force_p
)
6319 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6321 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
6328 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
6330 /* Block input so that we won't be interrupted by a SIGIO
6331 while being in an inconsistent state. */
6334 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
6336 struct image
*img
= c
->images
[i
];
6338 && (force_p
|| img
->timestamp
< old
))
6340 free_image (f
, img
);
6345 /* We may be clearing the image cache because, for example,
6346 Emacs was iconified for a longer period of time. In that
6347 case, current matrices may still contain references to
6348 images freed above. So, clear these matrices. */
6351 Lisp_Object tail
, frame
;
6353 FOR_EACH_FRAME (tail
, frame
)
6355 struct frame
*f
= XFRAME (frame
);
6357 && FRAME_X_IMAGE_CACHE (f
) == c
)
6358 clear_current_matrices (f
);
6361 ++windows_or_buffers_changed
;
6369 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
6371 doc
: /* Clear the image cache of FRAME.
6372 FRAME nil or omitted means use the selected frame.
6373 FRAME t means clear the image caches of all frames. */)
6381 FOR_EACH_FRAME (tail
, frame
)
6382 if (FRAME_X_P (XFRAME (frame
)))
6383 clear_image_cache (XFRAME (frame
), 1);
6386 clear_image_cache (check_x_frame (frame
), 1);
6392 /* Compute masks and transform image IMG on frame F, as specified
6393 by the image's specification, */
6396 postprocess_image (f
, img
)
6400 /* Manipulation of the image's mask. */
6403 Lisp_Object conversion
, spec
;
6408 /* `:heuristic-mask t'
6410 means build a mask heuristically.
6411 `:heuristic-mask (R G B)'
6412 `:mask (heuristic (R G B))'
6413 means build a mask from color (R G B) in the
6416 means remove a mask, if any. */
6418 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6420 x_build_heuristic_mask (f
, img
, mask
);
6425 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6427 if (EQ (mask
, Qheuristic
))
6428 x_build_heuristic_mask (f
, img
, Qt
);
6429 else if (CONSP (mask
)
6430 && EQ (XCAR (mask
), Qheuristic
))
6432 if (CONSP (XCDR (mask
)))
6433 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6435 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6437 else if (NILP (mask
) && found_p
&& img
->mask
)
6439 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6445 /* Should we apply an image transformation algorithm? */
6446 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6447 if (EQ (conversion
, Qdisabled
))
6448 x_disable_image (f
, img
);
6449 else if (EQ (conversion
, Qlaplace
))
6451 else if (EQ (conversion
, Qemboss
))
6453 else if (CONSP (conversion
)
6454 && EQ (XCAR (conversion
), Qedge_detection
))
6457 tem
= XCDR (conversion
);
6459 x_edge_detection (f
, img
,
6460 Fplist_get (tem
, QCmatrix
),
6461 Fplist_get (tem
, QCcolor_adjustment
));
6467 /* Return the id of image with Lisp specification SPEC on frame F.
6468 SPEC must be a valid Lisp image specification (see valid_image_p). */
6471 lookup_image (f
, spec
)
6475 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6479 struct gcpro gcpro1
;
6482 /* F must be a window-system frame, and SPEC must be a valid image
6484 xassert (FRAME_WINDOW_P (f
));
6485 xassert (valid_image_p (spec
));
6489 /* Look up SPEC in the hash table of the image cache. */
6490 hash
= sxhash (spec
, 0);
6491 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6493 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6494 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6497 /* If not found, create a new image and cache it. */
6500 extern Lisp_Object Qpostscript
;
6503 img
= make_image (spec
, hash
);
6504 cache_image (f
, img
);
6505 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6507 /* If we can't load the image, and we don't have a width and
6508 height, use some arbitrary width and height so that we can
6509 draw a rectangle for it. */
6510 if (img
->load_failed_p
)
6514 value
= image_spec_value (spec
, QCwidth
, NULL
);
6515 img
->width
= (INTEGERP (value
)
6516 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6517 value
= image_spec_value (spec
, QCheight
, NULL
);
6518 img
->height
= (INTEGERP (value
)
6519 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6523 /* Handle image type independent image attributes
6524 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
6525 `:background COLOR'. */
6526 Lisp_Object ascent
, margin
, relief
, bg
;
6528 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6529 if (INTEGERP (ascent
))
6530 img
->ascent
= XFASTINT (ascent
);
6531 else if (EQ (ascent
, Qcenter
))
6532 img
->ascent
= CENTERED_IMAGE_ASCENT
;
6534 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6535 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6536 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
6537 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
6538 && INTEGERP (XCDR (margin
)))
6540 if (XINT (XCAR (margin
)) > 0)
6541 img
->hmargin
= XFASTINT (XCAR (margin
));
6542 if (XINT (XCDR (margin
)) > 0)
6543 img
->vmargin
= XFASTINT (XCDR (margin
));
6546 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6547 if (INTEGERP (relief
))
6549 img
->relief
= XINT (relief
);
6550 img
->hmargin
+= abs (img
->relief
);
6551 img
->vmargin
+= abs (img
->relief
);
6554 if (! img
->background_valid
)
6556 bg
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6560 = x_alloc_image_color (f
, img
, bg
,
6561 FRAME_BACKGROUND_PIXEL (f
));
6562 img
->background_valid
= 1;
6566 /* Do image transformations and compute masks, unless we
6567 don't have the image yet. */
6568 if (!EQ (*img
->type
->type
, Qpostscript
))
6569 postprocess_image (f
, img
);
6573 xassert (!interrupt_input_blocked
);
6576 /* We're using IMG, so set its timestamp to `now'. */
6577 EMACS_GET_TIME (now
);
6578 img
->timestamp
= EMACS_SECS (now
);
6582 /* Value is the image id. */
6587 /* Cache image IMG in the image cache of frame F. */
6590 cache_image (f
, img
)
6594 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6597 /* Find a free slot in c->images. */
6598 for (i
= 0; i
< c
->used
; ++i
)
6599 if (c
->images
[i
] == NULL
)
6602 /* If no free slot found, maybe enlarge c->images. */
6603 if (i
== c
->used
&& c
->used
== c
->size
)
6606 c
->images
= (struct image
**) xrealloc (c
->images
,
6607 c
->size
* sizeof *c
->images
);
6610 /* Add IMG to c->images, and assign IMG an id. */
6616 /* Add IMG to the cache's hash table. */
6617 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6618 img
->next
= c
->buckets
[i
];
6620 img
->next
->prev
= img
;
6622 c
->buckets
[i
] = img
;
6626 /* Call FN on every image in the image cache of frame F. Used to mark
6627 Lisp Objects in the image cache. */
6630 forall_images_in_image_cache (f
, fn
)
6632 void (*fn
) P_ ((struct image
*img
));
6634 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6636 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6640 for (i
= 0; i
< c
->used
; ++i
)
6649 /***********************************************************************
6651 ***********************************************************************/
6653 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6654 XImage
**, Pixmap
*));
6655 static void x_destroy_x_image
P_ ((XImage
*));
6656 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6659 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6660 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6661 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6662 via xmalloc. Print error messages via image_error if an error
6663 occurs. Value is non-zero if successful. */
6666 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6668 int width
, height
, depth
;
6672 Display
*display
= FRAME_X_DISPLAY (f
);
6673 Screen
*screen
= FRAME_X_SCREEN (f
);
6674 Window window
= FRAME_X_WINDOW (f
);
6676 xassert (interrupt_input_blocked
);
6679 depth
= DefaultDepthOfScreen (screen
);
6680 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6681 depth
, ZPixmap
, 0, NULL
, width
, height
,
6682 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6685 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6689 /* Allocate image raster. */
6690 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6692 /* Allocate a pixmap of the same size. */
6693 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6694 if (*pixmap
== None
)
6696 x_destroy_x_image (*ximg
);
6698 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6706 /* Destroy XImage XIMG. Free XIMG->data. */
6709 x_destroy_x_image (ximg
)
6712 xassert (interrupt_input_blocked
);
6717 XDestroyImage (ximg
);
6722 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6723 are width and height of both the image and pixmap. */
6726 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6734 xassert (interrupt_input_blocked
);
6735 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6736 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6737 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6742 /***********************************************************************
6744 ***********************************************************************/
6746 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6747 static char *slurp_file
P_ ((char *, int *));
6750 /* Find image file FILE. Look in data-directory, then
6751 x-bitmap-file-path. Value is the full name of the file found, or
6752 nil if not found. */
6755 x_find_image_file (file
)
6758 Lisp_Object file_found
, search_path
;
6759 struct gcpro gcpro1
, gcpro2
;
6763 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6764 GCPRO2 (file_found
, search_path
);
6766 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6767 fd
= openp (search_path
, file
, Qnil
, &file_found
, Qnil
);
6779 /* Read FILE into memory. Value is a pointer to a buffer allocated
6780 with xmalloc holding FILE's contents. Value is null if an error
6781 occurred. *SIZE is set to the size of the file. */
6784 slurp_file (file
, size
)
6792 if (stat (file
, &st
) == 0
6793 && (fp
= fopen (file
, "r")) != NULL
6794 && (buf
= (char *) xmalloc (st
.st_size
),
6795 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6816 /***********************************************************************
6818 ***********************************************************************/
6820 static int xbm_scan
P_ ((char **, char *, char *, int *));
6821 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6822 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6824 static int xbm_image_p
P_ ((Lisp_Object object
));
6825 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6827 static int xbm_file_p
P_ ((Lisp_Object
));
6830 /* Indices of image specification fields in xbm_format, below. */
6832 enum xbm_keyword_index
6850 /* Vector of image_keyword structures describing the format
6851 of valid XBM image specifications. */
6853 static struct image_keyword xbm_format
[XBM_LAST
] =
6855 {":type", IMAGE_SYMBOL_VALUE
, 1},
6856 {":file", IMAGE_STRING_VALUE
, 0},
6857 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6858 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6859 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6860 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
6861 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
6862 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6863 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6864 {":relief", IMAGE_INTEGER_VALUE
, 0},
6865 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6866 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6867 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6870 /* Structure describing the image type XBM. */
6872 static struct image_type xbm_type
=
6881 /* Tokens returned from xbm_scan. */
6890 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6891 A valid specification is a list starting with the symbol `image'
6892 The rest of the list is a property list which must contain an
6895 If the specification specifies a file to load, it must contain
6896 an entry `:file FILENAME' where FILENAME is a string.
6898 If the specification is for a bitmap loaded from memory it must
6899 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6900 WIDTH and HEIGHT are integers > 0. DATA may be:
6902 1. a string large enough to hold the bitmap data, i.e. it must
6903 have a size >= (WIDTH + 7) / 8 * HEIGHT
6905 2. a bool-vector of size >= WIDTH * HEIGHT
6907 3. a vector of strings or bool-vectors, one for each line of the
6910 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6911 may not be specified in this case because they are defined in the
6914 Both the file and data forms may contain the additional entries
6915 `:background COLOR' and `:foreground COLOR'. If not present,
6916 foreground and background of the frame on which the image is
6917 displayed is used. */
6920 xbm_image_p (object
)
6923 struct image_keyword kw
[XBM_LAST
];
6925 bcopy (xbm_format
, kw
, sizeof kw
);
6926 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6929 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6931 if (kw
[XBM_FILE
].count
)
6933 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6936 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6938 /* In-memory XBM file. */
6939 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6947 /* Entries for `:width', `:height' and `:data' must be present. */
6948 if (!kw
[XBM_WIDTH
].count
6949 || !kw
[XBM_HEIGHT
].count
6950 || !kw
[XBM_DATA
].count
)
6953 data
= kw
[XBM_DATA
].value
;
6954 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6955 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6957 /* Check type of data, and width and height against contents of
6963 /* Number of elements of the vector must be >= height. */
6964 if (XVECTOR (data
)->size
< height
)
6967 /* Each string or bool-vector in data must be large enough
6968 for one line of the image. */
6969 for (i
= 0; i
< height
; ++i
)
6971 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6976 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6979 else if (BOOL_VECTOR_P (elt
))
6981 if (XBOOL_VECTOR (elt
)->size
< width
)
6988 else if (STRINGP (data
))
6991 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6994 else if (BOOL_VECTOR_P (data
))
6996 if (XBOOL_VECTOR (data
)->size
< width
* height
)
7007 /* Scan a bitmap file. FP is the stream to read from. Value is
7008 either an enumerator from enum xbm_token, or a character for a
7009 single-character token, or 0 at end of file. If scanning an
7010 identifier, store the lexeme of the identifier in SVAL. If
7011 scanning a number, store its value in *IVAL. */
7014 xbm_scan (s
, end
, sval
, ival
)
7023 /* Skip white space. */
7024 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
7029 else if (isdigit (c
))
7031 int value
= 0, digit
;
7033 if (c
== '0' && *s
< end
)
7036 if (c
== 'x' || c
== 'X')
7043 else if (c
>= 'a' && c
<= 'f')
7044 digit
= c
- 'a' + 10;
7045 else if (c
>= 'A' && c
<= 'F')
7046 digit
= c
- 'A' + 10;
7049 value
= 16 * value
+ digit
;
7052 else if (isdigit (c
))
7056 && (c
= *(*s
)++, isdigit (c
)))
7057 value
= 8 * value
+ c
- '0';
7064 && (c
= *(*s
)++, isdigit (c
)))
7065 value
= 10 * value
+ c
- '0';
7073 else if (isalpha (c
) || c
== '_')
7077 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
7084 else if (c
== '/' && **s
== '*')
7086 /* C-style comment. */
7088 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
7101 /* Replacement for XReadBitmapFileData which isn't available under old
7102 X versions. CONTENTS is a pointer to a buffer to parse; END is the
7103 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
7104 the image. Return in *DATA the bitmap data allocated with xmalloc.
7105 Value is non-zero if successful. DATA null means just test if
7106 CONTENTS looks like an in-memory XBM file. */
7109 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
7110 char *contents
, *end
;
7111 int *width
, *height
;
7112 unsigned char **data
;
7115 char buffer
[BUFSIZ
];
7118 int bytes_per_line
, i
, nbytes
;
7124 LA1 = xbm_scan (&s, end, buffer, &value)
7126 #define expect(TOKEN) \
7127 if (LA1 != (TOKEN)) \
7132 #define expect_ident(IDENT) \
7133 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
7138 *width
= *height
= -1;
7141 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
7143 /* Parse defines for width, height and hot-spots. */
7147 expect_ident ("define");
7148 expect (XBM_TK_IDENT
);
7150 if (LA1
== XBM_TK_NUMBER
);
7152 char *p
= strrchr (buffer
, '_');
7153 p
= p
? p
+ 1 : buffer
;
7154 if (strcmp (p
, "width") == 0)
7156 else if (strcmp (p
, "height") == 0)
7159 expect (XBM_TK_NUMBER
);
7162 if (*width
< 0 || *height
< 0)
7164 else if (data
== NULL
)
7167 /* Parse bits. Must start with `static'. */
7168 expect_ident ("static");
7169 if (LA1
== XBM_TK_IDENT
)
7171 if (strcmp (buffer
, "unsigned") == 0)
7174 expect_ident ("char");
7176 else if (strcmp (buffer
, "short") == 0)
7180 if (*width
% 16 && *width
% 16 < 9)
7183 else if (strcmp (buffer
, "char") == 0)
7191 expect (XBM_TK_IDENT
);
7197 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
7198 nbytes
= bytes_per_line
* *height
;
7199 p
= *data
= (char *) xmalloc (nbytes
);
7203 for (i
= 0; i
< nbytes
; i
+= 2)
7206 expect (XBM_TK_NUMBER
);
7209 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
7212 if (LA1
== ',' || LA1
== '}')
7220 for (i
= 0; i
< nbytes
; ++i
)
7223 expect (XBM_TK_NUMBER
);
7227 if (LA1
== ',' || LA1
== '}')
7252 /* Load XBM image IMG which will be displayed on frame F from buffer
7253 CONTENTS. END is the end of the buffer. Value is non-zero if
7257 xbm_load_image (f
, img
, contents
, end
)
7260 char *contents
, *end
;
7263 unsigned char *data
;
7266 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
7269 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7270 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7271 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7274 xassert (img
->width
> 0 && img
->height
> 0);
7276 /* Get foreground and background colors, maybe allocate colors. */
7277 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
7279 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
7280 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
7283 background
= x_alloc_image_color (f
, img
, value
, background
);
7284 img
->background
= background
;
7285 img
->background_valid
= 1;
7289 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7292 img
->width
, img
->height
,
7293 foreground
, background
,
7297 if (img
->pixmap
== None
)
7299 x_clear_image (f
, img
);
7300 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
7306 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7312 /* Value is non-zero if DATA looks like an in-memory XBM file. */
7319 return (STRINGP (data
)
7320 && xbm_read_bitmap_data (SDATA (data
),
7327 /* Fill image IMG which is used on frame F with pixmap data. Value is
7328 non-zero if successful. */
7336 Lisp_Object file_name
;
7338 xassert (xbm_image_p (img
->spec
));
7340 /* If IMG->spec specifies a file name, create a non-file spec from it. */
7341 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
7342 if (STRINGP (file_name
))
7347 struct gcpro gcpro1
;
7349 file
= x_find_image_file (file_name
);
7351 if (!STRINGP (file
))
7353 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
7358 contents
= slurp_file (SDATA (file
), &size
);
7359 if (contents
== NULL
)
7361 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7366 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
7371 struct image_keyword fmt
[XBM_LAST
];
7374 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7375 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7378 int in_memory_file_p
= 0;
7380 /* See if data looks like an in-memory XBM file. */
7381 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7382 in_memory_file_p
= xbm_file_p (data
);
7384 /* Parse the image specification. */
7385 bcopy (xbm_format
, fmt
, sizeof fmt
);
7386 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
7389 /* Get specified width, and height. */
7390 if (!in_memory_file_p
)
7392 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
7393 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
7394 xassert (img
->width
> 0 && img
->height
> 0);
7397 /* Get foreground and background colors, maybe allocate colors. */
7398 if (fmt
[XBM_FOREGROUND
].count
7399 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
7400 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
7402 if (fmt
[XBM_BACKGROUND
].count
7403 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
7404 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
7407 if (in_memory_file_p
)
7408 success_p
= xbm_load_image (f
, img
, SDATA (data
),
7417 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
7419 p
= bits
= (char *) alloca (nbytes
* img
->height
);
7420 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
7422 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
7424 bcopy (SDATA (line
), p
, nbytes
);
7426 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
7429 else if (STRINGP (data
))
7430 bits
= SDATA (data
);
7432 bits
= XBOOL_VECTOR (data
)->data
;
7434 /* Create the pixmap. */
7435 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7437 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7440 img
->width
, img
->height
,
7441 foreground
, background
,
7447 image_error ("Unable to create pixmap for XBM image `%s'",
7449 x_clear_image (f
, img
);
7459 /***********************************************************************
7461 ***********************************************************************/
7465 static int xpm_image_p
P_ ((Lisp_Object object
));
7466 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
7467 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
7469 #include "X11/xpm.h"
7471 /* The symbol `xpm' identifying XPM-format images. */
7475 /* Indices of image specification fields in xpm_format, below. */
7477 enum xpm_keyword_index
7493 /* Vector of image_keyword structures describing the format
7494 of valid XPM image specifications. */
7496 static struct image_keyword xpm_format
[XPM_LAST
] =
7498 {":type", IMAGE_SYMBOL_VALUE
, 1},
7499 {":file", IMAGE_STRING_VALUE
, 0},
7500 {":data", IMAGE_STRING_VALUE
, 0},
7501 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7502 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7503 {":relief", IMAGE_INTEGER_VALUE
, 0},
7504 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7505 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7506 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7507 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7508 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
7511 /* Structure describing the image type XBM. */
7513 static struct image_type xpm_type
=
7523 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7524 functions for allocating image colors. Our own functions handle
7525 color allocation failures more gracefully than the ones on the XPM
7528 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7529 #define ALLOC_XPM_COLORS
7532 #ifdef ALLOC_XPM_COLORS
7534 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7535 static void xpm_free_color_cache
P_ ((void));
7536 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7537 static int xpm_color_bucket
P_ ((char *));
7538 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7541 /* An entry in a hash table used to cache color definitions of named
7542 colors. This cache is necessary to speed up XPM image loading in
7543 case we do color allocations ourselves. Without it, we would need
7544 a call to XParseColor per pixel in the image. */
7546 struct xpm_cached_color
7548 /* Next in collision chain. */
7549 struct xpm_cached_color
*next
;
7551 /* Color definition (RGB and pixel color). */
7558 /* The hash table used for the color cache, and its bucket vector
7561 #define XPM_COLOR_CACHE_BUCKETS 1001
7562 struct xpm_cached_color
**xpm_color_cache
;
7564 /* Initialize the color cache. */
7567 xpm_init_color_cache (f
, attrs
)
7569 XpmAttributes
*attrs
;
7571 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7572 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7573 memset (xpm_color_cache
, 0, nbytes
);
7574 init_color_table ();
7576 if (attrs
->valuemask
& XpmColorSymbols
)
7581 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7582 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7583 attrs
->colorsymbols
[i
].value
, &color
))
7585 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7587 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7593 /* Free the color cache. */
7596 xpm_free_color_cache ()
7598 struct xpm_cached_color
*p
, *next
;
7601 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7602 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7608 xfree (xpm_color_cache
);
7609 xpm_color_cache
= NULL
;
7610 free_color_table ();
7614 /* Return the bucket index for color named COLOR_NAME in the color
7618 xpm_color_bucket (color_name
)
7624 for (s
= color_name
; *s
; ++s
)
7626 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7630 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7631 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7634 static struct xpm_cached_color
*
7635 xpm_cache_color (f
, color_name
, color
, bucket
)
7642 struct xpm_cached_color
*p
;
7645 bucket
= xpm_color_bucket (color_name
);
7647 nbytes
= sizeof *p
+ strlen (color_name
);
7648 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7649 strcpy (p
->name
, color_name
);
7651 p
->next
= xpm_color_cache
[bucket
];
7652 xpm_color_cache
[bucket
] = p
;
7657 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7658 return the cached definition in *COLOR. Otherwise, make a new
7659 entry in the cache and allocate the color. Value is zero if color
7660 allocation failed. */
7663 xpm_lookup_color (f
, color_name
, color
)
7668 struct xpm_cached_color
*p
;
7669 int h
= xpm_color_bucket (color_name
);
7671 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7672 if (strcmp (p
->name
, color_name
) == 0)
7677 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7680 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7682 p
= xpm_cache_color (f
, color_name
, color
, h
);
7689 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7690 CLOSURE is a pointer to the frame on which we allocate the
7691 color. Return in *COLOR the allocated color. Value is non-zero
7695 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7702 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7706 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7707 is a pointer to the frame on which we allocate the color. Value is
7708 non-zero if successful. */
7711 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7721 #endif /* ALLOC_XPM_COLORS */
7724 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7725 for XPM images. Such a list must consist of conses whose car and
7729 xpm_valid_color_symbols_p (color_symbols
)
7730 Lisp_Object color_symbols
;
7732 while (CONSP (color_symbols
))
7734 Lisp_Object sym
= XCAR (color_symbols
);
7736 || !STRINGP (XCAR (sym
))
7737 || !STRINGP (XCDR (sym
)))
7739 color_symbols
= XCDR (color_symbols
);
7742 return NILP (color_symbols
);
7746 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7749 xpm_image_p (object
)
7752 struct image_keyword fmt
[XPM_LAST
];
7753 bcopy (xpm_format
, fmt
, sizeof fmt
);
7754 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7755 /* Either `:file' or `:data' must be present. */
7756 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7757 /* Either no `:color-symbols' or it's a list of conses
7758 whose car and cdr are strings. */
7759 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7760 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7764 /* Load image IMG which will be displayed on frame F. Value is
7765 non-zero if successful. */
7773 XpmAttributes attrs
;
7774 Lisp_Object specified_file
, color_symbols
;
7776 /* Configure the XPM lib. Use the visual of frame F. Allocate
7777 close colors. Return colors allocated. */
7778 bzero (&attrs
, sizeof attrs
);
7779 attrs
.visual
= FRAME_X_VISUAL (f
);
7780 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7781 attrs
.valuemask
|= XpmVisual
;
7782 attrs
.valuemask
|= XpmColormap
;
7784 #ifdef ALLOC_XPM_COLORS
7785 /* Allocate colors with our own functions which handle
7786 failing color allocation more gracefully. */
7787 attrs
.color_closure
= f
;
7788 attrs
.alloc_color
= xpm_alloc_color
;
7789 attrs
.free_colors
= xpm_free_colors
;
7790 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7791 #else /* not ALLOC_XPM_COLORS */
7792 /* Let the XPM lib allocate colors. */
7793 attrs
.valuemask
|= XpmReturnAllocPixels
;
7794 #ifdef XpmAllocCloseColors
7795 attrs
.alloc_close_colors
= 1;
7796 attrs
.valuemask
|= XpmAllocCloseColors
;
7797 #else /* not XpmAllocCloseColors */
7798 attrs
.closeness
= 600;
7799 attrs
.valuemask
|= XpmCloseness
;
7800 #endif /* not XpmAllocCloseColors */
7801 #endif /* ALLOC_XPM_COLORS */
7803 /* If image specification contains symbolic color definitions, add
7804 these to `attrs'. */
7805 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7806 if (CONSP (color_symbols
))
7809 XpmColorSymbol
*xpm_syms
;
7812 attrs
.valuemask
|= XpmColorSymbols
;
7814 /* Count number of symbols. */
7815 attrs
.numsymbols
= 0;
7816 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7819 /* Allocate an XpmColorSymbol array. */
7820 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7821 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7822 bzero (xpm_syms
, size
);
7823 attrs
.colorsymbols
= xpm_syms
;
7825 /* Fill the color symbol array. */
7826 for (tail
= color_symbols
, i
= 0;
7828 ++i
, tail
= XCDR (tail
))
7830 Lisp_Object name
= XCAR (XCAR (tail
));
7831 Lisp_Object color
= XCDR (XCAR (tail
));
7832 xpm_syms
[i
].name
= (char *) alloca (SCHARS (name
) + 1);
7833 strcpy (xpm_syms
[i
].name
, SDATA (name
));
7834 xpm_syms
[i
].value
= (char *) alloca (SCHARS (color
) + 1);
7835 strcpy (xpm_syms
[i
].value
, SDATA (color
));
7839 /* Create a pixmap for the image, either from a file, or from a
7840 string buffer containing data in the same format as an XPM file. */
7841 #ifdef ALLOC_XPM_COLORS
7842 xpm_init_color_cache (f
, &attrs
);
7845 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7846 if (STRINGP (specified_file
))
7848 Lisp_Object file
= x_find_image_file (specified_file
);
7849 if (!STRINGP (file
))
7851 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7855 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7856 SDATA (file
), &img
->pixmap
, &img
->mask
,
7861 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7862 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7864 &img
->pixmap
, &img
->mask
,
7868 if (rc
== XpmSuccess
)
7870 #ifdef ALLOC_XPM_COLORS
7871 img
->colors
= colors_in_color_table (&img
->ncolors
);
7872 #else /* not ALLOC_XPM_COLORS */
7875 img
->ncolors
= attrs
.nalloc_pixels
;
7876 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7877 * sizeof *img
->colors
);
7878 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7880 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7881 #ifdef DEBUG_X_COLORS
7882 register_color (img
->colors
[i
]);
7885 #endif /* not ALLOC_XPM_COLORS */
7887 img
->width
= attrs
.width
;
7888 img
->height
= attrs
.height
;
7889 xassert (img
->width
> 0 && img
->height
> 0);
7891 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7892 XpmFreeAttributes (&attrs
);
7899 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7902 case XpmFileInvalid
:
7903 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7907 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7910 case XpmColorFailed
:
7911 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7915 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7920 #ifdef ALLOC_XPM_COLORS
7921 xpm_free_color_cache ();
7923 return rc
== XpmSuccess
;
7926 #endif /* HAVE_XPM != 0 */
7929 /***********************************************************************
7931 ***********************************************************************/
7933 /* An entry in the color table mapping an RGB color to a pixel color. */
7938 unsigned long pixel
;
7940 /* Next in color table collision list. */
7941 struct ct_color
*next
;
7944 /* The bucket vector size to use. Must be prime. */
7948 /* Value is a hash of the RGB color given by R, G, and B. */
7950 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7952 /* The color hash table. */
7954 struct ct_color
**ct_table
;
7956 /* Number of entries in the color table. */
7958 int ct_colors_allocated
;
7960 /* Initialize the color table. */
7965 int size
= CT_SIZE
* sizeof (*ct_table
);
7966 ct_table
= (struct ct_color
**) xmalloc (size
);
7967 bzero (ct_table
, size
);
7968 ct_colors_allocated
= 0;
7972 /* Free memory associated with the color table. */
7978 struct ct_color
*p
, *next
;
7980 for (i
= 0; i
< CT_SIZE
; ++i
)
7981 for (p
= ct_table
[i
]; p
; p
= next
)
7992 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7993 entry for that color already is in the color table, return the
7994 pixel color of that entry. Otherwise, allocate a new color for R,
7995 G, B, and make an entry in the color table. */
7997 static unsigned long
7998 lookup_rgb_color (f
, r
, g
, b
)
8002 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
8003 int i
= hash
% CT_SIZE
;
8006 for (p
= ct_table
[i
]; p
; p
= p
->next
)
8007 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
8020 cmap
= FRAME_X_COLORMAP (f
);
8021 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
8025 ++ct_colors_allocated
;
8027 p
= (struct ct_color
*) xmalloc (sizeof *p
);
8031 p
->pixel
= color
.pixel
;
8032 p
->next
= ct_table
[i
];
8036 return FRAME_FOREGROUND_PIXEL (f
);
8043 /* Look up pixel color PIXEL which is used on frame F in the color
8044 table. If not already present, allocate it. Value is PIXEL. */
8046 static unsigned long
8047 lookup_pixel_color (f
, pixel
)
8049 unsigned long pixel
;
8051 int i
= pixel
% CT_SIZE
;
8054 for (p
= ct_table
[i
]; p
; p
= p
->next
)
8055 if (p
->pixel
== pixel
)
8064 cmap
= FRAME_X_COLORMAP (f
);
8065 color
.pixel
= pixel
;
8066 x_query_color (f
, &color
);
8067 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
8071 ++ct_colors_allocated
;
8073 p
= (struct ct_color
*) xmalloc (sizeof *p
);
8078 p
->next
= ct_table
[i
];
8082 return FRAME_FOREGROUND_PIXEL (f
);
8089 /* Value is a vector of all pixel colors contained in the color table,
8090 allocated via xmalloc. Set *N to the number of colors. */
8092 static unsigned long *
8093 colors_in_color_table (n
)
8098 unsigned long *colors
;
8100 if (ct_colors_allocated
== 0)
8107 colors
= (unsigned long *) xmalloc (ct_colors_allocated
8109 *n
= ct_colors_allocated
;
8111 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
8112 for (p
= ct_table
[i
]; p
; p
= p
->next
)
8113 colors
[j
++] = p
->pixel
;
8121 /***********************************************************************
8123 ***********************************************************************/
8125 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
8126 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
8127 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
8129 /* Non-zero means draw a cross on images having `:conversion
8132 int cross_disabled_images
;
8134 /* Edge detection matrices for different edge-detection
8137 static int emboss_matrix
[9] = {
8139 2, -1, 0, /* y - 1 */
8141 0, 1, -2 /* y + 1 */
8144 static int laplace_matrix
[9] = {
8146 1, 0, 0, /* y - 1 */
8148 0, 0, -1 /* y + 1 */
8151 /* Value is the intensity of the color whose red/green/blue values
8154 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
8157 /* On frame F, return an array of XColor structures describing image
8158 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
8159 non-zero means also fill the red/green/blue members of the XColor
8160 structures. Value is a pointer to the array of XColors structures,
8161 allocated with xmalloc; it must be freed by the caller. */
8164 x_to_xcolors (f
, img
, rgb_p
)
8173 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
8175 /* Get the X image IMG->pixmap. */
8176 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
8177 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
8179 /* Fill the `pixel' members of the XColor array. I wished there
8180 were an easy and portable way to circumvent XGetPixel. */
8182 for (y
= 0; y
< img
->height
; ++y
)
8186 for (x
= 0; x
< img
->width
; ++x
, ++p
)
8187 p
->pixel
= XGetPixel (ximg
, x
, y
);
8190 x_query_colors (f
, row
, img
->width
);
8193 XDestroyImage (ximg
);
8198 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
8199 RGB members are set. F is the frame on which this all happens.
8200 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
8203 x_from_xcolors (f
, img
, colors
)
8213 init_color_table ();
8215 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
8218 for (y
= 0; y
< img
->height
; ++y
)
8219 for (x
= 0; x
< img
->width
; ++x
, ++p
)
8221 unsigned long pixel
;
8222 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
8223 XPutPixel (oimg
, x
, y
, pixel
);
8227 x_clear_image_1 (f
, img
, 1, 0, 1);
8229 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
8230 x_destroy_x_image (oimg
);
8231 img
->pixmap
= pixmap
;
8232 img
->colors
= colors_in_color_table (&img
->ncolors
);
8233 free_color_table ();
8237 /* On frame F, perform edge-detection on image IMG.
8239 MATRIX is a nine-element array specifying the transformation
8240 matrix. See emboss_matrix for an example.
8242 COLOR_ADJUST is a color adjustment added to each pixel of the
8246 x_detect_edges (f
, img
, matrix
, color_adjust
)
8249 int matrix
[9], color_adjust
;
8251 XColor
*colors
= x_to_xcolors (f
, img
, 1);
8255 for (i
= sum
= 0; i
< 9; ++i
)
8256 sum
+= abs (matrix
[i
]);
8258 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
8260 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
8262 for (y
= 0; y
< img
->height
; ++y
)
8264 p
= COLOR (new, 0, y
);
8265 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8266 p
= COLOR (new, img
->width
- 1, y
);
8267 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8270 for (x
= 1; x
< img
->width
- 1; ++x
)
8272 p
= COLOR (new, x
, 0);
8273 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8274 p
= COLOR (new, x
, img
->height
- 1);
8275 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8278 for (y
= 1; y
< img
->height
- 1; ++y
)
8280 p
= COLOR (new, 1, y
);
8282 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
8284 int r
, g
, b
, y1
, x1
;
8287 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
8288 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
8291 XColor
*t
= COLOR (colors
, x1
, y1
);
8292 r
+= matrix
[i
] * t
->red
;
8293 g
+= matrix
[i
] * t
->green
;
8294 b
+= matrix
[i
] * t
->blue
;
8297 r
= (r
/ sum
+ color_adjust
) & 0xffff;
8298 g
= (g
/ sum
+ color_adjust
) & 0xffff;
8299 b
= (b
/ sum
+ color_adjust
) & 0xffff;
8300 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
8305 x_from_xcolors (f
, img
, new);
8311 /* Perform the pre-defined `emboss' edge-detection on image IMG
8319 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
8323 /* Perform the pre-defined `laplace' edge-detection on image IMG
8331 x_detect_edges (f
, img
, laplace_matrix
, 45000);
8335 /* Perform edge-detection on image IMG on frame F, with specified
8336 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
8338 MATRIX must be either
8340 - a list of at least 9 numbers in row-major form
8341 - a vector of at least 9 numbers
8343 COLOR_ADJUST nil means use a default; otherwise it must be a
8347 x_edge_detection (f
, img
, matrix
, color_adjust
)
8350 Lisp_Object matrix
, color_adjust
;
8358 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
8359 ++i
, matrix
= XCDR (matrix
))
8360 trans
[i
] = XFLOATINT (XCAR (matrix
));
8362 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
8364 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
8365 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
8368 if (NILP (color_adjust
))
8369 color_adjust
= make_number (0xffff / 2);
8371 if (i
== 9 && NUMBERP (color_adjust
))
8372 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
8376 /* Transform image IMG on frame F so that it looks disabled. */
8379 x_disable_image (f
, img
)
8383 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
8385 if (dpyinfo
->n_planes
>= 2)
8387 /* Color (or grayscale). Convert to gray, and equalize. Just
8388 drawing such images with a stipple can look very odd, so
8389 we're using this method instead. */
8390 XColor
*colors
= x_to_xcolors (f
, img
, 1);
8392 const int h
= 15000;
8393 const int l
= 30000;
8395 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
8399 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
8400 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
8401 p
->red
= p
->green
= p
->blue
= i2
;
8404 x_from_xcolors (f
, img
, colors
);
8407 /* Draw a cross over the disabled image, if we must or if we
8409 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
8411 Display
*dpy
= FRAME_X_DISPLAY (f
);
8414 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
8415 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
8416 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
8417 img
->width
- 1, img
->height
- 1);
8418 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
8424 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
8425 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
8426 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
8427 img
->width
- 1, img
->height
- 1);
8428 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
8436 /* Build a mask for image IMG which is used on frame F. FILE is the
8437 name of an image file, for error messages. HOW determines how to
8438 determine the background color of IMG. If it is a list '(R G B)',
8439 with R, G, and B being integers >= 0, take that as the color of the
8440 background. Otherwise, determine the background color of IMG
8441 heuristically. Value is non-zero if successful. */
8444 x_build_heuristic_mask (f
, img
, how
)
8449 Display
*dpy
= FRAME_X_DISPLAY (f
);
8450 XImage
*ximg
, *mask_img
;
8451 int x
, y
, rc
, use_img_background
;
8452 unsigned long bg
= 0;
8456 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8458 img
->background_transparent_valid
= 0;
8461 /* Create an image and pixmap serving as mask. */
8462 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
8463 &mask_img
, &img
->mask
);
8467 /* Get the X image of IMG->pixmap. */
8468 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
8471 /* Determine the background color of ximg. If HOW is `(R G B)'
8472 take that as color. Otherwise, use the image's background color. */
8473 use_img_background
= 1;
8479 for (i
= 0; i
< 3 && CONSP (how
) && NATNUMP (XCAR (how
)); ++i
)
8481 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
8485 if (i
== 3 && NILP (how
))
8487 char color_name
[30];
8488 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
8489 bg
= x_alloc_image_color (f
, img
, build_string (color_name
), 0);
8490 use_img_background
= 0;
8494 if (use_img_background
)
8495 bg
= four_corners_best (ximg
, img
->width
, img
->height
);
8497 /* Set all bits in mask_img to 1 whose color in ximg is different
8498 from the background color bg. */
8499 for (y
= 0; y
< img
->height
; ++y
)
8500 for (x
= 0; x
< img
->width
; ++x
)
8501 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8503 /* Fill in the background_transparent field while we have the mask handy. */
8504 image_background_transparent (img
, f
, mask_img
);
8506 /* Put mask_img into img->mask. */
8507 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8508 x_destroy_x_image (mask_img
);
8509 XDestroyImage (ximg
);
8516 /***********************************************************************
8517 PBM (mono, gray, color)
8518 ***********************************************************************/
8520 static int pbm_image_p
P_ ((Lisp_Object object
));
8521 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8522 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8524 /* The symbol `pbm' identifying images of this type. */
8528 /* Indices of image specification fields in gs_format, below. */
8530 enum pbm_keyword_index
8546 /* Vector of image_keyword structures describing the format
8547 of valid user-defined image specifications. */
8549 static struct image_keyword pbm_format
[PBM_LAST
] =
8551 {":type", IMAGE_SYMBOL_VALUE
, 1},
8552 {":file", IMAGE_STRING_VALUE
, 0},
8553 {":data", IMAGE_STRING_VALUE
, 0},
8554 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8555 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8556 {":relief", IMAGE_INTEGER_VALUE
, 0},
8557 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8558 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8559 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8560 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8561 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8564 /* Structure describing the image type `pbm'. */
8566 static struct image_type pbm_type
=
8576 /* Return non-zero if OBJECT is a valid PBM image specification. */
8579 pbm_image_p (object
)
8582 struct image_keyword fmt
[PBM_LAST
];
8584 bcopy (pbm_format
, fmt
, sizeof fmt
);
8586 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8589 /* Must specify either :data or :file. */
8590 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8594 /* Scan a decimal number from *S and return it. Advance *S while
8595 reading the number. END is the end of the string. Value is -1 at
8599 pbm_scan_number (s
, end
)
8600 unsigned char **s
, *end
;
8602 int c
= 0, val
= -1;
8606 /* Skip white-space. */
8607 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8612 /* Skip comment to end of line. */
8613 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8616 else if (isdigit (c
))
8618 /* Read decimal number. */
8620 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8621 val
= 10 * val
+ c
- '0';
8632 /* Load PBM image IMG for use on frame F. */
8640 int width
, height
, max_color_idx
= 0;
8642 Lisp_Object file
, specified_file
;
8643 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8644 struct gcpro gcpro1
;
8645 unsigned char *contents
= NULL
;
8646 unsigned char *end
, *p
;
8649 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8653 if (STRINGP (specified_file
))
8655 file
= x_find_image_file (specified_file
);
8656 if (!STRINGP (file
))
8658 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8663 contents
= slurp_file (SDATA (file
), &size
);
8664 if (contents
== NULL
)
8666 image_error ("Error reading `%s'", file
, Qnil
);
8672 end
= contents
+ size
;
8677 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8679 end
= p
+ SBYTES (data
);
8682 /* Check magic number. */
8683 if (end
- p
< 2 || *p
++ != 'P')
8685 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8695 raw_p
= 0, type
= PBM_MONO
;
8699 raw_p
= 0, type
= PBM_GRAY
;
8703 raw_p
= 0, type
= PBM_COLOR
;
8707 raw_p
= 1, type
= PBM_MONO
;
8711 raw_p
= 1, type
= PBM_GRAY
;
8715 raw_p
= 1, type
= PBM_COLOR
;
8719 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8723 /* Read width, height, maximum color-component. Characters
8724 starting with `#' up to the end of a line are ignored. */
8725 width
= pbm_scan_number (&p
, end
);
8726 height
= pbm_scan_number (&p
, end
);
8728 if (type
!= PBM_MONO
)
8730 max_color_idx
= pbm_scan_number (&p
, end
);
8731 if (raw_p
&& max_color_idx
> 255)
8732 max_color_idx
= 255;
8737 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8740 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8741 &ximg
, &img
->pixmap
))
8744 /* Initialize the color hash table. */
8745 init_color_table ();
8747 if (type
== PBM_MONO
)
8750 struct image_keyword fmt
[PBM_LAST
];
8751 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8752 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8754 /* Parse the image specification. */
8755 bcopy (pbm_format
, fmt
, sizeof fmt
);
8756 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8758 /* Get foreground and background colors, maybe allocate colors. */
8759 if (fmt
[PBM_FOREGROUND
].count
8760 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
8761 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8762 if (fmt
[PBM_BACKGROUND
].count
8763 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
8765 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8766 img
->background
= bg
;
8767 img
->background_valid
= 1;
8770 for (y
= 0; y
< height
; ++y
)
8771 for (x
= 0; x
< width
; ++x
)
8781 g
= pbm_scan_number (&p
, end
);
8783 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8788 for (y
= 0; y
< height
; ++y
)
8789 for (x
= 0; x
< width
; ++x
)
8793 if (type
== PBM_GRAY
)
8794 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8803 r
= pbm_scan_number (&p
, end
);
8804 g
= pbm_scan_number (&p
, end
);
8805 b
= pbm_scan_number (&p
, end
);
8808 if (r
< 0 || g
< 0 || b
< 0)
8812 XDestroyImage (ximg
);
8813 image_error ("Invalid pixel value in image `%s'",
8818 /* RGB values are now in the range 0..max_color_idx.
8819 Scale this to the range 0..0xffff supported by X. */
8820 r
= (double) r
* 65535 / max_color_idx
;
8821 g
= (double) g
* 65535 / max_color_idx
;
8822 b
= (double) b
* 65535 / max_color_idx
;
8823 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8827 /* Store in IMG->colors the colors allocated for the image, and
8828 free the color table. */
8829 img
->colors
= colors_in_color_table (&img
->ncolors
);
8830 free_color_table ();
8832 /* Maybe fill in the background field while we have ximg handy. */
8833 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
8834 IMAGE_BACKGROUND (img
, f
, ximg
);
8836 /* Put the image into a pixmap. */
8837 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8838 x_destroy_x_image (ximg
);
8841 img
->height
= height
;
8850 /***********************************************************************
8852 ***********************************************************************/
8858 /* Function prototypes. */
8860 static int png_image_p
P_ ((Lisp_Object object
));
8861 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8863 /* The symbol `png' identifying images of this type. */
8867 /* Indices of image specification fields in png_format, below. */
8869 enum png_keyword_index
8884 /* Vector of image_keyword structures describing the format
8885 of valid user-defined image specifications. */
8887 static struct image_keyword png_format
[PNG_LAST
] =
8889 {":type", IMAGE_SYMBOL_VALUE
, 1},
8890 {":data", IMAGE_STRING_VALUE
, 0},
8891 {":file", IMAGE_STRING_VALUE
, 0},
8892 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8893 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8894 {":relief", IMAGE_INTEGER_VALUE
, 0},
8895 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8896 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8897 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8898 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8901 /* Structure describing the image type `png'. */
8903 static struct image_type png_type
=
8913 /* Return non-zero if OBJECT is a valid PNG image specification. */
8916 png_image_p (object
)
8919 struct image_keyword fmt
[PNG_LAST
];
8920 bcopy (png_format
, fmt
, sizeof fmt
);
8922 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8925 /* Must specify either the :data or :file keyword. */
8926 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8930 /* Error and warning handlers installed when the PNG library
8934 my_png_error (png_ptr
, msg
)
8935 png_struct
*png_ptr
;
8938 xassert (png_ptr
!= NULL
);
8939 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8940 longjmp (png_ptr
->jmpbuf
, 1);
8945 my_png_warning (png_ptr
, msg
)
8946 png_struct
*png_ptr
;
8949 xassert (png_ptr
!= NULL
);
8950 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8953 /* Memory source for PNG decoding. */
8955 struct png_memory_storage
8957 unsigned char *bytes
; /* The data */
8958 size_t len
; /* How big is it? */
8959 int index
; /* Where are we? */
8963 /* Function set as reader function when reading PNG image from memory.
8964 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8965 bytes from the input to DATA. */
8968 png_read_from_memory (png_ptr
, data
, length
)
8969 png_structp png_ptr
;
8973 struct png_memory_storage
*tbr
8974 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8976 if (length
> tbr
->len
- tbr
->index
)
8977 png_error (png_ptr
, "Read error");
8979 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8980 tbr
->index
= tbr
->index
+ length
;
8983 /* Load PNG image IMG for use on frame F. Value is non-zero if
8991 Lisp_Object file
, specified_file
;
8992 Lisp_Object specified_data
;
8994 XImage
*ximg
, *mask_img
= NULL
;
8995 struct gcpro gcpro1
;
8996 png_struct
*png_ptr
= NULL
;
8997 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8998 FILE *volatile fp
= NULL
;
9000 png_byte
* volatile pixels
= NULL
;
9001 png_byte
** volatile rows
= NULL
;
9002 png_uint_32 width
, height
;
9003 int bit_depth
, color_type
, interlace_type
;
9005 png_uint_32 row_bytes
;
9007 double screen_gamma
, image_gamma
;
9009 struct png_memory_storage tbr
; /* Data to be read */
9011 /* Find out what file to load. */
9012 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9013 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9017 if (NILP (specified_data
))
9019 file
= x_find_image_file (specified_file
);
9020 if (!STRINGP (file
))
9022 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9027 /* Open the image file. */
9028 fp
= fopen (SDATA (file
), "rb");
9031 image_error ("Cannot open image file `%s'", file
, Qnil
);
9037 /* Check PNG signature. */
9038 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
9039 || !png_check_sig (sig
, sizeof sig
))
9041 image_error ("Not a PNG file: `%s'", file
, Qnil
);
9049 /* Read from memory. */
9050 tbr
.bytes
= SDATA (specified_data
);
9051 tbr
.len
= SBYTES (specified_data
);
9054 /* Check PNG signature. */
9055 if (tbr
.len
< sizeof sig
9056 || !png_check_sig (tbr
.bytes
, sizeof sig
))
9058 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
9063 /* Need to skip past the signature. */
9064 tbr
.bytes
+= sizeof (sig
);
9067 /* Initialize read and info structs for PNG lib. */
9068 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
9069 my_png_error
, my_png_warning
);
9072 if (fp
) fclose (fp
);
9077 info_ptr
= png_create_info_struct (png_ptr
);
9080 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
9081 if (fp
) fclose (fp
);
9086 end_info
= png_create_info_struct (png_ptr
);
9089 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
9090 if (fp
) fclose (fp
);
9095 /* Set error jump-back. We come back here when the PNG library
9096 detects an error. */
9097 if (setjmp (png_ptr
->jmpbuf
))
9101 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
9104 if (fp
) fclose (fp
);
9109 /* Read image info. */
9110 if (!NILP (specified_data
))
9111 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
9113 png_init_io (png_ptr
, fp
);
9115 png_set_sig_bytes (png_ptr
, sizeof sig
);
9116 png_read_info (png_ptr
, info_ptr
);
9117 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
9118 &interlace_type
, NULL
, NULL
);
9120 /* If image contains simply transparency data, we prefer to
9121 construct a clipping mask. */
9122 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
9127 /* This function is easier to write if we only have to handle
9128 one data format: RGB or RGBA with 8 bits per channel. Let's
9129 transform other formats into that format. */
9131 /* Strip more than 8 bits per channel. */
9132 if (bit_depth
== 16)
9133 png_set_strip_16 (png_ptr
);
9135 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
9137 png_set_expand (png_ptr
);
9139 /* Convert grayscale images to RGB. */
9140 if (color_type
== PNG_COLOR_TYPE_GRAY
9141 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
9142 png_set_gray_to_rgb (png_ptr
);
9144 screen_gamma
= (f
->gamma
? 1 / f
->gamma
/ 0.45455 : 2.2);
9146 #if 0 /* Avoid double gamma correction for PNG images. */
9147 /* Tell the PNG lib to handle gamma correction for us. */
9148 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
9149 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
9150 /* The libpng documentation says this is right in this case. */
9151 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
9154 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
9155 /* Image contains gamma information. */
9156 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
9158 /* Use the standard default for the image gamma. */
9159 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
9162 /* Handle alpha channel by combining the image with a background
9163 color. Do this only if a real alpha channel is supplied. For
9164 simple transparency, we prefer a clipping mask. */
9167 png_color_16
*image_bg
;
9168 Lisp_Object specified_bg
9169 = image_spec_value (img
->spec
, QCbackground
, NULL
);
9171 if (STRINGP (specified_bg
))
9172 /* The user specified `:background', use that. */
9175 if (x_defined_color (f
, SDATA (specified_bg
), &color
, 0))
9177 png_color_16 user_bg
;
9179 bzero (&user_bg
, sizeof user_bg
);
9180 user_bg
.red
= color
.red
;
9181 user_bg
.green
= color
.green
;
9182 user_bg
.blue
= color
.blue
;
9184 png_set_background (png_ptr
, &user_bg
,
9185 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
9188 else if (png_get_bKGD (png_ptr
, info_ptr
, &image_bg
))
9189 /* Image contains a background color with which to
9190 combine the image. */
9191 png_set_background (png_ptr
, image_bg
,
9192 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
9195 /* Image does not contain a background color with which
9196 to combine the image data via an alpha channel. Use
9197 the frame's background instead. */
9200 png_color_16 frame_background
;
9202 cmap
= FRAME_X_COLORMAP (f
);
9203 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
9204 x_query_color (f
, &color
);
9206 bzero (&frame_background
, sizeof frame_background
);
9207 frame_background
.red
= color
.red
;
9208 frame_background
.green
= color
.green
;
9209 frame_background
.blue
= color
.blue
;
9211 png_set_background (png_ptr
, &frame_background
,
9212 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
9216 /* Update info structure. */
9217 png_read_update_info (png_ptr
, info_ptr
);
9219 /* Get number of channels. Valid values are 1 for grayscale images
9220 and images with a palette, 2 for grayscale images with transparency
9221 information (alpha channel), 3 for RGB images, and 4 for RGB
9222 images with alpha channel, i.e. RGBA. If conversions above were
9223 sufficient we should only have 3 or 4 channels here. */
9224 channels
= png_get_channels (png_ptr
, info_ptr
);
9225 xassert (channels
== 3 || channels
== 4);
9227 /* Number of bytes needed for one row of the image. */
9228 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
9230 /* Allocate memory for the image. */
9231 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
9232 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
9233 for (i
= 0; i
< height
; ++i
)
9234 rows
[i
] = pixels
+ i
* row_bytes
;
9236 /* Read the entire image. */
9237 png_read_image (png_ptr
, rows
);
9238 png_read_end (png_ptr
, info_ptr
);
9245 /* Create the X image and pixmap. */
9246 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
9250 /* Create an image and pixmap serving as mask if the PNG image
9251 contains an alpha channel. */
9254 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
9255 &mask_img
, &img
->mask
))
9257 x_destroy_x_image (ximg
);
9258 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
9263 /* Fill the X image and mask from PNG data. */
9264 init_color_table ();
9266 for (y
= 0; y
< height
; ++y
)
9268 png_byte
*p
= rows
[y
];
9270 for (x
= 0; x
< width
; ++x
)
9277 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
9279 /* An alpha channel, aka mask channel, associates variable
9280 transparency with an image. Where other image formats
9281 support binary transparency---fully transparent or fully
9282 opaque---PNG allows up to 254 levels of partial transparency.
9283 The PNG library implements partial transparency by combining
9284 the image with a specified background color.
9286 I'm not sure how to handle this here nicely: because the
9287 background on which the image is displayed may change, for
9288 real alpha channel support, it would be necessary to create
9289 a new image for each possible background.
9291 What I'm doing now is that a mask is created if we have
9292 boolean transparency information. Otherwise I'm using
9293 the frame's background color to combine the image with. */
9298 XPutPixel (mask_img
, x
, y
, *p
> 0);
9304 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9305 /* Set IMG's background color from the PNG image, unless the user
9309 if (png_get_bKGD (png_ptr
, info_ptr
, &bg
))
9311 img
->background
= lookup_rgb_color (f
, bg
->red
, bg
->green
, bg
->blue
);
9312 img
->background_valid
= 1;
9316 /* Remember colors allocated for this image. */
9317 img
->colors
= colors_in_color_table (&img
->ncolors
);
9318 free_color_table ();
9321 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
9326 img
->height
= height
;
9328 /* Maybe fill in the background field while we have ximg handy. */
9329 IMAGE_BACKGROUND (img
, f
, ximg
);
9331 /* Put the image into the pixmap, then free the X image and its buffer. */
9332 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9333 x_destroy_x_image (ximg
);
9335 /* Same for the mask. */
9338 /* Fill in the background_transparent field while we have the mask
9340 image_background_transparent (img
, f
, mask_img
);
9342 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
9343 x_destroy_x_image (mask_img
);
9350 #endif /* HAVE_PNG != 0 */
9354 /***********************************************************************
9356 ***********************************************************************/
9360 /* Work around a warning about HAVE_STDLIB_H being redefined in
9362 #ifdef HAVE_STDLIB_H
9363 #define HAVE_STDLIB_H_1
9364 #undef HAVE_STDLIB_H
9365 #endif /* HAVE_STLIB_H */
9367 #include <jpeglib.h>
9371 #ifdef HAVE_STLIB_H_1
9372 #define HAVE_STDLIB_H 1
9375 static int jpeg_image_p
P_ ((Lisp_Object object
));
9376 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
9378 /* The symbol `jpeg' identifying images of this type. */
9382 /* Indices of image specification fields in gs_format, below. */
9384 enum jpeg_keyword_index
9393 JPEG_HEURISTIC_MASK
,
9399 /* Vector of image_keyword structures describing the format
9400 of valid user-defined image specifications. */
9402 static struct image_keyword jpeg_format
[JPEG_LAST
] =
9404 {":type", IMAGE_SYMBOL_VALUE
, 1},
9405 {":data", IMAGE_STRING_VALUE
, 0},
9406 {":file", IMAGE_STRING_VALUE
, 0},
9407 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9408 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9409 {":relief", IMAGE_INTEGER_VALUE
, 0},
9410 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9411 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9412 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9413 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9416 /* Structure describing the image type `jpeg'. */
9418 static struct image_type jpeg_type
=
9428 /* Return non-zero if OBJECT is a valid JPEG image specification. */
9431 jpeg_image_p (object
)
9434 struct image_keyword fmt
[JPEG_LAST
];
9436 bcopy (jpeg_format
, fmt
, sizeof fmt
);
9438 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
9441 /* Must specify either the :data or :file keyword. */
9442 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
9446 struct my_jpeg_error_mgr
9448 struct jpeg_error_mgr pub
;
9449 jmp_buf setjmp_buffer
;
9454 my_error_exit (cinfo
)
9457 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
9458 longjmp (mgr
->setjmp_buffer
, 1);
9462 /* Init source method for JPEG data source manager. Called by
9463 jpeg_read_header() before any data is actually read. See
9464 libjpeg.doc from the JPEG lib distribution. */
9467 our_init_source (cinfo
)
9468 j_decompress_ptr cinfo
;
9473 /* Fill input buffer method for JPEG data source manager. Called
9474 whenever more data is needed. We read the whole image in one step,
9475 so this only adds a fake end of input marker at the end. */
9478 our_fill_input_buffer (cinfo
)
9479 j_decompress_ptr cinfo
;
9481 /* Insert a fake EOI marker. */
9482 struct jpeg_source_mgr
*src
= cinfo
->src
;
9483 static JOCTET buffer
[2];
9485 buffer
[0] = (JOCTET
) 0xFF;
9486 buffer
[1] = (JOCTET
) JPEG_EOI
;
9488 src
->next_input_byte
= buffer
;
9489 src
->bytes_in_buffer
= 2;
9494 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9495 is the JPEG data source manager. */
9498 our_skip_input_data (cinfo
, num_bytes
)
9499 j_decompress_ptr cinfo
;
9502 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9506 if (num_bytes
> src
->bytes_in_buffer
)
9507 ERREXIT (cinfo
, JERR_INPUT_EOF
);
9509 src
->bytes_in_buffer
-= num_bytes
;
9510 src
->next_input_byte
+= num_bytes
;
9515 /* Method to terminate data source. Called by
9516 jpeg_finish_decompress() after all data has been processed. */
9519 our_term_source (cinfo
)
9520 j_decompress_ptr cinfo
;
9525 /* Set up the JPEG lib for reading an image from DATA which contains
9526 LEN bytes. CINFO is the decompression info structure created for
9527 reading the image. */
9530 jpeg_memory_src (cinfo
, data
, len
)
9531 j_decompress_ptr cinfo
;
9535 struct jpeg_source_mgr
*src
;
9537 if (cinfo
->src
== NULL
)
9539 /* First time for this JPEG object? */
9540 cinfo
->src
= (struct jpeg_source_mgr
*)
9541 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9542 sizeof (struct jpeg_source_mgr
));
9543 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9544 src
->next_input_byte
= data
;
9547 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9548 src
->init_source
= our_init_source
;
9549 src
->fill_input_buffer
= our_fill_input_buffer
;
9550 src
->skip_input_data
= our_skip_input_data
;
9551 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9552 src
->term_source
= our_term_source
;
9553 src
->bytes_in_buffer
= len
;
9554 src
->next_input_byte
= data
;
9558 /* Load image IMG for use on frame F. Patterned after example.c
9559 from the JPEG lib. */
9566 struct jpeg_decompress_struct cinfo
;
9567 struct my_jpeg_error_mgr mgr
;
9568 Lisp_Object file
, specified_file
;
9569 Lisp_Object specified_data
;
9570 FILE * volatile fp
= NULL
;
9572 int row_stride
, x
, y
;
9573 XImage
*ximg
= NULL
;
9575 unsigned long *colors
;
9577 struct gcpro gcpro1
;
9579 /* Open the JPEG file. */
9580 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9581 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9585 if (NILP (specified_data
))
9587 file
= x_find_image_file (specified_file
);
9588 if (!STRINGP (file
))
9590 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9595 fp
= fopen (SDATA (file
), "r");
9598 image_error ("Cannot open `%s'", file
, Qnil
);
9604 /* Customize libjpeg's error handling to call my_error_exit when an
9605 error is detected. This function will perform a longjmp. */
9606 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9607 mgr
.pub
.error_exit
= my_error_exit
;
9609 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9613 /* Called from my_error_exit. Display a JPEG error. */
9614 char buffer
[JMSG_LENGTH_MAX
];
9615 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9616 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9617 build_string (buffer
));
9620 /* Close the input file and destroy the JPEG object. */
9622 fclose ((FILE *) fp
);
9623 jpeg_destroy_decompress (&cinfo
);
9625 /* If we already have an XImage, free that. */
9626 x_destroy_x_image (ximg
);
9628 /* Free pixmap and colors. */
9629 x_clear_image (f
, img
);
9635 /* Create the JPEG decompression object. Let it read from fp.
9636 Read the JPEG image header. */
9637 jpeg_create_decompress (&cinfo
);
9639 if (NILP (specified_data
))
9640 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9642 jpeg_memory_src (&cinfo
, SDATA (specified_data
),
9643 SBYTES (specified_data
));
9645 jpeg_read_header (&cinfo
, TRUE
);
9647 /* Customize decompression so that color quantization will be used.
9648 Start decompression. */
9649 cinfo
.quantize_colors
= TRUE
;
9650 jpeg_start_decompress (&cinfo
);
9651 width
= img
->width
= cinfo
.output_width
;
9652 height
= img
->height
= cinfo
.output_height
;
9654 /* Create X image and pixmap. */
9655 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9656 longjmp (mgr
.setjmp_buffer
, 2);
9658 /* Allocate colors. When color quantization is used,
9659 cinfo.actual_number_of_colors has been set with the number of
9660 colors generated, and cinfo.colormap is a two-dimensional array
9661 of color indices in the range 0..cinfo.actual_number_of_colors.
9662 No more than 255 colors will be generated. */
9666 if (cinfo
.out_color_components
> 2)
9667 ir
= 0, ig
= 1, ib
= 2;
9668 else if (cinfo
.out_color_components
> 1)
9669 ir
= 0, ig
= 1, ib
= 0;
9671 ir
= 0, ig
= 0, ib
= 0;
9673 /* Use the color table mechanism because it handles colors that
9674 cannot be allocated nicely. Such colors will be replaced with
9675 a default color, and we don't have to care about which colors
9676 can be freed safely, and which can't. */
9677 init_color_table ();
9678 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9681 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9683 /* Multiply RGB values with 255 because X expects RGB values
9684 in the range 0..0xffff. */
9685 int r
= cinfo
.colormap
[ir
][i
] << 8;
9686 int g
= cinfo
.colormap
[ig
][i
] << 8;
9687 int b
= cinfo
.colormap
[ib
][i
] << 8;
9688 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9691 /* Remember those colors actually allocated. */
9692 img
->colors
= colors_in_color_table (&img
->ncolors
);
9693 free_color_table ();
9697 row_stride
= width
* cinfo
.output_components
;
9698 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9700 for (y
= 0; y
< height
; ++y
)
9702 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9703 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9704 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9708 jpeg_finish_decompress (&cinfo
);
9709 jpeg_destroy_decompress (&cinfo
);
9711 fclose ((FILE *) fp
);
9713 /* Maybe fill in the background field while we have ximg handy. */
9714 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9715 IMAGE_BACKGROUND (img
, f
, ximg
);
9717 /* Put the image into the pixmap. */
9718 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9719 x_destroy_x_image (ximg
);
9724 #endif /* HAVE_JPEG */
9728 /***********************************************************************
9730 ***********************************************************************/
9736 static int tiff_image_p
P_ ((Lisp_Object object
));
9737 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9739 /* The symbol `tiff' identifying images of this type. */
9743 /* Indices of image specification fields in tiff_format, below. */
9745 enum tiff_keyword_index
9754 TIFF_HEURISTIC_MASK
,
9760 /* Vector of image_keyword structures describing the format
9761 of valid user-defined image specifications. */
9763 static struct image_keyword tiff_format
[TIFF_LAST
] =
9765 {":type", IMAGE_SYMBOL_VALUE
, 1},
9766 {":data", IMAGE_STRING_VALUE
, 0},
9767 {":file", IMAGE_STRING_VALUE
, 0},
9768 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9769 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9770 {":relief", IMAGE_INTEGER_VALUE
, 0},
9771 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9772 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9773 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9774 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9777 /* Structure describing the image type `tiff'. */
9779 static struct image_type tiff_type
=
9789 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9792 tiff_image_p (object
)
9795 struct image_keyword fmt
[TIFF_LAST
];
9796 bcopy (tiff_format
, fmt
, sizeof fmt
);
9798 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9801 /* Must specify either the :data or :file keyword. */
9802 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9806 /* Reading from a memory buffer for TIFF images Based on the PNG
9807 memory source, but we have to provide a lot of extra functions.
9810 We really only need to implement read and seek, but I am not
9811 convinced that the TIFF library is smart enough not to destroy
9812 itself if we only hand it the function pointers we need to
9817 unsigned char *bytes
;
9825 tiff_read_from_memory (data
, buf
, size
)
9830 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9832 if (size
> src
->len
- src
->index
)
9834 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9841 tiff_write_from_memory (data
, buf
, size
)
9851 tiff_seek_in_memory (data
, off
, whence
)
9856 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9861 case SEEK_SET
: /* Go from beginning of source. */
9865 case SEEK_END
: /* Go from end of source. */
9866 idx
= src
->len
+ off
;
9869 case SEEK_CUR
: /* Go from current position. */
9870 idx
= src
->index
+ off
;
9873 default: /* Invalid `whence'. */
9877 if (idx
> src
->len
|| idx
< 0)
9886 tiff_close_memory (data
)
9895 tiff_mmap_memory (data
, pbase
, psize
)
9900 /* It is already _IN_ memory. */
9906 tiff_unmap_memory (data
, base
, size
)
9911 /* We don't need to do this. */
9916 tiff_size_of_memory (data
)
9919 return ((tiff_memory_source
*) data
)->len
;
9924 tiff_error_handler (title
, format
, ap
)
9925 const char *title
, *format
;
9931 len
= sprintf (buf
, "TIFF error: %s ", title
);
9932 vsprintf (buf
+ len
, format
, ap
);
9933 add_to_log (buf
, Qnil
, Qnil
);
9938 tiff_warning_handler (title
, format
, ap
)
9939 const char *title
, *format
;
9945 len
= sprintf (buf
, "TIFF warning: %s ", title
);
9946 vsprintf (buf
+ len
, format
, ap
);
9947 add_to_log (buf
, Qnil
, Qnil
);
9951 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9959 Lisp_Object file
, specified_file
;
9960 Lisp_Object specified_data
;
9962 int width
, height
, x
, y
;
9966 struct gcpro gcpro1
;
9967 tiff_memory_source memsrc
;
9969 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9970 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9974 TIFFSetErrorHandler (tiff_error_handler
);
9975 TIFFSetWarningHandler (tiff_warning_handler
);
9977 if (NILP (specified_data
))
9979 /* Read from a file */
9980 file
= x_find_image_file (specified_file
);
9981 if (!STRINGP (file
))
9983 image_error ("Cannot find image file `%s'", file
, Qnil
);
9988 /* Try to open the image file. */
9989 tiff
= TIFFOpen (SDATA (file
), "r");
9992 image_error ("Cannot open `%s'", file
, Qnil
);
9999 /* Memory source! */
10000 memsrc
.bytes
= SDATA (specified_data
);
10001 memsrc
.len
= SBYTES (specified_data
);
10004 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
10005 (TIFFReadWriteProc
) tiff_read_from_memory
,
10006 (TIFFReadWriteProc
) tiff_write_from_memory
,
10007 tiff_seek_in_memory
,
10009 tiff_size_of_memory
,
10011 tiff_unmap_memory
);
10015 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
10021 /* Get width and height of the image, and allocate a raster buffer
10022 of width x height 32-bit values. */
10023 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
10024 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
10025 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
10027 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
10031 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
10037 /* Create the X image and pixmap. */
10038 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
10045 /* Initialize the color table. */
10046 init_color_table ();
10048 /* Process the pixel raster. Origin is in the lower-left corner. */
10049 for (y
= 0; y
< height
; ++y
)
10051 uint32
*row
= buf
+ y
* width
;
10053 for (x
= 0; x
< width
; ++x
)
10055 uint32 abgr
= row
[x
];
10056 int r
= TIFFGetR (abgr
) << 8;
10057 int g
= TIFFGetG (abgr
) << 8;
10058 int b
= TIFFGetB (abgr
) << 8;
10059 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
10063 /* Remember the colors allocated for the image. Free the color table. */
10064 img
->colors
= colors_in_color_table (&img
->ncolors
);
10065 free_color_table ();
10067 img
->width
= width
;
10068 img
->height
= height
;
10070 /* Maybe fill in the background field while we have ximg handy. */
10071 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10072 IMAGE_BACKGROUND (img
, f
, ximg
);
10074 /* Put the image into the pixmap, then free the X image and its buffer. */
10075 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10076 x_destroy_x_image (ximg
);
10083 #endif /* HAVE_TIFF != 0 */
10087 /***********************************************************************
10089 ***********************************************************************/
10093 #include <gif_lib.h>
10095 static int gif_image_p
P_ ((Lisp_Object object
));
10096 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
10098 /* The symbol `gif' identifying images of this type. */
10102 /* Indices of image specification fields in gif_format, below. */
10104 enum gif_keyword_index
10113 GIF_HEURISTIC_MASK
,
10120 /* Vector of image_keyword structures describing the format
10121 of valid user-defined image specifications. */
10123 static struct image_keyword gif_format
[GIF_LAST
] =
10125 {":type", IMAGE_SYMBOL_VALUE
, 1},
10126 {":data", IMAGE_STRING_VALUE
, 0},
10127 {":file", IMAGE_STRING_VALUE
, 0},
10128 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10129 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10130 {":relief", IMAGE_INTEGER_VALUE
, 0},
10131 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10132 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10133 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10134 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
10135 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10138 /* Structure describing the image type `gif'. */
10140 static struct image_type gif_type
=
10150 /* Return non-zero if OBJECT is a valid GIF image specification. */
10153 gif_image_p (object
)
10154 Lisp_Object object
;
10156 struct image_keyword fmt
[GIF_LAST
];
10157 bcopy (gif_format
, fmt
, sizeof fmt
);
10159 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
10162 /* Must specify either the :data or :file keyword. */
10163 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
10167 /* Reading a GIF image from memory
10168 Based on the PNG memory stuff to a certain extent. */
10172 unsigned char *bytes
;
10179 /* Make the current memory source available to gif_read_from_memory.
10180 It's done this way because not all versions of libungif support
10181 a UserData field in the GifFileType structure. */
10182 static gif_memory_source
*current_gif_memory_src
;
10185 gif_read_from_memory (file
, buf
, len
)
10190 gif_memory_source
*src
= current_gif_memory_src
;
10192 if (len
> src
->len
- src
->index
)
10195 bcopy (src
->bytes
+ src
->index
, buf
, len
);
10201 /* Load GIF image IMG for use on frame F. Value is non-zero if
10209 Lisp_Object file
, specified_file
;
10210 Lisp_Object specified_data
;
10211 int rc
, width
, height
, x
, y
, i
;
10213 ColorMapObject
*gif_color_map
;
10214 unsigned long pixel_colors
[256];
10216 struct gcpro gcpro1
;
10218 int ino
, image_left
, image_top
, image_width
, image_height
;
10219 gif_memory_source memsrc
;
10220 unsigned char *raster
;
10222 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10223 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10227 if (NILP (specified_data
))
10229 file
= x_find_image_file (specified_file
);
10230 if (!STRINGP (file
))
10232 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10237 /* Open the GIF file. */
10238 gif
= DGifOpenFileName (SDATA (file
));
10241 image_error ("Cannot open `%s'", file
, Qnil
);
10248 /* Read from memory! */
10249 current_gif_memory_src
= &memsrc
;
10250 memsrc
.bytes
= SDATA (specified_data
);
10251 memsrc
.len
= SBYTES (specified_data
);
10254 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
10257 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
10263 /* Read entire contents. */
10264 rc
= DGifSlurp (gif
);
10265 if (rc
== GIF_ERROR
)
10267 image_error ("Error reading `%s'", img
->spec
, Qnil
);
10268 DGifCloseFile (gif
);
10273 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
10274 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
10275 if (ino
>= gif
->ImageCount
)
10277 image_error ("Invalid image number `%s' in image `%s'",
10279 DGifCloseFile (gif
);
10284 width
= img
->width
= max (gif
->SWidth
, gif
->Image
.Left
+ gif
->Image
.Width
);
10285 height
= img
->height
= max (gif
->SHeight
, gif
->Image
.Top
+ gif
->Image
.Height
);
10287 /* Create the X image and pixmap. */
10288 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
10290 DGifCloseFile (gif
);
10295 /* Allocate colors. */
10296 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
10297 if (!gif_color_map
)
10298 gif_color_map
= gif
->SColorMap
;
10299 init_color_table ();
10300 bzero (pixel_colors
, sizeof pixel_colors
);
10302 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
10304 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
10305 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
10306 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
10307 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
10310 img
->colors
= colors_in_color_table (&img
->ncolors
);
10311 free_color_table ();
10313 /* Clear the part of the screen image that are not covered by
10314 the image from the GIF file. Full animated GIF support
10315 requires more than can be done here (see the gif89 spec,
10316 disposal methods). Let's simply assume that the part
10317 not covered by a sub-image is in the frame's background color. */
10318 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
10319 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
10320 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
10321 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
10323 for (y
= 0; y
< image_top
; ++y
)
10324 for (x
= 0; x
< width
; ++x
)
10325 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10327 for (y
= image_top
+ image_height
; y
< height
; ++y
)
10328 for (x
= 0; x
< width
; ++x
)
10329 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10331 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
10333 for (x
= 0; x
< image_left
; ++x
)
10334 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10335 for (x
= image_left
+ image_width
; x
< width
; ++x
)
10336 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10339 /* Read the GIF image into the X image. We use a local variable
10340 `raster' here because RasterBits below is a char *, and invites
10341 problems with bytes >= 0x80. */
10342 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
10344 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
10346 static int interlace_start
[] = {0, 4, 2, 1};
10347 static int interlace_increment
[] = {8, 8, 4, 2};
10349 int row
= interlace_start
[0];
10353 for (y
= 0; y
< image_height
; y
++)
10355 if (row
>= image_height
)
10357 row
= interlace_start
[++pass
];
10358 while (row
>= image_height
)
10359 row
= interlace_start
[++pass
];
10362 for (x
= 0; x
< image_width
; x
++)
10364 int i
= raster
[(y
* image_width
) + x
];
10365 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
10369 row
+= interlace_increment
[pass
];
10374 for (y
= 0; y
< image_height
; ++y
)
10375 for (x
= 0; x
< image_width
; ++x
)
10377 int i
= raster
[y
* image_width
+ x
];
10378 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
10382 DGifCloseFile (gif
);
10384 /* Maybe fill in the background field while we have ximg handy. */
10385 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10386 IMAGE_BACKGROUND (img
, f
, ximg
);
10388 /* Put the image into the pixmap, then free the X image and its buffer. */
10389 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10390 x_destroy_x_image (ximg
);
10396 #endif /* HAVE_GIF != 0 */
10400 /***********************************************************************
10402 ***********************************************************************/
10404 static int gs_image_p
P_ ((Lisp_Object object
));
10405 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
10406 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
10408 /* The symbol `postscript' identifying images of this type. */
10410 Lisp_Object Qpostscript
;
10412 /* Keyword symbols. */
10414 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
10416 /* Indices of image specification fields in gs_format, below. */
10418 enum gs_keyword_index
10436 /* Vector of image_keyword structures describing the format
10437 of valid user-defined image specifications. */
10439 static struct image_keyword gs_format
[GS_LAST
] =
10441 {":type", IMAGE_SYMBOL_VALUE
, 1},
10442 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10443 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10444 {":file", IMAGE_STRING_VALUE
, 1},
10445 {":loader", IMAGE_FUNCTION_VALUE
, 0},
10446 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
10447 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10448 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10449 {":relief", IMAGE_INTEGER_VALUE
, 0},
10450 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10451 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10452 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10453 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10456 /* Structure describing the image type `ghostscript'. */
10458 static struct image_type gs_type
=
10468 /* Free X resources of Ghostscript image IMG which is used on frame F. */
10471 gs_clear_image (f
, img
)
10475 /* IMG->data.ptr_val may contain a recorded colormap. */
10476 xfree (img
->data
.ptr_val
);
10477 x_clear_image (f
, img
);
10481 /* Return non-zero if OBJECT is a valid Ghostscript image
10485 gs_image_p (object
)
10486 Lisp_Object object
;
10488 struct image_keyword fmt
[GS_LAST
];
10492 bcopy (gs_format
, fmt
, sizeof fmt
);
10494 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
10497 /* Bounding box must be a list or vector containing 4 integers. */
10498 tem
= fmt
[GS_BOUNDING_BOX
].value
;
10501 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
10502 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
10507 else if (VECTORP (tem
))
10509 if (XVECTOR (tem
)->size
!= 4)
10511 for (i
= 0; i
< 4; ++i
)
10512 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
10522 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
10531 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
10532 struct gcpro gcpro1
, gcpro2
;
10534 double in_width
, in_height
;
10535 Lisp_Object pixel_colors
= Qnil
;
10537 /* Compute pixel size of pixmap needed from the given size in the
10538 image specification. Sizes in the specification are in pt. 1 pt
10539 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10541 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
10542 in_width
= XFASTINT (pt_width
) / 72.0;
10543 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
10544 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
10545 in_height
= XFASTINT (pt_height
) / 72.0;
10546 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
10548 /* Create the pixmap. */
10549 xassert (img
->pixmap
== None
);
10550 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10551 img
->width
, img
->height
,
10552 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
10556 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
10560 /* Call the loader to fill the pixmap. It returns a process object
10561 if successful. We do not record_unwind_protect here because
10562 other places in redisplay like calling window scroll functions
10563 don't either. Let the Lisp loader use `unwind-protect' instead. */
10564 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
10566 sprintf (buffer
, "%lu %lu",
10567 (unsigned long) FRAME_X_WINDOW (f
),
10568 (unsigned long) img
->pixmap
);
10569 window_and_pixmap_id
= build_string (buffer
);
10571 sprintf (buffer
, "%lu %lu",
10572 FRAME_FOREGROUND_PIXEL (f
),
10573 FRAME_BACKGROUND_PIXEL (f
));
10574 pixel_colors
= build_string (buffer
);
10576 XSETFRAME (frame
, f
);
10577 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
10579 loader
= intern ("gs-load-image");
10581 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10582 make_number (img
->width
),
10583 make_number (img
->height
),
10584 window_and_pixmap_id
,
10587 return PROCESSP (img
->data
.lisp_val
);
10591 /* Kill the Ghostscript process that was started to fill PIXMAP on
10592 frame F. Called from XTread_socket when receiving an event
10593 telling Emacs that Ghostscript has finished drawing. */
10596 x_kill_gs_process (pixmap
, f
)
10600 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10604 /* Find the image containing PIXMAP. */
10605 for (i
= 0; i
< c
->used
; ++i
)
10606 if (c
->images
[i
]->pixmap
== pixmap
)
10609 /* Should someone in between have cleared the image cache, for
10610 instance, give up. */
10614 /* Kill the GS process. We should have found PIXMAP in the image
10615 cache and its image should contain a process object. */
10616 img
= c
->images
[i
];
10617 xassert (PROCESSP (img
->data
.lisp_val
));
10618 Fkill_process (img
->data
.lisp_val
, Qnil
);
10619 img
->data
.lisp_val
= Qnil
;
10621 /* On displays with a mutable colormap, figure out the colors
10622 allocated for the image by looking at the pixels of an XImage for
10624 class = FRAME_X_VISUAL (f
)->class;
10625 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10631 /* Try to get an XImage for img->pixmep. */
10632 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10633 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10638 /* Initialize the color table. */
10639 init_color_table ();
10641 /* For each pixel of the image, look its color up in the
10642 color table. After having done so, the color table will
10643 contain an entry for each color used by the image. */
10644 for (y
= 0; y
< img
->height
; ++y
)
10645 for (x
= 0; x
< img
->width
; ++x
)
10647 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10648 lookup_pixel_color (f
, pixel
);
10651 /* Record colors in the image. Free color table and XImage. */
10652 img
->colors
= colors_in_color_table (&img
->ncolors
);
10653 free_color_table ();
10654 XDestroyImage (ximg
);
10656 #if 0 /* This doesn't seem to be the case. If we free the colors
10657 here, we get a BadAccess later in x_clear_image when
10658 freeing the colors. */
10659 /* We have allocated colors once, but Ghostscript has also
10660 allocated colors on behalf of us. So, to get the
10661 reference counts right, free them once. */
10663 x_free_colors (f
, img
->colors
, img
->ncolors
);
10667 image_error ("Cannot get X image of `%s'; colors will not be freed",
10673 /* Now that we have the pixmap, compute mask and transform the
10674 image if requested. */
10676 postprocess_image (f
, img
);
10682 /***********************************************************************
10684 ***********************************************************************/
10686 DEFUN ("x-change-window-property", Fx_change_window_property
,
10687 Sx_change_window_property
, 2, 3, 0,
10688 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
10689 PROP and VALUE must be strings. FRAME nil or omitted means use the
10690 selected frame. Value is VALUE. */)
10691 (prop
, value
, frame
)
10692 Lisp_Object frame
, prop
, value
;
10694 struct frame
*f
= check_x_frame (frame
);
10697 CHECK_STRING (prop
);
10698 CHECK_STRING (value
);
10701 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SDATA (prop
), False
);
10702 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10703 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10704 SDATA (value
), SCHARS (value
));
10706 /* Make sure the property is set when we return. */
10707 XFlush (FRAME_X_DISPLAY (f
));
10714 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10715 Sx_delete_window_property
, 1, 2, 0,
10716 doc
: /* Remove window property PROP from X window of FRAME.
10717 FRAME nil or omitted means use the selected frame. Value is PROP. */)
10719 Lisp_Object prop
, frame
;
10721 struct frame
*f
= check_x_frame (frame
);
10724 CHECK_STRING (prop
);
10726 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SDATA (prop
), False
);
10727 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10729 /* Make sure the property is removed when we return. */
10730 XFlush (FRAME_X_DISPLAY (f
));
10737 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10739 doc
: /* Value is the value of window property PROP on FRAME.
10740 If FRAME is nil or omitted, use the selected frame. Value is nil
10741 if FRAME hasn't a property with name PROP or if PROP has no string
10744 Lisp_Object prop
, frame
;
10746 struct frame
*f
= check_x_frame (frame
);
10749 Lisp_Object prop_value
= Qnil
;
10750 char *tmp_data
= NULL
;
10753 unsigned long actual_size
, bytes_remaining
;
10755 CHECK_STRING (prop
);
10757 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SDATA (prop
), False
);
10758 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10759 prop_atom
, 0, 0, False
, XA_STRING
,
10760 &actual_type
, &actual_format
, &actual_size
,
10761 &bytes_remaining
, (unsigned char **) &tmp_data
);
10764 int size
= bytes_remaining
;
10769 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10770 prop_atom
, 0, bytes_remaining
,
10772 &actual_type
, &actual_format
,
10773 &actual_size
, &bytes_remaining
,
10774 (unsigned char **) &tmp_data
);
10775 if (rc
== Success
&& tmp_data
)
10776 prop_value
= make_string (tmp_data
, size
);
10787 /***********************************************************************
10789 ***********************************************************************/
10791 /* If non-null, an asynchronous timer that, when it expires, displays
10792 an hourglass cursor on all frames. */
10794 static struct atimer
*hourglass_atimer
;
10796 /* Non-zero means an hourglass cursor is currently shown. */
10798 static int hourglass_shown_p
;
10800 /* Number of seconds to wait before displaying an hourglass cursor. */
10802 static Lisp_Object Vhourglass_delay
;
10804 /* Default number of seconds to wait before displaying an hourglass
10807 #define DEFAULT_HOURGLASS_DELAY 1
10809 /* Function prototypes. */
10811 static void show_hourglass
P_ ((struct atimer
*));
10812 static void hide_hourglass
P_ ((void));
10815 /* Cancel a currently active hourglass timer, and start a new one. */
10821 int secs
, usecs
= 0;
10823 cancel_hourglass ();
10825 if (INTEGERP (Vhourglass_delay
)
10826 && XINT (Vhourglass_delay
) > 0)
10827 secs
= XFASTINT (Vhourglass_delay
);
10828 else if (FLOATP (Vhourglass_delay
)
10829 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10832 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10833 secs
= XFASTINT (tem
);
10834 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10837 secs
= DEFAULT_HOURGLASS_DELAY
;
10839 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10840 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10841 show_hourglass
, NULL
);
10845 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10849 cancel_hourglass ()
10851 if (hourglass_atimer
)
10853 cancel_atimer (hourglass_atimer
);
10854 hourglass_atimer
= NULL
;
10857 if (hourglass_shown_p
)
10862 /* Timer function of hourglass_atimer. TIMER is equal to
10865 Display an hourglass pointer on all frames by mapping the frames'
10866 hourglass_window. Set the hourglass_p flag in the frames'
10867 output_data.x structure to indicate that an hourglass cursor is
10868 shown on the frames. */
10871 show_hourglass (timer
)
10872 struct atimer
*timer
;
10874 /* The timer implementation will cancel this timer automatically
10875 after this function has run. Set hourglass_atimer to null
10876 so that we know the timer doesn't have to be canceled. */
10877 hourglass_atimer
= NULL
;
10879 if (!hourglass_shown_p
)
10881 Lisp_Object rest
, frame
;
10885 FOR_EACH_FRAME (rest
, frame
)
10887 struct frame
*f
= XFRAME (frame
);
10889 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10891 Display
*dpy
= FRAME_X_DISPLAY (f
);
10893 #ifdef USE_X_TOOLKIT
10894 if (f
->output_data
.x
->widget
)
10896 if (FRAME_OUTER_WINDOW (f
))
10899 f
->output_data
.x
->hourglass_p
= 1;
10901 if (!f
->output_data
.x
->hourglass_window
)
10903 unsigned long mask
= CWCursor
;
10904 XSetWindowAttributes attrs
;
10906 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10908 f
->output_data
.x
->hourglass_window
10909 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10910 0, 0, 32000, 32000, 0, 0,
10916 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10922 hourglass_shown_p
= 1;
10928 /* Hide the hourglass pointer on all frames, if it is currently
10934 if (hourglass_shown_p
)
10936 Lisp_Object rest
, frame
;
10939 FOR_EACH_FRAME (rest
, frame
)
10941 struct frame
*f
= XFRAME (frame
);
10944 /* Watch out for newly created frames. */
10945 && f
->output_data
.x
->hourglass_window
)
10947 XUnmapWindow (FRAME_X_DISPLAY (f
),
10948 f
->output_data
.x
->hourglass_window
);
10949 /* Sync here because XTread_socket looks at the
10950 hourglass_p flag that is reset to zero below. */
10951 XSync (FRAME_X_DISPLAY (f
), False
);
10952 f
->output_data
.x
->hourglass_p
= 0;
10956 hourglass_shown_p
= 0;
10963 /***********************************************************************
10965 ***********************************************************************/
10967 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10968 Lisp_Object
, Lisp_Object
));
10969 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10970 Lisp_Object
, int, int, int *, int *));
10972 /* The frame of a currently visible tooltip. */
10974 Lisp_Object tip_frame
;
10976 /* If non-nil, a timer started that hides the last tooltip when it
10979 Lisp_Object tip_timer
;
10982 /* If non-nil, a vector of 3 elements containing the last args
10983 with which x-show-tip was called. See there. */
10985 Lisp_Object last_show_tip_args
;
10987 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
10989 Lisp_Object Vx_max_tooltip_size
;
10993 unwind_create_tip_frame (frame
)
10996 Lisp_Object deleted
;
10998 deleted
= unwind_create_frame (frame
);
10999 if (EQ (deleted
, Qt
))
11009 /* Create a frame for a tooltip on the display described by DPYINFO.
11010 PARMS is a list of frame parameters. TEXT is the string to
11011 display in the tip frame. Value is the frame.
11013 Note that functions called here, esp. x_default_parameter can
11014 signal errors, for instance when a specified color name is
11015 undefined. We have to make sure that we're in a consistent state
11016 when this happens. */
11019 x_create_tip_frame (dpyinfo
, parms
, text
)
11020 struct x_display_info
*dpyinfo
;
11021 Lisp_Object parms
, text
;
11024 Lisp_Object frame
, tem
;
11026 long window_prompting
= 0;
11028 int count
= SPECPDL_INDEX ();
11029 struct gcpro gcpro1
, gcpro2
, gcpro3
;
11031 int face_change_count_before
= face_change_count
;
11032 Lisp_Object buffer
;
11033 struct buffer
*old_buffer
;
11037 /* Use this general default value to start with until we know if
11038 this frame has a specified name. */
11039 Vx_resource_name
= Vinvocation_name
;
11041 #ifdef MULTI_KBOARD
11042 kb
= dpyinfo
->kboard
;
11044 kb
= &the_only_kboard
;
11047 /* Get the name of the frame to use for resource lookup. */
11048 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
11049 if (!STRINGP (name
)
11050 && !EQ (name
, Qunbound
)
11052 error ("Invalid frame name--not a string or nil");
11053 Vx_resource_name
= name
;
11056 GCPRO3 (parms
, name
, frame
);
11057 f
= make_frame (1);
11058 XSETFRAME (frame
, f
);
11060 buffer
= Fget_buffer_create (build_string (" *tip*"));
11061 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
11062 old_buffer
= current_buffer
;
11063 set_buffer_internal_1 (XBUFFER (buffer
));
11064 current_buffer
->truncate_lines
= Qnil
;
11066 Finsert (1, &text
);
11067 set_buffer_internal_1 (old_buffer
);
11069 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
11070 record_unwind_protect (unwind_create_tip_frame
, frame
);
11072 /* By setting the output method, we're essentially saying that
11073 the frame is live, as per FRAME_LIVE_P. If we get a signal
11074 from this point on, x_destroy_window might screw up reference
11076 f
->output_method
= output_x_window
;
11077 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
11078 bzero (f
->output_data
.x
, sizeof (struct x_output
));
11079 f
->output_data
.x
->icon_bitmap
= -1;
11080 f
->output_data
.x
->fontset
= -1;
11081 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
11082 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
11083 #ifdef USE_TOOLKIT_SCROLL_BARS
11084 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
11085 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
11086 #endif /* USE_TOOLKIT_SCROLL_BARS */
11087 f
->icon_name
= Qnil
;
11088 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
11090 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
11091 dpyinfo_refcount
= dpyinfo
->reference_count
;
11092 #endif /* GLYPH_DEBUG */
11093 #ifdef MULTI_KBOARD
11094 FRAME_KBOARD (f
) = kb
;
11096 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
11097 f
->output_data
.x
->explicit_parent
= 0;
11099 /* These colors will be set anyway later, but it's important
11100 to get the color reference counts right, so initialize them! */
11103 struct gcpro gcpro1
;
11105 black
= build_string ("black");
11107 f
->output_data
.x
->foreground_pixel
11108 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11109 f
->output_data
.x
->background_pixel
11110 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11111 f
->output_data
.x
->cursor_pixel
11112 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11113 f
->output_data
.x
->cursor_foreground_pixel
11114 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11115 f
->output_data
.x
->border_pixel
11116 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11117 f
->output_data
.x
->mouse_pixel
11118 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11122 /* Set the name; the functions to which we pass f expect the name to
11124 if (EQ (name
, Qunbound
) || NILP (name
))
11126 f
->name
= build_string (dpyinfo
->x_id_name
);
11127 f
->explicit_name
= 0;
11132 f
->explicit_name
= 1;
11133 /* use the frame's title when getting resources for this frame. */
11134 specbind (Qx_resource_name
, name
);
11137 /* Extract the window parameters from the supplied values that are
11138 needed to determine window geometry. */
11142 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
11145 /* First, try whatever font the caller has specified. */
11146 if (STRINGP (font
))
11148 tem
= Fquery_fontset (font
, Qnil
);
11150 font
= x_new_fontset (f
, SDATA (tem
));
11152 font
= x_new_font (f
, SDATA (font
));
11155 /* Try out a font which we hope has bold and italic variations. */
11156 if (!STRINGP (font
))
11157 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
11158 if (!STRINGP (font
))
11159 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11160 if (! STRINGP (font
))
11161 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11162 if (! STRINGP (font
))
11163 /* This was formerly the first thing tried, but it finds too many fonts
11164 and takes too long. */
11165 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
11166 /* If those didn't work, look for something which will at least work. */
11167 if (! STRINGP (font
))
11168 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
11170 if (! STRINGP (font
))
11171 font
= build_string ("fixed");
11173 x_default_parameter (f
, parms
, Qfont
, font
,
11174 "font", "Font", RES_TYPE_STRING
);
11177 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
11178 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
11180 /* This defaults to 2 in order to match xterm. We recognize either
11181 internalBorderWidth or internalBorder (which is what xterm calls
11183 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11187 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
11188 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
11189 if (! EQ (value
, Qunbound
))
11190 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
11194 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
11195 "internalBorderWidth", "internalBorderWidth",
11198 /* Also do the stuff which must be set before the window exists. */
11199 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
11200 "foreground", "Foreground", RES_TYPE_STRING
);
11201 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
11202 "background", "Background", RES_TYPE_STRING
);
11203 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
11204 "pointerColor", "Foreground", RES_TYPE_STRING
);
11205 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
11206 "cursorColor", "Foreground", RES_TYPE_STRING
);
11207 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
11208 "borderColor", "BorderColor", RES_TYPE_STRING
);
11210 /* Init faces before x_default_parameter is called for scroll-bar
11211 parameters because that function calls x_set_scroll_bar_width,
11212 which calls change_frame_size, which calls Fset_window_buffer,
11213 which runs hooks, which call Fvertical_motion. At the end, we
11214 end up in init_iterator with a null face cache, which should not
11216 init_frame_faces (f
);
11218 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
11219 window_prompting
= x_figure_window_size (f
, parms
);
11221 if (window_prompting
& XNegative
)
11223 if (window_prompting
& YNegative
)
11224 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
11226 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
11230 if (window_prompting
& YNegative
)
11231 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
11233 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
11236 f
->output_data
.x
->size_hint_flags
= window_prompting
;
11238 XSetWindowAttributes attrs
;
11239 unsigned long mask
;
11242 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
11243 if (DoesSaveUnders (dpyinfo
->screen
))
11244 mask
|= CWSaveUnder
;
11246 /* Window managers look at the override-redirect flag to determine
11247 whether or net to give windows a decoration (Xlib spec, chapter
11249 attrs
.override_redirect
= True
;
11250 attrs
.save_under
= True
;
11251 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
11252 /* Arrange for getting MapNotify and UnmapNotify events. */
11253 attrs
.event_mask
= StructureNotifyMask
;
11255 = FRAME_X_WINDOW (f
)
11256 = XCreateWindow (FRAME_X_DISPLAY (f
),
11257 FRAME_X_DISPLAY_INFO (f
)->root_window
,
11258 /* x, y, width, height */
11262 CopyFromParent
, InputOutput
, CopyFromParent
,
11269 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
11270 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
11271 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
11272 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
11273 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
11274 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
11276 /* Dimensions, especially f->height, must be done via change_frame_size.
11277 Change will not be effected unless different from the current
11280 height
= f
->height
;
11282 SET_FRAME_WIDTH (f
, 0);
11283 change_frame_size (f
, height
, width
, 1, 0, 0);
11285 /* Add `tooltip' frame parameter's default value. */
11286 if (NILP (Fframe_parameter (frame
, intern ("tooltip"))))
11287 Fmodify_frame_parameters (frame
, Fcons (Fcons (intern ("tooltip"), Qt
),
11290 /* Set up faces after all frame parameters are known. This call
11291 also merges in face attributes specified for new frames.
11293 Frame parameters may be changed if .Xdefaults contains
11294 specifications for the default font. For example, if there is an
11295 `Emacs.default.attributeBackground: pink', the `background-color'
11296 attribute of the frame get's set, which let's the internal border
11297 of the tooltip frame appear in pink. Prevent this. */
11299 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
11301 /* Set tip_frame here, so that */
11303 call1 (Qface_set_after_frame_default
, frame
);
11305 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
11306 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
11314 /* It is now ok to make the frame official even if we get an error
11315 below. And the frame needs to be on Vframe_list or making it
11316 visible won't work. */
11317 Vframe_list
= Fcons (frame
, Vframe_list
);
11319 /* Now that the frame is official, it counts as a reference to
11321 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
11323 /* Setting attributes of faces of the tooltip frame from resources
11324 and similar will increment face_change_count, which leads to the
11325 clearing of all current matrices. Since this isn't necessary
11326 here, avoid it by resetting face_change_count to the value it
11327 had before we created the tip frame. */
11328 face_change_count
= face_change_count_before
;
11330 /* Discard the unwind_protect. */
11331 return unbind_to (count
, frame
);
11335 /* Compute where to display tip frame F. PARMS is the list of frame
11336 parameters for F. DX and DY are specified offsets from the current
11337 location of the mouse. WIDTH and HEIGHT are the width and height
11338 of the tooltip. Return coordinates relative to the root window of
11339 the display in *ROOT_X, and *ROOT_Y. */
11342 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
11344 Lisp_Object parms
, dx
, dy
;
11346 int *root_x
, *root_y
;
11348 Lisp_Object left
, top
;
11350 Window root
, child
;
11353 /* User-specified position? */
11354 left
= Fcdr (Fassq (Qleft
, parms
));
11355 top
= Fcdr (Fassq (Qtop
, parms
));
11357 /* Move the tooltip window where the mouse pointer is. Resize and
11359 if (!INTEGERP (left
) || !INTEGERP (top
))
11362 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
11363 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
11367 if (INTEGERP (top
))
11368 *root_y
= XINT (top
);
11369 else if (*root_y
+ XINT (dy
) - height
< 0)
11370 *root_y
-= XINT (dy
);
11374 *root_y
+= XINT (dy
);
11377 if (INTEGERP (left
))
11378 *root_x
= XINT (left
);
11379 else if (*root_x
+ XINT (dx
) + width
<= FRAME_X_DISPLAY_INFO (f
)->width
)
11380 /* It fits to the right of the pointer. */
11381 *root_x
+= XINT (dx
);
11382 else if (width
+ XINT (dx
) <= *root_x
)
11383 /* It fits to the left of the pointer. */
11384 *root_x
-= width
+ XINT (dx
);
11386 /* Put it left-justified on the screen--it ought to fit that way. */
11391 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
11392 doc
: /* Show STRING in a "tooltip" window on frame FRAME.
11393 A tooltip window is a small X window displaying a string.
11395 FRAME nil or omitted means use the selected frame.
11397 PARMS is an optional list of frame parameters which can be used to
11398 change the tooltip's appearance.
11400 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
11401 means use the default timeout of 5 seconds.
11403 If the list of frame parameters PARAMS contains a `left' parameters,
11404 the tooltip is displayed at that x-position. Otherwise it is
11405 displayed at the mouse position, with offset DX added (default is 5 if
11406 DX isn't specified). Likewise for the y-position; if a `top' frame
11407 parameter is specified, it determines the y-position of the tooltip
11408 window, otherwise it is displayed at the mouse position, with offset
11409 DY added (default is -10).
11411 A tooltip's maximum size is specified by `x-max-tooltip-size'.
11412 Text larger than the specified size is clipped. */)
11413 (string
, frame
, parms
, timeout
, dx
, dy
)
11414 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
11418 int root_x
, root_y
;
11419 struct buffer
*old_buffer
;
11420 struct text_pos pos
;
11421 int i
, width
, height
;
11422 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
11423 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
11424 int count
= SPECPDL_INDEX ();
11426 specbind (Qinhibit_redisplay
, Qt
);
11428 GCPRO4 (string
, parms
, frame
, timeout
);
11430 CHECK_STRING (string
);
11431 f
= check_x_frame (frame
);
11432 if (NILP (timeout
))
11433 timeout
= make_number (5);
11435 CHECK_NATNUM (timeout
);
11438 dx
= make_number (5);
11443 dy
= make_number (-10);
11447 if (NILP (last_show_tip_args
))
11448 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
11450 if (!NILP (tip_frame
))
11452 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
11453 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
11454 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
11456 if (EQ (frame
, last_frame
)
11457 && !NILP (Fequal (last_string
, string
))
11458 && !NILP (Fequal (last_parms
, parms
)))
11460 struct frame
*f
= XFRAME (tip_frame
);
11462 /* Only DX and DY have changed. */
11463 if (!NILP (tip_timer
))
11465 Lisp_Object timer
= tip_timer
;
11467 call1 (Qcancel_timer
, timer
);
11471 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
11472 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
11473 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11480 /* Hide a previous tip, if any. */
11483 ASET (last_show_tip_args
, 0, string
);
11484 ASET (last_show_tip_args
, 1, frame
);
11485 ASET (last_show_tip_args
, 2, parms
);
11487 /* Add default values to frame parameters. */
11488 if (NILP (Fassq (Qname
, parms
)))
11489 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
11490 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11491 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
11492 if (NILP (Fassq (Qborder_width
, parms
)))
11493 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
11494 if (NILP (Fassq (Qborder_color
, parms
)))
11495 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
11496 if (NILP (Fassq (Qbackground_color
, parms
)))
11497 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
11500 /* Create a frame for the tooltip, and record it in the global
11501 variable tip_frame. */
11502 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
, string
);
11503 f
= XFRAME (frame
);
11505 /* Set up the frame's root window. */
11506 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
11507 w
->left
= w
->top
= make_number (0);
11509 if (CONSP (Vx_max_tooltip_size
)
11510 && INTEGERP (XCAR (Vx_max_tooltip_size
))
11511 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
11512 && INTEGERP (XCDR (Vx_max_tooltip_size
))
11513 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
11515 w
->width
= XCAR (Vx_max_tooltip_size
);
11516 w
->height
= XCDR (Vx_max_tooltip_size
);
11520 w
->width
= make_number (80);
11521 w
->height
= make_number (40);
11524 f
->window_width
= XINT (w
->width
);
11526 w
->pseudo_window_p
= 1;
11528 /* Display the tooltip text in a temporary buffer. */
11529 old_buffer
= current_buffer
;
11530 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
11531 current_buffer
->truncate_lines
= Qnil
;
11532 clear_glyph_matrix (w
->desired_matrix
);
11533 clear_glyph_matrix (w
->current_matrix
);
11534 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
11535 try_window (FRAME_ROOT_WINDOW (f
), pos
);
11537 /* Compute width and height of the tooltip. */
11538 width
= height
= 0;
11539 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
11541 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
11542 struct glyph
*last
;
11545 /* Stop at the first empty row at the end. */
11546 if (!row
->enabled_p
|| !row
->displays_text_p
)
11549 /* Let the row go over the full width of the frame. */
11550 row
->full_width_p
= 1;
11552 /* There's a glyph at the end of rows that is used to place
11553 the cursor there. Don't include the width of this glyph. */
11554 if (row
->used
[TEXT_AREA
])
11556 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
11557 row_width
= row
->pixel_width
- last
->pixel_width
;
11560 row_width
= row
->pixel_width
;
11562 height
+= row
->height
;
11563 width
= max (width
, row_width
);
11566 /* Add the frame's internal border to the width and height the X
11567 window should have. */
11568 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11569 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11571 /* Move the tooltip window where the mouse pointer is. Resize and
11573 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
11576 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11577 root_x
, root_y
, width
, height
);
11578 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
11581 /* Draw into the window. */
11582 w
->must_be_updated_p
= 1;
11583 update_single_window (w
, 1);
11585 /* Restore original current buffer. */
11586 set_buffer_internal_1 (old_buffer
);
11587 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
11590 /* Let the tip disappear after timeout seconds. */
11591 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
11592 intern ("x-hide-tip"));
11595 return unbind_to (count
, Qnil
);
11599 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
11600 doc
: /* Hide the current tooltip window, if there is any.
11601 Value is t if tooltip was open, nil otherwise. */)
11605 Lisp_Object deleted
, frame
, timer
;
11606 struct gcpro gcpro1
, gcpro2
;
11608 /* Return quickly if nothing to do. */
11609 if (NILP (tip_timer
) && NILP (tip_frame
))
11614 GCPRO2 (frame
, timer
);
11615 tip_frame
= tip_timer
= deleted
= Qnil
;
11617 count
= SPECPDL_INDEX ();
11618 specbind (Qinhibit_redisplay
, Qt
);
11619 specbind (Qinhibit_quit
, Qt
);
11622 call1 (Qcancel_timer
, timer
);
11624 if (FRAMEP (frame
))
11626 Fdelete_frame (frame
, Qnil
);
11630 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11631 redisplay procedure is not called when a tip frame over menu
11632 items is unmapped. Redisplay the menu manually... */
11634 struct frame
*f
= SELECTED_FRAME ();
11635 Widget w
= f
->output_data
.x
->menubar_widget
;
11636 extern void xlwmenu_redisplay
P_ ((Widget
));
11638 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
11642 xlwmenu_redisplay (w
);
11646 #endif /* USE_LUCID */
11650 return unbind_to (count
, deleted
);
11655 /***********************************************************************
11656 File selection dialog
11657 ***********************************************************************/
11661 /* Callback for "OK" and "Cancel" on file selection dialog. */
11664 file_dialog_cb (widget
, client_data
, call_data
)
11666 XtPointer call_data
, client_data
;
11668 int *result
= (int *) client_data
;
11669 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11670 *result
= cb
->reason
;
11674 /* Callback for unmapping a file selection dialog. This is used to
11675 capture the case where a dialog is closed via a window manager's
11676 closer button, for example. Using a XmNdestroyCallback didn't work
11680 file_dialog_unmap_cb (widget
, client_data
, call_data
)
11682 XtPointer call_data
, client_data
;
11684 int *result
= (int *) client_data
;
11685 *result
= XmCR_CANCEL
;
11689 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11690 doc
: /* Read file name, prompting with PROMPT in directory DIR.
11691 Use a file selection dialog.
11692 Select DEFAULT-FILENAME in the dialog's file selection box, if
11693 specified. Don't let the user enter a file name in the file
11694 selection dialog's entry field, if MUSTMATCH is non-nil. */)
11695 (prompt
, dir
, default_filename
, mustmatch
)
11696 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11699 struct frame
*f
= SELECTED_FRAME ();
11700 Lisp_Object file
= Qnil
;
11701 Widget dialog
, text
, list
, help
;
11704 extern XtAppContext Xt_app_con
;
11705 XmString dir_xmstring
, pattern_xmstring
;
11706 int count
= SPECPDL_INDEX ();
11707 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11709 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11710 CHECK_STRING (prompt
);
11711 CHECK_STRING (dir
);
11713 /* Prevent redisplay. */
11714 specbind (Qinhibit_redisplay
, Qt
);
11718 /* Create the dialog with PROMPT as title, using DIR as initial
11719 directory and using "*" as pattern. */
11720 dir
= Fexpand_file_name (dir
, Qnil
);
11721 dir_xmstring
= XmStringCreateLocalized (SDATA (dir
));
11722 pattern_xmstring
= XmStringCreateLocalized ("*");
11724 XtSetArg (al
[ac
], XmNtitle
, SDATA (prompt
)); ++ac
;
11725 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11726 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11727 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11728 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11729 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11731 XmStringFree (dir_xmstring
);
11732 XmStringFree (pattern_xmstring
);
11734 /* Add callbacks for OK and Cancel. */
11735 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11736 (XtPointer
) &result
);
11737 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11738 (XtPointer
) &result
);
11739 XtAddCallback (dialog
, XmNunmapCallback
, file_dialog_unmap_cb
,
11740 (XtPointer
) &result
);
11742 /* Disable the help button since we can't display help. */
11743 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11744 XtSetSensitive (help
, False
);
11746 /* Mark OK button as default. */
11747 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11748 XmNshowAsDefault
, True
, NULL
);
11750 /* If MUSTMATCH is non-nil, disable the file entry field of the
11751 dialog, so that the user must select a file from the files list
11752 box. We can't remove it because we wouldn't have a way to get at
11753 the result file name, then. */
11754 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11755 if (!NILP (mustmatch
))
11758 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11759 XtSetSensitive (text
, False
);
11760 XtSetSensitive (label
, False
);
11763 /* Manage the dialog, so that list boxes get filled. */
11764 XtManageChild (dialog
);
11766 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11767 must include the path for this to work. */
11768 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11769 if (STRINGP (default_filename
))
11771 XmString default_xmstring
;
11775 = XmStringCreateLocalized (SDATA (default_filename
));
11777 if (!XmListItemExists (list
, default_xmstring
))
11779 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11780 XmListAddItem (list
, default_xmstring
, 0);
11784 item_pos
= XmListItemPos (list
, default_xmstring
);
11785 XmStringFree (default_xmstring
);
11787 /* Select the item and scroll it into view. */
11788 XmListSelectPos (list
, item_pos
, True
);
11789 XmListSetPos (list
, item_pos
);
11792 /* Process events until the user presses Cancel or OK. */
11794 while (result
== 0)
11797 XtAppNextEvent (Xt_app_con
, &event
);
11798 (void) x_dispatch_event (&event
, FRAME_X_DISPLAY (f
) );
11801 /* Get the result. */
11802 if (result
== XmCR_OK
)
11807 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11808 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11809 XmStringFree (text
);
11810 file
= build_string (data
);
11817 XtUnmanageChild (dialog
);
11818 XtDestroyWidget (dialog
);
11822 /* Make "Cancel" equivalent to C-g. */
11824 Fsignal (Qquit
, Qnil
);
11826 return unbind_to (count
, file
);
11829 #endif /* USE_MOTIF */
11833 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11834 "Read file name, prompting with PROMPT in directory DIR.\n\
11835 Use a file selection dialog.\n\
11836 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
11837 specified. Don't let the user enter a file name in the file\n\
11838 selection dialog's entry field, if MUSTMATCH is non-nil.")
11839 (prompt
, dir
, default_filename
, mustmatch
)
11840 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11842 FRAME_PTR f
= SELECTED_FRAME ();
11844 Lisp_Object file
= Qnil
;
11845 int count
= specpdl_ptr
- specpdl
;
11846 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11850 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11851 CHECK_STRING (prompt
);
11852 CHECK_STRING (dir
);
11854 /* Prevent redisplay. */
11855 specbind (Qinhibit_redisplay
, Qt
);
11859 if (STRINGP (default_filename
))
11860 cdef_file
= SDATA (default_filename
);
11862 cdef_file
= SDATA (dir
);
11864 fn
= xg_get_file_name (f
, SDATA (prompt
), cdef_file
, ! NILP (mustmatch
));
11868 file
= build_string (fn
);
11875 /* Make "Cancel" equivalent to C-g. */
11877 Fsignal (Qquit
, Qnil
);
11879 return unbind_to (count
, file
);
11882 #endif /* USE_GTK */
11885 /***********************************************************************
11887 ***********************************************************************/
11889 #ifdef HAVE_XKBGETKEYBOARD
11890 #include <X11/XKBlib.h>
11891 #include <X11/keysym.h>
11894 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11895 Sx_backspace_delete_keys_p
, 0, 1, 0,
11896 doc
: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
11897 FRAME nil means use the selected frame.
11898 Value is t if we know that both keys are present, and are mapped to the
11899 usual X keysyms. */)
11903 #ifdef HAVE_XKBGETKEYBOARD
11905 struct frame
*f
= check_x_frame (frame
);
11906 Display
*dpy
= FRAME_X_DISPLAY (f
);
11907 Lisp_Object have_keys
;
11908 int major
, minor
, op
, event
, error
;
11912 /* Check library version in case we're dynamically linked. */
11913 major
= XkbMajorVersion
;
11914 minor
= XkbMinorVersion
;
11915 if (!XkbLibraryVersion (&major
, &minor
))
11921 /* Check that the server supports XKB. */
11922 major
= XkbMajorVersion
;
11923 minor
= XkbMinorVersion
;
11924 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11931 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11934 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11936 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11938 for (i
= kb
->min_key_code
;
11939 (i
< kb
->max_key_code
11940 && (delete_keycode
== 0 || backspace_keycode
== 0));
11943 /* The XKB symbolic key names can be seen most easily in
11944 the PS file generated by `xkbprint -label name
11946 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11947 delete_keycode
= i
;
11948 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11949 backspace_keycode
= i
;
11952 XkbFreeNames (kb
, 0, True
);
11955 XkbFreeClientMap (kb
, 0, True
);
11958 && backspace_keycode
11959 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11960 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11965 #else /* not HAVE_XKBGETKEYBOARD */
11967 #endif /* not HAVE_XKBGETKEYBOARD */
11972 /***********************************************************************
11974 ***********************************************************************/
11979 /* This is zero if not using X windows. */
11982 /* The section below is built by the lisp expression at the top of the file,
11983 just above where these variables are declared. */
11984 /*&&& init symbols here &&&*/
11985 Qauto_raise
= intern ("auto-raise");
11986 staticpro (&Qauto_raise
);
11987 Qauto_lower
= intern ("auto-lower");
11988 staticpro (&Qauto_lower
);
11989 Qborder_color
= intern ("border-color");
11990 staticpro (&Qborder_color
);
11991 Qborder_width
= intern ("border-width");
11992 staticpro (&Qborder_width
);
11993 Qcursor_color
= intern ("cursor-color");
11994 staticpro (&Qcursor_color
);
11995 Qcursor_type
= intern ("cursor-type");
11996 staticpro (&Qcursor_type
);
11997 Qgeometry
= intern ("geometry");
11998 staticpro (&Qgeometry
);
11999 Qicon_left
= intern ("icon-left");
12000 staticpro (&Qicon_left
);
12001 Qicon_top
= intern ("icon-top");
12002 staticpro (&Qicon_top
);
12003 Qicon_type
= intern ("icon-type");
12004 staticpro (&Qicon_type
);
12005 Qicon_name
= intern ("icon-name");
12006 staticpro (&Qicon_name
);
12007 Qinternal_border_width
= intern ("internal-border-width");
12008 staticpro (&Qinternal_border_width
);
12009 Qleft
= intern ("left");
12010 staticpro (&Qleft
);
12011 Qright
= intern ("right");
12012 staticpro (&Qright
);
12013 Qmouse_color
= intern ("mouse-color");
12014 staticpro (&Qmouse_color
);
12015 Qnone
= intern ("none");
12016 staticpro (&Qnone
);
12017 Qparent_id
= intern ("parent-id");
12018 staticpro (&Qparent_id
);
12019 Qscroll_bar_width
= intern ("scroll-bar-width");
12020 staticpro (&Qscroll_bar_width
);
12021 Qsuppress_icon
= intern ("suppress-icon");
12022 staticpro (&Qsuppress_icon
);
12023 Qundefined_color
= intern ("undefined-color");
12024 staticpro (&Qundefined_color
);
12025 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
12026 staticpro (&Qvertical_scroll_bars
);
12027 Qvisibility
= intern ("visibility");
12028 staticpro (&Qvisibility
);
12029 Qwindow_id
= intern ("window-id");
12030 staticpro (&Qwindow_id
);
12031 Qouter_window_id
= intern ("outer-window-id");
12032 staticpro (&Qouter_window_id
);
12033 Qx_frame_parameter
= intern ("x-frame-parameter");
12034 staticpro (&Qx_frame_parameter
);
12035 Qx_resource_name
= intern ("x-resource-name");
12036 staticpro (&Qx_resource_name
);
12037 Quser_position
= intern ("user-position");
12038 staticpro (&Quser_position
);
12039 Quser_size
= intern ("user-size");
12040 staticpro (&Quser_size
);
12041 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
12042 staticpro (&Qscroll_bar_foreground
);
12043 Qscroll_bar_background
= intern ("scroll-bar-background");
12044 staticpro (&Qscroll_bar_background
);
12045 Qscreen_gamma
= intern ("screen-gamma");
12046 staticpro (&Qscreen_gamma
);
12047 Qline_spacing
= intern ("line-spacing");
12048 staticpro (&Qline_spacing
);
12049 Qcenter
= intern ("center");
12050 staticpro (&Qcenter
);
12051 Qcompound_text
= intern ("compound-text");
12052 staticpro (&Qcompound_text
);
12053 Qcancel_timer
= intern ("cancel-timer");
12054 staticpro (&Qcancel_timer
);
12055 Qwait_for_wm
= intern ("wait-for-wm");
12056 staticpro (&Qwait_for_wm
);
12057 Qfullscreen
= intern ("fullscreen");
12058 staticpro (&Qfullscreen
);
12059 Qfullwidth
= intern ("fullwidth");
12060 staticpro (&Qfullwidth
);
12061 Qfullheight
= intern ("fullheight");
12062 staticpro (&Qfullheight
);
12063 Qfullboth
= intern ("fullboth");
12064 staticpro (&Qfullboth
);
12065 /* This is the end of symbol initialization. */
12067 /* Text property `display' should be nonsticky by default. */
12068 Vtext_property_default_nonsticky
12069 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
12072 Qlaplace
= intern ("laplace");
12073 staticpro (&Qlaplace
);
12074 Qemboss
= intern ("emboss");
12075 staticpro (&Qemboss
);
12076 Qedge_detection
= intern ("edge-detection");
12077 staticpro (&Qedge_detection
);
12078 Qheuristic
= intern ("heuristic");
12079 staticpro (&Qheuristic
);
12080 QCmatrix
= intern (":matrix");
12081 staticpro (&QCmatrix
);
12082 QCcolor_adjustment
= intern (":color-adjustment");
12083 staticpro (&QCcolor_adjustment
);
12084 QCmask
= intern (":mask");
12085 staticpro (&QCmask
);
12087 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
12088 staticpro (&Qface_set_after_frame_default
);
12090 Fput (Qundefined_color
, Qerror_conditions
,
12091 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
12092 Fput (Qundefined_color
, Qerror_message
,
12093 build_string ("Undefined color"));
12095 init_x_parm_symbols ();
12097 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
12098 doc
: /* Non-nil means always draw a cross over disabled images.
12099 Disabled images are those having an `:conversion disabled' property.
12100 A cross is always drawn on black & white displays. */);
12101 cross_disabled_images
= 0;
12103 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
12104 doc
: /* List of directories to search for window system bitmap files. */);
12105 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
12107 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
12108 doc
: /* The shape of the pointer when over text.
12109 Changing the value does not affect existing frames
12110 unless you set the mouse color. */);
12111 Vx_pointer_shape
= Qnil
;
12113 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
12114 doc
: /* The name Emacs uses to look up X resources.
12115 `x-get-resource' uses this as the first component of the instance name
12116 when requesting resource values.
12117 Emacs initially sets `x-resource-name' to the name under which Emacs
12118 was invoked, or to the value specified with the `-name' or `-rn'
12119 switches, if present.
12121 It may be useful to bind this variable locally around a call
12122 to `x-get-resource'. See also the variable `x-resource-class'. */);
12123 Vx_resource_name
= Qnil
;
12125 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
12126 doc
: /* The class Emacs uses to look up X resources.
12127 `x-get-resource' uses this as the first component of the instance class
12128 when requesting resource values.
12130 Emacs initially sets `x-resource-class' to "Emacs".
12132 Setting this variable permanently is not a reasonable thing to do,
12133 but binding this variable locally around a call to `x-get-resource'
12134 is a reasonable practice. See also the variable `x-resource-name'. */);
12135 Vx_resource_class
= build_string (EMACS_CLASS
);
12137 #if 0 /* This doesn't really do anything. */
12138 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
12139 doc
: /* The shape of the pointer when not over text.
12140 This variable takes effect when you create a new frame
12141 or when you set the mouse color. */);
12143 Vx_nontext_pointer_shape
= Qnil
;
12145 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
12146 doc
: /* The shape of the pointer when Emacs is busy.
12147 This variable takes effect when you create a new frame
12148 or when you set the mouse color. */);
12149 Vx_hourglass_pointer_shape
= Qnil
;
12151 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
12152 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
12153 display_hourglass_p
= 1;
12155 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
12156 doc
: /* *Seconds to wait before displaying an hourglass pointer.
12157 Value must be an integer or float. */);
12158 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
12160 #if 0 /* This doesn't really do anything. */
12161 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
12162 doc
: /* The shape of the pointer when over the mode line.
12163 This variable takes effect when you create a new frame
12164 or when you set the mouse color. */);
12166 Vx_mode_pointer_shape
= Qnil
;
12168 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
12169 &Vx_sensitive_text_pointer_shape
,
12170 doc
: /* The shape of the pointer when over mouse-sensitive text.
12171 This variable takes effect when you create a new frame
12172 or when you set the mouse color. */);
12173 Vx_sensitive_text_pointer_shape
= Qnil
;
12175 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
12176 &Vx_window_horizontal_drag_shape
,
12177 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
12178 This variable takes effect when you create a new frame
12179 or when you set the mouse color. */);
12180 Vx_window_horizontal_drag_shape
= Qnil
;
12182 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
12183 doc
: /* A string indicating the foreground color of the cursor box. */);
12184 Vx_cursor_fore_pixel
= Qnil
;
12186 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
12187 doc
: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
12188 Text larger than this is clipped. */);
12189 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
12191 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
12192 doc
: /* Non-nil if no X window manager is in use.
12193 Emacs doesn't try to figure this out; this is always nil
12194 unless you set it to something else. */);
12195 /* We don't have any way to find this out, so set it to nil
12196 and maybe the user would like to set it to t. */
12197 Vx_no_window_manager
= Qnil
;
12199 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
12200 &Vx_pixel_size_width_font_regexp
,
12201 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
12203 Since Emacs gets width of a font matching with this regexp from
12204 PIXEL_SIZE field of the name, font finding mechanism gets faster for
12205 such a font. This is especially effective for such large fonts as
12206 Chinese, Japanese, and Korean. */);
12207 Vx_pixel_size_width_font_regexp
= Qnil
;
12209 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
12210 doc
: /* Time after which cached images are removed from the cache.
12211 When an image has not been displayed this many seconds, remove it
12212 from the image cache. Value must be an integer or nil with nil
12213 meaning don't clear the cache. */);
12214 Vimage_cache_eviction_delay
= make_number (30 * 60);
12216 #ifdef USE_X_TOOLKIT
12217 Fprovide (intern ("x-toolkit"), Qnil
);
12219 Fprovide (intern ("motif"), Qnil
);
12221 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string
,
12222 doc
: /* Version info for LessTif/Motif. */);
12223 Vmotif_version_string
= build_string (XmVERSION_STRING
);
12224 #endif /* USE_MOTIF */
12225 #endif /* USE_X_TOOLKIT */
12227 defsubr (&Sx_get_resource
);
12229 /* X window properties. */
12230 defsubr (&Sx_change_window_property
);
12231 defsubr (&Sx_delete_window_property
);
12232 defsubr (&Sx_window_property
);
12234 defsubr (&Sxw_display_color_p
);
12235 defsubr (&Sx_display_grayscale_p
);
12236 defsubr (&Sxw_color_defined_p
);
12237 defsubr (&Sxw_color_values
);
12238 defsubr (&Sx_server_max_request_size
);
12239 defsubr (&Sx_server_vendor
);
12240 defsubr (&Sx_server_version
);
12241 defsubr (&Sx_display_pixel_width
);
12242 defsubr (&Sx_display_pixel_height
);
12243 defsubr (&Sx_display_mm_width
);
12244 defsubr (&Sx_display_mm_height
);
12245 defsubr (&Sx_display_screens
);
12246 defsubr (&Sx_display_planes
);
12247 defsubr (&Sx_display_color_cells
);
12248 defsubr (&Sx_display_visual_class
);
12249 defsubr (&Sx_display_backing_store
);
12250 defsubr (&Sx_display_save_under
);
12251 defsubr (&Sx_parse_geometry
);
12252 defsubr (&Sx_create_frame
);
12253 defsubr (&Sx_open_connection
);
12254 defsubr (&Sx_close_connection
);
12255 defsubr (&Sx_display_list
);
12256 defsubr (&Sx_synchronize
);
12257 defsubr (&Sx_focus_frame
);
12258 defsubr (&Sx_backspace_delete_keys_p
);
12260 /* Setting callback functions for fontset handler. */
12261 get_font_info_func
= x_get_font_info
;
12263 #if 0 /* This function pointer doesn't seem to be used anywhere.
12264 And the pointer assigned has the wrong type, anyway. */
12265 list_fonts_func
= x_list_fonts
;
12268 load_font_func
= x_load_font
;
12269 find_ccl_program_func
= x_find_ccl_program
;
12270 query_font_func
= x_query_font
;
12271 set_frame_fontset_func
= x_set_font
;
12272 check_window_system_func
= check_x
;
12275 Qxbm
= intern ("xbm");
12277 QCconversion
= intern (":conversion");
12278 staticpro (&QCconversion
);
12279 QCheuristic_mask
= intern (":heuristic-mask");
12280 staticpro (&QCheuristic_mask
);
12281 QCcolor_symbols
= intern (":color-symbols");
12282 staticpro (&QCcolor_symbols
);
12283 QCascent
= intern (":ascent");
12284 staticpro (&QCascent
);
12285 QCmargin
= intern (":margin");
12286 staticpro (&QCmargin
);
12287 QCrelief
= intern (":relief");
12288 staticpro (&QCrelief
);
12289 Qpostscript
= intern ("postscript");
12290 staticpro (&Qpostscript
);
12291 QCloader
= intern (":loader");
12292 staticpro (&QCloader
);
12293 QCbounding_box
= intern (":bounding-box");
12294 staticpro (&QCbounding_box
);
12295 QCpt_width
= intern (":pt-width");
12296 staticpro (&QCpt_width
);
12297 QCpt_height
= intern (":pt-height");
12298 staticpro (&QCpt_height
);
12299 QCindex
= intern (":index");
12300 staticpro (&QCindex
);
12301 Qpbm
= intern ("pbm");
12305 Qxpm
= intern ("xpm");
12310 Qjpeg
= intern ("jpeg");
12311 staticpro (&Qjpeg
);
12315 Qtiff
= intern ("tiff");
12316 staticpro (&Qtiff
);
12320 Qgif
= intern ("gif");
12325 Qpng
= intern ("png");
12329 defsubr (&Sclear_image_cache
);
12330 defsubr (&Simage_size
);
12331 defsubr (&Simage_mask_p
);
12333 hourglass_atimer
= NULL
;
12334 hourglass_shown_p
= 0;
12336 defsubr (&Sx_show_tip
);
12337 defsubr (&Sx_hide_tip
);
12339 staticpro (&tip_timer
);
12341 staticpro (&tip_frame
);
12343 last_show_tip_args
= Qnil
;
12344 staticpro (&last_show_tip_args
);
12347 defsubr (&Sx_file_dialog
);
12355 image_types
= NULL
;
12356 Vimage_types
= Qnil
;
12358 define_image_type (&xbm_type
);
12359 define_image_type (&gs_type
);
12360 define_image_type (&pbm_type
);
12363 define_image_type (&xpm_type
);
12367 define_image_type (&jpeg_type
);
12371 define_image_type (&tiff_type
);
12375 define_image_type (&gif_type
);
12379 define_image_type (&png_type
);
12383 #endif /* HAVE_X_WINDOWS */