1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999, 2000, 2001
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
31 /* This makes the fields of a Display accessible, in Xlib header files. */
33 #define XLIB_ILLEGAL_ACCESS
40 #include "intervals.h"
41 #include "dispextern.h"
43 #include "blockinput.h"
49 #include "termhooks.h"
55 #include <sys/types.h>
59 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
60 #include "bitmaps/gray.xbm"
62 #include <X11/bitmaps/gray>
65 #include "[.bitmaps]gray.xbm"
73 #include <X11/Shell.h>
76 #include <X11/Xaw/Paned.h>
77 #include <X11/Xaw/Label.h>
78 #endif /* USE_MOTIF */
81 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
90 #include "../lwlib/lwlib.h"
94 #include <Xm/DialogS.h>
95 #include <Xm/FileSB.h>
98 /* Do the EDITRES protocol if running X11R5
99 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
101 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
103 extern void _XEditResCheckMessages ();
104 #endif /* R5 + Athena */
106 /* Unique id counter for widgets created by the Lucid Widget Library. */
108 extern LWLIB_ID widget_id_tick
;
111 /* This is part of a kludge--see lwlib/xlwmenu.c. */
112 extern XFontStruct
*xlwmenu_default_font
;
115 extern void free_frame_menubar ();
116 extern double atof ();
120 /* LessTif/Motif version info. */
122 static Lisp_Object Vmotif_version_string
;
124 #endif /* USE_MOTIF */
126 #endif /* USE_X_TOOLKIT */
129 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
131 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
134 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
135 it, and including `bitmaps/gray' more than once is a problem when
136 config.h defines `static' as an empty replacement string. */
138 int gray_bitmap_width
= gray_width
;
139 int gray_bitmap_height
= gray_height
;
140 char *gray_bitmap_bits
= gray_bits
;
142 /* The name we're using in resource queries. Most often "emacs". */
144 Lisp_Object Vx_resource_name
;
146 /* The application class we're using in resource queries.
149 Lisp_Object Vx_resource_class
;
151 /* Non-zero means we're allowed to display an hourglass cursor. */
153 int display_hourglass_p
;
155 /* The background and shape of the mouse pointer, and shape when not
156 over text or in the modeline. */
158 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
159 Lisp_Object Vx_hourglass_pointer_shape
;
161 /* The shape when over mouse-sensitive text. */
163 Lisp_Object Vx_sensitive_text_pointer_shape
;
165 /* If non-nil, the pointer shape to indicate that windows can be
166 dragged horizontally. */
168 Lisp_Object Vx_window_horizontal_drag_shape
;
170 /* Color of chars displayed in cursor box. */
172 Lisp_Object Vx_cursor_fore_pixel
;
174 /* Nonzero if using X. */
178 /* Non nil if no window manager is in use. */
180 Lisp_Object Vx_no_window_manager
;
182 /* Search path for bitmap files. */
184 Lisp_Object Vx_bitmap_file_path
;
186 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
188 Lisp_Object Vx_pixel_size_width_font_regexp
;
190 Lisp_Object Qauto_raise
;
191 Lisp_Object Qauto_lower
;
192 Lisp_Object Qborder_color
;
193 Lisp_Object Qborder_width
;
194 extern Lisp_Object Qbox
;
195 Lisp_Object Qcursor_color
;
196 Lisp_Object Qcursor_type
;
197 Lisp_Object Qgeometry
;
198 Lisp_Object Qicon_left
;
199 Lisp_Object Qicon_top
;
200 Lisp_Object Qicon_type
;
201 Lisp_Object Qicon_name
;
202 Lisp_Object Qinternal_border_width
;
205 Lisp_Object Qmouse_color
;
207 Lisp_Object Qouter_window_id
;
208 Lisp_Object Qparent_id
;
209 Lisp_Object Qscroll_bar_width
;
210 Lisp_Object Qsuppress_icon
;
211 extern Lisp_Object Qtop
;
212 Lisp_Object Qundefined_color
;
213 Lisp_Object Qvertical_scroll_bars
;
214 Lisp_Object Qvisibility
;
215 Lisp_Object Qwindow_id
;
216 Lisp_Object Qx_frame_parameter
;
217 Lisp_Object Qx_resource_name
;
218 Lisp_Object Quser_position
;
219 Lisp_Object Quser_size
;
220 extern Lisp_Object Qdisplay
;
221 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
222 Lisp_Object Qscreen_gamma
, Qline_spacing
, Qcenter
;
223 Lisp_Object Qcompound_text
, Qcancel_timer
;
224 Lisp_Object Qwait_for_wm
;
225 Lisp_Object Qfullscreen
;
226 Lisp_Object Qfullwidth
;
227 Lisp_Object Qfullheight
;
228 Lisp_Object Qfullboth
;
230 /* The below are defined in frame.c. */
232 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
233 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
234 extern Lisp_Object Qtool_bar_lines
;
236 extern Lisp_Object Vwindow_system_version
;
238 Lisp_Object Qface_set_after_frame_default
;
241 int image_cache_refcount
, dpyinfo_refcount
;
246 /* Error if we are not connected to X. */
252 error ("X windows are not in use or not initialized");
255 /* Nonzero if we can use mouse menus.
256 You should not call this unless HAVE_MENUS is defined. */
264 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
265 and checking validity for X. */
268 check_x_frame (frame
)
274 frame
= selected_frame
;
275 CHECK_LIVE_FRAME (frame
);
278 error ("Non-X frame used");
282 /* Let the user specify an X display with a frame.
283 nil stands for the selected frame--or, if that is not an X frame,
284 the first X display on the list. */
286 static struct x_display_info
*
287 check_x_display_info (frame
)
290 struct x_display_info
*dpyinfo
= NULL
;
294 struct frame
*sf
= XFRAME (selected_frame
);
296 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
297 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
298 else if (x_display_list
!= 0)
299 dpyinfo
= x_display_list
;
301 error ("X windows are not in use or not initialized");
303 else if (STRINGP (frame
))
304 dpyinfo
= x_display_info_for_name (frame
);
307 FRAME_PTR f
= check_x_frame (frame
);
308 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
315 /* Return the Emacs frame-object corresponding to an X window.
316 It could be the frame's main window or an icon window. */
318 /* This function can be called during GC, so use GC_xxx type test macros. */
321 x_window_to_frame (dpyinfo
, wdesc
)
322 struct x_display_info
*dpyinfo
;
325 Lisp_Object tail
, frame
;
328 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
331 if (!GC_FRAMEP (frame
))
334 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
336 if (f
->output_data
.x
->hourglass_window
== wdesc
)
339 if ((f
->output_data
.x
->edit_widget
340 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
341 /* A tooltip frame? */
342 || (!f
->output_data
.x
->edit_widget
343 && FRAME_X_WINDOW (f
) == wdesc
)
344 || f
->output_data
.x
->icon_desc
== wdesc
)
346 #else /* not USE_X_TOOLKIT */
348 if (f
->output_data
.x
->edit_widget
)
350 GtkWidget
*gwdesc
= xg_win_to_widget (wdesc
);
351 struct x_output
*x
= f
->output_data
.x
;
352 if (gwdesc
!= 0 && gwdesc
== x
->edit_widget
)
356 if (FRAME_X_WINDOW (f
) == wdesc
357 || f
->output_data
.x
->icon_desc
== wdesc
)
359 #endif /* not USE_X_TOOLKIT */
364 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
365 /* Like x_window_to_frame but also compares the window with the widget's
369 x_any_window_to_frame (dpyinfo
, wdesc
)
370 struct x_display_info
*dpyinfo
;
373 Lisp_Object tail
, frame
;
374 struct frame
*f
, *found
;
378 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
381 if (!GC_FRAMEP (frame
))
385 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
387 /* This frame matches if the window is any of its widgets. */
388 x
= f
->output_data
.x
;
389 if (x
->hourglass_window
== wdesc
)
394 GtkWidget
*gwdesc
= xg_win_to_widget (wdesc
);
396 && (gwdesc
== x
->widget
397 || gwdesc
== x
->edit_widget
398 || gwdesc
== x
->vbox_widget
399 || gwdesc
== x
->menubar_widget
))
402 if (wdesc
== XtWindow (x
->widget
)
403 || wdesc
== XtWindow (x
->column_widget
)
404 || wdesc
== XtWindow (x
->edit_widget
))
406 /* Match if the window is this frame's menubar. */
407 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
411 else if (FRAME_X_WINDOW (f
) == wdesc
)
412 /* A tooltip frame. */
420 /* Likewise, but exclude the menu bar widget. */
423 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
424 struct x_display_info
*dpyinfo
;
427 Lisp_Object tail
, frame
;
431 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
434 if (!GC_FRAMEP (frame
))
437 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
439 x
= f
->output_data
.x
;
440 /* This frame matches if the window is any of its widgets. */
441 if (x
->hourglass_window
== wdesc
)
446 GtkWidget
*gwdesc
= xg_win_to_widget (wdesc
);
448 && (gwdesc
== x
->widget
449 || gwdesc
== x
->edit_widget
450 || gwdesc
== x
->vbox_widget
))
453 if (wdesc
== XtWindow (x
->widget
)
454 || wdesc
== XtWindow (x
->column_widget
)
455 || wdesc
== XtWindow (x
->edit_widget
))
459 else if (FRAME_X_WINDOW (f
) == wdesc
)
460 /* A tooltip frame. */
466 /* Likewise, but consider only the menu bar widget. */
469 x_menubar_window_to_frame (dpyinfo
, wdesc
)
470 struct x_display_info
*dpyinfo
;
473 Lisp_Object tail
, frame
;
477 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
480 if (!GC_FRAMEP (frame
))
483 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
485 x
= f
->output_data
.x
;
486 /* Match if the window is this frame's menubar. */
488 if (x
->menubar_widget
)
490 GtkWidget
*gwdesc
= xg_win_to_widget (wdesc
);
495 && (gwdesc
== x
->menubar_widget
496 || gtk_widget_get_parent (gwdesc
) == x
->menubar_widget
))
502 if (x
->menubar_widget
503 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
510 /* Return the frame whose principal (outermost) window is WDESC.
511 If WDESC is some other (smaller) window, we return 0. */
514 x_top_window_to_frame (dpyinfo
, wdesc
)
515 struct x_display_info
*dpyinfo
;
518 Lisp_Object tail
, frame
;
522 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
525 if (!GC_FRAMEP (frame
))
528 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
530 x
= f
->output_data
.x
;
534 /* This frame matches if the window is its topmost widget. */
536 GtkWidget
*gwdesc
= xg_win_to_widget (wdesc
);
537 if (gwdesc
== x
->widget
)
540 if (wdesc
== XtWindow (x
->widget
))
542 #if 0 /* I don't know why it did this,
543 but it seems logically wrong,
544 and it causes trouble for MapNotify events. */
545 /* Match if the window is this frame's menubar. */
546 if (x
->menubar_widget
547 && wdesc
== XtWindow (x
->menubar_widget
))
552 else if (FRAME_X_WINDOW (f
) == wdesc
)
558 #endif /* USE_X_TOOLKIT || USE_GTK */
562 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
563 id, which is just an int that this section returns. Bitmaps are
564 reference counted so they can be shared among frames.
566 Bitmap indices are guaranteed to be > 0, so a negative number can
567 be used to indicate no bitmap.
569 If you use x_create_bitmap_from_data, then you must keep track of
570 the bitmaps yourself. That is, creating a bitmap from the same
571 data more than once will not be caught. */
574 /* Functions to access the contents of a bitmap, given an id. */
577 x_bitmap_height (f
, id
)
581 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
585 x_bitmap_width (f
, id
)
589 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
593 x_bitmap_pixmap (f
, id
)
597 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
601 /* Allocate a new bitmap record. Returns index of new record. */
604 x_allocate_bitmap_record (f
)
607 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
610 if (dpyinfo
->bitmaps
== NULL
)
612 dpyinfo
->bitmaps_size
= 10;
614 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
615 dpyinfo
->bitmaps_last
= 1;
619 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
620 return ++dpyinfo
->bitmaps_last
;
622 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
623 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
626 dpyinfo
->bitmaps_size
*= 2;
628 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
629 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
630 return ++dpyinfo
->bitmaps_last
;
633 /* Add one reference to the reference count of the bitmap with id ID. */
636 x_reference_bitmap (f
, id
)
640 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
643 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
646 x_create_bitmap_from_data (f
, bits
, width
, height
)
649 unsigned int width
, height
;
651 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
655 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
656 bits
, width
, height
);
661 id
= x_allocate_bitmap_record (f
);
662 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
663 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
664 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
665 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
666 dpyinfo
->bitmaps
[id
- 1].height
= height
;
667 dpyinfo
->bitmaps
[id
- 1].width
= width
;
672 /* Create bitmap from file FILE for frame F. */
675 x_create_bitmap_from_file (f
, file
)
679 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
680 unsigned int width
, height
;
682 int xhot
, yhot
, result
, id
;
687 /* Look for an existing bitmap with the same name. */
688 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
690 if (dpyinfo
->bitmaps
[id
].refcount
691 && dpyinfo
->bitmaps
[id
].file
692 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) SDATA (file
)))
694 ++dpyinfo
->bitmaps
[id
].refcount
;
699 /* Search bitmap-file-path for the file, if appropriate. */
700 fd
= openp (Vx_bitmap_file_path
, file
, Qnil
, &found
, Qnil
);
705 filename
= (char *) SDATA (found
);
707 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
708 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
709 if (result
!= BitmapSuccess
)
712 id
= x_allocate_bitmap_record (f
);
713 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
714 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
715 dpyinfo
->bitmaps
[id
- 1].file
716 = (char *) xmalloc (SBYTES (file
) + 1);
717 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
718 dpyinfo
->bitmaps
[id
- 1].height
= height
;
719 dpyinfo
->bitmaps
[id
- 1].width
= width
;
720 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, SDATA (file
));
725 /* Remove reference to bitmap with id number ID. */
728 x_destroy_bitmap (f
, id
)
732 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
736 --dpyinfo
->bitmaps
[id
- 1].refcount
;
737 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
740 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
741 if (dpyinfo
->bitmaps
[id
- 1].file
)
743 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
744 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
751 /* Free all the bitmaps for the display specified by DPYINFO. */
754 x_destroy_all_bitmaps (dpyinfo
)
755 struct x_display_info
*dpyinfo
;
758 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
759 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
761 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
762 if (dpyinfo
->bitmaps
[i
].file
)
763 xfree (dpyinfo
->bitmaps
[i
].file
);
765 dpyinfo
->bitmaps_last
= 0;
768 /* Connect the frame-parameter names for X frames
769 to the ways of passing the parameter values to the window system.
771 The name of a parameter, as a Lisp symbol,
772 has an `x-frame-parameter' property which is an integer in Lisp
773 that is an index in this table. */
775 struct x_frame_parm_table
778 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
781 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
782 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
783 static void x_change_window_heights
P_ ((Lisp_Object
, int));
784 static void x_disable_image
P_ ((struct frame
*, struct image
*));
785 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
786 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
787 static void x_set_wait_for_wm
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
788 static void x_set_fullscreen
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
789 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
790 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
791 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
792 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
793 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
794 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
795 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
796 static void x_set_fringe_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
797 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
798 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
799 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
801 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
802 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
803 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
804 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
806 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
807 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
808 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
809 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
810 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
811 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
812 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
814 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
816 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
821 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
822 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
824 static void init_color_table
P_ ((void));
825 static void free_color_table
P_ ((void));
826 static unsigned long *colors_in_color_table
P_ ((int *n
));
827 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
828 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
832 static struct x_frame_parm_table x_frame_parms
[] =
834 {"auto-raise", x_set_autoraise
},
835 {"auto-lower", x_set_autolower
},
836 {"background-color", x_set_background_color
},
837 {"border-color", x_set_border_color
},
838 {"border-width", x_set_border_width
},
839 {"cursor-color", x_set_cursor_color
},
840 {"cursor-type", x_set_cursor_type
},
841 {"font", x_set_font
},
842 {"foreground-color", x_set_foreground_color
},
843 {"icon-name", x_set_icon_name
},
844 {"icon-type", x_set_icon_type
},
845 {"internal-border-width", x_set_internal_border_width
},
846 {"menu-bar-lines", x_set_menu_bar_lines
},
847 {"mouse-color", x_set_mouse_color
},
848 {"name", x_explicitly_set_name
},
849 {"scroll-bar-width", x_set_scroll_bar_width
},
850 {"title", x_set_title
},
851 {"unsplittable", x_set_unsplittable
},
852 {"vertical-scroll-bars", x_set_vertical_scroll_bars
},
853 {"visibility", x_set_visibility
},
854 {"tool-bar-lines", x_set_tool_bar_lines
},
855 {"scroll-bar-foreground", x_set_scroll_bar_foreground
},
856 {"scroll-bar-background", x_set_scroll_bar_background
},
857 {"screen-gamma", x_set_screen_gamma
},
858 {"line-spacing", x_set_line_spacing
},
859 {"left-fringe", x_set_fringe_width
},
860 {"right-fringe", x_set_fringe_width
},
861 {"wait-for-wm", x_set_wait_for_wm
},
862 {"fullscreen", x_set_fullscreen
},
866 /* Attach the `x-frame-parameter' properties to
867 the Lisp symbol names of parameters relevant to X. */
870 init_x_parm_symbols ()
874 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
875 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
880 /* Really try to move where we want to be in case of fullscreen. Some WMs
881 moves the window where we tell them. Some (mwm, twm) moves the outer
882 window manager window there instead.
883 Try to compensate for those WM here. */
885 x_fullscreen_move (f
, new_top
, new_left
)
890 if (new_top
!= f
->output_data
.x
->top_pos
891 || new_left
!= f
->output_data
.x
->left_pos
)
893 int move_x
= new_left
+ f
->output_data
.x
->x_pixels_outer_diff
;
894 int move_y
= new_top
+ f
->output_data
.x
->y_pixels_outer_diff
;
896 f
->output_data
.x
->want_fullscreen
|= FULLSCREEN_MOVE_WAIT
;
897 x_set_offset (f
, move_x
, move_y
, 1);
901 /* Change the parameters of frame F as specified by ALIST.
902 If a parameter is not specially recognized, do nothing special;
903 otherwise call the `x_set_...' function for that parameter.
904 Except for certain geometry properties, always call store_frame_param
905 to store the new value in the parameter alist. */
908 x_set_frame_parameters (f
, alist
)
914 /* If both of these parameters are present, it's more efficient to
915 set them both at once. So we wait until we've looked at the
916 entire list before we set them. */
920 Lisp_Object left
, top
;
922 /* Same with these. */
923 Lisp_Object icon_left
, icon_top
;
925 /* Record in these vectors all the parms specified. */
929 int left_no_change
= 0, top_no_change
= 0;
930 int icon_left_no_change
= 0, icon_top_no_change
= 0;
931 int fullscreen_is_being_set
= 0;
933 struct gcpro gcpro1
, gcpro2
;
936 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
939 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
940 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
942 /* Extract parm names and values into those vectors. */
945 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
950 parms
[i
] = Fcar (elt
);
951 values
[i
] = Fcdr (elt
);
954 /* TAIL and ALIST are not used again below here. */
957 GCPRO2 (*parms
, *values
);
961 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
962 because their values appear in VALUES and strings are not valid. */
963 top
= left
= Qunbound
;
964 icon_left
= icon_top
= Qunbound
;
966 /* Provide default values for HEIGHT and WIDTH. */
967 if (FRAME_NEW_WIDTH (f
))
968 width
= FRAME_NEW_WIDTH (f
);
970 width
= FRAME_WIDTH (f
);
972 if (FRAME_NEW_HEIGHT (f
))
973 height
= FRAME_NEW_HEIGHT (f
);
975 height
= FRAME_HEIGHT (f
);
977 /* Process foreground_color and background_color before anything else.
978 They are independent of other properties, but other properties (e.g.,
979 cursor_color) are dependent upon them. */
980 /* Process default font as well, since fringe widths depends on it. */
981 /* Also, process fullscreen, width and height depend upon that */
982 for (p
= 0; p
< i
; p
++)
984 Lisp_Object prop
, val
;
988 if (EQ (prop
, Qforeground_color
)
989 || EQ (prop
, Qbackground_color
)
991 || EQ (prop
, Qfullscreen
))
993 register Lisp_Object param_index
, old_value
;
995 old_value
= get_frame_param (f
, prop
);
996 fullscreen_is_being_set
|= EQ (prop
, Qfullscreen
);
998 if (NILP (Fequal (val
, old_value
)))
1000 store_frame_param (f
, prop
, val
);
1002 param_index
= Fget (prop
, Qx_frame_parameter
);
1003 if (NATNUMP (param_index
)
1004 && (XFASTINT (param_index
)
1005 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
1006 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
1011 /* Now process them in reverse of specified order. */
1012 for (i
--; i
>= 0; i
--)
1014 Lisp_Object prop
, val
;
1019 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
1020 width
= XFASTINT (val
);
1021 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
1022 height
= XFASTINT (val
);
1023 else if (EQ (prop
, Qtop
))
1025 else if (EQ (prop
, Qleft
))
1027 else if (EQ (prop
, Qicon_top
))
1029 else if (EQ (prop
, Qicon_left
))
1031 else if (EQ (prop
, Qforeground_color
)
1032 || EQ (prop
, Qbackground_color
)
1034 || EQ (prop
, Qfullscreen
))
1035 /* Processed above. */
1039 register Lisp_Object param_index
, old_value
;
1041 old_value
= get_frame_param (f
, prop
);
1043 store_frame_param (f
, prop
, val
);
1045 param_index
= Fget (prop
, Qx_frame_parameter
);
1046 if (NATNUMP (param_index
)
1047 && (XFASTINT (param_index
)
1048 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
1049 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
1053 /* Don't die if just one of these was set. */
1054 if (EQ (left
, Qunbound
))
1057 if (f
->output_data
.x
->left_pos
< 0)
1058 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
1060 XSETINT (left
, f
->output_data
.x
->left_pos
);
1062 if (EQ (top
, Qunbound
))
1065 if (f
->output_data
.x
->top_pos
< 0)
1066 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
1068 XSETINT (top
, f
->output_data
.x
->top_pos
);
1071 /* If one of the icon positions was not set, preserve or default it. */
1072 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
1074 icon_left_no_change
= 1;
1075 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
1076 if (NILP (icon_left
))
1077 XSETINT (icon_left
, 0);
1079 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
1081 icon_top_no_change
= 1;
1082 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
1083 if (NILP (icon_top
))
1084 XSETINT (icon_top
, 0);
1087 if (FRAME_VISIBLE_P (f
) && fullscreen_is_being_set
)
1089 /* If the frame is visible already and the fullscreen parameter is
1090 being set, it is too late to set WM manager hints to specify
1092 Here we first get the width, height and position that applies to
1093 fullscreen. We then move the frame to the appropriate
1094 position. Resize of the frame is taken care of in the code after
1095 this if-statement. */
1096 int new_left
, new_top
;
1098 x_fullscreen_adjust (f
, &width
, &height
, &new_top
, &new_left
);
1099 x_fullscreen_move (f
, new_top
, new_left
);
1102 /* Don't set these parameters unless they've been explicitly
1103 specified. The window might be mapped or resized while we're in
1104 this function, and we don't want to override that unless the lisp
1105 code has asked for it.
1107 Don't set these parameters unless they actually differ from the
1108 window's current parameters; the window may not actually exist
1113 check_frame_size (f
, &height
, &width
);
1115 XSETFRAME (frame
, f
);
1117 if (width
!= FRAME_WIDTH (f
)
1118 || height
!= FRAME_HEIGHT (f
)
1119 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1120 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1122 if ((!NILP (left
) || !NILP (top
))
1123 && ! (left_no_change
&& top_no_change
)
1124 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1125 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1130 /* Record the signs. */
1131 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1132 if (EQ (left
, Qminus
))
1133 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1134 else if (INTEGERP (left
))
1136 leftpos
= XINT (left
);
1138 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1140 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1141 && CONSP (XCDR (left
))
1142 && INTEGERP (XCAR (XCDR (left
))))
1144 leftpos
= - XINT (XCAR (XCDR (left
)));
1145 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1147 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1148 && CONSP (XCDR (left
))
1149 && INTEGERP (XCAR (XCDR (left
))))
1151 leftpos
= XINT (XCAR (XCDR (left
)));
1154 if (EQ (top
, Qminus
))
1155 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1156 else if (INTEGERP (top
))
1158 toppos
= XINT (top
);
1160 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1162 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1163 && CONSP (XCDR (top
))
1164 && INTEGERP (XCAR (XCDR (top
))))
1166 toppos
= - XINT (XCAR (XCDR (top
)));
1167 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1169 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1170 && CONSP (XCDR (top
))
1171 && INTEGERP (XCAR (XCDR (top
))))
1173 toppos
= XINT (XCAR (XCDR (top
)));
1177 /* Store the numeric value of the position. */
1178 f
->output_data
.x
->top_pos
= toppos
;
1179 f
->output_data
.x
->left_pos
= leftpos
;
1181 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1183 /* Actually set that position, and convert to absolute. */
1184 x_set_offset (f
, leftpos
, toppos
, -1);
1187 if ((!NILP (icon_left
) || !NILP (icon_top
))
1188 && ! (icon_left_no_change
&& icon_top_no_change
))
1189 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1195 /* Store the screen positions of frame F into XPTR and YPTR.
1196 These are the positions of the containing window manager window,
1197 not Emacs's own window. */
1200 x_real_positions (f
, xptr
, yptr
)
1204 int win_x
, win_y
, outer_x
, outer_y
;
1205 int real_x
= 0, real_y
= 0;
1207 Window win
= f
->output_data
.x
->parent_desc
;
1213 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1215 if (win
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1216 win
= FRAME_OUTER_WINDOW (f
);
1218 /* This loop traverses up the containment tree until we hit the root
1219 window. Window managers may intersect many windows between our window
1220 and the root window. The window we find just before the root window
1221 should be the outer WM window. */
1224 Window wm_window
, rootw
;
1225 Window
*tmp_children
;
1226 unsigned int tmp_nchildren
;
1229 success
= XQueryTree (FRAME_X_DISPLAY (f
), win
, &rootw
,
1230 &wm_window
, &tmp_children
, &tmp_nchildren
);
1232 had_errors
= x_had_errors_p (FRAME_X_DISPLAY (f
));
1234 /* Don't free tmp_children if XQueryTree failed. */
1238 XFree ((char *) tmp_children
);
1240 if (wm_window
== rootw
|| had_errors
)
1249 Window child
, rootw
;
1251 /* Get the real coordinates for the WM window upper left corner */
1252 XGetGeometry (FRAME_X_DISPLAY (f
), win
,
1253 &rootw
, &real_x
, &real_y
, &ign
, &ign
, &ign
, &ign
);
1255 /* Translate real coordinates to coordinates relative to our
1256 window. For our window, the upper left corner is 0, 0.
1257 Since the upper left corner of the WM window is outside
1258 our window, win_x and win_y will be negative:
1260 ------------------ ---> x
1262 | ----------------- v y
1265 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1267 /* From-window, to-window. */
1268 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1271 /* From-position, to-position. */
1272 real_x
, real_y
, &win_x
, &win_y
,
1277 if (FRAME_X_WINDOW (f
) == FRAME_OUTER_WINDOW (f
))
1284 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1286 /* From-window, to-window. */
1287 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1288 FRAME_OUTER_WINDOW (f
),
1290 /* From-position, to-position. */
1291 real_x
, real_y
, &outer_x
, &outer_y
,
1297 had_errors
= x_had_errors_p (FRAME_X_DISPLAY (f
));
1300 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1304 if (had_errors
) return;
1306 f
->output_data
.x
->x_pixels_diff
= -win_x
;
1307 f
->output_data
.x
->y_pixels_diff
= -win_y
;
1308 f
->output_data
.x
->x_pixels_outer_diff
= -outer_x
;
1309 f
->output_data
.x
->y_pixels_outer_diff
= -outer_y
;
1315 /* Insert a description of internally-recorded parameters of frame X
1316 into the parameter alist *ALISTPTR that is to be given to the user.
1317 Only parameters that are specific to the X window system
1318 and whose values are not correctly recorded in the frame's
1319 param_alist need to be considered here. */
1322 x_report_frame_params (f
, alistptr
)
1324 Lisp_Object
*alistptr
;
1329 /* Represent negative positions (off the top or left screen edge)
1330 in a way that Fmodify_frame_parameters will understand correctly. */
1331 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1332 if (f
->output_data
.x
->left_pos
>= 0)
1333 store_in_alist (alistptr
, Qleft
, tem
);
1335 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1337 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1338 if (f
->output_data
.x
->top_pos
>= 0)
1339 store_in_alist (alistptr
, Qtop
, tem
);
1341 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1343 store_in_alist (alistptr
, Qborder_width
,
1344 make_number (f
->output_data
.x
->border_width
));
1345 store_in_alist (alistptr
, Qinternal_border_width
,
1346 make_number (f
->output_data
.x
->internal_border_width
));
1347 store_in_alist (alistptr
, Qleft_fringe
,
1348 make_number (f
->output_data
.x
->left_fringe_width
));
1349 store_in_alist (alistptr
, Qright_fringe
,
1350 make_number (f
->output_data
.x
->right_fringe_width
));
1351 store_in_alist (alistptr
, Qscroll_bar_width
,
1352 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1354 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
1355 ? make_number (FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
1356 /* nil means "use default width"
1357 for non-toolkit scroll bar.
1358 ruler-mode.el depends on this. */
1360 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1361 store_in_alist (alistptr
, Qwindow_id
,
1362 build_string (buf
));
1363 #ifdef USE_X_TOOLKIT
1364 /* Tooltip frame may not have this widget. */
1365 if (f
->output_data
.x
->widget
)
1367 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1368 store_in_alist (alistptr
, Qouter_window_id
,
1369 build_string (buf
));
1370 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1371 FRAME_SAMPLE_VISIBILITY (f
);
1372 store_in_alist (alistptr
, Qvisibility
,
1373 (FRAME_VISIBLE_P (f
) ? Qt
1374 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1375 store_in_alist (alistptr
, Qdisplay
,
1376 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1378 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1381 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1382 store_in_alist (alistptr
, Qparent_id
, tem
);
1387 /* Gamma-correct COLOR on frame F. */
1390 gamma_correct (f
, color
)
1396 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1397 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1398 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1403 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1404 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1405 allocate the color. Value is zero if COLOR_NAME is invalid, or
1406 no color could be allocated. */
1409 x_defined_color (f
, color_name
, color
, alloc_p
)
1416 Display
*dpy
= FRAME_X_DISPLAY (f
);
1417 Colormap cmap
= FRAME_X_COLORMAP (f
);
1420 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1421 if (success_p
&& alloc_p
)
1422 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1429 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1430 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1431 Signal an error if color can't be allocated. */
1434 x_decode_color (f
, color_name
, mono_color
)
1436 Lisp_Object color_name
;
1441 CHECK_STRING (color_name
);
1443 #if 0 /* Don't do this. It's wrong when we're not using the default
1444 colormap, it makes freeing difficult, and it's probably not
1445 an important optimization. */
1446 if (strcmp (SDATA (color_name
), "black") == 0)
1447 return BLACK_PIX_DEFAULT (f
);
1448 else if (strcmp (SDATA (color_name
), "white") == 0)
1449 return WHITE_PIX_DEFAULT (f
);
1452 /* Return MONO_COLOR for monochrome frames. */
1453 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1456 /* x_defined_color is responsible for coping with failures
1457 by looking for a near-miss. */
1458 if (x_defined_color (f
, SDATA (color_name
), &cdef
, 1))
1461 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1462 Fcons (color_name
, Qnil
)));
1468 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1469 the previous value of that parameter, NEW_VALUE is the new value. */
1472 x_set_line_spacing (f
, new_value
, old_value
)
1474 Lisp_Object new_value
, old_value
;
1476 if (NILP (new_value
))
1477 f
->extra_line_spacing
= 0;
1478 else if (NATNUMP (new_value
))
1479 f
->extra_line_spacing
= XFASTINT (new_value
);
1481 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1482 Fcons (new_value
, Qnil
)));
1483 if (FRAME_VISIBLE_P (f
))
1488 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1489 the previous value of that parameter, NEW_VALUE is the new value.
1490 See also the comment of wait_for_wm in struct x_output. */
1493 x_set_wait_for_wm (f
, new_value
, old_value
)
1495 Lisp_Object new_value
, old_value
;
1497 f
->output_data
.x
->wait_for_wm
= !NILP (new_value
);
1501 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
1502 the previous value of that parameter, NEW_VALUE is the new value. */
1505 x_set_fullscreen (f
, new_value
, old_value
)
1507 Lisp_Object new_value
, old_value
;
1509 if (NILP (new_value
))
1510 f
->output_data
.x
->want_fullscreen
= FULLSCREEN_NONE
;
1511 else if (EQ (new_value
, Qfullboth
))
1512 f
->output_data
.x
->want_fullscreen
= FULLSCREEN_BOTH
;
1513 else if (EQ (new_value
, Qfullwidth
))
1514 f
->output_data
.x
->want_fullscreen
= FULLSCREEN_WIDTH
;
1515 else if (EQ (new_value
, Qfullheight
))
1516 f
->output_data
.x
->want_fullscreen
= FULLSCREEN_HEIGHT
;
1520 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1521 the previous value of that parameter, NEW_VALUE is the new
1525 x_set_screen_gamma (f
, new_value
, old_value
)
1527 Lisp_Object new_value
, old_value
;
1529 if (NILP (new_value
))
1531 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1532 /* The value 0.4545 is the normal viewing gamma. */
1533 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1535 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1536 Fcons (new_value
, Qnil
)));
1538 clear_face_cache (0);
1542 /* Functions called only from `x_set_frame_param'
1543 to set individual parameters.
1545 If FRAME_X_WINDOW (f) is 0,
1546 the frame is being created and its X-window does not exist yet.
1547 In that case, just record the parameter's new value
1548 in the standard place; do not attempt to change the window. */
1551 x_set_foreground_color (f
, arg
, oldval
)
1553 Lisp_Object arg
, oldval
;
1555 struct x_output
*x
= f
->output_data
.x
;
1556 unsigned long fg
, old_fg
;
1558 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1559 old_fg
= x
->foreground_pixel
;
1560 x
->foreground_pixel
= fg
;
1562 if (FRAME_X_WINDOW (f
) != 0)
1564 Display
*dpy
= FRAME_X_DISPLAY (f
);
1567 XSetForeground (dpy
, x
->normal_gc
, fg
);
1568 XSetBackground (dpy
, x
->reverse_gc
, fg
);
1570 if (x
->cursor_pixel
== old_fg
)
1572 unload_color (f
, x
->cursor_pixel
);
1573 x
->cursor_pixel
= x_copy_color (f
, fg
);
1574 XSetBackground (dpy
, x
->cursor_gc
, x
->cursor_pixel
);
1579 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1581 if (FRAME_VISIBLE_P (f
))
1585 unload_color (f
, old_fg
);
1589 x_set_background_color (f
, arg
, oldval
)
1591 Lisp_Object arg
, oldval
;
1593 struct x_output
*x
= f
->output_data
.x
;
1596 bg
= x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1597 unload_color (f
, x
->background_pixel
);
1598 x
->background_pixel
= bg
;
1600 if (FRAME_X_WINDOW (f
) != 0)
1602 Display
*dpy
= FRAME_X_DISPLAY (f
);
1605 XSetBackground (dpy
, x
->normal_gc
, bg
);
1606 XSetForeground (dpy
, x
->reverse_gc
, bg
);
1607 XSetWindowBackground (dpy
, FRAME_X_WINDOW (f
), bg
);
1608 XSetForeground (dpy
, x
->cursor_gc
, bg
);
1611 xg_set_background_color (f
, bg
);
1614 #ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1615 toolkit scroll bars. */
1618 for (bar
= FRAME_SCROLL_BARS (f
);
1620 bar
= XSCROLL_BAR (bar
)->next
)
1622 Window window
= SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
));
1623 XSetWindowBackground (dpy
, window
, bg
);
1626 #endif /* USE_TOOLKIT_SCROLL_BARS */
1629 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1631 if (FRAME_VISIBLE_P (f
))
1637 x_set_mouse_color (f
, arg
, oldval
)
1639 Lisp_Object arg
, oldval
;
1641 struct x_output
*x
= f
->output_data
.x
;
1642 Display
*dpy
= FRAME_X_DISPLAY (f
);
1643 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1644 Cursor hourglass_cursor
, horizontal_drag_cursor
;
1646 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1647 unsigned long mask_color
= x
->background_pixel
;
1649 /* Don't let pointers be invisible. */
1650 if (mask_color
== pixel
)
1652 x_free_colors (f
, &pixel
, 1);
1653 pixel
= x_copy_color (f
, x
->foreground_pixel
);
1656 unload_color (f
, x
->mouse_pixel
);
1657 x
->mouse_pixel
= pixel
;
1661 /* It's not okay to crash if the user selects a screwy cursor. */
1662 count
= x_catch_errors (dpy
);
1664 if (!NILP (Vx_pointer_shape
))
1666 CHECK_NUMBER (Vx_pointer_shape
);
1667 cursor
= XCreateFontCursor (dpy
, XINT (Vx_pointer_shape
));
1670 cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1671 x_check_errors (dpy
, "bad text pointer cursor: %s");
1673 if (!NILP (Vx_nontext_pointer_shape
))
1675 CHECK_NUMBER (Vx_nontext_pointer_shape
);
1677 = XCreateFontCursor (dpy
, XINT (Vx_nontext_pointer_shape
));
1680 nontext_cursor
= XCreateFontCursor (dpy
, XC_left_ptr
);
1681 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1683 if (!NILP (Vx_hourglass_pointer_shape
))
1685 CHECK_NUMBER (Vx_hourglass_pointer_shape
);
1687 = XCreateFontCursor (dpy
, XINT (Vx_hourglass_pointer_shape
));
1690 hourglass_cursor
= XCreateFontCursor (dpy
, XC_watch
);
1691 x_check_errors (dpy
, "bad hourglass pointer cursor: %s");
1693 x_check_errors (dpy
, "bad nontext pointer cursor: %s");
1694 if (!NILP (Vx_mode_pointer_shape
))
1696 CHECK_NUMBER (Vx_mode_pointer_shape
);
1697 mode_cursor
= XCreateFontCursor (dpy
, XINT (Vx_mode_pointer_shape
));
1700 mode_cursor
= XCreateFontCursor (dpy
, XC_xterm
);
1701 x_check_errors (dpy
, "bad modeline pointer cursor: %s");
1703 if (!NILP (Vx_sensitive_text_pointer_shape
))
1705 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
);
1707 = XCreateFontCursor (dpy
, XINT (Vx_sensitive_text_pointer_shape
));
1710 cross_cursor
= XCreateFontCursor (dpy
, XC_hand2
);
1712 if (!NILP (Vx_window_horizontal_drag_shape
))
1714 CHECK_NUMBER (Vx_window_horizontal_drag_shape
);
1715 horizontal_drag_cursor
1716 = XCreateFontCursor (dpy
, XINT (Vx_window_horizontal_drag_shape
));
1719 horizontal_drag_cursor
1720 = XCreateFontCursor (dpy
, XC_sb_h_double_arrow
);
1722 /* Check and report errors with the above calls. */
1723 x_check_errors (dpy
, "can't set cursor shape: %s");
1724 x_uncatch_errors (dpy
, count
);
1727 XColor fore_color
, back_color
;
1729 fore_color
.pixel
= x
->mouse_pixel
;
1730 x_query_color (f
, &fore_color
);
1731 back_color
.pixel
= mask_color
;
1732 x_query_color (f
, &back_color
);
1734 XRecolorCursor (dpy
, cursor
, &fore_color
, &back_color
);
1735 XRecolorCursor (dpy
, nontext_cursor
, &fore_color
, &back_color
);
1736 XRecolorCursor (dpy
, mode_cursor
, &fore_color
, &back_color
);
1737 XRecolorCursor (dpy
, cross_cursor
, &fore_color
, &back_color
);
1738 XRecolorCursor (dpy
, hourglass_cursor
, &fore_color
, &back_color
);
1739 XRecolorCursor (dpy
, horizontal_drag_cursor
, &fore_color
, &back_color
);
1742 if (FRAME_X_WINDOW (f
) != 0)
1743 XDefineCursor (dpy
, FRAME_X_WINDOW (f
), cursor
);
1745 if (cursor
!= x
->text_cursor
1746 && x
->text_cursor
!= 0)
1747 XFreeCursor (dpy
, x
->text_cursor
);
1748 x
->text_cursor
= cursor
;
1750 if (nontext_cursor
!= x
->nontext_cursor
1751 && x
->nontext_cursor
!= 0)
1752 XFreeCursor (dpy
, x
->nontext_cursor
);
1753 x
->nontext_cursor
= nontext_cursor
;
1755 if (hourglass_cursor
!= x
->hourglass_cursor
1756 && x
->hourglass_cursor
!= 0)
1757 XFreeCursor (dpy
, x
->hourglass_cursor
);
1758 x
->hourglass_cursor
= hourglass_cursor
;
1760 if (mode_cursor
!= x
->modeline_cursor
1761 && x
->modeline_cursor
!= 0)
1762 XFreeCursor (dpy
, f
->output_data
.x
->modeline_cursor
);
1763 x
->modeline_cursor
= mode_cursor
;
1765 if (cross_cursor
!= x
->cross_cursor
1766 && x
->cross_cursor
!= 0)
1767 XFreeCursor (dpy
, x
->cross_cursor
);
1768 x
->cross_cursor
= cross_cursor
;
1770 if (horizontal_drag_cursor
!= x
->horizontal_drag_cursor
1771 && x
->horizontal_drag_cursor
!= 0)
1772 XFreeCursor (dpy
, x
->horizontal_drag_cursor
);
1773 x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1778 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1782 x_set_cursor_color (f
, arg
, oldval
)
1784 Lisp_Object arg
, oldval
;
1786 unsigned long fore_pixel
, pixel
;
1787 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1788 struct x_output
*x
= f
->output_data
.x
;
1790 if (!NILP (Vx_cursor_fore_pixel
))
1792 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1793 WHITE_PIX_DEFAULT (f
));
1794 fore_pixel_allocated_p
= 1;
1797 fore_pixel
= x
->background_pixel
;
1799 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1800 pixel_allocated_p
= 1;
1802 /* Make sure that the cursor color differs from the background color. */
1803 if (pixel
== x
->background_pixel
)
1805 if (pixel_allocated_p
)
1807 x_free_colors (f
, &pixel
, 1);
1808 pixel_allocated_p
= 0;
1811 pixel
= x
->mouse_pixel
;
1812 if (pixel
== fore_pixel
)
1814 if (fore_pixel_allocated_p
)
1816 x_free_colors (f
, &fore_pixel
, 1);
1817 fore_pixel_allocated_p
= 0;
1819 fore_pixel
= x
->background_pixel
;
1823 unload_color (f
, x
->cursor_foreground_pixel
);
1824 if (!fore_pixel_allocated_p
)
1825 fore_pixel
= x_copy_color (f
, fore_pixel
);
1826 x
->cursor_foreground_pixel
= fore_pixel
;
1828 unload_color (f
, x
->cursor_pixel
);
1829 if (!pixel_allocated_p
)
1830 pixel
= x_copy_color (f
, pixel
);
1831 x
->cursor_pixel
= pixel
;
1833 if (FRAME_X_WINDOW (f
) != 0)
1836 XSetBackground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, x
->cursor_pixel
);
1837 XSetForeground (FRAME_X_DISPLAY (f
), x
->cursor_gc
, fore_pixel
);
1840 if (FRAME_VISIBLE_P (f
))
1842 x_update_cursor (f
, 0);
1843 x_update_cursor (f
, 1);
1847 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1850 /* Set the border-color of frame F to value described by ARG.
1851 ARG can be a string naming a color.
1852 The border-color is used for the border that is drawn by the X server.
1853 Note that this does not fully take effect if done before
1854 F has an x-window; it must be redone when the window is created.
1856 Note: this is done in two routines because of the way X10 works.
1858 Note: under X11, this is normally the province of the window manager,
1859 and so emacs' border colors may be overridden. */
1862 x_set_border_color (f
, arg
, oldval
)
1864 Lisp_Object arg
, oldval
;
1869 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1870 x_set_border_pixel (f
, pix
);
1871 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1874 /* Set the border-color of frame F to pixel value PIX.
1875 Note that this does not fully take effect if done before
1876 F has an x-window. */
1879 x_set_border_pixel (f
, pix
)
1883 unload_color (f
, f
->output_data
.x
->border_pixel
);
1884 f
->output_data
.x
->border_pixel
= pix
;
1886 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1889 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1890 (unsigned long)pix
);
1893 if (FRAME_VISIBLE_P (f
))
1901 x_set_cursor_type (f
, arg
, oldval
)
1903 Lisp_Object arg
, oldval
;
1905 set_frame_cursor_types (f
, arg
);
1907 /* Make sure the cursor gets redrawn. */
1908 cursor_type_changed
= 1;
1912 x_set_icon_type (f
, arg
, oldval
)
1914 Lisp_Object arg
, oldval
;
1920 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1923 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1928 result
= x_text_icon (f
,
1929 (char *) SDATA ((!NILP (f
->icon_name
)
1933 result
= x_bitmap_icon (f
, arg
);
1938 error ("No icon window available");
1941 XFlush (FRAME_X_DISPLAY (f
));
1945 /* Return non-nil if frame F wants a bitmap icon. */
1953 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1961 x_set_icon_name (f
, arg
, oldval
)
1963 Lisp_Object arg
, oldval
;
1969 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1972 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1977 if (f
->output_data
.x
->icon_bitmap
!= 0)
1982 result
= x_text_icon (f
,
1983 (char *) SDATA ((!NILP (f
->icon_name
)
1992 error ("No icon window available");
1995 XFlush (FRAME_X_DISPLAY (f
));
2000 x_set_font (f
, arg
, oldval
)
2002 Lisp_Object arg
, oldval
;
2005 Lisp_Object fontset_name
;
2007 int old_fontset
= f
->output_data
.x
->fontset
;
2011 fontset_name
= Fquery_fontset (arg
, Qnil
);
2014 result
= (STRINGP (fontset_name
)
2015 ? x_new_fontset (f
, SDATA (fontset_name
))
2016 : x_new_font (f
, SDATA (arg
)));
2019 if (EQ (result
, Qnil
))
2020 error ("Font `%s' is not defined", SDATA (arg
));
2021 else if (EQ (result
, Qt
))
2022 error ("The characters of the given font have varying widths");
2023 else if (STRINGP (result
))
2025 if (STRINGP (fontset_name
))
2027 /* Fontset names are built from ASCII font names, so the
2028 names may be equal despite there was a change. */
2029 if (old_fontset
== f
->output_data
.x
->fontset
)
2032 else if (!NILP (Fequal (result
, oldval
)))
2035 store_frame_param (f
, Qfont
, result
);
2036 recompute_basic_faces (f
);
2041 do_pending_window_change (0);
2043 /* Don't call `face-set-after-frame-default' when faces haven't been
2044 initialized yet. This is the case when called from
2045 Fx_create_frame. In that case, the X widget or window doesn't
2046 exist either, and we can end up in x_report_frame_params with a
2047 null widget which gives a segfault. */
2048 if (FRAME_FACE_CACHE (f
))
2050 XSETFRAME (frame
, f
);
2051 call1 (Qface_set_after_frame_default
, frame
);
2056 x_set_fringe_width (f
, new_value
, old_value
)
2058 Lisp_Object new_value
, old_value
;
2060 x_compute_fringe_widths (f
, 1);
2064 x_set_border_width (f
, arg
, oldval
)
2066 Lisp_Object arg
, oldval
;
2070 if (XINT (arg
) == f
->output_data
.x
->border_width
)
2073 if (FRAME_X_WINDOW (f
) != 0)
2074 error ("Cannot change the border width of a window");
2076 f
->output_data
.x
->border_width
= XINT (arg
);
2080 x_set_internal_border_width (f
, arg
, oldval
)
2082 Lisp_Object arg
, oldval
;
2084 int old
= f
->output_data
.x
->internal_border_width
;
2087 f
->output_data
.x
->internal_border_width
= XINT (arg
);
2088 if (f
->output_data
.x
->internal_border_width
< 0)
2089 f
->output_data
.x
->internal_border_width
= 0;
2091 #ifdef USE_X_TOOLKIT
2092 if (f
->output_data
.x
->edit_widget
)
2093 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
2096 if (f
->output_data
.x
->internal_border_width
== old
)
2099 if (FRAME_X_WINDOW (f
) != 0)
2101 x_set_window_size (f
, 0, f
->width
, f
->height
);
2102 SET_FRAME_GARBAGED (f
);
2103 do_pending_window_change (0);
2106 SET_FRAME_GARBAGED (f
);
2110 x_set_visibility (f
, value
, oldval
)
2112 Lisp_Object value
, oldval
;
2115 XSETFRAME (frame
, f
);
2118 Fmake_frame_invisible (frame
, Qt
);
2119 else if (EQ (value
, Qicon
))
2120 Ficonify_frame (frame
);
2122 Fmake_frame_visible (frame
);
2126 /* Change window heights in windows rooted in WINDOW by N lines. */
2129 x_change_window_heights (window
, n
)
2133 struct window
*w
= XWINDOW (window
);
2135 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
2136 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
2138 if (INTEGERP (w
->orig_top
))
2139 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
2140 if (INTEGERP (w
->orig_height
))
2141 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
2143 /* Handle just the top child in a vertical split. */
2144 if (!NILP (w
->vchild
))
2145 x_change_window_heights (w
->vchild
, n
);
2147 /* Adjust all children in a horizontal split. */
2148 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
2150 w
= XWINDOW (window
);
2151 x_change_window_heights (window
, n
);
2156 x_set_menu_bar_lines (f
, value
, oldval
)
2158 Lisp_Object value
, oldval
;
2161 #ifndef USE_X_TOOLKIT
2162 int olines
= FRAME_MENU_BAR_LINES (f
);
2165 /* Right now, menu bars don't work properly in minibuf-only frames;
2166 most of the commands try to apply themselves to the minibuffer
2167 frame itself, and get an error because you can't switch buffers
2168 in or split the minibuffer window. */
2169 if (FRAME_MINIBUF_ONLY_P (f
))
2172 if (INTEGERP (value
))
2173 nlines
= XINT (value
);
2177 /* Make sure we redisplay all windows in this frame. */
2178 windows_or_buffers_changed
++;
2180 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
2181 FRAME_MENU_BAR_LINES (f
) = 0;
2184 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2185 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
2186 /* Make sure next redisplay shows the menu bar. */
2187 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2191 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2192 free_frame_menubar (f
);
2193 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2195 f
->output_data
.x
->menubar_widget
= 0;
2197 #else /* not USE_X_TOOLKIT && not USE_GTK */
2198 FRAME_MENU_BAR_LINES (f
) = nlines
;
2199 x_change_window_heights (f
->root_window
, nlines
- olines
);
2200 #endif /* not USE_X_TOOLKIT */
2205 /* Set the number of lines used for the tool bar of frame F to VALUE.
2206 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2207 is the old number of tool bar lines. This function changes the
2208 height of all windows on frame F to match the new tool bar height.
2209 The frame's height doesn't change. */
2212 x_set_tool_bar_lines (f
, value
, oldval
)
2214 Lisp_Object value
, oldval
;
2216 int delta
, nlines
, root_height
;
2217 Lisp_Object root_window
;
2219 /* Treat tool bars like menu bars. */
2220 if (FRAME_MINIBUF_ONLY_P (f
))
2223 /* Use VALUE only if an integer >= 0. */
2224 if (INTEGERP (value
) && XINT (value
) >= 0)
2225 nlines
= XFASTINT (value
);
2230 FRAME_TOOL_BAR_LINES (f
) = 0;
2233 FRAME_EXTERNAL_TOOL_BAR (f
) = 1;
2234 if (FRAME_X_P (f
) && f
->output_data
.x
->toolbar_widget
== 0)
2235 /* Make sure next redisplay shows the tool bar. */
2236 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2237 update_frame_tool_bar (f
);
2241 if (FRAME_EXTERNAL_TOOL_BAR (f
))
2242 free_frame_tool_bar (f
);
2243 FRAME_EXTERNAL_TOOL_BAR (f
) = 0;
2249 /* Make sure we redisplay all windows in this frame. */
2250 ++windows_or_buffers_changed
;
2252 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2254 /* Don't resize the tool-bar to more than we have room for. */
2255 root_window
= FRAME_ROOT_WINDOW (f
);
2256 root_height
= XINT (XWINDOW (root_window
)->height
);
2257 if (root_height
- delta
< 1)
2259 delta
= root_height
- 1;
2260 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2263 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2264 x_change_window_heights (root_window
, delta
);
2267 /* We also have to make sure that the internal border at the top of
2268 the frame, below the menu bar or tool bar, is redrawn when the
2269 tool bar disappears. This is so because the internal border is
2270 below the tool bar if one is displayed, but is below the menu bar
2271 if there isn't a tool bar. The tool bar draws into the area
2272 below the menu bar. */
2273 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2277 clear_current_matrices (f
);
2278 updating_frame
= NULL
;
2281 /* If the tool bar gets smaller, the internal border below it
2282 has to be cleared. It was formerly part of the display
2283 of the larger tool bar, and updating windows won't clear it. */
2286 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2287 int width
= PIXEL_WIDTH (f
);
2288 int y
= nlines
* CANON_Y_UNIT (f
);
2291 x_clear_area (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2292 0, y
, width
, height
, False
);
2295 if (WINDOWP (f
->tool_bar_window
))
2296 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2301 /* Set the foreground color for scroll bars on frame F to VALUE.
2302 VALUE should be a string, a color name. If it isn't a string or
2303 isn't a valid color name, do nothing. OLDVAL is the old value of
2304 the frame parameter. */
2307 x_set_scroll_bar_foreground (f
, value
, oldval
)
2309 Lisp_Object value
, oldval
;
2311 unsigned long pixel
;
2313 if (STRINGP (value
))
2314 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2318 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2319 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2321 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2322 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2324 /* Remove all scroll bars because they have wrong colors. */
2325 if (condemn_scroll_bars_hook
)
2326 (*condemn_scroll_bars_hook
) (f
);
2327 if (judge_scroll_bars_hook
)
2328 (*judge_scroll_bars_hook
) (f
);
2330 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2336 /* Set the background color for scroll bars on frame F to VALUE VALUE
2337 should be a string, a color name. If it isn't a string or isn't a
2338 valid color name, do nothing. OLDVAL is the old value of the frame
2342 x_set_scroll_bar_background (f
, value
, oldval
)
2344 Lisp_Object value
, oldval
;
2346 unsigned long pixel
;
2348 if (STRINGP (value
))
2349 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2353 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2354 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2356 #ifdef USE_TOOLKIT_SCROLL_BARS
2357 /* Scrollbar shadow colors. */
2358 if (f
->output_data
.x
->scroll_bar_top_shadow_pixel
!= -1)
2360 unload_color (f
, f
->output_data
.x
->scroll_bar_top_shadow_pixel
);
2361 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
2363 if (f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
!= -1)
2365 unload_color (f
, f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
);
2366 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
2368 #endif /* USE_TOOLKIT_SCROLL_BARS */
2370 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2371 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2373 /* Remove all scroll bars because they have wrong colors. */
2374 if (condemn_scroll_bars_hook
)
2375 (*condemn_scroll_bars_hook
) (f
);
2376 if (judge_scroll_bars_hook
)
2377 (*judge_scroll_bars_hook
) (f
);
2379 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2385 /* Encode Lisp string STRING as a text in a format appropriate for
2386 XICCC (X Inter Client Communication Conventions).
2388 If STRING contains only ASCII characters, do no conversion and
2389 return the string data of STRING. Otherwise, encode the text by
2390 CODING_SYSTEM, and return a newly allocated memory area which
2391 should be freed by `xfree' by a caller.
2393 SELECTIONP non-zero means the string is being encoded for an X
2394 selection, so it is safe to run pre-write conversions (which
2397 Store the byte length of resulting text in *TEXT_BYTES.
2399 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2400 which means that the `encoding' of the result can be `STRING'.
2401 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2402 the result should be `COMPOUND_TEXT'. */
2405 x_encode_text (string
, coding_system
, selectionp
, text_bytes
, stringp
)
2406 Lisp_Object string
, coding_system
;
2407 int *text_bytes
, *stringp
;
2410 unsigned char *str
= SDATA (string
);
2411 int chars
= SCHARS (string
);
2412 int bytes
= SBYTES (string
);
2416 struct coding_system coding
;
2417 extern Lisp_Object Qcompound_text_with_extensions
;
2419 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2420 if (charset_info
== 0)
2422 /* No multibyte character in OBJ. We need not encode it. */
2423 *text_bytes
= bytes
;
2428 setup_coding_system (coding_system
, &coding
);
2430 && SYMBOLP (coding
.pre_write_conversion
)
2431 && !NILP (Ffboundp (coding
.pre_write_conversion
)))
2433 string
= run_pre_post_conversion_on_str (string
, &coding
, 1);
2434 str
= SDATA (string
);
2435 chars
= SCHARS (string
);
2436 bytes
= SBYTES (string
);
2438 coding
.src_multibyte
= 1;
2439 coding
.dst_multibyte
= 0;
2440 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2441 if (coding
.type
== coding_type_iso2022
)
2442 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2443 /* We suppress producing escape sequences for composition. */
2444 coding
.composing
= COMPOSITION_DISABLED
;
2445 bufsize
= encoding_buffer_size (&coding
, bytes
);
2446 buf
= (unsigned char *) xmalloc (bufsize
);
2447 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2448 *text_bytes
= coding
.produced
;
2449 *stringp
= (charset_info
== 1
2450 || (!EQ (coding_system
, Qcompound_text
)
2451 && !EQ (coding_system
, Qcompound_text_with_extensions
)));
2456 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2459 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2460 name; if NAME is a string, set F's name to NAME and set
2461 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2463 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2464 suggesting a new name, which lisp code should override; if
2465 F->explicit_name is set, ignore the new name; otherwise, set it. */
2468 x_set_name (f
, name
, explicit)
2473 /* Make sure that requests from lisp code override requests from
2474 Emacs redisplay code. */
2477 /* If we're switching from explicit to implicit, we had better
2478 update the mode lines and thereby update the title. */
2479 if (f
->explicit_name
&& NILP (name
))
2480 update_mode_lines
= 1;
2482 f
->explicit_name
= ! NILP (name
);
2484 else if (f
->explicit_name
)
2487 /* If NAME is nil, set the name to the x_id_name. */
2490 /* Check for no change needed in this very common case
2491 before we do any consing. */
2492 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2495 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2498 CHECK_STRING (name
);
2500 /* Don't change the name if it's already NAME. */
2501 if (! NILP (Fstring_equal (name
, f
->name
)))
2506 /* For setting the frame title, the title parameter should override
2507 the name parameter. */
2508 if (! NILP (f
->title
))
2511 if (FRAME_X_WINDOW (f
))
2516 XTextProperty text
, icon
;
2518 Lisp_Object coding_system
;
2520 /* 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
;
2555 #ifdef USE_X_TOOLKIT
2556 XSetWMName (FRAME_X_DISPLAY (f
),
2557 XtWindow (f
->output_data
.x
->widget
), &text
);
2558 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2560 #else /* not USE_X_TOOLKIT */
2562 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f
)),
2564 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_OUTER_WINDOW (f
),
2566 #else /* not USE_GTK */
2567 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2568 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2569 #endif /* not USE_GTK */
2570 #endif /* not USE_X_TOOLKIT */
2571 if (!NILP (f
->icon_name
)
2572 && icon
.value
!= (unsigned char *) SDATA (f
->icon_name
))
2574 if (text
.value
!= (unsigned char *) SDATA (name
))
2577 #else /* not HAVE_X11R4 */
2578 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2580 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2582 #endif /* not HAVE_X11R4 */
2587 /* This function should be called when the user's lisp code has
2588 specified a name for the frame; the name will override any set by the
2591 x_explicitly_set_name (f
, arg
, oldval
)
2593 Lisp_Object arg
, oldval
;
2595 x_set_name (f
, arg
, 1);
2598 /* This function should be called by Emacs redisplay code to set the
2599 name; names set this way will never override names set by the user's
2602 x_implicitly_set_name (f
, arg
, oldval
)
2604 Lisp_Object arg
, oldval
;
2606 x_set_name (f
, arg
, 0);
2609 /* Change the title of frame F to NAME.
2610 If NAME is nil, use the frame name as the title.
2612 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2613 name; if NAME is a string, set F's name to NAME and set
2614 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2616 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2617 suggesting a new name, which lisp code should override; if
2618 F->explicit_name is set, ignore the new name; otherwise, set it. */
2621 x_set_title (f
, name
, old_name
)
2623 Lisp_Object name
, old_name
;
2625 /* Don't change the title if it's already NAME. */
2626 if (EQ (name
, f
->title
))
2629 update_mode_lines
= 1;
2636 CHECK_STRING (name
);
2638 if (FRAME_X_WINDOW (f
))
2643 XTextProperty text
, icon
;
2645 Lisp_Object coding_system
;
2647 coding_system
= Qcompound_text
;
2648 /* See the comment "Note: Encoding strategy" in x_set_name. */
2649 text
.value
= x_encode_text (name
, coding_system
, 0, &bytes
, &stringp
);
2650 text
.encoding
= (stringp
? XA_STRING
2651 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2653 text
.nitems
= bytes
;
2655 if (NILP (f
->icon_name
))
2661 /* See the comment "Note: Encoding strategy" in x_set_name. */
2662 icon
.value
= x_encode_text (f
->icon_name
, coding_system
, 0,
2664 icon
.encoding
= (stringp
? XA_STRING
2665 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2667 icon
.nitems
= bytes
;
2669 #ifdef USE_X_TOOLKIT
2670 XSetWMName (FRAME_X_DISPLAY (f
),
2671 XtWindow (f
->output_data
.x
->widget
), &text
);
2672 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2674 #else /* not USE_X_TOOLKIT */
2676 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f
)),
2678 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_OUTER_WINDOW (f
),
2680 #else /* not USE_GTK */
2681 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2682 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2683 #endif /* not USE_GTK */
2684 #endif /* not USE_X_TOOLKIT */
2685 if (!NILP (f
->icon_name
)
2686 && icon
.value
!= (unsigned char *) SDATA (f
->icon_name
))
2688 if (text
.value
!= (unsigned char *) SDATA (name
))
2691 #else /* not HAVE_X11R4 */
2692 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2694 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2696 #endif /* not HAVE_X11R4 */
2702 x_set_autoraise (f
, arg
, oldval
)
2704 Lisp_Object arg
, oldval
;
2706 f
->auto_raise
= !EQ (Qnil
, arg
);
2710 x_set_autolower (f
, arg
, oldval
)
2712 Lisp_Object arg
, oldval
;
2714 f
->auto_lower
= !EQ (Qnil
, arg
);
2718 x_set_unsplittable (f
, arg
, oldval
)
2720 Lisp_Object arg
, oldval
;
2722 f
->no_split
= !NILP (arg
);
2726 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2728 Lisp_Object arg
, oldval
;
2730 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2731 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2732 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2733 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2735 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2737 ? vertical_scroll_bar_none
2739 ? vertical_scroll_bar_right
2740 : vertical_scroll_bar_left
);
2742 /* We set this parameter before creating the X window for the
2743 frame, so we can get the geometry right from the start.
2744 However, if the window hasn't been created yet, we shouldn't
2745 call x_set_window_size. */
2746 if (FRAME_X_WINDOW (f
))
2747 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2748 do_pending_window_change (0);
2753 x_set_scroll_bar_width (f
, arg
, oldval
)
2755 Lisp_Object arg
, oldval
;
2757 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2761 #ifdef USE_TOOLKIT_SCROLL_BARS
2762 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2763 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2764 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2765 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2767 /* Make the actual width at least 14 pixels and a multiple of a
2769 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2771 /* Use all of that space (aside from required margins) for the
2773 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2776 if (FRAME_X_WINDOW (f
))
2777 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2778 do_pending_window_change (0);
2780 else if (INTEGERP (arg
) && XINT (arg
) > 0
2781 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2783 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2784 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2786 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2787 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2788 if (FRAME_X_WINDOW (f
))
2789 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2792 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2793 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2794 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2799 /* Subroutines of creating an X frame. */
2801 /* Make sure that Vx_resource_name is set to a reasonable value.
2802 Fix it up, or set it to `emacs' if it is too hopeless. */
2805 validate_x_resource_name ()
2808 /* Number of valid characters in the resource name. */
2810 /* Number of invalid characters in the resource name. */
2815 if (!STRINGP (Vx_resource_class
))
2816 Vx_resource_class
= build_string (EMACS_CLASS
);
2818 if (STRINGP (Vx_resource_name
))
2820 unsigned char *p
= SDATA (Vx_resource_name
);
2823 len
= SBYTES (Vx_resource_name
);
2825 /* Only letters, digits, - and _ are valid in resource names.
2826 Count the valid characters and count the invalid ones. */
2827 for (i
= 0; i
< len
; i
++)
2830 if (! ((c
>= 'a' && c
<= 'z')
2831 || (c
>= 'A' && c
<= 'Z')
2832 || (c
>= '0' && c
<= '9')
2833 || c
== '-' || c
== '_'))
2840 /* Not a string => completely invalid. */
2841 bad_count
= 5, good_count
= 0;
2843 /* If name is valid already, return. */
2847 /* If name is entirely invalid, or nearly so, use `emacs'. */
2849 || (good_count
== 1 && bad_count
> 0))
2851 Vx_resource_name
= build_string ("emacs");
2855 /* Name is partly valid. Copy it and replace the invalid characters
2856 with underscores. */
2858 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2860 for (i
= 0; i
< len
; i
++)
2862 int c
= SREF (new, i
);
2863 if (! ((c
>= 'a' && c
<= 'z')
2864 || (c
>= 'A' && c
<= 'Z')
2865 || (c
>= '0' && c
<= '9')
2866 || c
== '-' || c
== '_'))
2872 extern char *x_get_string_resource ();
2874 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2875 doc
: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
2876 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
2877 class, where INSTANCE is the name under which Emacs was invoked, or
2878 the name specified by the `-name' or `-rn' command-line arguments.
2880 The optional arguments COMPONENT and SUBCLASS add to the key and the
2881 class, respectively. You must specify both of them or neither.
2882 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
2883 and the class is `Emacs.CLASS.SUBCLASS'. */)
2884 (attribute
, class, component
, subclass
)
2885 Lisp_Object attribute
, class, component
, subclass
;
2887 register char *value
;
2893 CHECK_STRING (attribute
);
2894 CHECK_STRING (class);
2896 if (!NILP (component
))
2897 CHECK_STRING (component
);
2898 if (!NILP (subclass
))
2899 CHECK_STRING (subclass
);
2900 if (NILP (component
) != NILP (subclass
))
2901 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2903 validate_x_resource_name ();
2905 /* Allocate space for the components, the dots which separate them,
2906 and the final '\0'. Make them big enough for the worst case. */
2907 name_key
= (char *) alloca (SBYTES (Vx_resource_name
)
2908 + (STRINGP (component
)
2909 ? SBYTES (component
) : 0)
2910 + SBYTES (attribute
)
2913 class_key
= (char *) alloca (SBYTES (Vx_resource_class
)
2915 + (STRINGP (subclass
)
2916 ? SBYTES (subclass
) : 0)
2919 /* Start with emacs.FRAMENAME for the name (the specific one)
2920 and with `Emacs' for the class key (the general one). */
2921 strcpy (name_key
, SDATA (Vx_resource_name
));
2922 strcpy (class_key
, SDATA (Vx_resource_class
));
2924 strcat (class_key
, ".");
2925 strcat (class_key
, SDATA (class));
2927 if (!NILP (component
))
2929 strcat (class_key
, ".");
2930 strcat (class_key
, SDATA (subclass
));
2932 strcat (name_key
, ".");
2933 strcat (name_key
, SDATA (component
));
2936 strcat (name_key
, ".");
2937 strcat (name_key
, SDATA (attribute
));
2939 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2940 name_key
, class_key
);
2942 if (value
!= (char *) 0)
2943 return build_string (value
);
2948 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2951 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2952 struct x_display_info
*dpyinfo
;
2953 Lisp_Object attribute
, class, component
, subclass
;
2955 register char *value
;
2959 CHECK_STRING (attribute
);
2960 CHECK_STRING (class);
2962 if (!NILP (component
))
2963 CHECK_STRING (component
);
2964 if (!NILP (subclass
))
2965 CHECK_STRING (subclass
);
2966 if (NILP (component
) != NILP (subclass
))
2967 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2969 validate_x_resource_name ();
2971 /* Allocate space for the components, the dots which separate them,
2972 and the final '\0'. Make them big enough for the worst case. */
2973 name_key
= (char *) alloca (SBYTES (Vx_resource_name
)
2974 + (STRINGP (component
)
2975 ? SBYTES (component
) : 0)
2976 + SBYTES (attribute
)
2979 class_key
= (char *) alloca (SBYTES (Vx_resource_class
)
2981 + (STRINGP (subclass
)
2982 ? SBYTES (subclass
) : 0)
2985 /* Start with emacs.FRAMENAME for the name (the specific one)
2986 and with `Emacs' for the class key (the general one). */
2987 strcpy (name_key
, SDATA (Vx_resource_name
));
2988 strcpy (class_key
, SDATA (Vx_resource_class
));
2990 strcat (class_key
, ".");
2991 strcat (class_key
, SDATA (class));
2993 if (!NILP (component
))
2995 strcat (class_key
, ".");
2996 strcat (class_key
, SDATA (subclass
));
2998 strcat (name_key
, ".");
2999 strcat (name_key
, SDATA (component
));
3002 strcat (name_key
, ".");
3003 strcat (name_key
, SDATA (attribute
));
3005 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
3007 if (value
!= (char *) 0)
3008 return build_string (value
);
3013 /* Used when C code wants a resource value. */
3016 x_get_resource_string (attribute
, class)
3017 char *attribute
, *class;
3021 struct frame
*sf
= SELECTED_FRAME ();
3023 /* Allocate space for the components, the dots which separate them,
3024 and the final '\0'. */
3025 name_key
= (char *) alloca (SBYTES (Vinvocation_name
)
3026 + strlen (attribute
) + 2);
3027 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
3028 + strlen (class) + 2);
3030 sprintf (name_key
, "%s.%s",
3031 SDATA (Vinvocation_name
),
3033 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
3035 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
3036 name_key
, class_key
);
3039 /* Types we might convert a resource string into. */
3049 /* Return the value of parameter PARAM.
3051 First search ALIST, then Vdefault_frame_alist, then the X defaults
3052 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3054 Convert the resource to the type specified by desired_type.
3056 If no default is specified, return Qunbound. If you call
3057 x_get_arg, make sure you deal with Qunbound in a reasonable way,
3058 and don't let it get stored in any Lisp-visible variables! */
3061 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
3062 struct x_display_info
*dpyinfo
;
3063 Lisp_Object alist
, param
;
3066 enum resource_types type
;
3068 register Lisp_Object tem
;
3070 tem
= Fassq (param
, alist
);
3072 tem
= Fassq (param
, Vdefault_frame_alist
);
3078 tem
= display_x_get_resource (dpyinfo
,
3079 build_string (attribute
),
3080 build_string (class),
3088 case RES_TYPE_NUMBER
:
3089 return make_number (atoi (SDATA (tem
)));
3091 case RES_TYPE_FLOAT
:
3092 return make_float (atof (SDATA (tem
)));
3094 case RES_TYPE_BOOLEAN
:
3095 tem
= Fdowncase (tem
);
3096 if (!strcmp (SDATA (tem
), "on")
3097 || !strcmp (SDATA (tem
), "true"))
3102 case RES_TYPE_STRING
:
3105 case RES_TYPE_SYMBOL
:
3106 /* As a special case, we map the values `true' and `on'
3107 to Qt, and `false' and `off' to Qnil. */
3110 lower
= Fdowncase (tem
);
3111 if (!strcmp (SDATA (lower
), "on")
3112 || !strcmp (SDATA (lower
), "true"))
3114 else if (!strcmp (SDATA (lower
), "off")
3115 || !strcmp (SDATA (lower
), "false"))
3118 return Fintern (tem
, Qnil
);
3131 /* Like x_get_arg, but also record the value in f->param_alist. */
3134 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
3136 Lisp_Object alist
, param
;
3139 enum resource_types type
;
3143 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
3144 attribute
, class, type
);
3146 store_frame_param (f
, param
, value
);
3151 /* Record in frame F the specified or default value according to ALIST
3152 of the parameter named PROP (a Lisp symbol).
3153 If no value is specified for PROP, look for an X default for XPROP
3154 on the frame named NAME.
3155 If that is not found either, use the value DEFLT. */
3158 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
3165 enum resource_types type
;
3169 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
3170 if (EQ (tem
, Qunbound
))
3172 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3177 /* Record in frame F the specified or default value according to ALIST
3178 of the parameter named PROP (a Lisp symbol). If no value is
3179 specified for PROP, look for an X default for XPROP on the frame
3180 named NAME. If that is not found either, use the value DEFLT. */
3183 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
3192 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3195 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
3196 if (EQ (tem
, Qunbound
))
3198 #ifdef USE_TOOLKIT_SCROLL_BARS
3200 /* See if an X resource for the scroll bar color has been
3202 tem
= display_x_get_resource (dpyinfo
,
3203 build_string (foreground_p
3207 build_string ("verticalScrollBar"),
3211 /* If nothing has been specified, scroll bars will use a
3212 toolkit-dependent default. Because these defaults are
3213 difficult to get at without actually creating a scroll
3214 bar, use nil to indicate that no color has been
3219 #else /* not USE_TOOLKIT_SCROLL_BARS */
3223 #endif /* not USE_TOOLKIT_SCROLL_BARS */
3226 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3232 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3233 doc
: /* Parse an X-style geometry string STRING.
3234 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3235 The properties returned may include `top', `left', `height', and `width'.
3236 The value of `left' or `top' may be an integer,
3237 or a list (+ N) meaning N pixels relative to top/left corner,
3238 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3243 unsigned int width
, height
;
3246 CHECK_STRING (string
);
3248 geometry
= XParseGeometry ((char *) SDATA (string
),
3249 &x
, &y
, &width
, &height
);
3252 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
3253 error ("Must specify both x and y position, or neither");
3257 if (geometry
& XValue
)
3259 Lisp_Object element
;
3261 if (x
>= 0 && (geometry
& XNegative
))
3262 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3263 else if (x
< 0 && ! (geometry
& XNegative
))
3264 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3266 element
= Fcons (Qleft
, make_number (x
));
3267 result
= Fcons (element
, result
);
3270 if (geometry
& YValue
)
3272 Lisp_Object element
;
3274 if (y
>= 0 && (geometry
& YNegative
))
3275 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3276 else if (y
< 0 && ! (geometry
& YNegative
))
3277 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3279 element
= Fcons (Qtop
, make_number (y
));
3280 result
= Fcons (element
, result
);
3283 if (geometry
& WidthValue
)
3284 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3285 if (geometry
& HeightValue
)
3286 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3291 /* Calculate the desired size and position of this window,
3292 and return the flags saying which aspects were specified.
3294 This function does not make the coordinates positive. */
3296 #define DEFAULT_ROWS 40
3297 #define DEFAULT_COLS 80
3300 x_figure_window_size (f
, parms
)
3304 register Lisp_Object tem0
, tem1
, tem2
;
3305 long window_prompting
= 0;
3306 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3308 /* Default values if we fall through.
3309 Actually, if that happens we should get
3310 window manager prompting. */
3311 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3312 f
->height
= DEFAULT_ROWS
;
3313 /* Window managers expect that if program-specified
3314 positions are not (0,0), they're intentional, not defaults. */
3315 f
->output_data
.x
->top_pos
= 0;
3316 f
->output_data
.x
->left_pos
= 0;
3318 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3319 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3320 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3321 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3323 if (!EQ (tem0
, Qunbound
))
3325 CHECK_NUMBER (tem0
);
3326 f
->height
= XINT (tem0
);
3328 if (!EQ (tem1
, Qunbound
))
3330 CHECK_NUMBER (tem1
);
3331 SET_FRAME_WIDTH (f
, XINT (tem1
));
3333 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3334 window_prompting
|= USSize
;
3336 window_prompting
|= PSize
;
3339 f
->output_data
.x
->vertical_scroll_bar_extra
3340 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3342 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3344 x_compute_fringe_widths (f
, 0);
3346 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3347 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3349 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3350 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3351 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3352 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3354 if (EQ (tem0
, Qminus
))
3356 f
->output_data
.x
->top_pos
= 0;
3357 window_prompting
|= YNegative
;
3359 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3360 && CONSP (XCDR (tem0
))
3361 && INTEGERP (XCAR (XCDR (tem0
))))
3363 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3364 window_prompting
|= YNegative
;
3366 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3367 && CONSP (XCDR (tem0
))
3368 && INTEGERP (XCAR (XCDR (tem0
))))
3370 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3372 else if (EQ (tem0
, Qunbound
))
3373 f
->output_data
.x
->top_pos
= 0;
3376 CHECK_NUMBER (tem0
);
3377 f
->output_data
.x
->top_pos
= XINT (tem0
);
3378 if (f
->output_data
.x
->top_pos
< 0)
3379 window_prompting
|= YNegative
;
3382 if (EQ (tem1
, Qminus
))
3384 f
->output_data
.x
->left_pos
= 0;
3385 window_prompting
|= XNegative
;
3387 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3388 && CONSP (XCDR (tem1
))
3389 && INTEGERP (XCAR (XCDR (tem1
))))
3391 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3392 window_prompting
|= XNegative
;
3394 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3395 && CONSP (XCDR (tem1
))
3396 && INTEGERP (XCAR (XCDR (tem1
))))
3398 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3400 else if (EQ (tem1
, Qunbound
))
3401 f
->output_data
.x
->left_pos
= 0;
3404 CHECK_NUMBER (tem1
);
3405 f
->output_data
.x
->left_pos
= XINT (tem1
);
3406 if (f
->output_data
.x
->left_pos
< 0)
3407 window_prompting
|= XNegative
;
3410 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3411 window_prompting
|= USPosition
;
3413 window_prompting
|= PPosition
;
3416 if (f
->output_data
.x
->want_fullscreen
!= FULLSCREEN_NONE
)
3421 /* It takes both for some WM:s to place it where we want */
3422 window_prompting
= USPosition
| PPosition
;
3423 x_fullscreen_adjust (f
, &width
, &height
, &top
, &left
);
3426 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3427 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3428 f
->output_data
.x
->left_pos
= left
;
3429 f
->output_data
.x
->top_pos
= top
;
3432 return window_prompting
;
3435 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3438 XSetWMProtocols (dpy
, w
, protocols
, count
)
3445 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3446 if (prop
== None
) return False
;
3447 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3448 (unsigned char *) protocols
, count
);
3451 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3453 #ifdef USE_X_TOOLKIT
3455 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3456 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3457 already be present because of the toolkit (Motif adds some of them,
3458 for example, but Xt doesn't). */
3461 hack_wm_protocols (f
, widget
)
3465 Display
*dpy
= XtDisplay (widget
);
3466 Window w
= XtWindow (widget
);
3467 int need_delete
= 1;
3473 Atom type
, *atoms
= 0;
3475 unsigned long nitems
= 0;
3476 unsigned long bytes_after
;
3478 if ((XGetWindowProperty (dpy
, w
,
3479 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3480 (long)0, (long)100, False
, XA_ATOM
,
3481 &type
, &format
, &nitems
, &bytes_after
,
3482 (unsigned char **) &atoms
)
3484 && format
== 32 && type
== XA_ATOM
)
3488 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3490 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3492 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3495 if (atoms
) XFree ((char *) atoms
);
3501 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3503 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3505 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3507 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3508 XA_ATOM
, 32, PropModeAppend
,
3509 (unsigned char *) props
, count
);
3517 /* Support routines for XIC (X Input Context). */
3521 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3522 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3525 /* Supported XIM styles, ordered by preferenc. */
3527 static XIMStyle supported_xim_styles
[] =
3529 XIMPreeditPosition
| XIMStatusArea
,
3530 XIMPreeditPosition
| XIMStatusNothing
,
3531 XIMPreeditPosition
| XIMStatusNone
,
3532 XIMPreeditNothing
| XIMStatusArea
,
3533 XIMPreeditNothing
| XIMStatusNothing
,
3534 XIMPreeditNothing
| XIMStatusNone
,
3535 XIMPreeditNone
| XIMStatusArea
,
3536 XIMPreeditNone
| XIMStatusNothing
,
3537 XIMPreeditNone
| XIMStatusNone
,
3542 /* Create an X fontset on frame F with base font name
3546 xic_create_xfontset (f
, base_fontname
)
3548 char *base_fontname
;
3551 char **missing_list
;
3555 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3556 base_fontname
, &missing_list
,
3557 &missing_count
, &def_string
);
3559 XFreeStringList (missing_list
);
3561 /* No need to free def_string. */
3566 /* Value is the best input style, given user preferences USER (already
3567 checked to be supported by Emacs), and styles supported by the
3568 input method XIM. */
3571 best_xim_style (user
, xim
)
3577 for (i
= 0; i
< user
->count_styles
; ++i
)
3578 for (j
= 0; j
< xim
->count_styles
; ++j
)
3579 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3580 return user
->supported_styles
[i
];
3582 /* Return the default style. */
3583 return XIMPreeditNothing
| XIMStatusNothing
;
3586 /* Create XIC for frame F. */
3588 static XIMStyle xic_style
;
3591 create_frame_xic (f
)
3596 XFontSet xfs
= NULL
;
3601 xim
= FRAME_X_XIM (f
);
3606 XVaNestedList preedit_attr
;
3607 XVaNestedList status_attr
;
3608 char *base_fontname
;
3611 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3612 spot
.x
= 0; spot
.y
= 1;
3613 /* Create X fontset. */
3614 fontset
= FRAME_FONTSET (f
);
3616 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3619 /* Determine the base fontname from the ASCII font name of
3621 char *ascii_font
= (char *) SDATA (fontset_ascii (fontset
));
3622 char *p
= ascii_font
;
3625 for (i
= 0; *p
; p
++)
3628 /* As the font name doesn't conform to XLFD, we can't
3629 modify it to get a suitable base fontname for the
3631 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3634 int len
= strlen (ascii_font
) + 1;
3637 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3646 base_fontname
= (char *) alloca (len
);
3647 bzero (base_fontname
, len
);
3648 strcpy (base_fontname
, "-*-*-");
3649 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3650 strcat (base_fontname
, "*-*-*-*-*-*-*");
3653 xfs
= xic_create_xfontset (f
, base_fontname
);
3655 /* Determine XIC style. */
3658 XIMStyles supported_list
;
3659 supported_list
.count_styles
= (sizeof supported_xim_styles
3660 / sizeof supported_xim_styles
[0]);
3661 supported_list
.supported_styles
= supported_xim_styles
;
3662 xic_style
= best_xim_style (&supported_list
,
3663 FRAME_X_XIM_STYLES (f
));
3666 preedit_attr
= XVaCreateNestedList (0,
3669 FRAME_FOREGROUND_PIXEL (f
),
3671 FRAME_BACKGROUND_PIXEL (f
),
3672 (xic_style
& XIMPreeditPosition
3677 status_attr
= XVaCreateNestedList (0,
3683 FRAME_FOREGROUND_PIXEL (f
),
3685 FRAME_BACKGROUND_PIXEL (f
),
3688 xic
= XCreateIC (xim
,
3689 XNInputStyle
, xic_style
,
3690 XNClientWindow
, FRAME_X_WINDOW(f
),
3691 XNFocusWindow
, FRAME_X_WINDOW(f
),
3692 XNStatusAttributes
, status_attr
,
3693 XNPreeditAttributes
, preedit_attr
,
3695 XFree (preedit_attr
);
3696 XFree (status_attr
);
3699 FRAME_XIC (f
) = xic
;
3700 FRAME_XIC_STYLE (f
) = xic_style
;
3701 FRAME_XIC_FONTSET (f
) = xfs
;
3705 /* Destroy XIC and free XIC fontset of frame F, if any. */
3711 if (FRAME_XIC (f
) == NULL
)
3714 XDestroyIC (FRAME_XIC (f
));
3715 if (FRAME_XIC_FONTSET (f
))
3716 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3718 FRAME_XIC (f
) = NULL
;
3719 FRAME_XIC_FONTSET (f
) = NULL
;
3723 /* Place preedit area for XIC of window W's frame to specified
3724 pixel position X/Y. X and Y are relative to window W. */
3727 xic_set_preeditarea (w
, x
, y
)
3731 struct frame
*f
= XFRAME (w
->frame
);
3735 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3736 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3737 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3738 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3743 /* Place status area for XIC in bottom right corner of frame F.. */
3746 xic_set_statusarea (f
)
3749 XIC xic
= FRAME_XIC (f
);
3754 /* Negotiate geometry of status area. If input method has existing
3755 status area, use its current size. */
3756 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3757 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3758 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3761 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3762 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3765 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3767 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3768 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3772 area
.width
= needed
->width
;
3773 area
.height
= needed
->height
;
3774 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3775 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3776 - FRAME_MENUBAR_HEIGHT (f
)
3777 - FRAME_TOOLBAR_HEIGHT (f
)
3778 - FRAME_INTERNAL_BORDER_WIDTH (f
));
3781 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3782 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3787 /* Set X fontset for XIC of frame F, using base font name
3788 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3791 xic_set_xfontset (f
, base_fontname
)
3793 char *base_fontname
;
3798 xfs
= xic_create_xfontset (f
, base_fontname
);
3800 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3801 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3802 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3803 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3804 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3807 if (FRAME_XIC_FONTSET (f
))
3808 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3809 FRAME_XIC_FONTSET (f
) = xfs
;
3812 #endif /* HAVE_X_I18N */
3816 #ifdef USE_X_TOOLKIT
3818 /* Create and set up the X widget for frame F. */
3821 x_window (f
, window_prompting
, minibuffer_only
)
3823 long window_prompting
;
3824 int minibuffer_only
;
3826 XClassHint class_hints
;
3827 XSetWindowAttributes attributes
;
3828 unsigned long attribute_mask
;
3829 Widget shell_widget
;
3831 Widget frame_widget
;
3837 /* Use the resource name as the top-level widget name
3838 for looking up resources. Make a non-Lisp copy
3839 for the window manager, so GC relocation won't bother it.
3841 Elsewhere we specify the window name for the window manager. */
3844 char *str
= (char *) SDATA (Vx_resource_name
);
3845 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3846 strcpy (f
->namebuf
, str
);
3850 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3851 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3852 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3853 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3854 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3855 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3856 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3857 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3858 applicationShellWidgetClass
,
3859 FRAME_X_DISPLAY (f
), al
, ac
);
3861 f
->output_data
.x
->widget
= shell_widget
;
3862 /* maybe_set_screen_title_format (shell_widget); */
3864 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3865 (widget_value
*) NULL
,
3866 shell_widget
, False
,
3870 (lw_callback
) NULL
);
3873 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3874 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3875 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3876 XtSetValues (pane_widget
, al
, ac
);
3877 f
->output_data
.x
->column_widget
= pane_widget
;
3879 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3880 the emacs screen when changing menubar. This reduces flickering. */
3883 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3884 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3885 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3886 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3887 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3888 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3889 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3890 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3891 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3894 f
->output_data
.x
->edit_widget
= frame_widget
;
3896 XtManageChild (frame_widget
);
3898 /* Do some needed geometry management. */
3901 char *tem
, shell_position
[32];
3904 int extra_borders
= 0;
3906 = (f
->output_data
.x
->menubar_widget
3907 ? (f
->output_data
.x
->menubar_widget
->core
.height
3908 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3911 #if 0 /* Experimentally, we now get the right results
3912 for -geometry -0-0 without this. 24 Aug 96, rms. */
3913 if (FRAME_EXTERNAL_MENU_BAR (f
))
3916 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3917 menubar_size
+= ibw
;
3921 f
->output_data
.x
->menubar_height
= menubar_size
;
3924 /* Motif seems to need this amount added to the sizes
3925 specified for the shell widget. The Athena/Lucid widgets don't.
3926 Both conclusions reached experimentally. -- rms. */
3927 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3928 &extra_borders
, NULL
);
3932 /* Convert our geometry parameters into a geometry string
3934 Note that we do not specify here whether the position
3935 is a user-specified or program-specified one.
3936 We pass that information later, in x_wm_set_size_hints. */
3938 int left
= f
->output_data
.x
->left_pos
;
3939 int xneg
= window_prompting
& XNegative
;
3940 int top
= f
->output_data
.x
->top_pos
;
3941 int yneg
= window_prompting
& YNegative
;
3947 if (window_prompting
& USPosition
)
3948 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3949 PIXEL_WIDTH (f
) + extra_borders
,
3950 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3951 (xneg
? '-' : '+'), left
,
3952 (yneg
? '-' : '+'), top
);
3954 sprintf (shell_position
, "=%dx%d",
3955 PIXEL_WIDTH (f
) + extra_borders
,
3956 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3959 len
= strlen (shell_position
) + 1;
3960 /* We don't free this because we don't know whether
3961 it is safe to free it while the frame exists.
3962 It isn't worth the trouble of arranging to free it
3963 when the frame is deleted. */
3964 tem
= (char *) xmalloc (len
);
3965 strncpy (tem
, shell_position
, len
);
3966 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3967 XtSetValues (shell_widget
, al
, ac
);
3970 XtManageChild (pane_widget
);
3971 XtRealizeWidget (shell_widget
);
3973 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3975 validate_x_resource_name ();
3977 class_hints
.res_name
= (char *) SDATA (Vx_resource_name
);
3978 class_hints
.res_class
= (char *) SDATA (Vx_resource_class
);
3979 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3982 FRAME_XIC (f
) = NULL
;
3984 create_frame_xic (f
);
3988 f
->output_data
.x
->wm_hints
.input
= True
;
3989 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3990 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3991 &f
->output_data
.x
->wm_hints
);
3993 hack_wm_protocols (f
, shell_widget
);
3996 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3999 /* Do a stupid property change to force the server to generate a
4000 PropertyNotify event so that the event_stream server timestamp will
4001 be initialized to something relevant to the time we created the window.
4003 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
4004 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
4005 XA_ATOM
, 32, PropModeAppend
,
4006 (unsigned char*) NULL
, 0);
4008 /* Make all the standard events reach the Emacs frame. */
4009 attributes
.event_mask
= STANDARD_EVENT_SET
;
4014 /* XIM server might require some X events. */
4015 unsigned long fevent
= NoEventMask
;
4016 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
4017 attributes
.event_mask
|= fevent
;
4019 #endif /* HAVE_X_I18N */
4021 attribute_mask
= CWEventMask
;
4022 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
4023 attribute_mask
, &attributes
);
4025 XtMapWidget (frame_widget
);
4027 /* x_set_name normally ignores requests to set the name if the
4028 requested name is the same as the current name. This is the one
4029 place where that assumption isn't correct; f->name is set, but
4030 the X server hasn't been told. */
4033 int explicit = f
->explicit_name
;
4035 f
->explicit_name
= 0;
4038 x_set_name (f
, name
, explicit);
4041 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4042 f
->output_data
.x
->text_cursor
);
4046 /* This is a no-op, except under Motif. Make sure main areas are
4047 set to something reasonable, in case we get an error later. */
4048 lw_set_main_areas (pane_widget
, 0, frame_widget
);
4051 #else /* not USE_X_TOOLKIT */
4057 if (! xg_create_frame_widgets (f
))
4058 error ("Unable to create window");
4061 FRAME_XIC (f
) = NULL
;
4064 create_frame_xic (f
);
4067 /* XIM server might require some X events. */
4068 unsigned long fevent
= NoEventMask
;
4069 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
4071 if (fevent
!= NoEventMask
)
4073 XSetWindowAttributes attributes
;
4074 XWindowAttributes wattr
;
4075 unsigned long attribute_mask
;
4077 XGetWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4079 attributes
.event_mask
= wattr
.your_event_mask
| fevent
;
4080 attribute_mask
= CWEventMask
;
4081 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4082 attribute_mask
, &attributes
);
4090 #else /*! USE_GTK */
4091 /* Create and set up the X window for frame F. */
4098 XClassHint class_hints
;
4099 XSetWindowAttributes attributes
;
4100 unsigned long attribute_mask
;
4102 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
4103 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
4104 attributes
.bit_gravity
= StaticGravity
;
4105 attributes
.backing_store
= NotUseful
;
4106 attributes
.save_under
= True
;
4107 attributes
.event_mask
= STANDARD_EVENT_SET
;
4108 attributes
.colormap
= FRAME_X_COLORMAP (f
);
4109 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
4114 = XCreateWindow (FRAME_X_DISPLAY (f
),
4115 f
->output_data
.x
->parent_desc
,
4116 f
->output_data
.x
->left_pos
,
4117 f
->output_data
.x
->top_pos
,
4118 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
4119 f
->output_data
.x
->border_width
,
4120 CopyFromParent
, /* depth */
4121 InputOutput
, /* class */
4123 attribute_mask
, &attributes
);
4127 create_frame_xic (f
);
4130 /* XIM server might require some X events. */
4131 unsigned long fevent
= NoEventMask
;
4132 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
4133 attributes
.event_mask
|= fevent
;
4134 attribute_mask
= CWEventMask
;
4135 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4136 attribute_mask
, &attributes
);
4139 #endif /* HAVE_X_I18N */
4141 validate_x_resource_name ();
4143 class_hints
.res_name
= (char *) SDATA (Vx_resource_name
);
4144 class_hints
.res_class
= (char *) SDATA (Vx_resource_class
);
4145 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
4147 /* The menubar is part of the ordinary display;
4148 it does not count in addition to the height of the window. */
4149 f
->output_data
.x
->menubar_height
= 0;
4151 /* This indicates that we use the "Passive Input" input model.
4152 Unless we do this, we don't get the Focus{In,Out} events that we
4153 need to draw the cursor correctly. Accursed bureaucrats.
4154 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
4156 f
->output_data
.x
->wm_hints
.input
= True
;
4157 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
4158 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4159 &f
->output_data
.x
->wm_hints
);
4160 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
4162 /* Request "save yourself" and "delete window" commands from wm. */
4165 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
4166 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
4167 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
4170 /* x_set_name normally ignores requests to set the name if the
4171 requested name is the same as the current name. This is the one
4172 place where that assumption isn't correct; f->name is set, but
4173 the X server hasn't been told. */
4176 int explicit = f
->explicit_name
;
4178 f
->explicit_name
= 0;
4181 x_set_name (f
, name
, explicit);
4184 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4185 f
->output_data
.x
->text_cursor
);
4189 if (FRAME_X_WINDOW (f
) == 0)
4190 error ("Unable to create window");
4193 #endif /* not USE_GTK */
4194 #endif /* not USE_X_TOOLKIT */
4196 /* Handle the icon stuff for this window. Perhaps later we might
4197 want an x_set_icon_position which can be called interactively as
4205 Lisp_Object icon_x
, icon_y
;
4206 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4208 /* Set the position of the icon. Note that twm groups all
4209 icons in an icon window. */
4210 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
4211 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
4212 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
4214 CHECK_NUMBER (icon_x
);
4215 CHECK_NUMBER (icon_y
);
4217 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
4218 error ("Both left and top icon corners of icon must be specified");
4222 if (! EQ (icon_x
, Qunbound
))
4223 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
4225 /* Start up iconic or window? */
4226 x_wm_set_window_state
4227 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
4232 x_text_icon (f
, (char *) SDATA ((!NILP (f
->icon_name
)
4239 /* Make the GCs needed for this window, setting the
4240 background, border and mouse colors; also create the
4241 mouse cursor and the gray border tile. */
4243 static char cursor_bits
[] =
4245 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4246 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4247 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4248 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
4255 XGCValues gc_values
;
4259 /* Create the GCs of this frame.
4260 Note that many default values are used. */
4263 gc_values
.font
= f
->output_data
.x
->font
->fid
;
4264 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
4265 gc_values
.background
= f
->output_data
.x
->background_pixel
;
4266 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
4267 f
->output_data
.x
->normal_gc
4268 = XCreateGC (FRAME_X_DISPLAY (f
),
4270 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
4273 /* Reverse video style. */
4274 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4275 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
4276 f
->output_data
.x
->reverse_gc
4277 = XCreateGC (FRAME_X_DISPLAY (f
),
4279 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
4282 /* Cursor has cursor-color background, background-color foreground. */
4283 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4284 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
4285 gc_values
.fill_style
= FillOpaqueStippled
;
4287 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
4288 FRAME_X_DISPLAY_INFO (f
)->root_window
,
4289 cursor_bits
, 16, 16);
4290 f
->output_data
.x
->cursor_gc
4291 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4292 (GCFont
| GCForeground
| GCBackground
4293 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
4297 f
->output_data
.x
->white_relief
.gc
= 0;
4298 f
->output_data
.x
->black_relief
.gc
= 0;
4300 /* Create the gray border tile used when the pointer is not in
4301 the frame. Since this depends on the frame's pixel values,
4302 this must be done on a per-frame basis. */
4303 f
->output_data
.x
->border_tile
4304 = (XCreatePixmapFromBitmapData
4305 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
4306 gray_bits
, gray_width
, gray_height
,
4307 f
->output_data
.x
->foreground_pixel
,
4308 f
->output_data
.x
->background_pixel
,
4309 DefaultDepth (FRAME_X_DISPLAY (f
), FRAME_X_SCREEN_NUMBER (f
))));
4315 /* Free what was was allocated in x_make_gc. */
4321 Display
*dpy
= FRAME_X_DISPLAY (f
);
4325 if (f
->output_data
.x
->normal_gc
)
4327 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
4328 f
->output_data
.x
->normal_gc
= 0;
4331 if (f
->output_data
.x
->reverse_gc
)
4333 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4334 f
->output_data
.x
->reverse_gc
= 0;
4337 if (f
->output_data
.x
->cursor_gc
)
4339 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4340 f
->output_data
.x
->cursor_gc
= 0;
4343 if (f
->output_data
.x
->border_tile
)
4345 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4346 f
->output_data
.x
->border_tile
= 0;
4353 /* Handler for signals raised during x_create_frame and
4354 x_create_top_frame. FRAME is the frame which is partially
4358 unwind_create_frame (frame
)
4361 struct frame
*f
= XFRAME (frame
);
4363 /* If frame is ``official'', nothing to do. */
4364 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4367 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4370 x_free_frame_resources (f
);
4372 /* Check that reference counts are indeed correct. */
4373 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4374 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4382 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4384 doc
: /* Make a new X window, which is called a "frame" in Emacs terms.
4385 Returns an Emacs frame object.
4386 ALIST is an alist of frame parameters.
4387 If the parameters specify that the frame should not have a minibuffer,
4388 and do not specify a specific minibuffer window to use,
4389 then `default-minibuffer-frame' must be a frame whose minibuffer can
4390 be shared by the new frame.
4392 This function is an internal primitive--use `make-frame' instead. */)
4397 Lisp_Object frame
, tem
;
4399 int minibuffer_only
= 0;
4400 long window_prompting
= 0;
4402 int count
= SPECPDL_INDEX ();
4403 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4404 Lisp_Object display
;
4405 struct x_display_info
*dpyinfo
= NULL
;
4411 /* Use this general default value to start with
4412 until we know if this frame has a specified name. */
4413 Vx_resource_name
= Vinvocation_name
;
4415 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4416 if (EQ (display
, Qunbound
))
4418 dpyinfo
= check_x_display_info (display
);
4420 kb
= dpyinfo
->kboard
;
4422 kb
= &the_only_kboard
;
4425 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4427 && ! EQ (name
, Qunbound
)
4429 error ("Invalid frame name--not a string or nil");
4432 Vx_resource_name
= name
;
4434 /* See if parent window is specified. */
4435 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4436 if (EQ (parent
, Qunbound
))
4438 if (! NILP (parent
))
4439 CHECK_NUMBER (parent
);
4441 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4442 /* No need to protect DISPLAY because that's not used after passing
4443 it to make_frame_without_minibuffer. */
4445 GCPRO4 (parms
, parent
, name
, frame
);
4446 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4448 if (EQ (tem
, Qnone
) || NILP (tem
))
4449 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4450 else if (EQ (tem
, Qonly
))
4452 f
= make_minibuffer_frame ();
4453 minibuffer_only
= 1;
4455 else if (WINDOWP (tem
))
4456 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4460 XSETFRAME (frame
, f
);
4462 /* Note that X Windows does support scroll bars. */
4463 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4465 f
->output_method
= output_x_window
;
4466 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4467 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4468 f
->output_data
.x
->icon_bitmap
= -1;
4469 f
->output_data
.x
->fontset
= -1;
4470 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4471 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4472 #ifdef USE_TOOLKIT_SCROLL_BARS
4473 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
4474 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
4475 #endif /* USE_TOOLKIT_SCROLL_BARS */
4476 record_unwind_protect (unwind_create_frame
, frame
);
4479 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4481 if (! STRINGP (f
->icon_name
))
4482 f
->icon_name
= Qnil
;
4484 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4486 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4487 dpyinfo_refcount
= dpyinfo
->reference_count
;
4488 #endif /* GLYPH_DEBUG */
4490 FRAME_KBOARD (f
) = kb
;
4493 /* These colors will be set anyway later, but it's important
4494 to get the color reference counts right, so initialize them! */
4497 struct gcpro gcpro1
;
4499 /* Function x_decode_color can signal an error. Make
4500 sure to initialize color slots so that we won't try
4501 to free colors we haven't allocated. */
4502 f
->output_data
.x
->foreground_pixel
= -1;
4503 f
->output_data
.x
->background_pixel
= -1;
4504 f
->output_data
.x
->cursor_pixel
= -1;
4505 f
->output_data
.x
->cursor_foreground_pixel
= -1;
4506 f
->output_data
.x
->border_pixel
= -1;
4507 f
->output_data
.x
->mouse_pixel
= -1;
4509 black
= build_string ("black");
4511 f
->output_data
.x
->foreground_pixel
4512 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4513 f
->output_data
.x
->background_pixel
4514 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4515 f
->output_data
.x
->cursor_pixel
4516 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4517 f
->output_data
.x
->cursor_foreground_pixel
4518 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4519 f
->output_data
.x
->border_pixel
4520 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4521 f
->output_data
.x
->mouse_pixel
4522 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4526 /* Specify the parent under which to make this X window. */
4530 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4531 f
->output_data
.x
->explicit_parent
= 1;
4535 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4536 f
->output_data
.x
->explicit_parent
= 0;
4539 /* Set the name; the functions to which we pass f expect the name to
4541 if (EQ (name
, Qunbound
) || NILP (name
))
4543 f
->name
= build_string (dpyinfo
->x_id_name
);
4544 f
->explicit_name
= 0;
4549 f
->explicit_name
= 1;
4550 /* use the frame's title when getting resources for this frame. */
4551 specbind (Qx_resource_name
, name
);
4554 /* Extract the window parameters from the supplied values
4555 that are needed to determine window geometry. */
4559 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4562 /* First, try whatever font the caller has specified. */
4565 tem
= Fquery_fontset (font
, Qnil
);
4567 font
= x_new_fontset (f
, SDATA (tem
));
4569 font
= x_new_font (f
, SDATA (font
));
4572 /* Try out a font which we hope has bold and italic variations. */
4573 if (!STRINGP (font
))
4574 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4575 if (!STRINGP (font
))
4576 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4577 if (! STRINGP (font
))
4578 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4579 if (! STRINGP (font
))
4580 /* This was formerly the first thing tried, but it finds too many fonts
4581 and takes too long. */
4582 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4583 /* If those didn't work, look for something which will at least work. */
4584 if (! STRINGP (font
))
4585 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4587 if (! STRINGP (font
))
4588 font
= build_string ("fixed");
4590 x_default_parameter (f
, parms
, Qfont
, font
,
4591 "font", "Font", RES_TYPE_STRING
);
4595 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4596 whereby it fails to get any font. */
4597 xlwmenu_default_font
= f
->output_data
.x
->font
;
4600 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4601 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4603 /* This defaults to 1 in order to match xterm. We recognize either
4604 internalBorderWidth or internalBorder (which is what xterm calls
4606 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4610 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4611 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4612 if (! EQ (value
, Qunbound
))
4613 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4616 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4617 "internalBorderWidth", "internalBorderWidth",
4619 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4620 "verticalScrollBars", "ScrollBars",
4623 /* Also do the stuff which must be set before the window exists. */
4624 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4625 "foreground", "Foreground", RES_TYPE_STRING
);
4626 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4627 "background", "Background", RES_TYPE_STRING
);
4628 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4629 "pointerColor", "Foreground", RES_TYPE_STRING
);
4630 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4631 "cursorColor", "Foreground", RES_TYPE_STRING
);
4632 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4633 "borderColor", "BorderColor", RES_TYPE_STRING
);
4634 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4635 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4636 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4637 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4638 x_default_parameter (f
, parms
, Qleft_fringe
, Qnil
,
4639 "leftFringe", "LeftFringe", RES_TYPE_NUMBER
);
4640 x_default_parameter (f
, parms
, Qright_fringe
, Qnil
,
4641 "rightFringe", "RightFringe", RES_TYPE_NUMBER
);
4643 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4644 "scrollBarForeground",
4645 "ScrollBarForeground", 1);
4646 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4647 "scrollBarBackground",
4648 "ScrollBarBackground", 0);
4650 /* Init faces before x_default_parameter is called for scroll-bar
4651 parameters because that function calls x_set_scroll_bar_width,
4652 which calls change_frame_size, which calls Fset_window_buffer,
4653 which runs hooks, which call Fvertical_motion. At the end, we
4654 end up in init_iterator with a null face cache, which should not
4656 init_frame_faces (f
);
4658 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4659 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4660 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4661 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4662 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4663 "bufferPredicate", "BufferPredicate",
4665 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4666 "title", "Title", RES_TYPE_STRING
);
4667 x_default_parameter (f
, parms
, Qwait_for_wm
, Qt
,
4668 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN
);
4669 x_default_parameter (f
, parms
, Qfullscreen
, Qnil
,
4670 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL
);
4672 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4674 /* Add the tool-bar height to the initial frame height so that the
4675 user gets a text display area of the size he specified with -g or
4676 via .Xdefaults. Later changes of the tool-bar height don't
4677 change the frame size. This is done so that users can create
4678 tall Emacs frames without having to guess how tall the tool-bar
4680 if (FRAME_TOOL_BAR_LINES (f
))
4682 int margin
, relief
, bar_height
;
4684 relief
= (tool_bar_button_relief
>= 0
4685 ? tool_bar_button_relief
4686 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
4688 if (INTEGERP (Vtool_bar_button_margin
)
4689 && XINT (Vtool_bar_button_margin
) > 0)
4690 margin
= XFASTINT (Vtool_bar_button_margin
);
4691 else if (CONSP (Vtool_bar_button_margin
)
4692 && INTEGERP (XCDR (Vtool_bar_button_margin
))
4693 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
4694 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
4698 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
4699 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
4702 /* Compute the size of the X window. */
4703 window_prompting
= x_figure_window_size (f
, parms
);
4705 if (window_prompting
& XNegative
)
4707 if (window_prompting
& YNegative
)
4708 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4710 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4714 if (window_prompting
& YNegative
)
4715 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4717 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4720 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4722 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4723 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4725 /* Create the X widget or window. */
4726 #ifdef USE_X_TOOLKIT
4727 x_window (f
, window_prompting
, minibuffer_only
);
4735 /* Now consider the frame official. */
4736 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4737 Vframe_list
= Fcons (frame
, Vframe_list
);
4739 /* We need to do this after creating the X window, so that the
4740 icon-creation functions can say whose icon they're describing. */
4741 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4742 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4744 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4745 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4746 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4747 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4748 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4749 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4750 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4751 "scrollBarWidth", "ScrollBarWidth",
4754 /* Dimensions, especially f->height, must be done via change_frame_size.
4755 Change will not be effected unless different from the current
4761 SET_FRAME_WIDTH (f
, 0);
4762 change_frame_size (f
, height
, width
, 1, 0, 0);
4764 /* Set up faces after all frame parameters are known. This call
4765 also merges in face attributes specified for new frames. If we
4766 don't do this, the `menu' face for instance won't have the right
4767 colors, and the menu bar won't appear in the specified colors for
4769 call1 (Qface_set_after_frame_default
, frame
);
4771 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
4772 /* Create the menu bar. */
4773 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4775 /* If this signals an error, we haven't set size hints for the
4776 frame and we didn't make it visible. */
4777 initialize_frame_menubar (f
);
4780 /* This is a no-op, except under Motif where it arranges the
4781 main window for the widgets on it. */
4782 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4783 f
->output_data
.x
->menubar_widget
,
4784 f
->output_data
.x
->edit_widget
);
4785 #endif /* not USE_GTK */
4787 #endif /* USE_X_TOOLKIT || USE_GTK */
4789 /* Tell the server what size and position, etc, we want, and how
4790 badly we want them. This should be done after we have the menu
4791 bar so that its size can be taken into account. */
4793 x_wm_set_size_hint (f
, window_prompting
, 0);
4796 /* Make the window appear on the frame and enable display, unless
4797 the caller says not to. However, with explicit parent, Emacs
4798 cannot control visibility, so don't try. */
4799 if (! f
->output_data
.x
->explicit_parent
)
4801 Lisp_Object visibility
;
4803 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4805 if (EQ (visibility
, Qunbound
))
4808 if (EQ (visibility
, Qicon
))
4809 x_iconify_frame (f
);
4810 else if (! NILP (visibility
))
4811 x_make_frame_visible (f
);
4813 /* Must have been Qnil. */
4819 /* Make sure windows on this frame appear in calls to next-window
4820 and similar functions. */
4821 Vwindow_list
= Qnil
;
4823 return unbind_to (count
, frame
);
4827 /* FRAME is used only to get a handle on the X display. We don't pass the
4828 display info directly because we're called from frame.c, which doesn't
4829 know about that structure. */
4832 x_get_focus_frame (frame
)
4833 struct frame
*frame
;
4835 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4837 if (! dpyinfo
->x_focus_frame
)
4840 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4845 /* In certain situations, when the window manager follows a
4846 click-to-focus policy, there seems to be no way around calling
4847 XSetInputFocus to give another frame the input focus .
4849 In an ideal world, XSetInputFocus should generally be avoided so
4850 that applications don't interfere with the window manager's focus
4851 policy. But I think it's okay to use when it's clearly done
4852 following a user-command. */
4854 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4855 doc
: /* Set the input focus to FRAME.
4856 FRAME nil means use the selected frame. */)
4860 struct frame
*f
= check_x_frame (frame
);
4861 Display
*dpy
= FRAME_X_DISPLAY (f
);
4865 count
= x_catch_errors (dpy
);
4866 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4867 RevertToParent
, CurrentTime
);
4868 x_uncatch_errors (dpy
, count
);
4875 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4876 doc
: /* Internal function called by `color-defined-p', which see. */)
4878 Lisp_Object color
, frame
;
4881 FRAME_PTR f
= check_x_frame (frame
);
4883 CHECK_STRING (color
);
4885 if (x_defined_color (f
, SDATA (color
), &foo
, 0))
4891 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4892 doc
: /* Internal function called by `color-values', which see. */)
4894 Lisp_Object color
, frame
;
4897 FRAME_PTR f
= check_x_frame (frame
);
4899 CHECK_STRING (color
);
4901 if (x_defined_color (f
, SDATA (color
), &foo
, 0))
4905 rgb
[0] = make_number (foo
.red
);
4906 rgb
[1] = make_number (foo
.green
);
4907 rgb
[2] = make_number (foo
.blue
);
4908 return Flist (3, rgb
);
4914 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4915 doc
: /* Internal function called by `display-color-p', which see. */)
4917 Lisp_Object display
;
4919 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4921 if (dpyinfo
->n_planes
<= 2)
4924 switch (dpyinfo
->visual
->class)
4937 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4939 doc
: /* Return t if the X display supports shades of gray.
4940 Note that color displays do support shades of gray.
4941 The optional argument DISPLAY specifies which display to ask about.
4942 DISPLAY should be either a frame or a display name (a string).
4943 If omitted or nil, that stands for the selected frame's display. */)
4945 Lisp_Object display
;
4947 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4949 if (dpyinfo
->n_planes
<= 1)
4952 switch (dpyinfo
->visual
->class)
4967 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4969 doc
: /* Returns the width in pixels of the X display DISPLAY.
4970 The optional argument DISPLAY specifies which display to ask about.
4971 DISPLAY should be either a frame or a display name (a string).
4972 If omitted or nil, that stands for the selected frame's display. */)
4974 Lisp_Object display
;
4976 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4978 return make_number (dpyinfo
->width
);
4981 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4982 Sx_display_pixel_height
, 0, 1, 0,
4983 doc
: /* Returns the height in pixels of the X display DISPLAY.
4984 The optional argument DISPLAY specifies which display to ask about.
4985 DISPLAY should be either a frame or a display name (a string).
4986 If omitted or nil, that stands for the selected frame's display. */)
4988 Lisp_Object display
;
4990 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4992 return make_number (dpyinfo
->height
);
4995 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4997 doc
: /* Returns the number of bitplanes of the X display DISPLAY.
4998 The optional argument DISPLAY specifies which display to ask about.
4999 DISPLAY should be either a frame or a display name (a string).
5000 If omitted or nil, that stands for the selected frame's display. */)
5002 Lisp_Object display
;
5004 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5006 return make_number (dpyinfo
->n_planes
);
5009 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
5011 doc
: /* Returns the number of color cells of the X display DISPLAY.
5012 The optional argument DISPLAY specifies which display to ask about.
5013 DISPLAY should be either a frame or a display name (a string).
5014 If omitted or nil, that stands for the selected frame's display. */)
5016 Lisp_Object display
;
5018 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5020 return make_number (DisplayCells (dpyinfo
->display
,
5021 XScreenNumberOfScreen (dpyinfo
->screen
)));
5024 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
5025 Sx_server_max_request_size
,
5027 doc
: /* Returns the maximum request size of the X server of display DISPLAY.
5028 The optional argument DISPLAY specifies which display to ask about.
5029 DISPLAY should be either a frame or a display name (a string).
5030 If omitted or nil, that stands for the selected frame's display. */)
5032 Lisp_Object display
;
5034 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5036 return make_number (MAXREQUEST (dpyinfo
->display
));
5039 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
5040 doc
: /* Returns the vendor ID string of the X server of display DISPLAY.
5041 The optional argument DISPLAY specifies which display to ask about.
5042 DISPLAY should be either a frame or a display name (a string).
5043 If omitted or nil, that stands for the selected frame's display. */)
5045 Lisp_Object display
;
5047 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5048 char *vendor
= ServerVendor (dpyinfo
->display
);
5050 if (! vendor
) vendor
= "";
5051 return build_string (vendor
);
5054 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
5055 doc
: /* Returns the version numbers of the X server of display DISPLAY.
5056 The value is a list of three integers: the major and minor
5057 version numbers of the X Protocol in use, and the vendor-specific release
5058 number. See also the function `x-server-vendor'.
5060 The optional argument DISPLAY specifies which display to ask about.
5061 DISPLAY should be either a frame or a display name (a string).
5062 If omitted or nil, that stands for the selected frame's display. */)
5064 Lisp_Object display
;
5066 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5067 Display
*dpy
= dpyinfo
->display
;
5069 return Fcons (make_number (ProtocolVersion (dpy
)),
5070 Fcons (make_number (ProtocolRevision (dpy
)),
5071 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
5074 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
5075 doc
: /* Return the number of screens on the X server of display DISPLAY.
5076 The optional argument DISPLAY specifies which display to ask about.
5077 DISPLAY should be either a frame or a display name (a string).
5078 If omitted or nil, that stands for the selected frame's display. */)
5080 Lisp_Object display
;
5082 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5084 return make_number (ScreenCount (dpyinfo
->display
));
5087 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
5088 doc
: /* Return the height in millimeters of the X display DISPLAY.
5089 The optional argument DISPLAY specifies which display to ask about.
5090 DISPLAY should be either a frame or a display name (a string).
5091 If omitted or nil, that stands for the selected frame's display. */)
5093 Lisp_Object display
;
5095 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5097 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
5100 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
5101 doc
: /* Return the width in millimeters of the X display DISPLAY.
5102 The optional argument DISPLAY specifies which display to ask about.
5103 DISPLAY should be either a frame or a display name (a string).
5104 If omitted or nil, that stands for the selected frame's display. */)
5106 Lisp_Object display
;
5108 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5110 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
5113 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
5114 Sx_display_backing_store
, 0, 1, 0,
5115 doc
: /* Returns an indication of whether X display DISPLAY does backing store.
5116 The value may be `always', `when-mapped', or `not-useful'.
5117 The optional argument DISPLAY specifies which display to ask about.
5118 DISPLAY should be either a frame or a display name (a string).
5119 If omitted or nil, that stands for the selected frame's display. */)
5121 Lisp_Object display
;
5123 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5126 switch (DoesBackingStore (dpyinfo
->screen
))
5129 result
= intern ("always");
5133 result
= intern ("when-mapped");
5137 result
= intern ("not-useful");
5141 error ("Strange value for BackingStore parameter of screen");
5148 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
5149 Sx_display_visual_class
, 0, 1, 0,
5150 doc
: /* Return the visual class of the X display DISPLAY.
5151 The value is one of the symbols `static-gray', `gray-scale',
5152 `static-color', `pseudo-color', `true-color', or `direct-color'.
5154 The optional argument DISPLAY specifies which display to ask about.
5155 DISPLAY should be either a frame or a display name (a string).
5156 If omitted or nil, that stands for the selected frame's display. */)
5158 Lisp_Object display
;
5160 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5163 switch (dpyinfo
->visual
->class)
5166 result
= intern ("static-gray");
5169 result
= intern ("gray-scale");
5172 result
= intern ("static-color");
5175 result
= intern ("pseudo-color");
5178 result
= intern ("true-color");
5181 result
= intern ("direct-color");
5184 error ("Display has an unknown visual class");
5191 DEFUN ("x-display-save-under", Fx_display_save_under
,
5192 Sx_display_save_under
, 0, 1, 0,
5193 doc
: /* Returns t if the X display DISPLAY supports the save-under feature.
5194 The optional argument DISPLAY specifies which display to ask about.
5195 DISPLAY should be either a frame or a display name (a string).
5196 If omitted or nil, that stands for the selected frame's display. */)
5198 Lisp_Object display
;
5200 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5202 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
5210 register struct frame
*f
;
5212 return PIXEL_WIDTH (f
);
5217 register struct frame
*f
;
5219 return PIXEL_HEIGHT (f
);
5224 register struct frame
*f
;
5226 return FONT_WIDTH (f
->output_data
.x
->font
);
5231 register struct frame
*f
;
5233 return f
->output_data
.x
->line_height
;
5238 register struct frame
*f
;
5240 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
5245 /************************************************************************
5247 ************************************************************************/
5250 /* Mapping visual names to visuals. */
5252 static struct visual_class
5259 {"StaticGray", StaticGray
},
5260 {"GrayScale", GrayScale
},
5261 {"StaticColor", StaticColor
},
5262 {"PseudoColor", PseudoColor
},
5263 {"TrueColor", TrueColor
},
5264 {"DirectColor", DirectColor
},
5269 #ifndef HAVE_XSCREENNUMBEROFSCREEN
5271 /* Value is the screen number of screen SCR. This is a substitute for
5272 the X function with the same name when that doesn't exist. */
5275 XScreenNumberOfScreen (scr
)
5276 register Screen
*scr
;
5278 Display
*dpy
= scr
->display
;
5281 for (i
= 0; i
< dpy
->nscreens
; ++i
)
5282 if (scr
== dpy
->screens
+ i
)
5288 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5291 /* Select the visual that should be used on display DPYINFO. Set
5292 members of DPYINFO appropriately. Called from x_term_init. */
5295 select_visual (dpyinfo
)
5296 struct x_display_info
*dpyinfo
;
5298 Display
*dpy
= dpyinfo
->display
;
5299 Screen
*screen
= dpyinfo
->screen
;
5302 /* See if a visual is specified. */
5303 value
= display_x_get_resource (dpyinfo
,
5304 build_string ("visualClass"),
5305 build_string ("VisualClass"),
5307 if (STRINGP (value
))
5309 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
5310 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
5311 depth, a decimal number. NAME is compared with case ignored. */
5312 char *s
= (char *) alloca (SBYTES (value
) + 1);
5317 strcpy (s
, SDATA (value
));
5318 dash
= index (s
, '-');
5321 dpyinfo
->n_planes
= atoi (dash
+ 1);
5325 /* We won't find a matching visual with depth 0, so that
5326 an error will be printed below. */
5327 dpyinfo
->n_planes
= 0;
5329 /* Determine the visual class. */
5330 for (i
= 0; visual_classes
[i
].name
; ++i
)
5331 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
5333 class = visual_classes
[i
].class;
5337 /* Look up a matching visual for the specified class. */
5339 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
5340 dpyinfo
->n_planes
, class, &vinfo
))
5341 fatal ("Invalid visual specification `%s'", SDATA (value
));
5343 dpyinfo
->visual
= vinfo
.visual
;
5348 XVisualInfo
*vinfo
, vinfo_template
;
5350 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
5353 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
5355 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
5357 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5358 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
5359 &vinfo_template
, &n_visuals
);
5361 fatal ("Can't get proper X visual info");
5363 dpyinfo
->n_planes
= vinfo
->depth
;
5364 XFree ((char *) vinfo
);
5369 /* Return the X display structure for the display named NAME.
5370 Open a new connection if necessary. */
5372 struct x_display_info
*
5373 x_display_info_for_name (name
)
5377 struct x_display_info
*dpyinfo
;
5379 CHECK_STRING (name
);
5381 if (! EQ (Vwindow_system
, intern ("x")))
5382 error ("Not using X Windows");
5384 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5386 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5389 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5394 /* Use this general default value to start with. */
5395 Vx_resource_name
= Vinvocation_name
;
5397 validate_x_resource_name ();
5399 dpyinfo
= x_term_init (name
, (char *)0,
5400 (char *) SDATA (Vx_resource_name
));
5403 error ("Cannot connect to X server %s", SDATA (name
));
5406 XSETFASTINT (Vwindow_system_version
, 11);
5412 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5414 doc
: /* Open a connection to an X server.
5415 DISPLAY is the name of the display to connect to.
5416 Optional second arg XRM-STRING is a string of resources in xrdb format.
5417 If the optional third arg MUST-SUCCEED is non-nil,
5418 terminate Emacs if we can't open the connection. */)
5419 (display
, xrm_string
, must_succeed
)
5420 Lisp_Object display
, xrm_string
, must_succeed
;
5422 unsigned char *xrm_option
;
5423 struct x_display_info
*dpyinfo
;
5425 CHECK_STRING (display
);
5426 if (! NILP (xrm_string
))
5427 CHECK_STRING (xrm_string
);
5429 if (! EQ (Vwindow_system
, intern ("x")))
5430 error ("Not using X Windows");
5432 if (! NILP (xrm_string
))
5433 xrm_option
= (unsigned char *) SDATA (xrm_string
);
5435 xrm_option
= (unsigned char *) 0;
5437 validate_x_resource_name ();
5439 /* This is what opens the connection and sets x_current_display.
5440 This also initializes many symbols, such as those used for input. */
5441 dpyinfo
= x_term_init (display
, xrm_option
,
5442 (char *) SDATA (Vx_resource_name
));
5446 if (!NILP (must_succeed
))
5447 fatal ("Cannot connect to X server %s.\n\
5448 Check the DISPLAY environment variable or use `-d'.\n\
5449 Also use the `xauth' program to verify that you have the proper\n\
5450 authorization information needed to connect the X server.\n\
5451 An insecure way to solve the problem may be to use `xhost'.\n",
5454 error ("Cannot connect to X server %s", SDATA (display
));
5459 XSETFASTINT (Vwindow_system_version
, 11);
5463 DEFUN ("x-close-connection", Fx_close_connection
,
5464 Sx_close_connection
, 1, 1, 0,
5465 doc
: /* Close the connection to DISPLAY's X server.
5466 For DISPLAY, specify either a frame or a display name (a string).
5467 If DISPLAY is nil, that stands for the selected frame's display. */)
5469 Lisp_Object display
;
5471 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5474 if (dpyinfo
->reference_count
> 0)
5475 error ("Display still has frames on it");
5478 /* Free the fonts in the font table. */
5479 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5480 if (dpyinfo
->font_table
[i
].name
)
5482 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5483 xfree (dpyinfo
->font_table
[i
].full_name
);
5484 xfree (dpyinfo
->font_table
[i
].name
);
5485 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5488 x_destroy_all_bitmaps (dpyinfo
);
5489 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5491 #ifdef USE_X_TOOLKIT
5492 XtCloseDisplay (dpyinfo
->display
);
5494 XCloseDisplay (dpyinfo
->display
);
5497 x_delete_display (dpyinfo
);
5503 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5504 doc
: /* Return the list of display names that Emacs has connections to. */)
5507 Lisp_Object tail
, result
;
5510 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5511 result
= Fcons (XCAR (XCAR (tail
)), result
);
5516 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5517 doc
: /* If ON is non-nil, report X errors as soon as the erring request is made.
5518 If ON is nil, allow buffering of requests.
5519 Turning on synchronization prohibits the Xlib routines from buffering
5520 requests and seriously degrades performance, but makes debugging much
5522 The optional second argument DISPLAY specifies which display to act on.
5523 DISPLAY should be either a frame or a display name (a string).
5524 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
5526 Lisp_Object display
, on
;
5528 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5530 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5535 /* Wait for responses to all X commands issued so far for frame F. */
5542 XSync (FRAME_X_DISPLAY (f
), False
);
5547 /***********************************************************************
5549 ***********************************************************************/
5551 /* Value is the number of elements of vector VECTOR. */
5553 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5555 /* List of supported image types. Use define_image_type to add new
5556 types. Use lookup_image_type to find a type for a given symbol. */
5558 static struct image_type
*image_types
;
5560 /* The symbol `image' which is the car of the lists used to represent
5563 extern Lisp_Object Qimage
;
5565 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5571 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5572 extern Lisp_Object QCdata
, QCtype
;
5573 Lisp_Object QCascent
, QCmargin
, QCrelief
;
5574 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
5575 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5577 /* Other symbols. */
5579 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5581 /* Time in seconds after which images should be removed from the cache
5582 if not displayed. */
5584 Lisp_Object Vimage_cache_eviction_delay
;
5586 /* Function prototypes. */
5588 static void define_image_type
P_ ((struct image_type
*type
));
5589 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5590 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5591 static void x_laplace
P_ ((struct frame
*, struct image
*));
5592 static void x_emboss
P_ ((struct frame
*, struct image
*));
5593 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5597 /* Define a new image type from TYPE. This adds a copy of TYPE to
5598 image_types and adds the symbol *TYPE->type to Vimage_types. */
5601 define_image_type (type
)
5602 struct image_type
*type
;
5604 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5605 The initialized data segment is read-only. */
5606 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5607 bcopy (type
, p
, sizeof *p
);
5608 p
->next
= image_types
;
5610 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5614 /* Look up image type SYMBOL, and return a pointer to its image_type
5615 structure. Value is null if SYMBOL is not a known image type. */
5617 static INLINE
struct image_type
*
5618 lookup_image_type (symbol
)
5621 struct image_type
*type
;
5623 for (type
= image_types
; type
; type
= type
->next
)
5624 if (EQ (symbol
, *type
->type
))
5631 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5632 valid image specification is a list whose car is the symbol
5633 `image', and whose rest is a property list. The property list must
5634 contain a value for key `:type'. That value must be the name of a
5635 supported image type. The rest of the property list depends on the
5639 valid_image_p (object
)
5644 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5648 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
5649 if (EQ (XCAR (tem
), QCtype
))
5652 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
5654 struct image_type
*type
;
5655 type
= lookup_image_type (XCAR (tem
));
5657 valid_p
= type
->valid_p (object
);
5668 /* Log error message with format string FORMAT and argument ARG.
5669 Signaling an error, e.g. when an image cannot be loaded, is not a
5670 good idea because this would interrupt redisplay, and the error
5671 message display would lead to another redisplay. This function
5672 therefore simply displays a message. */
5675 image_error (format
, arg1
, arg2
)
5677 Lisp_Object arg1
, arg2
;
5679 add_to_log (format
, arg1
, arg2
);
5684 /***********************************************************************
5685 Image specifications
5686 ***********************************************************************/
5688 enum image_value_type
5690 IMAGE_DONT_CHECK_VALUE_TYPE
,
5692 IMAGE_STRING_OR_NIL_VALUE
,
5694 IMAGE_POSITIVE_INTEGER_VALUE
,
5695 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
5696 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5698 IMAGE_INTEGER_VALUE
,
5699 IMAGE_FUNCTION_VALUE
,
5704 /* Structure used when parsing image specifications. */
5706 struct image_keyword
5708 /* Name of keyword. */
5711 /* The type of value allowed. */
5712 enum image_value_type type
;
5714 /* Non-zero means key must be present. */
5717 /* Used to recognize duplicate keywords in a property list. */
5720 /* The value that was found. */
5725 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5727 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5730 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5731 has the format (image KEYWORD VALUE ...). One of the keyword/
5732 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5733 image_keywords structures of size NKEYWORDS describing other
5734 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5737 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5739 struct image_keyword
*keywords
;
5746 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5749 plist
= XCDR (spec
);
5750 while (CONSP (plist
))
5752 Lisp_Object key
, value
;
5754 /* First element of a pair must be a symbol. */
5756 plist
= XCDR (plist
);
5760 /* There must follow a value. */
5763 value
= XCAR (plist
);
5764 plist
= XCDR (plist
);
5766 /* Find key in KEYWORDS. Error if not found. */
5767 for (i
= 0; i
< nkeywords
; ++i
)
5768 if (strcmp (keywords
[i
].name
, SDATA (SYMBOL_NAME (key
))) == 0)
5774 /* Record that we recognized the keyword. If a keywords
5775 was found more than once, it's an error. */
5776 keywords
[i
].value
= value
;
5777 ++keywords
[i
].count
;
5779 if (keywords
[i
].count
> 1)
5782 /* Check type of value against allowed type. */
5783 switch (keywords
[i
].type
)
5785 case IMAGE_STRING_VALUE
:
5786 if (!STRINGP (value
))
5790 case IMAGE_STRING_OR_NIL_VALUE
:
5791 if (!STRINGP (value
) && !NILP (value
))
5795 case IMAGE_SYMBOL_VALUE
:
5796 if (!SYMBOLP (value
))
5800 case IMAGE_POSITIVE_INTEGER_VALUE
:
5801 if (!INTEGERP (value
) || XINT (value
) <= 0)
5805 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
5806 if (INTEGERP (value
) && XINT (value
) >= 0)
5809 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
5810 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
5814 case IMAGE_ASCENT_VALUE
:
5815 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5817 else if (INTEGERP (value
)
5818 && XINT (value
) >= 0
5819 && XINT (value
) <= 100)
5823 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5824 if (!INTEGERP (value
) || XINT (value
) < 0)
5828 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5831 case IMAGE_FUNCTION_VALUE
:
5832 value
= indirect_function (value
);
5834 || COMPILEDP (value
)
5835 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5839 case IMAGE_NUMBER_VALUE
:
5840 if (!INTEGERP (value
) && !FLOATP (value
))
5844 case IMAGE_INTEGER_VALUE
:
5845 if (!INTEGERP (value
))
5849 case IMAGE_BOOL_VALUE
:
5850 if (!NILP (value
) && !EQ (value
, Qt
))
5859 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5863 /* Check that all mandatory fields are present. */
5864 for (i
= 0; i
< nkeywords
; ++i
)
5865 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5868 return NILP (plist
);
5872 /* Return the value of KEY in image specification SPEC. Value is nil
5873 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5874 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5877 image_spec_value (spec
, key
, found
)
5878 Lisp_Object spec
, key
;
5883 xassert (valid_image_p (spec
));
5885 for (tail
= XCDR (spec
);
5886 CONSP (tail
) && CONSP (XCDR (tail
));
5887 tail
= XCDR (XCDR (tail
)))
5889 if (EQ (XCAR (tail
), key
))
5893 return XCAR (XCDR (tail
));
5903 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5904 doc
: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
5905 PIXELS non-nil means return the size in pixels, otherwise return the
5906 size in canonical character units.
5907 FRAME is the frame on which the image will be displayed. FRAME nil
5908 or omitted means use the selected frame. */)
5909 (spec
, pixels
, frame
)
5910 Lisp_Object spec
, pixels
, frame
;
5915 if (valid_image_p (spec
))
5917 struct frame
*f
= check_x_frame (frame
);
5918 int id
= lookup_image (f
, spec
);
5919 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5920 int width
= img
->width
+ 2 * img
->hmargin
;
5921 int height
= img
->height
+ 2 * img
->vmargin
;
5924 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5925 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5927 size
= Fcons (make_number (width
), make_number (height
));
5930 error ("Invalid image specification");
5936 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5937 doc
: /* Return t if image SPEC has a mask bitmap.
5938 FRAME is the frame on which the image will be displayed. FRAME nil
5939 or omitted means use the selected frame. */)
5941 Lisp_Object spec
, frame
;
5946 if (valid_image_p (spec
))
5948 struct frame
*f
= check_x_frame (frame
);
5949 int id
= lookup_image (f
, spec
);
5950 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5955 error ("Invalid image specification");
5962 /***********************************************************************
5963 Image type independent image structures
5964 ***********************************************************************/
5966 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5967 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5970 /* Allocate and return a new image structure for image specification
5971 SPEC. SPEC has a hash value of HASH. */
5973 static struct image
*
5974 make_image (spec
, hash
)
5978 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5980 xassert (valid_image_p (spec
));
5981 bzero (img
, sizeof *img
);
5982 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5983 xassert (img
->type
!= NULL
);
5985 img
->data
.lisp_val
= Qnil
;
5986 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5992 /* Free image IMG which was used on frame F, including its resources. */
6001 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6003 /* Remove IMG from the hash table of its cache. */
6005 img
->prev
->next
= img
->next
;
6007 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
6010 img
->next
->prev
= img
->prev
;
6012 c
->images
[img
->id
] = NULL
;
6014 /* Free resources, then free IMG. */
6015 img
->type
->free (f
, img
);
6021 /* Prepare image IMG for display on frame F. Must be called before
6022 drawing an image. */
6025 prepare_image_for_display (f
, img
)
6031 /* We're about to display IMG, so set its timestamp to `now'. */
6033 img
->timestamp
= EMACS_SECS (t
);
6035 /* If IMG doesn't have a pixmap yet, load it now, using the image
6036 type dependent loader function. */
6037 if (img
->pixmap
== None
&& !img
->load_failed_p
)
6038 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6042 /* Value is the number of pixels for the ascent of image IMG when
6043 drawn in face FACE. */
6046 image_ascent (img
, face
)
6050 int height
= img
->height
+ img
->vmargin
;
6053 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
6056 /* This expression is arranged so that if the image can't be
6057 exactly centered, it will be moved slightly up. This is
6058 because a typical font is `top-heavy' (due to the presence
6059 uppercase letters), so the image placement should err towards
6060 being top-heavy too. It also just generally looks better. */
6061 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
6063 ascent
= height
/ 2;
6066 ascent
= height
* img
->ascent
/ 100.0;
6072 /* Image background colors. */
6074 static unsigned long
6075 four_corners_best (ximg
, width
, height
)
6077 unsigned long width
, height
;
6079 unsigned long corners
[4], best
;
6082 /* Get the colors at the corners of ximg. */
6083 corners
[0] = XGetPixel (ximg
, 0, 0);
6084 corners
[1] = XGetPixel (ximg
, width
- 1, 0);
6085 corners
[2] = XGetPixel (ximg
, width
- 1, height
- 1);
6086 corners
[3] = XGetPixel (ximg
, 0, height
- 1);
6088 /* Choose the most frequently found color as background. */
6089 for (i
= best_count
= 0; i
< 4; ++i
)
6093 for (j
= n
= 0; j
< 4; ++j
)
6094 if (corners
[i
] == corners
[j
])
6098 best
= corners
[i
], best_count
= n
;
6104 /* Return the `background' field of IMG. If IMG doesn't have one yet,
6105 it is guessed heuristically. If non-zero, XIMG is an existing XImage
6106 object to use for the heuristic. */
6109 image_background (img
, f
, ximg
)
6114 if (! img
->background_valid
)
6115 /* IMG doesn't have a background yet, try to guess a reasonable value. */
6117 int free_ximg
= !ximg
;
6120 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
6121 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
6123 img
->background
= four_corners_best (ximg
, img
->width
, img
->height
);
6126 XDestroyImage (ximg
);
6128 img
->background_valid
= 1;
6131 return img
->background
;
6134 /* Return the `background_transparent' field of IMG. If IMG doesn't
6135 have one yet, it is guessed heuristically. If non-zero, MASK is an
6136 existing XImage object to use for the heuristic. */
6139 image_background_transparent (img
, f
, mask
)
6144 if (! img
->background_transparent_valid
)
6145 /* IMG doesn't have a background yet, try to guess a reasonable value. */
6149 int free_mask
= !mask
;
6152 mask
= XGetImage (FRAME_X_DISPLAY (f
), img
->mask
,
6153 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
6155 img
->background_transparent
6156 = !four_corners_best (mask
, img
->width
, img
->height
);
6159 XDestroyImage (mask
);
6162 img
->background_transparent
= 0;
6164 img
->background_transparent_valid
= 1;
6167 return img
->background_transparent
;
6171 /***********************************************************************
6172 Helper functions for X image types
6173 ***********************************************************************/
6175 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
6177 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
6178 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
6180 Lisp_Object color_name
,
6181 unsigned long dflt
));
6184 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
6185 free the pixmap if any. MASK_P non-zero means clear the mask
6186 pixmap if any. COLORS_P non-zero means free colors allocated for
6187 the image, if any. */
6190 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
6193 int pixmap_p
, mask_p
, colors_p
;
6195 if (pixmap_p
&& img
->pixmap
)
6197 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
6199 img
->background_valid
= 0;
6202 if (mask_p
&& img
->mask
)
6204 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6206 img
->background_transparent_valid
= 0;
6209 if (colors_p
&& img
->ncolors
)
6211 x_free_colors (f
, img
->colors
, img
->ncolors
);
6212 xfree (img
->colors
);
6218 /* Free X resources of image IMG which is used on frame F. */
6221 x_clear_image (f
, img
)
6226 x_clear_image_1 (f
, img
, 1, 1, 1);
6231 /* Allocate color COLOR_NAME for image IMG on frame F. If color
6232 cannot be allocated, use DFLT. Add a newly allocated color to
6233 IMG->colors, so that it can be freed again. Value is the pixel
6236 static unsigned long
6237 x_alloc_image_color (f
, img
, color_name
, dflt
)
6240 Lisp_Object color_name
;
6244 unsigned long result
;
6246 xassert (STRINGP (color_name
));
6248 if (x_defined_color (f
, SDATA (color_name
), &color
, 1))
6250 /* This isn't called frequently so we get away with simply
6251 reallocating the color vector to the needed size, here. */
6254 (unsigned long *) xrealloc (img
->colors
,
6255 img
->ncolors
* sizeof *img
->colors
);
6256 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
6257 result
= color
.pixel
;
6267 /***********************************************************************
6269 ***********************************************************************/
6271 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
6272 static void postprocess_image
P_ ((struct frame
*, struct image
*));
6275 /* Return a new, initialized image cache that is allocated from the
6276 heap. Call free_image_cache to free an image cache. */
6278 struct image_cache
*
6281 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
6284 bzero (c
, sizeof *c
);
6286 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
6287 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
6288 c
->buckets
= (struct image
**) xmalloc (size
);
6289 bzero (c
->buckets
, size
);
6294 /* Free image cache of frame F. Be aware that X frames share images
6298 free_image_cache (f
)
6301 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6306 /* Cache should not be referenced by any frame when freed. */
6307 xassert (c
->refcount
== 0);
6309 for (i
= 0; i
< c
->used
; ++i
)
6310 free_image (f
, c
->images
[i
]);
6314 FRAME_X_IMAGE_CACHE (f
) = NULL
;
6319 /* Clear image cache of frame F. FORCE_P non-zero means free all
6320 images. FORCE_P zero means clear only images that haven't been
6321 displayed for some time. Should be called from time to time to
6322 reduce the number of loaded images. If image-eviction-seconds is
6323 non-nil, this frees images in the cache which weren't displayed for
6324 at least that many seconds. */
6327 clear_image_cache (f
, force_p
)
6331 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6333 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
6340 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
6342 /* Block input so that we won't be interrupted by a SIGIO
6343 while being in an inconsistent state. */
6346 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
6348 struct image
*img
= c
->images
[i
];
6350 && (force_p
|| img
->timestamp
< old
))
6352 free_image (f
, img
);
6357 /* We may be clearing the image cache because, for example,
6358 Emacs was iconified for a longer period of time. In that
6359 case, current matrices may still contain references to
6360 images freed above. So, clear these matrices. */
6363 Lisp_Object tail
, frame
;
6365 FOR_EACH_FRAME (tail
, frame
)
6367 struct frame
*f
= XFRAME (frame
);
6369 && FRAME_X_IMAGE_CACHE (f
) == c
)
6370 clear_current_matrices (f
);
6373 ++windows_or_buffers_changed
;
6381 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
6383 doc
: /* Clear the image cache of FRAME.
6384 FRAME nil or omitted means use the selected frame.
6385 FRAME t means clear the image caches of all frames. */)
6393 FOR_EACH_FRAME (tail
, frame
)
6394 if (FRAME_X_P (XFRAME (frame
)))
6395 clear_image_cache (XFRAME (frame
), 1);
6398 clear_image_cache (check_x_frame (frame
), 1);
6404 /* Compute masks and transform image IMG on frame F, as specified
6405 by the image's specification, */
6408 postprocess_image (f
, img
)
6412 /* Manipulation of the image's mask. */
6415 Lisp_Object conversion
, spec
;
6420 /* `:heuristic-mask t'
6422 means build a mask heuristically.
6423 `:heuristic-mask (R G B)'
6424 `:mask (heuristic (R G B))'
6425 means build a mask from color (R G B) in the
6428 means remove a mask, if any. */
6430 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6432 x_build_heuristic_mask (f
, img
, mask
);
6437 mask
= image_spec_value (spec
, QCmask
, &found_p
);
6439 if (EQ (mask
, Qheuristic
))
6440 x_build_heuristic_mask (f
, img
, Qt
);
6441 else if (CONSP (mask
)
6442 && EQ (XCAR (mask
), Qheuristic
))
6444 if (CONSP (XCDR (mask
)))
6445 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6447 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6449 else if (NILP (mask
) && found_p
&& img
->mask
)
6451 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6457 /* Should we apply an image transformation algorithm? */
6458 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
6459 if (EQ (conversion
, Qdisabled
))
6460 x_disable_image (f
, img
);
6461 else if (EQ (conversion
, Qlaplace
))
6463 else if (EQ (conversion
, Qemboss
))
6465 else if (CONSP (conversion
)
6466 && EQ (XCAR (conversion
), Qedge_detection
))
6469 tem
= XCDR (conversion
);
6471 x_edge_detection (f
, img
,
6472 Fplist_get (tem
, QCmatrix
),
6473 Fplist_get (tem
, QCcolor_adjustment
));
6479 /* Return the id of image with Lisp specification SPEC on frame F.
6480 SPEC must be a valid Lisp image specification (see valid_image_p). */
6483 lookup_image (f
, spec
)
6487 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6491 struct gcpro gcpro1
;
6494 /* F must be a window-system frame, and SPEC must be a valid image
6496 xassert (FRAME_WINDOW_P (f
));
6497 xassert (valid_image_p (spec
));
6501 /* Look up SPEC in the hash table of the image cache. */
6502 hash
= sxhash (spec
, 0);
6503 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6505 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6506 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6509 /* If not found, create a new image and cache it. */
6512 extern Lisp_Object Qpostscript
;
6515 img
= make_image (spec
, hash
);
6516 cache_image (f
, img
);
6517 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6519 /* If we can't load the image, and we don't have a width and
6520 height, use some arbitrary width and height so that we can
6521 draw a rectangle for it. */
6522 if (img
->load_failed_p
)
6526 value
= image_spec_value (spec
, QCwidth
, NULL
);
6527 img
->width
= (INTEGERP (value
)
6528 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6529 value
= image_spec_value (spec
, QCheight
, NULL
);
6530 img
->height
= (INTEGERP (value
)
6531 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6535 /* Handle image type independent image attributes
6536 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
6537 `:background COLOR'. */
6538 Lisp_Object ascent
, margin
, relief
, bg
;
6540 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6541 if (INTEGERP (ascent
))
6542 img
->ascent
= XFASTINT (ascent
);
6543 else if (EQ (ascent
, Qcenter
))
6544 img
->ascent
= CENTERED_IMAGE_ASCENT
;
6546 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6547 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6548 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
6549 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
6550 && INTEGERP (XCDR (margin
)))
6552 if (XINT (XCAR (margin
)) > 0)
6553 img
->hmargin
= XFASTINT (XCAR (margin
));
6554 if (XINT (XCDR (margin
)) > 0)
6555 img
->vmargin
= XFASTINT (XCDR (margin
));
6558 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6559 if (INTEGERP (relief
))
6561 img
->relief
= XINT (relief
);
6562 img
->hmargin
+= abs (img
->relief
);
6563 img
->vmargin
+= abs (img
->relief
);
6566 if (! img
->background_valid
)
6568 bg
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6572 = x_alloc_image_color (f
, img
, bg
,
6573 FRAME_BACKGROUND_PIXEL (f
));
6574 img
->background_valid
= 1;
6578 /* Do image transformations and compute masks, unless we
6579 don't have the image yet. */
6580 if (!EQ (*img
->type
->type
, Qpostscript
))
6581 postprocess_image (f
, img
);
6585 xassert (!interrupt_input_blocked
);
6588 /* We're using IMG, so set its timestamp to `now'. */
6589 EMACS_GET_TIME (now
);
6590 img
->timestamp
= EMACS_SECS (now
);
6594 /* Value is the image id. */
6599 /* Cache image IMG in the image cache of frame F. */
6602 cache_image (f
, img
)
6606 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6609 /* Find a free slot in c->images. */
6610 for (i
= 0; i
< c
->used
; ++i
)
6611 if (c
->images
[i
] == NULL
)
6614 /* If no free slot found, maybe enlarge c->images. */
6615 if (i
== c
->used
&& c
->used
== c
->size
)
6618 c
->images
= (struct image
**) xrealloc (c
->images
,
6619 c
->size
* sizeof *c
->images
);
6622 /* Add IMG to c->images, and assign IMG an id. */
6628 /* Add IMG to the cache's hash table. */
6629 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6630 img
->next
= c
->buckets
[i
];
6632 img
->next
->prev
= img
;
6634 c
->buckets
[i
] = img
;
6638 /* Call FN on every image in the image cache of frame F. Used to mark
6639 Lisp Objects in the image cache. */
6642 forall_images_in_image_cache (f
, fn
)
6644 void (*fn
) P_ ((struct image
*img
));
6646 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6648 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6652 for (i
= 0; i
< c
->used
; ++i
)
6661 /***********************************************************************
6663 ***********************************************************************/
6665 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6666 XImage
**, Pixmap
*));
6667 static void x_destroy_x_image
P_ ((XImage
*));
6668 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6671 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6672 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6673 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6674 via xmalloc. Print error messages via image_error if an error
6675 occurs. Value is non-zero if successful. */
6678 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6680 int width
, height
, depth
;
6684 Display
*display
= FRAME_X_DISPLAY (f
);
6685 Screen
*screen
= FRAME_X_SCREEN (f
);
6686 Window window
= FRAME_X_WINDOW (f
);
6688 xassert (interrupt_input_blocked
);
6691 depth
= DefaultDepthOfScreen (screen
);
6692 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6693 depth
, ZPixmap
, 0, NULL
, width
, height
,
6694 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6697 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6701 /* Allocate image raster. */
6702 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6704 /* Allocate a pixmap of the same size. */
6705 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6706 if (*pixmap
== None
)
6708 x_destroy_x_image (*ximg
);
6710 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6718 /* Destroy XImage XIMG. Free XIMG->data. */
6721 x_destroy_x_image (ximg
)
6724 xassert (interrupt_input_blocked
);
6729 XDestroyImage (ximg
);
6734 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6735 are width and height of both the image and pixmap. */
6738 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6746 xassert (interrupt_input_blocked
);
6747 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6748 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6749 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6754 /***********************************************************************
6756 ***********************************************************************/
6758 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6759 static char *slurp_file
P_ ((char *, int *));
6762 /* Find image file FILE. Look in data-directory, then
6763 x-bitmap-file-path. Value is the full name of the file found, or
6764 nil if not found. */
6767 x_find_image_file (file
)
6770 Lisp_Object file_found
, search_path
;
6771 struct gcpro gcpro1
, gcpro2
;
6775 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6776 GCPRO2 (file_found
, search_path
);
6778 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6779 fd
= openp (search_path
, file
, Qnil
, &file_found
, Qnil
);
6791 /* Read FILE into memory. Value is a pointer to a buffer allocated
6792 with xmalloc holding FILE's contents. Value is null if an error
6793 occurred. *SIZE is set to the size of the file. */
6796 slurp_file (file
, size
)
6804 if (stat (file
, &st
) == 0
6805 && (fp
= fopen (file
, "r")) != NULL
6806 && (buf
= (char *) xmalloc (st
.st_size
),
6807 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6828 /***********************************************************************
6830 ***********************************************************************/
6832 static int xbm_scan
P_ ((char **, char *, char *, int *));
6833 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6834 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6836 static int xbm_image_p
P_ ((Lisp_Object object
));
6837 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6839 static int xbm_file_p
P_ ((Lisp_Object
));
6842 /* Indices of image specification fields in xbm_format, below. */
6844 enum xbm_keyword_index
6862 /* Vector of image_keyword structures describing the format
6863 of valid XBM image specifications. */
6865 static struct image_keyword xbm_format
[XBM_LAST
] =
6867 {":type", IMAGE_SYMBOL_VALUE
, 1},
6868 {":file", IMAGE_STRING_VALUE
, 0},
6869 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6870 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6871 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6872 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
6873 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
6874 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6875 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6876 {":relief", IMAGE_INTEGER_VALUE
, 0},
6877 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6878 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6879 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6882 /* Structure describing the image type XBM. */
6884 static struct image_type xbm_type
=
6893 /* Tokens returned from xbm_scan. */
6902 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6903 A valid specification is a list starting with the symbol `image'
6904 The rest of the list is a property list which must contain an
6907 If the specification specifies a file to load, it must contain
6908 an entry `:file FILENAME' where FILENAME is a string.
6910 If the specification is for a bitmap loaded from memory it must
6911 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6912 WIDTH and HEIGHT are integers > 0. DATA may be:
6914 1. a string large enough to hold the bitmap data, i.e. it must
6915 have a size >= (WIDTH + 7) / 8 * HEIGHT
6917 2. a bool-vector of size >= WIDTH * HEIGHT
6919 3. a vector of strings or bool-vectors, one for each line of the
6922 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6923 may not be specified in this case because they are defined in the
6926 Both the file and data forms may contain the additional entries
6927 `:background COLOR' and `:foreground COLOR'. If not present,
6928 foreground and background of the frame on which the image is
6929 displayed is used. */
6932 xbm_image_p (object
)
6935 struct image_keyword kw
[XBM_LAST
];
6937 bcopy (xbm_format
, kw
, sizeof kw
);
6938 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6941 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6943 if (kw
[XBM_FILE
].count
)
6945 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6948 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6950 /* In-memory XBM file. */
6951 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6959 /* Entries for `:width', `:height' and `:data' must be present. */
6960 if (!kw
[XBM_WIDTH
].count
6961 || !kw
[XBM_HEIGHT
].count
6962 || !kw
[XBM_DATA
].count
)
6965 data
= kw
[XBM_DATA
].value
;
6966 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6967 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6969 /* Check type of data, and width and height against contents of
6975 /* Number of elements of the vector must be >= height. */
6976 if (XVECTOR (data
)->size
< height
)
6979 /* Each string or bool-vector in data must be large enough
6980 for one line of the image. */
6981 for (i
= 0; i
< height
; ++i
)
6983 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6988 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6991 else if (BOOL_VECTOR_P (elt
))
6993 if (XBOOL_VECTOR (elt
)->size
< width
)
7000 else if (STRINGP (data
))
7003 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
7006 else if (BOOL_VECTOR_P (data
))
7008 if (XBOOL_VECTOR (data
)->size
< width
* height
)
7019 /* Scan a bitmap file. FP is the stream to read from. Value is
7020 either an enumerator from enum xbm_token, or a character for a
7021 single-character token, or 0 at end of file. If scanning an
7022 identifier, store the lexeme of the identifier in SVAL. If
7023 scanning a number, store its value in *IVAL. */
7026 xbm_scan (s
, end
, sval
, ival
)
7035 /* Skip white space. */
7036 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
7041 else if (isdigit (c
))
7043 int value
= 0, digit
;
7045 if (c
== '0' && *s
< end
)
7048 if (c
== 'x' || c
== 'X')
7055 else if (c
>= 'a' && c
<= 'f')
7056 digit
= c
- 'a' + 10;
7057 else if (c
>= 'A' && c
<= 'F')
7058 digit
= c
- 'A' + 10;
7061 value
= 16 * value
+ digit
;
7064 else if (isdigit (c
))
7068 && (c
= *(*s
)++, isdigit (c
)))
7069 value
= 8 * value
+ c
- '0';
7076 && (c
= *(*s
)++, isdigit (c
)))
7077 value
= 10 * value
+ c
- '0';
7085 else if (isalpha (c
) || c
== '_')
7089 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
7096 else if (c
== '/' && **s
== '*')
7098 /* C-style comment. */
7100 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
7113 /* Replacement for XReadBitmapFileData which isn't available under old
7114 X versions. CONTENTS is a pointer to a buffer to parse; END is the
7115 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
7116 the image. Return in *DATA the bitmap data allocated with xmalloc.
7117 Value is non-zero if successful. DATA null means just test if
7118 CONTENTS looks like an in-memory XBM file. */
7121 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
7122 char *contents
, *end
;
7123 int *width
, *height
;
7124 unsigned char **data
;
7127 char buffer
[BUFSIZ
];
7130 int bytes_per_line
, i
, nbytes
;
7136 LA1 = xbm_scan (&s, end, buffer, &value)
7138 #define expect(TOKEN) \
7139 if (LA1 != (TOKEN)) \
7144 #define expect_ident(IDENT) \
7145 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
7150 *width
= *height
= -1;
7153 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
7155 /* Parse defines for width, height and hot-spots. */
7159 expect_ident ("define");
7160 expect (XBM_TK_IDENT
);
7162 if (LA1
== XBM_TK_NUMBER
);
7164 char *p
= strrchr (buffer
, '_');
7165 p
= p
? p
+ 1 : buffer
;
7166 if (strcmp (p
, "width") == 0)
7168 else if (strcmp (p
, "height") == 0)
7171 expect (XBM_TK_NUMBER
);
7174 if (*width
< 0 || *height
< 0)
7176 else if (data
== NULL
)
7179 /* Parse bits. Must start with `static'. */
7180 expect_ident ("static");
7181 if (LA1
== XBM_TK_IDENT
)
7183 if (strcmp (buffer
, "unsigned") == 0)
7186 expect_ident ("char");
7188 else if (strcmp (buffer
, "short") == 0)
7192 if (*width
% 16 && *width
% 16 < 9)
7195 else if (strcmp (buffer
, "char") == 0)
7203 expect (XBM_TK_IDENT
);
7209 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
7210 nbytes
= bytes_per_line
* *height
;
7211 p
= *data
= (char *) xmalloc (nbytes
);
7215 for (i
= 0; i
< nbytes
; i
+= 2)
7218 expect (XBM_TK_NUMBER
);
7221 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
7224 if (LA1
== ',' || LA1
== '}')
7232 for (i
= 0; i
< nbytes
; ++i
)
7235 expect (XBM_TK_NUMBER
);
7239 if (LA1
== ',' || LA1
== '}')
7264 /* Load XBM image IMG which will be displayed on frame F from buffer
7265 CONTENTS. END is the end of the buffer. Value is non-zero if
7269 xbm_load_image (f
, img
, contents
, end
)
7272 char *contents
, *end
;
7275 unsigned char *data
;
7278 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
7281 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7282 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7283 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7286 xassert (img
->width
> 0 && img
->height
> 0);
7288 /* Get foreground and background colors, maybe allocate colors. */
7289 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
7291 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
7292 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
7295 background
= x_alloc_image_color (f
, img
, value
, background
);
7296 img
->background
= background
;
7297 img
->background_valid
= 1;
7301 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7304 img
->width
, img
->height
,
7305 foreground
, background
,
7309 if (img
->pixmap
== None
)
7311 x_clear_image (f
, img
);
7312 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
7318 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7324 /* Value is non-zero if DATA looks like an in-memory XBM file. */
7331 return (STRINGP (data
)
7332 && xbm_read_bitmap_data (SDATA (data
),
7339 /* Fill image IMG which is used on frame F with pixmap data. Value is
7340 non-zero if successful. */
7348 Lisp_Object file_name
;
7350 xassert (xbm_image_p (img
->spec
));
7352 /* If IMG->spec specifies a file name, create a non-file spec from it. */
7353 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
7354 if (STRINGP (file_name
))
7359 struct gcpro gcpro1
;
7361 file
= x_find_image_file (file_name
);
7363 if (!STRINGP (file
))
7365 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
7370 contents
= slurp_file (SDATA (file
), &size
);
7371 if (contents
== NULL
)
7373 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7378 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
7383 struct image_keyword fmt
[XBM_LAST
];
7386 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7387 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7390 int in_memory_file_p
= 0;
7392 /* See if data looks like an in-memory XBM file. */
7393 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7394 in_memory_file_p
= xbm_file_p (data
);
7396 /* Parse the image specification. */
7397 bcopy (xbm_format
, fmt
, sizeof fmt
);
7398 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
7401 /* Get specified width, and height. */
7402 if (!in_memory_file_p
)
7404 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
7405 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
7406 xassert (img
->width
> 0 && img
->height
> 0);
7409 /* Get foreground and background colors, maybe allocate colors. */
7410 if (fmt
[XBM_FOREGROUND
].count
7411 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
7412 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
7414 if (fmt
[XBM_BACKGROUND
].count
7415 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
7416 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
7419 if (in_memory_file_p
)
7420 success_p
= xbm_load_image (f
, img
, SDATA (data
),
7429 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
7431 p
= bits
= (char *) alloca (nbytes
* img
->height
);
7432 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
7434 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
7436 bcopy (SDATA (line
), p
, nbytes
);
7438 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
7441 else if (STRINGP (data
))
7442 bits
= SDATA (data
);
7444 bits
= XBOOL_VECTOR (data
)->data
;
7446 /* Create the pixmap. */
7447 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7449 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7452 img
->width
, img
->height
,
7453 foreground
, background
,
7459 image_error ("Unable to create pixmap for XBM image `%s'",
7461 x_clear_image (f
, img
);
7471 /***********************************************************************
7473 ***********************************************************************/
7477 static int xpm_image_p
P_ ((Lisp_Object object
));
7478 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
7479 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
7481 #include "X11/xpm.h"
7483 /* The symbol `xpm' identifying XPM-format images. */
7487 /* Indices of image specification fields in xpm_format, below. */
7489 enum xpm_keyword_index
7505 /* Vector of image_keyword structures describing the format
7506 of valid XPM image specifications. */
7508 static struct image_keyword xpm_format
[XPM_LAST
] =
7510 {":type", IMAGE_SYMBOL_VALUE
, 1},
7511 {":file", IMAGE_STRING_VALUE
, 0},
7512 {":data", IMAGE_STRING_VALUE
, 0},
7513 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7514 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7515 {":relief", IMAGE_INTEGER_VALUE
, 0},
7516 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7517 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7518 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7519 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7520 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
7523 /* Structure describing the image type XBM. */
7525 static struct image_type xpm_type
=
7535 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7536 functions for allocating image colors. Our own functions handle
7537 color allocation failures more gracefully than the ones on the XPM
7540 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7541 #define ALLOC_XPM_COLORS
7544 #ifdef ALLOC_XPM_COLORS
7546 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
7547 static void xpm_free_color_cache
P_ ((void));
7548 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
7549 static int xpm_color_bucket
P_ ((char *));
7550 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7553 /* An entry in a hash table used to cache color definitions of named
7554 colors. This cache is necessary to speed up XPM image loading in
7555 case we do color allocations ourselves. Without it, we would need
7556 a call to XParseColor per pixel in the image. */
7558 struct xpm_cached_color
7560 /* Next in collision chain. */
7561 struct xpm_cached_color
*next
;
7563 /* Color definition (RGB and pixel color). */
7570 /* The hash table used for the color cache, and its bucket vector
7573 #define XPM_COLOR_CACHE_BUCKETS 1001
7574 struct xpm_cached_color
**xpm_color_cache
;
7576 /* Initialize the color cache. */
7579 xpm_init_color_cache (f
, attrs
)
7581 XpmAttributes
*attrs
;
7583 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7584 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7585 memset (xpm_color_cache
, 0, nbytes
);
7586 init_color_table ();
7588 if (attrs
->valuemask
& XpmColorSymbols
)
7593 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7594 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7595 attrs
->colorsymbols
[i
].value
, &color
))
7597 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7599 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7605 /* Free the color cache. */
7608 xpm_free_color_cache ()
7610 struct xpm_cached_color
*p
, *next
;
7613 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7614 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7620 xfree (xpm_color_cache
);
7621 xpm_color_cache
= NULL
;
7622 free_color_table ();
7626 /* Return the bucket index for color named COLOR_NAME in the color
7630 xpm_color_bucket (color_name
)
7636 for (s
= color_name
; *s
; ++s
)
7638 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7642 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7643 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7646 static struct xpm_cached_color
*
7647 xpm_cache_color (f
, color_name
, color
, bucket
)
7654 struct xpm_cached_color
*p
;
7657 bucket
= xpm_color_bucket (color_name
);
7659 nbytes
= sizeof *p
+ strlen (color_name
);
7660 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7661 strcpy (p
->name
, color_name
);
7663 p
->next
= xpm_color_cache
[bucket
];
7664 xpm_color_cache
[bucket
] = p
;
7669 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7670 return the cached definition in *COLOR. Otherwise, make a new
7671 entry in the cache and allocate the color. Value is zero if color
7672 allocation failed. */
7675 xpm_lookup_color (f
, color_name
, color
)
7680 struct xpm_cached_color
*p
;
7681 int h
= xpm_color_bucket (color_name
);
7683 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7684 if (strcmp (p
->name
, color_name
) == 0)
7689 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7692 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7694 p
= xpm_cache_color (f
, color_name
, color
, h
);
7701 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7702 CLOSURE is a pointer to the frame on which we allocate the
7703 color. Return in *COLOR the allocated color. Value is non-zero
7707 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7714 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7718 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7719 is a pointer to the frame on which we allocate the color. Value is
7720 non-zero if successful. */
7723 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7733 #endif /* ALLOC_XPM_COLORS */
7736 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7737 for XPM images. Such a list must consist of conses whose car and
7741 xpm_valid_color_symbols_p (color_symbols
)
7742 Lisp_Object color_symbols
;
7744 while (CONSP (color_symbols
))
7746 Lisp_Object sym
= XCAR (color_symbols
);
7748 || !STRINGP (XCAR (sym
))
7749 || !STRINGP (XCDR (sym
)))
7751 color_symbols
= XCDR (color_symbols
);
7754 return NILP (color_symbols
);
7758 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7761 xpm_image_p (object
)
7764 struct image_keyword fmt
[XPM_LAST
];
7765 bcopy (xpm_format
, fmt
, sizeof fmt
);
7766 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7767 /* Either `:file' or `:data' must be present. */
7768 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7769 /* Either no `:color-symbols' or it's a list of conses
7770 whose car and cdr are strings. */
7771 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7772 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7776 /* Load image IMG which will be displayed on frame F. Value is
7777 non-zero if successful. */
7785 XpmAttributes attrs
;
7786 Lisp_Object specified_file
, color_symbols
;
7788 /* Configure the XPM lib. Use the visual of frame F. Allocate
7789 close colors. Return colors allocated. */
7790 bzero (&attrs
, sizeof attrs
);
7791 attrs
.visual
= FRAME_X_VISUAL (f
);
7792 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7793 attrs
.valuemask
|= XpmVisual
;
7794 attrs
.valuemask
|= XpmColormap
;
7796 #ifdef ALLOC_XPM_COLORS
7797 /* Allocate colors with our own functions which handle
7798 failing color allocation more gracefully. */
7799 attrs
.color_closure
= f
;
7800 attrs
.alloc_color
= xpm_alloc_color
;
7801 attrs
.free_colors
= xpm_free_colors
;
7802 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7803 #else /* not ALLOC_XPM_COLORS */
7804 /* Let the XPM lib allocate colors. */
7805 attrs
.valuemask
|= XpmReturnAllocPixels
;
7806 #ifdef XpmAllocCloseColors
7807 attrs
.alloc_close_colors
= 1;
7808 attrs
.valuemask
|= XpmAllocCloseColors
;
7809 #else /* not XpmAllocCloseColors */
7810 attrs
.closeness
= 600;
7811 attrs
.valuemask
|= XpmCloseness
;
7812 #endif /* not XpmAllocCloseColors */
7813 #endif /* ALLOC_XPM_COLORS */
7815 /* If image specification contains symbolic color definitions, add
7816 these to `attrs'. */
7817 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7818 if (CONSP (color_symbols
))
7821 XpmColorSymbol
*xpm_syms
;
7824 attrs
.valuemask
|= XpmColorSymbols
;
7826 /* Count number of symbols. */
7827 attrs
.numsymbols
= 0;
7828 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7831 /* Allocate an XpmColorSymbol array. */
7832 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7833 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7834 bzero (xpm_syms
, size
);
7835 attrs
.colorsymbols
= xpm_syms
;
7837 /* Fill the color symbol array. */
7838 for (tail
= color_symbols
, i
= 0;
7840 ++i
, tail
= XCDR (tail
))
7842 Lisp_Object name
= XCAR (XCAR (tail
));
7843 Lisp_Object color
= XCDR (XCAR (tail
));
7844 xpm_syms
[i
].name
= (char *) alloca (SCHARS (name
) + 1);
7845 strcpy (xpm_syms
[i
].name
, SDATA (name
));
7846 xpm_syms
[i
].value
= (char *) alloca (SCHARS (color
) + 1);
7847 strcpy (xpm_syms
[i
].value
, SDATA (color
));
7851 /* Create a pixmap for the image, either from a file, or from a
7852 string buffer containing data in the same format as an XPM file. */
7853 #ifdef ALLOC_XPM_COLORS
7854 xpm_init_color_cache (f
, &attrs
);
7857 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7858 if (STRINGP (specified_file
))
7860 Lisp_Object file
= x_find_image_file (specified_file
);
7861 if (!STRINGP (file
))
7863 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7867 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7868 SDATA (file
), &img
->pixmap
, &img
->mask
,
7873 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7874 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7876 &img
->pixmap
, &img
->mask
,
7880 if (rc
== XpmSuccess
)
7882 #ifdef ALLOC_XPM_COLORS
7883 img
->colors
= colors_in_color_table (&img
->ncolors
);
7884 #else /* not ALLOC_XPM_COLORS */
7887 img
->ncolors
= attrs
.nalloc_pixels
;
7888 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7889 * sizeof *img
->colors
);
7890 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7892 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7893 #ifdef DEBUG_X_COLORS
7894 register_color (img
->colors
[i
]);
7897 #endif /* not ALLOC_XPM_COLORS */
7899 img
->width
= attrs
.width
;
7900 img
->height
= attrs
.height
;
7901 xassert (img
->width
> 0 && img
->height
> 0);
7903 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7904 XpmFreeAttributes (&attrs
);
7911 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7914 case XpmFileInvalid
:
7915 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7919 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7922 case XpmColorFailed
:
7923 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7927 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7932 #ifdef ALLOC_XPM_COLORS
7933 xpm_free_color_cache ();
7935 return rc
== XpmSuccess
;
7938 #endif /* HAVE_XPM != 0 */
7941 /***********************************************************************
7943 ***********************************************************************/
7945 /* An entry in the color table mapping an RGB color to a pixel color. */
7950 unsigned long pixel
;
7952 /* Next in color table collision list. */
7953 struct ct_color
*next
;
7956 /* The bucket vector size to use. Must be prime. */
7960 /* Value is a hash of the RGB color given by R, G, and B. */
7962 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7964 /* The color hash table. */
7966 struct ct_color
**ct_table
;
7968 /* Number of entries in the color table. */
7970 int ct_colors_allocated
;
7972 /* Initialize the color table. */
7977 int size
= CT_SIZE
* sizeof (*ct_table
);
7978 ct_table
= (struct ct_color
**) xmalloc (size
);
7979 bzero (ct_table
, size
);
7980 ct_colors_allocated
= 0;
7984 /* Free memory associated with the color table. */
7990 struct ct_color
*p
, *next
;
7992 for (i
= 0; i
< CT_SIZE
; ++i
)
7993 for (p
= ct_table
[i
]; p
; p
= next
)
8004 /* Value is a pixel color for RGB color R, G, B on frame F. If an
8005 entry for that color already is in the color table, return the
8006 pixel color of that entry. Otherwise, allocate a new color for R,
8007 G, B, and make an entry in the color table. */
8009 static unsigned long
8010 lookup_rgb_color (f
, r
, g
, b
)
8014 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
8015 int i
= hash
% CT_SIZE
;
8018 for (p
= ct_table
[i
]; p
; p
= p
->next
)
8019 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
8032 cmap
= FRAME_X_COLORMAP (f
);
8033 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
8037 ++ct_colors_allocated
;
8039 p
= (struct ct_color
*) xmalloc (sizeof *p
);
8043 p
->pixel
= color
.pixel
;
8044 p
->next
= ct_table
[i
];
8048 return FRAME_FOREGROUND_PIXEL (f
);
8055 /* Look up pixel color PIXEL which is used on frame F in the color
8056 table. If not already present, allocate it. Value is PIXEL. */
8058 static unsigned long
8059 lookup_pixel_color (f
, pixel
)
8061 unsigned long pixel
;
8063 int i
= pixel
% CT_SIZE
;
8066 for (p
= ct_table
[i
]; p
; p
= p
->next
)
8067 if (p
->pixel
== pixel
)
8076 cmap
= FRAME_X_COLORMAP (f
);
8077 color
.pixel
= pixel
;
8078 x_query_color (f
, &color
);
8079 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
8083 ++ct_colors_allocated
;
8085 p
= (struct ct_color
*) xmalloc (sizeof *p
);
8090 p
->next
= ct_table
[i
];
8094 return FRAME_FOREGROUND_PIXEL (f
);
8101 /* Value is a vector of all pixel colors contained in the color table,
8102 allocated via xmalloc. Set *N to the number of colors. */
8104 static unsigned long *
8105 colors_in_color_table (n
)
8110 unsigned long *colors
;
8112 if (ct_colors_allocated
== 0)
8119 colors
= (unsigned long *) xmalloc (ct_colors_allocated
8121 *n
= ct_colors_allocated
;
8123 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
8124 for (p
= ct_table
[i
]; p
; p
= p
->next
)
8125 colors
[j
++] = p
->pixel
;
8133 /***********************************************************************
8135 ***********************************************************************/
8137 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
8138 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
8139 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
8141 /* Non-zero means draw a cross on images having `:conversion
8144 int cross_disabled_images
;
8146 /* Edge detection matrices for different edge-detection
8149 static int emboss_matrix
[9] = {
8151 2, -1, 0, /* y - 1 */
8153 0, 1, -2 /* y + 1 */
8156 static int laplace_matrix
[9] = {
8158 1, 0, 0, /* y - 1 */
8160 0, 0, -1 /* y + 1 */
8163 /* Value is the intensity of the color whose red/green/blue values
8166 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
8169 /* On frame F, return an array of XColor structures describing image
8170 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
8171 non-zero means also fill the red/green/blue members of the XColor
8172 structures. Value is a pointer to the array of XColors structures,
8173 allocated with xmalloc; it must be freed by the caller. */
8176 x_to_xcolors (f
, img
, rgb_p
)
8185 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
8187 /* Get the X image IMG->pixmap. */
8188 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
8189 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
8191 /* Fill the `pixel' members of the XColor array. I wished there
8192 were an easy and portable way to circumvent XGetPixel. */
8194 for (y
= 0; y
< img
->height
; ++y
)
8198 for (x
= 0; x
< img
->width
; ++x
, ++p
)
8199 p
->pixel
= XGetPixel (ximg
, x
, y
);
8202 x_query_colors (f
, row
, img
->width
);
8205 XDestroyImage (ximg
);
8210 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
8211 RGB members are set. F is the frame on which this all happens.
8212 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
8215 x_from_xcolors (f
, img
, colors
)
8225 init_color_table ();
8227 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
8230 for (y
= 0; y
< img
->height
; ++y
)
8231 for (x
= 0; x
< img
->width
; ++x
, ++p
)
8233 unsigned long pixel
;
8234 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
8235 XPutPixel (oimg
, x
, y
, pixel
);
8239 x_clear_image_1 (f
, img
, 1, 0, 1);
8241 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
8242 x_destroy_x_image (oimg
);
8243 img
->pixmap
= pixmap
;
8244 img
->colors
= colors_in_color_table (&img
->ncolors
);
8245 free_color_table ();
8249 /* On frame F, perform edge-detection on image IMG.
8251 MATRIX is a nine-element array specifying the transformation
8252 matrix. See emboss_matrix for an example.
8254 COLOR_ADJUST is a color adjustment added to each pixel of the
8258 x_detect_edges (f
, img
, matrix
, color_adjust
)
8261 int matrix
[9], color_adjust
;
8263 XColor
*colors
= x_to_xcolors (f
, img
, 1);
8267 for (i
= sum
= 0; i
< 9; ++i
)
8268 sum
+= abs (matrix
[i
]);
8270 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
8272 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
8274 for (y
= 0; y
< img
->height
; ++y
)
8276 p
= COLOR (new, 0, y
);
8277 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8278 p
= COLOR (new, img
->width
- 1, y
);
8279 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8282 for (x
= 1; x
< img
->width
- 1; ++x
)
8284 p
= COLOR (new, x
, 0);
8285 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8286 p
= COLOR (new, x
, img
->height
- 1);
8287 p
->red
= p
->green
= p
->blue
= 0xffff/2;
8290 for (y
= 1; y
< img
->height
- 1; ++y
)
8292 p
= COLOR (new, 1, y
);
8294 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
8296 int r
, g
, b
, y1
, x1
;
8299 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
8300 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
8303 XColor
*t
= COLOR (colors
, x1
, y1
);
8304 r
+= matrix
[i
] * t
->red
;
8305 g
+= matrix
[i
] * t
->green
;
8306 b
+= matrix
[i
] * t
->blue
;
8309 r
= (r
/ sum
+ color_adjust
) & 0xffff;
8310 g
= (g
/ sum
+ color_adjust
) & 0xffff;
8311 b
= (b
/ sum
+ color_adjust
) & 0xffff;
8312 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
8317 x_from_xcolors (f
, img
, new);
8323 /* Perform the pre-defined `emboss' edge-detection on image IMG
8331 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
8335 /* Perform the pre-defined `laplace' edge-detection on image IMG
8343 x_detect_edges (f
, img
, laplace_matrix
, 45000);
8347 /* Perform edge-detection on image IMG on frame F, with specified
8348 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
8350 MATRIX must be either
8352 - a list of at least 9 numbers in row-major form
8353 - a vector of at least 9 numbers
8355 COLOR_ADJUST nil means use a default; otherwise it must be a
8359 x_edge_detection (f
, img
, matrix
, color_adjust
)
8362 Lisp_Object matrix
, color_adjust
;
8370 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
8371 ++i
, matrix
= XCDR (matrix
))
8372 trans
[i
] = XFLOATINT (XCAR (matrix
));
8374 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
8376 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
8377 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
8380 if (NILP (color_adjust
))
8381 color_adjust
= make_number (0xffff / 2);
8383 if (i
== 9 && NUMBERP (color_adjust
))
8384 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
8388 /* Transform image IMG on frame F so that it looks disabled. */
8391 x_disable_image (f
, img
)
8395 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
8397 if (dpyinfo
->n_planes
>= 2)
8399 /* Color (or grayscale). Convert to gray, and equalize. Just
8400 drawing such images with a stipple can look very odd, so
8401 we're using this method instead. */
8402 XColor
*colors
= x_to_xcolors (f
, img
, 1);
8404 const int h
= 15000;
8405 const int l
= 30000;
8407 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
8411 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
8412 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
8413 p
->red
= p
->green
= p
->blue
= i2
;
8416 x_from_xcolors (f
, img
, colors
);
8419 /* Draw a cross over the disabled image, if we must or if we
8421 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
8423 Display
*dpy
= FRAME_X_DISPLAY (f
);
8426 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
8427 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
8428 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
8429 img
->width
- 1, img
->height
- 1);
8430 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
8436 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
8437 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
8438 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
8439 img
->width
- 1, img
->height
- 1);
8440 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
8448 /* Build a mask for image IMG which is used on frame F. FILE is the
8449 name of an image file, for error messages. HOW determines how to
8450 determine the background color of IMG. If it is a list '(R G B)',
8451 with R, G, and B being integers >= 0, take that as the color of the
8452 background. Otherwise, determine the background color of IMG
8453 heuristically. Value is non-zero if successful. */
8456 x_build_heuristic_mask (f
, img
, how
)
8461 Display
*dpy
= FRAME_X_DISPLAY (f
);
8462 XImage
*ximg
, *mask_img
;
8463 int x
, y
, rc
, use_img_background
;
8464 unsigned long bg
= 0;
8468 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8470 img
->background_transparent_valid
= 0;
8473 /* Create an image and pixmap serving as mask. */
8474 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
8475 &mask_img
, &img
->mask
);
8479 /* Get the X image of IMG->pixmap. */
8480 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
8483 /* Determine the background color of ximg. If HOW is `(R G B)'
8484 take that as color. Otherwise, use the image's background color. */
8485 use_img_background
= 1;
8491 for (i
= 0; i
< 3 && CONSP (how
) && NATNUMP (XCAR (how
)); ++i
)
8493 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
8497 if (i
== 3 && NILP (how
))
8499 char color_name
[30];
8500 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
8501 bg
= x_alloc_image_color (f
, img
, build_string (color_name
), 0);
8502 use_img_background
= 0;
8506 if (use_img_background
)
8507 bg
= four_corners_best (ximg
, img
->width
, img
->height
);
8509 /* Set all bits in mask_img to 1 whose color in ximg is different
8510 from the background color bg. */
8511 for (y
= 0; y
< img
->height
; ++y
)
8512 for (x
= 0; x
< img
->width
; ++x
)
8513 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8515 /* Fill in the background_transparent field while we have the mask handy. */
8516 image_background_transparent (img
, f
, mask_img
);
8518 /* Put mask_img into img->mask. */
8519 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8520 x_destroy_x_image (mask_img
);
8521 XDestroyImage (ximg
);
8528 /***********************************************************************
8529 PBM (mono, gray, color)
8530 ***********************************************************************/
8532 static int pbm_image_p
P_ ((Lisp_Object object
));
8533 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8534 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8536 /* The symbol `pbm' identifying images of this type. */
8540 /* Indices of image specification fields in gs_format, below. */
8542 enum pbm_keyword_index
8558 /* Vector of image_keyword structures describing the format
8559 of valid user-defined image specifications. */
8561 static struct image_keyword pbm_format
[PBM_LAST
] =
8563 {":type", IMAGE_SYMBOL_VALUE
, 1},
8564 {":file", IMAGE_STRING_VALUE
, 0},
8565 {":data", IMAGE_STRING_VALUE
, 0},
8566 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8567 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8568 {":relief", IMAGE_INTEGER_VALUE
, 0},
8569 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8570 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8571 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8572 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8573 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8576 /* Structure describing the image type `pbm'. */
8578 static struct image_type pbm_type
=
8588 /* Return non-zero if OBJECT is a valid PBM image specification. */
8591 pbm_image_p (object
)
8594 struct image_keyword fmt
[PBM_LAST
];
8596 bcopy (pbm_format
, fmt
, sizeof fmt
);
8598 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8601 /* Must specify either :data or :file. */
8602 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8606 /* Scan a decimal number from *S and return it. Advance *S while
8607 reading the number. END is the end of the string. Value is -1 at
8611 pbm_scan_number (s
, end
)
8612 unsigned char **s
, *end
;
8614 int c
= 0, val
= -1;
8618 /* Skip white-space. */
8619 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8624 /* Skip comment to end of line. */
8625 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8628 else if (isdigit (c
))
8630 /* Read decimal number. */
8632 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8633 val
= 10 * val
+ c
- '0';
8644 /* Load PBM image IMG for use on frame F. */
8652 int width
, height
, max_color_idx
= 0;
8654 Lisp_Object file
, specified_file
;
8655 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8656 struct gcpro gcpro1
;
8657 unsigned char *contents
= NULL
;
8658 unsigned char *end
, *p
;
8661 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8665 if (STRINGP (specified_file
))
8667 file
= x_find_image_file (specified_file
);
8668 if (!STRINGP (file
))
8670 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8675 contents
= slurp_file (SDATA (file
), &size
);
8676 if (contents
== NULL
)
8678 image_error ("Error reading `%s'", file
, Qnil
);
8684 end
= contents
+ size
;
8689 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8691 end
= p
+ SBYTES (data
);
8694 /* Check magic number. */
8695 if (end
- p
< 2 || *p
++ != 'P')
8697 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8707 raw_p
= 0, type
= PBM_MONO
;
8711 raw_p
= 0, type
= PBM_GRAY
;
8715 raw_p
= 0, type
= PBM_COLOR
;
8719 raw_p
= 1, type
= PBM_MONO
;
8723 raw_p
= 1, type
= PBM_GRAY
;
8727 raw_p
= 1, type
= PBM_COLOR
;
8731 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8735 /* Read width, height, maximum color-component. Characters
8736 starting with `#' up to the end of a line are ignored. */
8737 width
= pbm_scan_number (&p
, end
);
8738 height
= pbm_scan_number (&p
, end
);
8740 if (type
!= PBM_MONO
)
8742 max_color_idx
= pbm_scan_number (&p
, end
);
8743 if (raw_p
&& max_color_idx
> 255)
8744 max_color_idx
= 255;
8749 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8752 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8753 &ximg
, &img
->pixmap
))
8756 /* Initialize the color hash table. */
8757 init_color_table ();
8759 if (type
== PBM_MONO
)
8762 struct image_keyword fmt
[PBM_LAST
];
8763 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8764 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8766 /* Parse the image specification. */
8767 bcopy (pbm_format
, fmt
, sizeof fmt
);
8768 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8770 /* Get foreground and background colors, maybe allocate colors. */
8771 if (fmt
[PBM_FOREGROUND
].count
8772 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
8773 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8774 if (fmt
[PBM_BACKGROUND
].count
8775 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
8777 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8778 img
->background
= bg
;
8779 img
->background_valid
= 1;
8782 for (y
= 0; y
< height
; ++y
)
8783 for (x
= 0; x
< width
; ++x
)
8793 g
= pbm_scan_number (&p
, end
);
8795 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8800 for (y
= 0; y
< height
; ++y
)
8801 for (x
= 0; x
< width
; ++x
)
8805 if (type
== PBM_GRAY
)
8806 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8815 r
= pbm_scan_number (&p
, end
);
8816 g
= pbm_scan_number (&p
, end
);
8817 b
= pbm_scan_number (&p
, end
);
8820 if (r
< 0 || g
< 0 || b
< 0)
8824 XDestroyImage (ximg
);
8825 image_error ("Invalid pixel value in image `%s'",
8830 /* RGB values are now in the range 0..max_color_idx.
8831 Scale this to the range 0..0xffff supported by X. */
8832 r
= (double) r
* 65535 / max_color_idx
;
8833 g
= (double) g
* 65535 / max_color_idx
;
8834 b
= (double) b
* 65535 / max_color_idx
;
8835 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8839 /* Store in IMG->colors the colors allocated for the image, and
8840 free the color table. */
8841 img
->colors
= colors_in_color_table (&img
->ncolors
);
8842 free_color_table ();
8844 /* Maybe fill in the background field while we have ximg handy. */
8845 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
8846 IMAGE_BACKGROUND (img
, f
, ximg
);
8848 /* Put the image into a pixmap. */
8849 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8850 x_destroy_x_image (ximg
);
8853 img
->height
= height
;
8862 /***********************************************************************
8864 ***********************************************************************/
8870 /* Function prototypes. */
8872 static int png_image_p
P_ ((Lisp_Object object
));
8873 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8875 /* The symbol `png' identifying images of this type. */
8879 /* Indices of image specification fields in png_format, below. */
8881 enum png_keyword_index
8896 /* Vector of image_keyword structures describing the format
8897 of valid user-defined image specifications. */
8899 static struct image_keyword png_format
[PNG_LAST
] =
8901 {":type", IMAGE_SYMBOL_VALUE
, 1},
8902 {":data", IMAGE_STRING_VALUE
, 0},
8903 {":file", IMAGE_STRING_VALUE
, 0},
8904 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8905 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8906 {":relief", IMAGE_INTEGER_VALUE
, 0},
8907 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8908 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8909 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8910 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
8913 /* Structure describing the image type `png'. */
8915 static struct image_type png_type
=
8925 /* Return non-zero if OBJECT is a valid PNG image specification. */
8928 png_image_p (object
)
8931 struct image_keyword fmt
[PNG_LAST
];
8932 bcopy (png_format
, fmt
, sizeof fmt
);
8934 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8937 /* Must specify either the :data or :file keyword. */
8938 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8942 /* Error and warning handlers installed when the PNG library
8946 my_png_error (png_ptr
, msg
)
8947 png_struct
*png_ptr
;
8950 xassert (png_ptr
!= NULL
);
8951 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8952 longjmp (png_ptr
->jmpbuf
, 1);
8957 my_png_warning (png_ptr
, msg
)
8958 png_struct
*png_ptr
;
8961 xassert (png_ptr
!= NULL
);
8962 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8965 /* Memory source for PNG decoding. */
8967 struct png_memory_storage
8969 unsigned char *bytes
; /* The data */
8970 size_t len
; /* How big is it? */
8971 int index
; /* Where are we? */
8975 /* Function set as reader function when reading PNG image from memory.
8976 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8977 bytes from the input to DATA. */
8980 png_read_from_memory (png_ptr
, data
, length
)
8981 png_structp png_ptr
;
8985 struct png_memory_storage
*tbr
8986 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8988 if (length
> tbr
->len
- tbr
->index
)
8989 png_error (png_ptr
, "Read error");
8991 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8992 tbr
->index
= tbr
->index
+ length
;
8995 /* Load PNG image IMG for use on frame F. Value is non-zero if
9003 Lisp_Object file
, specified_file
;
9004 Lisp_Object specified_data
;
9006 XImage
*ximg
, *mask_img
= NULL
;
9007 struct gcpro gcpro1
;
9008 png_struct
*png_ptr
= NULL
;
9009 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
9010 FILE *volatile fp
= NULL
;
9012 png_byte
* volatile pixels
= NULL
;
9013 png_byte
** volatile rows
= NULL
;
9014 png_uint_32 width
, height
;
9015 int bit_depth
, color_type
, interlace_type
;
9017 png_uint_32 row_bytes
;
9019 double screen_gamma
, image_gamma
;
9021 struct png_memory_storage tbr
; /* Data to be read */
9023 /* Find out what file to load. */
9024 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9025 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9029 if (NILP (specified_data
))
9031 file
= x_find_image_file (specified_file
);
9032 if (!STRINGP (file
))
9034 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9039 /* Open the image file. */
9040 fp
= fopen (SDATA (file
), "rb");
9043 image_error ("Cannot open image file `%s'", file
, Qnil
);
9049 /* Check PNG signature. */
9050 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
9051 || !png_check_sig (sig
, sizeof sig
))
9053 image_error ("Not a PNG file: `%s'", file
, Qnil
);
9061 /* Read from memory. */
9062 tbr
.bytes
= SDATA (specified_data
);
9063 tbr
.len
= SBYTES (specified_data
);
9066 /* Check PNG signature. */
9067 if (tbr
.len
< sizeof sig
9068 || !png_check_sig (tbr
.bytes
, sizeof sig
))
9070 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
9075 /* Need to skip past the signature. */
9076 tbr
.bytes
+= sizeof (sig
);
9079 /* Initialize read and info structs for PNG lib. */
9080 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
9081 my_png_error
, my_png_warning
);
9084 if (fp
) fclose (fp
);
9089 info_ptr
= png_create_info_struct (png_ptr
);
9092 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
9093 if (fp
) fclose (fp
);
9098 end_info
= png_create_info_struct (png_ptr
);
9101 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
9102 if (fp
) fclose (fp
);
9107 /* Set error jump-back. We come back here when the PNG library
9108 detects an error. */
9109 if (setjmp (png_ptr
->jmpbuf
))
9113 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
9116 if (fp
) fclose (fp
);
9121 /* Read image info. */
9122 if (!NILP (specified_data
))
9123 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
9125 png_init_io (png_ptr
, fp
);
9127 png_set_sig_bytes (png_ptr
, sizeof sig
);
9128 png_read_info (png_ptr
, info_ptr
);
9129 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
9130 &interlace_type
, NULL
, NULL
);
9132 /* If image contains simply transparency data, we prefer to
9133 construct a clipping mask. */
9134 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
9139 /* This function is easier to write if we only have to handle
9140 one data format: RGB or RGBA with 8 bits per channel. Let's
9141 transform other formats into that format. */
9143 /* Strip more than 8 bits per channel. */
9144 if (bit_depth
== 16)
9145 png_set_strip_16 (png_ptr
);
9147 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
9149 png_set_expand (png_ptr
);
9151 /* Convert grayscale images to RGB. */
9152 if (color_type
== PNG_COLOR_TYPE_GRAY
9153 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
9154 png_set_gray_to_rgb (png_ptr
);
9156 screen_gamma
= (f
->gamma
? 1 / f
->gamma
/ 0.45455 : 2.2);
9158 #if 0 /* Avoid double gamma correction for PNG images. */
9159 /* Tell the PNG lib to handle gamma correction for us. */
9160 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
9161 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
9162 /* The libpng documentation says this is right in this case. */
9163 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
9166 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
9167 /* Image contains gamma information. */
9168 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
9170 /* Use the standard default for the image gamma. */
9171 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
9174 /* Handle alpha channel by combining the image with a background
9175 color. Do this only if a real alpha channel is supplied. For
9176 simple transparency, we prefer a clipping mask. */
9179 png_color_16
*image_bg
;
9180 Lisp_Object specified_bg
9181 = image_spec_value (img
->spec
, QCbackground
, NULL
);
9183 if (STRINGP (specified_bg
))
9184 /* The user specified `:background', use that. */
9187 if (x_defined_color (f
, SDATA (specified_bg
), &color
, 0))
9189 png_color_16 user_bg
;
9191 bzero (&user_bg
, sizeof user_bg
);
9192 user_bg
.red
= color
.red
;
9193 user_bg
.green
= color
.green
;
9194 user_bg
.blue
= color
.blue
;
9196 png_set_background (png_ptr
, &user_bg
,
9197 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
9200 else if (png_get_bKGD (png_ptr
, info_ptr
, &image_bg
))
9201 /* Image contains a background color with which to
9202 combine the image. */
9203 png_set_background (png_ptr
, image_bg
,
9204 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
9207 /* Image does not contain a background color with which
9208 to combine the image data via an alpha channel. Use
9209 the frame's background instead. */
9212 png_color_16 frame_background
;
9214 cmap
= FRAME_X_COLORMAP (f
);
9215 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
9216 x_query_color (f
, &color
);
9218 bzero (&frame_background
, sizeof frame_background
);
9219 frame_background
.red
= color
.red
;
9220 frame_background
.green
= color
.green
;
9221 frame_background
.blue
= color
.blue
;
9223 png_set_background (png_ptr
, &frame_background
,
9224 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
9228 /* Update info structure. */
9229 png_read_update_info (png_ptr
, info_ptr
);
9231 /* Get number of channels. Valid values are 1 for grayscale images
9232 and images with a palette, 2 for grayscale images with transparency
9233 information (alpha channel), 3 for RGB images, and 4 for RGB
9234 images with alpha channel, i.e. RGBA. If conversions above were
9235 sufficient we should only have 3 or 4 channels here. */
9236 channels
= png_get_channels (png_ptr
, info_ptr
);
9237 xassert (channels
== 3 || channels
== 4);
9239 /* Number of bytes needed for one row of the image. */
9240 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
9242 /* Allocate memory for the image. */
9243 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
9244 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
9245 for (i
= 0; i
< height
; ++i
)
9246 rows
[i
] = pixels
+ i
* row_bytes
;
9248 /* Read the entire image. */
9249 png_read_image (png_ptr
, rows
);
9250 png_read_end (png_ptr
, info_ptr
);
9257 /* Create the X image and pixmap. */
9258 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
9262 /* Create an image and pixmap serving as mask if the PNG image
9263 contains an alpha channel. */
9266 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
9267 &mask_img
, &img
->mask
))
9269 x_destroy_x_image (ximg
);
9270 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
9275 /* Fill the X image and mask from PNG data. */
9276 init_color_table ();
9278 for (y
= 0; y
< height
; ++y
)
9280 png_byte
*p
= rows
[y
];
9282 for (x
= 0; x
< width
; ++x
)
9289 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
9291 /* An alpha channel, aka mask channel, associates variable
9292 transparency with an image. Where other image formats
9293 support binary transparency---fully transparent or fully
9294 opaque---PNG allows up to 254 levels of partial transparency.
9295 The PNG library implements partial transparency by combining
9296 the image with a specified background color.
9298 I'm not sure how to handle this here nicely: because the
9299 background on which the image is displayed may change, for
9300 real alpha channel support, it would be necessary to create
9301 a new image for each possible background.
9303 What I'm doing now is that a mask is created if we have
9304 boolean transparency information. Otherwise I'm using
9305 the frame's background color to combine the image with. */
9310 XPutPixel (mask_img
, x
, y
, *p
> 0);
9316 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9317 /* Set IMG's background color from the PNG image, unless the user
9321 if (png_get_bKGD (png_ptr
, info_ptr
, &bg
))
9323 img
->background
= lookup_rgb_color (f
, bg
->red
, bg
->green
, bg
->blue
);
9324 img
->background_valid
= 1;
9328 /* Remember colors allocated for this image. */
9329 img
->colors
= colors_in_color_table (&img
->ncolors
);
9330 free_color_table ();
9333 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
9338 img
->height
= height
;
9340 /* Maybe fill in the background field while we have ximg handy. */
9341 IMAGE_BACKGROUND (img
, f
, ximg
);
9343 /* Put the image into the pixmap, then free the X image and its buffer. */
9344 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9345 x_destroy_x_image (ximg
);
9347 /* Same for the mask. */
9350 /* Fill in the background_transparent field while we have the mask
9352 image_background_transparent (img
, f
, mask_img
);
9354 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
9355 x_destroy_x_image (mask_img
);
9362 #endif /* HAVE_PNG != 0 */
9366 /***********************************************************************
9368 ***********************************************************************/
9372 /* Work around a warning about HAVE_STDLIB_H being redefined in
9374 #ifdef HAVE_STDLIB_H
9375 #define HAVE_STDLIB_H_1
9376 #undef HAVE_STDLIB_H
9377 #endif /* HAVE_STLIB_H */
9379 #include <jpeglib.h>
9383 #ifdef HAVE_STLIB_H_1
9384 #define HAVE_STDLIB_H 1
9387 static int jpeg_image_p
P_ ((Lisp_Object object
));
9388 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
9390 /* The symbol `jpeg' identifying images of this type. */
9394 /* Indices of image specification fields in gs_format, below. */
9396 enum jpeg_keyword_index
9405 JPEG_HEURISTIC_MASK
,
9411 /* Vector of image_keyword structures describing the format
9412 of valid user-defined image specifications. */
9414 static struct image_keyword jpeg_format
[JPEG_LAST
] =
9416 {":type", IMAGE_SYMBOL_VALUE
, 1},
9417 {":data", IMAGE_STRING_VALUE
, 0},
9418 {":file", IMAGE_STRING_VALUE
, 0},
9419 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9420 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9421 {":relief", IMAGE_INTEGER_VALUE
, 0},
9422 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9423 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9424 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9425 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9428 /* Structure describing the image type `jpeg'. */
9430 static struct image_type jpeg_type
=
9440 /* Return non-zero if OBJECT is a valid JPEG image specification. */
9443 jpeg_image_p (object
)
9446 struct image_keyword fmt
[JPEG_LAST
];
9448 bcopy (jpeg_format
, fmt
, sizeof fmt
);
9450 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
9453 /* Must specify either the :data or :file keyword. */
9454 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
9458 struct my_jpeg_error_mgr
9460 struct jpeg_error_mgr pub
;
9461 jmp_buf setjmp_buffer
;
9466 my_error_exit (cinfo
)
9469 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
9470 longjmp (mgr
->setjmp_buffer
, 1);
9474 /* Init source method for JPEG data source manager. Called by
9475 jpeg_read_header() before any data is actually read. See
9476 libjpeg.doc from the JPEG lib distribution. */
9479 our_init_source (cinfo
)
9480 j_decompress_ptr cinfo
;
9485 /* Fill input buffer method for JPEG data source manager. Called
9486 whenever more data is needed. We read the whole image in one step,
9487 so this only adds a fake end of input marker at the end. */
9490 our_fill_input_buffer (cinfo
)
9491 j_decompress_ptr cinfo
;
9493 /* Insert a fake EOI marker. */
9494 struct jpeg_source_mgr
*src
= cinfo
->src
;
9495 static JOCTET buffer
[2];
9497 buffer
[0] = (JOCTET
) 0xFF;
9498 buffer
[1] = (JOCTET
) JPEG_EOI
;
9500 src
->next_input_byte
= buffer
;
9501 src
->bytes_in_buffer
= 2;
9506 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9507 is the JPEG data source manager. */
9510 our_skip_input_data (cinfo
, num_bytes
)
9511 j_decompress_ptr cinfo
;
9514 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9518 if (num_bytes
> src
->bytes_in_buffer
)
9519 ERREXIT (cinfo
, JERR_INPUT_EOF
);
9521 src
->bytes_in_buffer
-= num_bytes
;
9522 src
->next_input_byte
+= num_bytes
;
9527 /* Method to terminate data source. Called by
9528 jpeg_finish_decompress() after all data has been processed. */
9531 our_term_source (cinfo
)
9532 j_decompress_ptr cinfo
;
9537 /* Set up the JPEG lib for reading an image from DATA which contains
9538 LEN bytes. CINFO is the decompression info structure created for
9539 reading the image. */
9542 jpeg_memory_src (cinfo
, data
, len
)
9543 j_decompress_ptr cinfo
;
9547 struct jpeg_source_mgr
*src
;
9549 if (cinfo
->src
== NULL
)
9551 /* First time for this JPEG object? */
9552 cinfo
->src
= (struct jpeg_source_mgr
*)
9553 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
9554 sizeof (struct jpeg_source_mgr
));
9555 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9556 src
->next_input_byte
= data
;
9559 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
9560 src
->init_source
= our_init_source
;
9561 src
->fill_input_buffer
= our_fill_input_buffer
;
9562 src
->skip_input_data
= our_skip_input_data
;
9563 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
9564 src
->term_source
= our_term_source
;
9565 src
->bytes_in_buffer
= len
;
9566 src
->next_input_byte
= data
;
9570 /* Load image IMG for use on frame F. Patterned after example.c
9571 from the JPEG lib. */
9578 struct jpeg_decompress_struct cinfo
;
9579 struct my_jpeg_error_mgr mgr
;
9580 Lisp_Object file
, specified_file
;
9581 Lisp_Object specified_data
;
9582 FILE * volatile fp
= NULL
;
9584 int row_stride
, x
, y
;
9585 XImage
*ximg
= NULL
;
9587 unsigned long *colors
;
9589 struct gcpro gcpro1
;
9591 /* Open the JPEG file. */
9592 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9593 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9597 if (NILP (specified_data
))
9599 file
= x_find_image_file (specified_file
);
9600 if (!STRINGP (file
))
9602 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9607 fp
= fopen (SDATA (file
), "r");
9610 image_error ("Cannot open `%s'", file
, Qnil
);
9616 /* Customize libjpeg's error handling to call my_error_exit when an
9617 error is detected. This function will perform a longjmp. */
9618 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9619 mgr
.pub
.error_exit
= my_error_exit
;
9621 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9625 /* Called from my_error_exit. Display a JPEG error. */
9626 char buffer
[JMSG_LENGTH_MAX
];
9627 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9628 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9629 build_string (buffer
));
9632 /* Close the input file and destroy the JPEG object. */
9634 fclose ((FILE *) fp
);
9635 jpeg_destroy_decompress (&cinfo
);
9637 /* If we already have an XImage, free that. */
9638 x_destroy_x_image (ximg
);
9640 /* Free pixmap and colors. */
9641 x_clear_image (f
, img
);
9647 /* Create the JPEG decompression object. Let it read from fp.
9648 Read the JPEG image header. */
9649 jpeg_create_decompress (&cinfo
);
9651 if (NILP (specified_data
))
9652 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9654 jpeg_memory_src (&cinfo
, SDATA (specified_data
),
9655 SBYTES (specified_data
));
9657 jpeg_read_header (&cinfo
, TRUE
);
9659 /* Customize decompression so that color quantization will be used.
9660 Start decompression. */
9661 cinfo
.quantize_colors
= TRUE
;
9662 jpeg_start_decompress (&cinfo
);
9663 width
= img
->width
= cinfo
.output_width
;
9664 height
= img
->height
= cinfo
.output_height
;
9666 /* Create X image and pixmap. */
9667 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9668 longjmp (mgr
.setjmp_buffer
, 2);
9670 /* Allocate colors. When color quantization is used,
9671 cinfo.actual_number_of_colors has been set with the number of
9672 colors generated, and cinfo.colormap is a two-dimensional array
9673 of color indices in the range 0..cinfo.actual_number_of_colors.
9674 No more than 255 colors will be generated. */
9678 if (cinfo
.out_color_components
> 2)
9679 ir
= 0, ig
= 1, ib
= 2;
9680 else if (cinfo
.out_color_components
> 1)
9681 ir
= 0, ig
= 1, ib
= 0;
9683 ir
= 0, ig
= 0, ib
= 0;
9685 /* Use the color table mechanism because it handles colors that
9686 cannot be allocated nicely. Such colors will be replaced with
9687 a default color, and we don't have to care about which colors
9688 can be freed safely, and which can't. */
9689 init_color_table ();
9690 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9693 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9695 /* Multiply RGB values with 255 because X expects RGB values
9696 in the range 0..0xffff. */
9697 int r
= cinfo
.colormap
[ir
][i
] << 8;
9698 int g
= cinfo
.colormap
[ig
][i
] << 8;
9699 int b
= cinfo
.colormap
[ib
][i
] << 8;
9700 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9703 /* Remember those colors actually allocated. */
9704 img
->colors
= colors_in_color_table (&img
->ncolors
);
9705 free_color_table ();
9709 row_stride
= width
* cinfo
.output_components
;
9710 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9712 for (y
= 0; y
< height
; ++y
)
9714 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9715 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9716 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9720 jpeg_finish_decompress (&cinfo
);
9721 jpeg_destroy_decompress (&cinfo
);
9723 fclose ((FILE *) fp
);
9725 /* Maybe fill in the background field while we have ximg handy. */
9726 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
9727 IMAGE_BACKGROUND (img
, f
, ximg
);
9729 /* Put the image into the pixmap. */
9730 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9731 x_destroy_x_image (ximg
);
9736 #endif /* HAVE_JPEG */
9740 /***********************************************************************
9742 ***********************************************************************/
9748 static int tiff_image_p
P_ ((Lisp_Object object
));
9749 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9751 /* The symbol `tiff' identifying images of this type. */
9755 /* Indices of image specification fields in tiff_format, below. */
9757 enum tiff_keyword_index
9766 TIFF_HEURISTIC_MASK
,
9772 /* Vector of image_keyword structures describing the format
9773 of valid user-defined image specifications. */
9775 static struct image_keyword tiff_format
[TIFF_LAST
] =
9777 {":type", IMAGE_SYMBOL_VALUE
, 1},
9778 {":data", IMAGE_STRING_VALUE
, 0},
9779 {":file", IMAGE_STRING_VALUE
, 0},
9780 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9781 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9782 {":relief", IMAGE_INTEGER_VALUE
, 0},
9783 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9784 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9785 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9786 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9789 /* Structure describing the image type `tiff'. */
9791 static struct image_type tiff_type
=
9801 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9804 tiff_image_p (object
)
9807 struct image_keyword fmt
[TIFF_LAST
];
9808 bcopy (tiff_format
, fmt
, sizeof fmt
);
9810 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9813 /* Must specify either the :data or :file keyword. */
9814 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9818 /* Reading from a memory buffer for TIFF images Based on the PNG
9819 memory source, but we have to provide a lot of extra functions.
9822 We really only need to implement read and seek, but I am not
9823 convinced that the TIFF library is smart enough not to destroy
9824 itself if we only hand it the function pointers we need to
9829 unsigned char *bytes
;
9837 tiff_read_from_memory (data
, buf
, size
)
9842 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9844 if (size
> src
->len
- src
->index
)
9846 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9853 tiff_write_from_memory (data
, buf
, size
)
9863 tiff_seek_in_memory (data
, off
, whence
)
9868 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9873 case SEEK_SET
: /* Go from beginning of source. */
9877 case SEEK_END
: /* Go from end of source. */
9878 idx
= src
->len
+ off
;
9881 case SEEK_CUR
: /* Go from current position. */
9882 idx
= src
->index
+ off
;
9885 default: /* Invalid `whence'. */
9889 if (idx
> src
->len
|| idx
< 0)
9898 tiff_close_memory (data
)
9907 tiff_mmap_memory (data
, pbase
, psize
)
9912 /* It is already _IN_ memory. */
9918 tiff_unmap_memory (data
, base
, size
)
9923 /* We don't need to do this. */
9928 tiff_size_of_memory (data
)
9931 return ((tiff_memory_source
*) data
)->len
;
9936 tiff_error_handler (title
, format
, ap
)
9937 const char *title
, *format
;
9943 len
= sprintf (buf
, "TIFF error: %s ", title
);
9944 vsprintf (buf
+ len
, format
, ap
);
9945 add_to_log (buf
, Qnil
, Qnil
);
9950 tiff_warning_handler (title
, format
, ap
)
9951 const char *title
, *format
;
9957 len
= sprintf (buf
, "TIFF warning: %s ", title
);
9958 vsprintf (buf
+ len
, format
, ap
);
9959 add_to_log (buf
, Qnil
, Qnil
);
9963 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9971 Lisp_Object file
, specified_file
;
9972 Lisp_Object specified_data
;
9974 int width
, height
, x
, y
;
9978 struct gcpro gcpro1
;
9979 tiff_memory_source memsrc
;
9981 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9982 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9986 TIFFSetErrorHandler (tiff_error_handler
);
9987 TIFFSetWarningHandler (tiff_warning_handler
);
9989 if (NILP (specified_data
))
9991 /* Read from a file */
9992 file
= x_find_image_file (specified_file
);
9993 if (!STRINGP (file
))
9995 image_error ("Cannot find image file `%s'", file
, Qnil
);
10000 /* Try to open the image file. */
10001 tiff
= TIFFOpen (SDATA (file
), "r");
10004 image_error ("Cannot open `%s'", file
, Qnil
);
10011 /* Memory source! */
10012 memsrc
.bytes
= SDATA (specified_data
);
10013 memsrc
.len
= SBYTES (specified_data
);
10016 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
10017 (TIFFReadWriteProc
) tiff_read_from_memory
,
10018 (TIFFReadWriteProc
) tiff_write_from_memory
,
10019 tiff_seek_in_memory
,
10021 tiff_size_of_memory
,
10023 tiff_unmap_memory
);
10027 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
10033 /* Get width and height of the image, and allocate a raster buffer
10034 of width x height 32-bit values. */
10035 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
10036 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
10037 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
10039 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
10043 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
10049 /* Create the X image and pixmap. */
10050 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
10057 /* Initialize the color table. */
10058 init_color_table ();
10060 /* Process the pixel raster. Origin is in the lower-left corner. */
10061 for (y
= 0; y
< height
; ++y
)
10063 uint32
*row
= buf
+ y
* width
;
10065 for (x
= 0; x
< width
; ++x
)
10067 uint32 abgr
= row
[x
];
10068 int r
= TIFFGetR (abgr
) << 8;
10069 int g
= TIFFGetG (abgr
) << 8;
10070 int b
= TIFFGetB (abgr
) << 8;
10071 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
10075 /* Remember the colors allocated for the image. Free the color table. */
10076 img
->colors
= colors_in_color_table (&img
->ncolors
);
10077 free_color_table ();
10079 img
->width
= width
;
10080 img
->height
= height
;
10082 /* Maybe fill in the background field while we have ximg handy. */
10083 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10084 IMAGE_BACKGROUND (img
, f
, ximg
);
10086 /* Put the image into the pixmap, then free the X image and its buffer. */
10087 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10088 x_destroy_x_image (ximg
);
10095 #endif /* HAVE_TIFF != 0 */
10099 /***********************************************************************
10101 ***********************************************************************/
10105 #include <gif_lib.h>
10107 static int gif_image_p
P_ ((Lisp_Object object
));
10108 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
10110 /* The symbol `gif' identifying images of this type. */
10114 /* Indices of image specification fields in gif_format, below. */
10116 enum gif_keyword_index
10125 GIF_HEURISTIC_MASK
,
10132 /* Vector of image_keyword structures describing the format
10133 of valid user-defined image specifications. */
10135 static struct image_keyword gif_format
[GIF_LAST
] =
10137 {":type", IMAGE_SYMBOL_VALUE
, 1},
10138 {":data", IMAGE_STRING_VALUE
, 0},
10139 {":file", IMAGE_STRING_VALUE
, 0},
10140 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10141 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10142 {":relief", IMAGE_INTEGER_VALUE
, 0},
10143 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10144 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10145 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10146 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
10147 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10150 /* Structure describing the image type `gif'. */
10152 static struct image_type gif_type
=
10162 /* Return non-zero if OBJECT is a valid GIF image specification. */
10165 gif_image_p (object
)
10166 Lisp_Object object
;
10168 struct image_keyword fmt
[GIF_LAST
];
10169 bcopy (gif_format
, fmt
, sizeof fmt
);
10171 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
10174 /* Must specify either the :data or :file keyword. */
10175 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
10179 /* Reading a GIF image from memory
10180 Based on the PNG memory stuff to a certain extent. */
10184 unsigned char *bytes
;
10191 /* Make the current memory source available to gif_read_from_memory.
10192 It's done this way because not all versions of libungif support
10193 a UserData field in the GifFileType structure. */
10194 static gif_memory_source
*current_gif_memory_src
;
10197 gif_read_from_memory (file
, buf
, len
)
10202 gif_memory_source
*src
= current_gif_memory_src
;
10204 if (len
> src
->len
- src
->index
)
10207 bcopy (src
->bytes
+ src
->index
, buf
, len
);
10213 /* Load GIF image IMG for use on frame F. Value is non-zero if
10221 Lisp_Object file
, specified_file
;
10222 Lisp_Object specified_data
;
10223 int rc
, width
, height
, x
, y
, i
;
10225 ColorMapObject
*gif_color_map
;
10226 unsigned long pixel_colors
[256];
10228 struct gcpro gcpro1
;
10230 int ino
, image_left
, image_top
, image_width
, image_height
;
10231 gif_memory_source memsrc
;
10232 unsigned char *raster
;
10234 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10235 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10239 if (NILP (specified_data
))
10241 file
= x_find_image_file (specified_file
);
10242 if (!STRINGP (file
))
10244 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10249 /* Open the GIF file. */
10250 gif
= DGifOpenFileName (SDATA (file
));
10253 image_error ("Cannot open `%s'", file
, Qnil
);
10260 /* Read from memory! */
10261 current_gif_memory_src
= &memsrc
;
10262 memsrc
.bytes
= SDATA (specified_data
);
10263 memsrc
.len
= SBYTES (specified_data
);
10266 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
10269 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
10275 /* Read entire contents. */
10276 rc
= DGifSlurp (gif
);
10277 if (rc
== GIF_ERROR
)
10279 image_error ("Error reading `%s'", img
->spec
, Qnil
);
10280 DGifCloseFile (gif
);
10285 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
10286 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
10287 if (ino
>= gif
->ImageCount
)
10289 image_error ("Invalid image number `%s' in image `%s'",
10291 DGifCloseFile (gif
);
10296 width
= img
->width
= max (gif
->SWidth
, gif
->Image
.Left
+ gif
->Image
.Width
);
10297 height
= img
->height
= max (gif
->SHeight
, gif
->Image
.Top
+ gif
->Image
.Height
);
10299 /* Create the X image and pixmap. */
10300 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
10302 DGifCloseFile (gif
);
10307 /* Allocate colors. */
10308 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
10309 if (!gif_color_map
)
10310 gif_color_map
= gif
->SColorMap
;
10311 init_color_table ();
10312 bzero (pixel_colors
, sizeof pixel_colors
);
10314 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
10316 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
10317 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
10318 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
10319 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
10322 img
->colors
= colors_in_color_table (&img
->ncolors
);
10323 free_color_table ();
10325 /* Clear the part of the screen image that are not covered by
10326 the image from the GIF file. Full animated GIF support
10327 requires more than can be done here (see the gif89 spec,
10328 disposal methods). Let's simply assume that the part
10329 not covered by a sub-image is in the frame's background color. */
10330 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
10331 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
10332 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
10333 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
10335 for (y
= 0; y
< image_top
; ++y
)
10336 for (x
= 0; x
< width
; ++x
)
10337 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10339 for (y
= image_top
+ image_height
; y
< height
; ++y
)
10340 for (x
= 0; x
< width
; ++x
)
10341 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10343 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
10345 for (x
= 0; x
< image_left
; ++x
)
10346 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10347 for (x
= image_left
+ image_width
; x
< width
; ++x
)
10348 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
10351 /* Read the GIF image into the X image. We use a local variable
10352 `raster' here because RasterBits below is a char *, and invites
10353 problems with bytes >= 0x80. */
10354 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
10356 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
10358 static int interlace_start
[] = {0, 4, 2, 1};
10359 static int interlace_increment
[] = {8, 8, 4, 2};
10361 int row
= interlace_start
[0];
10365 for (y
= 0; y
< image_height
; y
++)
10367 if (row
>= image_height
)
10369 row
= interlace_start
[++pass
];
10370 while (row
>= image_height
)
10371 row
= interlace_start
[++pass
];
10374 for (x
= 0; x
< image_width
; x
++)
10376 int i
= raster
[(y
* image_width
) + x
];
10377 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
10381 row
+= interlace_increment
[pass
];
10386 for (y
= 0; y
< image_height
; ++y
)
10387 for (x
= 0; x
< image_width
; ++x
)
10389 int i
= raster
[y
* image_width
+ x
];
10390 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
10394 DGifCloseFile (gif
);
10396 /* Maybe fill in the background field while we have ximg handy. */
10397 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10398 IMAGE_BACKGROUND (img
, f
, ximg
);
10400 /* Put the image into the pixmap, then free the X image and its buffer. */
10401 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10402 x_destroy_x_image (ximg
);
10408 #endif /* HAVE_GIF != 0 */
10412 /***********************************************************************
10414 ***********************************************************************/
10416 static int gs_image_p
P_ ((Lisp_Object object
));
10417 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
10418 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
10420 /* The symbol `postscript' identifying images of this type. */
10422 Lisp_Object Qpostscript
;
10424 /* Keyword symbols. */
10426 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
10428 /* Indices of image specification fields in gs_format, below. */
10430 enum gs_keyword_index
10448 /* Vector of image_keyword structures describing the format
10449 of valid user-defined image specifications. */
10451 static struct image_keyword gs_format
[GS_LAST
] =
10453 {":type", IMAGE_SYMBOL_VALUE
, 1},
10454 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10455 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
10456 {":file", IMAGE_STRING_VALUE
, 1},
10457 {":loader", IMAGE_FUNCTION_VALUE
, 0},
10458 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
10459 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10460 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10461 {":relief", IMAGE_INTEGER_VALUE
, 0},
10462 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10463 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10464 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10465 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10468 /* Structure describing the image type `ghostscript'. */
10470 static struct image_type gs_type
=
10480 /* Free X resources of Ghostscript image IMG which is used on frame F. */
10483 gs_clear_image (f
, img
)
10487 /* IMG->data.ptr_val may contain a recorded colormap. */
10488 xfree (img
->data
.ptr_val
);
10489 x_clear_image (f
, img
);
10493 /* Return non-zero if OBJECT is a valid Ghostscript image
10497 gs_image_p (object
)
10498 Lisp_Object object
;
10500 struct image_keyword fmt
[GS_LAST
];
10504 bcopy (gs_format
, fmt
, sizeof fmt
);
10506 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
10509 /* Bounding box must be a list or vector containing 4 integers. */
10510 tem
= fmt
[GS_BOUNDING_BOX
].value
;
10513 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
10514 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
10519 else if (VECTORP (tem
))
10521 if (XVECTOR (tem
)->size
!= 4)
10523 for (i
= 0; i
< 4; ++i
)
10524 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
10534 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
10543 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
10544 struct gcpro gcpro1
, gcpro2
;
10546 double in_width
, in_height
;
10547 Lisp_Object pixel_colors
= Qnil
;
10549 /* Compute pixel size of pixmap needed from the given size in the
10550 image specification. Sizes in the specification are in pt. 1 pt
10551 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10553 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
10554 in_width
= XFASTINT (pt_width
) / 72.0;
10555 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
10556 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
10557 in_height
= XFASTINT (pt_height
) / 72.0;
10558 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
10560 /* Create the pixmap. */
10561 xassert (img
->pixmap
== None
);
10562 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10563 img
->width
, img
->height
,
10564 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
10568 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
10572 /* Call the loader to fill the pixmap. It returns a process object
10573 if successful. We do not record_unwind_protect here because
10574 other places in redisplay like calling window scroll functions
10575 don't either. Let the Lisp loader use `unwind-protect' instead. */
10576 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
10578 sprintf (buffer
, "%lu %lu",
10579 (unsigned long) FRAME_X_WINDOW (f
),
10580 (unsigned long) img
->pixmap
);
10581 window_and_pixmap_id
= build_string (buffer
);
10583 sprintf (buffer
, "%lu %lu",
10584 FRAME_FOREGROUND_PIXEL (f
),
10585 FRAME_BACKGROUND_PIXEL (f
));
10586 pixel_colors
= build_string (buffer
);
10588 XSETFRAME (frame
, f
);
10589 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
10591 loader
= intern ("gs-load-image");
10593 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
10594 make_number (img
->width
),
10595 make_number (img
->height
),
10596 window_and_pixmap_id
,
10599 return PROCESSP (img
->data
.lisp_val
);
10603 /* Kill the Ghostscript process that was started to fill PIXMAP on
10604 frame F. Called from XTread_socket when receiving an event
10605 telling Emacs that Ghostscript has finished drawing. */
10608 x_kill_gs_process (pixmap
, f
)
10612 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10616 /* Find the image containing PIXMAP. */
10617 for (i
= 0; i
< c
->used
; ++i
)
10618 if (c
->images
[i
]->pixmap
== pixmap
)
10621 /* Should someone in between have cleared the image cache, for
10622 instance, give up. */
10626 /* Kill the GS process. We should have found PIXMAP in the image
10627 cache and its image should contain a process object. */
10628 img
= c
->images
[i
];
10629 xassert (PROCESSP (img
->data
.lisp_val
));
10630 Fkill_process (img
->data
.lisp_val
, Qnil
);
10631 img
->data
.lisp_val
= Qnil
;
10633 /* On displays with a mutable colormap, figure out the colors
10634 allocated for the image by looking at the pixels of an XImage for
10636 class = FRAME_X_VISUAL (f
)->class;
10637 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10643 /* Try to get an XImage for img->pixmep. */
10644 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10645 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10650 /* Initialize the color table. */
10651 init_color_table ();
10653 /* For each pixel of the image, look its color up in the
10654 color table. After having done so, the color table will
10655 contain an entry for each color used by the image. */
10656 for (y
= 0; y
< img
->height
; ++y
)
10657 for (x
= 0; x
< img
->width
; ++x
)
10659 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10660 lookup_pixel_color (f
, pixel
);
10663 /* Record colors in the image. Free color table and XImage. */
10664 img
->colors
= colors_in_color_table (&img
->ncolors
);
10665 free_color_table ();
10666 XDestroyImage (ximg
);
10668 #if 0 /* This doesn't seem to be the case. If we free the colors
10669 here, we get a BadAccess later in x_clear_image when
10670 freeing the colors. */
10671 /* We have allocated colors once, but Ghostscript has also
10672 allocated colors on behalf of us. So, to get the
10673 reference counts right, free them once. */
10675 x_free_colors (f
, img
->colors
, img
->ncolors
);
10679 image_error ("Cannot get X image of `%s'; colors will not be freed",
10685 /* Now that we have the pixmap, compute mask and transform the
10686 image if requested. */
10688 postprocess_image (f
, img
);
10694 /***********************************************************************
10696 ***********************************************************************/
10698 DEFUN ("x-change-window-property", Fx_change_window_property
,
10699 Sx_change_window_property
, 2, 3, 0,
10700 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
10701 PROP and VALUE must be strings. FRAME nil or omitted means use the
10702 selected frame. Value is VALUE. */)
10703 (prop
, value
, frame
)
10704 Lisp_Object frame
, prop
, value
;
10706 struct frame
*f
= check_x_frame (frame
);
10709 CHECK_STRING (prop
);
10710 CHECK_STRING (value
);
10713 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SDATA (prop
), False
);
10714 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10715 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10716 SDATA (value
), SCHARS (value
));
10718 /* Make sure the property is set when we return. */
10719 XFlush (FRAME_X_DISPLAY (f
));
10726 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10727 Sx_delete_window_property
, 1, 2, 0,
10728 doc
: /* Remove window property PROP from X window of FRAME.
10729 FRAME nil or omitted means use the selected frame. Value is PROP. */)
10731 Lisp_Object prop
, frame
;
10733 struct frame
*f
= check_x_frame (frame
);
10736 CHECK_STRING (prop
);
10738 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SDATA (prop
), False
);
10739 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10741 /* Make sure the property is removed when we return. */
10742 XFlush (FRAME_X_DISPLAY (f
));
10749 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10751 doc
: /* Value is the value of window property PROP on FRAME.
10752 If FRAME is nil or omitted, use the selected frame. Value is nil
10753 if FRAME hasn't a property with name PROP or if PROP has no string
10756 Lisp_Object prop
, frame
;
10758 struct frame
*f
= check_x_frame (frame
);
10761 Lisp_Object prop_value
= Qnil
;
10762 char *tmp_data
= NULL
;
10765 unsigned long actual_size
, bytes_remaining
;
10767 CHECK_STRING (prop
);
10769 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SDATA (prop
), False
);
10770 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10771 prop_atom
, 0, 0, False
, XA_STRING
,
10772 &actual_type
, &actual_format
, &actual_size
,
10773 &bytes_remaining
, (unsigned char **) &tmp_data
);
10776 int size
= bytes_remaining
;
10781 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10782 prop_atom
, 0, bytes_remaining
,
10784 &actual_type
, &actual_format
,
10785 &actual_size
, &bytes_remaining
,
10786 (unsigned char **) &tmp_data
);
10787 if (rc
== Success
&& tmp_data
)
10788 prop_value
= make_string (tmp_data
, size
);
10799 /***********************************************************************
10801 ***********************************************************************/
10803 /* If non-null, an asynchronous timer that, when it expires, displays
10804 an hourglass cursor on all frames. */
10806 static struct atimer
*hourglass_atimer
;
10808 /* Non-zero means an hourglass cursor is currently shown. */
10810 static int hourglass_shown_p
;
10812 /* Number of seconds to wait before displaying an hourglass cursor. */
10814 static Lisp_Object Vhourglass_delay
;
10816 /* Default number of seconds to wait before displaying an hourglass
10819 #define DEFAULT_HOURGLASS_DELAY 1
10821 /* Function prototypes. */
10823 static void show_hourglass
P_ ((struct atimer
*));
10824 static void hide_hourglass
P_ ((void));
10827 /* Cancel a currently active hourglass timer, and start a new one. */
10833 int secs
, usecs
= 0;
10835 cancel_hourglass ();
10837 if (INTEGERP (Vhourglass_delay
)
10838 && XINT (Vhourglass_delay
) > 0)
10839 secs
= XFASTINT (Vhourglass_delay
);
10840 else if (FLOATP (Vhourglass_delay
)
10841 && XFLOAT_DATA (Vhourglass_delay
) > 0)
10844 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
10845 secs
= XFASTINT (tem
);
10846 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
10849 secs
= DEFAULT_HOURGLASS_DELAY
;
10851 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10852 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10853 show_hourglass
, NULL
);
10857 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
10861 cancel_hourglass ()
10863 if (hourglass_atimer
)
10865 cancel_atimer (hourglass_atimer
);
10866 hourglass_atimer
= NULL
;
10869 if (hourglass_shown_p
)
10874 /* Timer function of hourglass_atimer. TIMER is equal to
10877 Display an hourglass pointer on all frames by mapping the frames'
10878 hourglass_window. Set the hourglass_p flag in the frames'
10879 output_data.x structure to indicate that an hourglass cursor is
10880 shown on the frames. */
10883 show_hourglass (timer
)
10884 struct atimer
*timer
;
10886 /* The timer implementation will cancel this timer automatically
10887 after this function has run. Set hourglass_atimer to null
10888 so that we know the timer doesn't have to be canceled. */
10889 hourglass_atimer
= NULL
;
10891 if (!hourglass_shown_p
)
10893 Lisp_Object rest
, frame
;
10897 FOR_EACH_FRAME (rest
, frame
)
10899 struct frame
*f
= XFRAME (frame
);
10901 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10903 Display
*dpy
= FRAME_X_DISPLAY (f
);
10905 #ifdef USE_X_TOOLKIT
10906 if (f
->output_data
.x
->widget
)
10908 if (FRAME_OUTER_WINDOW (f
))
10911 f
->output_data
.x
->hourglass_p
= 1;
10913 if (!f
->output_data
.x
->hourglass_window
)
10915 unsigned long mask
= CWCursor
;
10916 XSetWindowAttributes attrs
;
10918 attrs
.cursor
= f
->output_data
.x
->hourglass_cursor
;
10920 f
->output_data
.x
->hourglass_window
10921 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10922 0, 0, 32000, 32000, 0, 0,
10928 XMapRaised (dpy
, f
->output_data
.x
->hourglass_window
);
10934 hourglass_shown_p
= 1;
10940 /* Hide the hourglass pointer on all frames, if it is currently
10946 if (hourglass_shown_p
)
10948 Lisp_Object rest
, frame
;
10951 FOR_EACH_FRAME (rest
, frame
)
10953 struct frame
*f
= XFRAME (frame
);
10956 /* Watch out for newly created frames. */
10957 && f
->output_data
.x
->hourglass_window
)
10959 XUnmapWindow (FRAME_X_DISPLAY (f
),
10960 f
->output_data
.x
->hourglass_window
);
10961 /* Sync here because XTread_socket looks at the
10962 hourglass_p flag that is reset to zero below. */
10963 XSync (FRAME_X_DISPLAY (f
), False
);
10964 f
->output_data
.x
->hourglass_p
= 0;
10968 hourglass_shown_p
= 0;
10975 /***********************************************************************
10977 ***********************************************************************/
10979 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10980 Lisp_Object
, Lisp_Object
));
10981 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10982 Lisp_Object
, int, int, int *, int *));
10984 /* The frame of a currently visible tooltip. */
10986 Lisp_Object tip_frame
;
10988 /* If non-nil, a timer started that hides the last tooltip when it
10991 Lisp_Object tip_timer
;
10994 /* If non-nil, a vector of 3 elements containing the last args
10995 with which x-show-tip was called. See there. */
10997 Lisp_Object last_show_tip_args
;
10999 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
11001 Lisp_Object Vx_max_tooltip_size
;
11005 unwind_create_tip_frame (frame
)
11008 Lisp_Object deleted
;
11010 deleted
= unwind_create_frame (frame
);
11011 if (EQ (deleted
, Qt
))
11021 /* Create a frame for a tooltip on the display described by DPYINFO.
11022 PARMS is a list of frame parameters. TEXT is the string to
11023 display in the tip frame. Value is the frame.
11025 Note that functions called here, esp. x_default_parameter can
11026 signal errors, for instance when a specified color name is
11027 undefined. We have to make sure that we're in a consistent state
11028 when this happens. */
11031 x_create_tip_frame (dpyinfo
, parms
, text
)
11032 struct x_display_info
*dpyinfo
;
11033 Lisp_Object parms
, text
;
11036 Lisp_Object frame
, tem
;
11038 long window_prompting
= 0;
11040 int count
= SPECPDL_INDEX ();
11041 struct gcpro gcpro1
, gcpro2
, gcpro3
;
11043 int face_change_count_before
= face_change_count
;
11044 Lisp_Object buffer
;
11045 struct buffer
*old_buffer
;
11049 /* Use this general default value to start with until we know if
11050 this frame has a specified name. */
11051 Vx_resource_name
= Vinvocation_name
;
11053 #ifdef MULTI_KBOARD
11054 kb
= dpyinfo
->kboard
;
11056 kb
= &the_only_kboard
;
11059 /* Get the name of the frame to use for resource lookup. */
11060 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
11061 if (!STRINGP (name
)
11062 && !EQ (name
, Qunbound
)
11064 error ("Invalid frame name--not a string or nil");
11065 Vx_resource_name
= name
;
11068 GCPRO3 (parms
, name
, frame
);
11069 f
= make_frame (1);
11070 XSETFRAME (frame
, f
);
11072 buffer
= Fget_buffer_create (build_string (" *tip*"));
11073 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
11074 old_buffer
= current_buffer
;
11075 set_buffer_internal_1 (XBUFFER (buffer
));
11076 current_buffer
->truncate_lines
= Qnil
;
11078 Finsert (1, &text
);
11079 set_buffer_internal_1 (old_buffer
);
11081 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
11082 record_unwind_protect (unwind_create_tip_frame
, frame
);
11084 /* By setting the output method, we're essentially saying that
11085 the frame is live, as per FRAME_LIVE_P. If we get a signal
11086 from this point on, x_destroy_window might screw up reference
11088 f
->output_method
= output_x_window
;
11089 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
11090 bzero (f
->output_data
.x
, sizeof (struct x_output
));
11091 f
->output_data
.x
->icon_bitmap
= -1;
11092 f
->output_data
.x
->fontset
= -1;
11093 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
11094 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
11095 #ifdef USE_TOOLKIT_SCROLL_BARS
11096 f
->output_data
.x
->scroll_bar_top_shadow_pixel
= -1;
11097 f
->output_data
.x
->scroll_bar_bottom_shadow_pixel
= -1;
11098 #endif /* USE_TOOLKIT_SCROLL_BARS */
11099 f
->icon_name
= Qnil
;
11100 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
11102 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
11103 dpyinfo_refcount
= dpyinfo
->reference_count
;
11104 #endif /* GLYPH_DEBUG */
11105 #ifdef MULTI_KBOARD
11106 FRAME_KBOARD (f
) = kb
;
11108 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
11109 f
->output_data
.x
->explicit_parent
= 0;
11111 /* These colors will be set anyway later, but it's important
11112 to get the color reference counts right, so initialize them! */
11115 struct gcpro gcpro1
;
11117 black
= build_string ("black");
11119 f
->output_data
.x
->foreground_pixel
11120 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11121 f
->output_data
.x
->background_pixel
11122 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11123 f
->output_data
.x
->cursor_pixel
11124 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11125 f
->output_data
.x
->cursor_foreground_pixel
11126 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11127 f
->output_data
.x
->border_pixel
11128 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11129 f
->output_data
.x
->mouse_pixel
11130 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
11134 /* Set the name; the functions to which we pass f expect the name to
11136 if (EQ (name
, Qunbound
) || NILP (name
))
11138 f
->name
= build_string (dpyinfo
->x_id_name
);
11139 f
->explicit_name
= 0;
11144 f
->explicit_name
= 1;
11145 /* use the frame's title when getting resources for this frame. */
11146 specbind (Qx_resource_name
, name
);
11149 /* Extract the window parameters from the supplied values that are
11150 needed to determine window geometry. */
11154 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
11157 /* First, try whatever font the caller has specified. */
11158 if (STRINGP (font
))
11160 tem
= Fquery_fontset (font
, Qnil
);
11162 font
= x_new_fontset (f
, SDATA (tem
));
11164 font
= x_new_font (f
, SDATA (font
));
11167 /* Try out a font which we hope has bold and italic variations. */
11168 if (!STRINGP (font
))
11169 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
11170 if (!STRINGP (font
))
11171 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11172 if (! STRINGP (font
))
11173 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11174 if (! STRINGP (font
))
11175 /* This was formerly the first thing tried, but it finds too many fonts
11176 and takes too long. */
11177 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
11178 /* If those didn't work, look for something which will at least work. */
11179 if (! STRINGP (font
))
11180 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
11182 if (! STRINGP (font
))
11183 font
= build_string ("fixed");
11185 x_default_parameter (f
, parms
, Qfont
, font
,
11186 "font", "Font", RES_TYPE_STRING
);
11189 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
11190 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
11192 /* This defaults to 2 in order to match xterm. We recognize either
11193 internalBorderWidth or internalBorder (which is what xterm calls
11195 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11199 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
11200 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
11201 if (! EQ (value
, Qunbound
))
11202 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
11206 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
11207 "internalBorderWidth", "internalBorderWidth",
11210 /* Also do the stuff which must be set before the window exists. */
11211 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
11212 "foreground", "Foreground", RES_TYPE_STRING
);
11213 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
11214 "background", "Background", RES_TYPE_STRING
);
11215 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
11216 "pointerColor", "Foreground", RES_TYPE_STRING
);
11217 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
11218 "cursorColor", "Foreground", RES_TYPE_STRING
);
11219 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
11220 "borderColor", "BorderColor", RES_TYPE_STRING
);
11222 /* Init faces before x_default_parameter is called for scroll-bar
11223 parameters because that function calls x_set_scroll_bar_width,
11224 which calls change_frame_size, which calls Fset_window_buffer,
11225 which runs hooks, which call Fvertical_motion. At the end, we
11226 end up in init_iterator with a null face cache, which should not
11228 init_frame_faces (f
);
11230 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
11231 window_prompting
= x_figure_window_size (f
, parms
);
11233 if (window_prompting
& XNegative
)
11235 if (window_prompting
& YNegative
)
11236 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
11238 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
11242 if (window_prompting
& YNegative
)
11243 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
11245 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
11248 f
->output_data
.x
->size_hint_flags
= window_prompting
;
11250 XSetWindowAttributes attrs
;
11251 unsigned long mask
;
11254 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
11255 if (DoesSaveUnders (dpyinfo
->screen
))
11256 mask
|= CWSaveUnder
;
11258 /* Window managers look at the override-redirect flag to determine
11259 whether or net to give windows a decoration (Xlib spec, chapter
11261 attrs
.override_redirect
= True
;
11262 attrs
.save_under
= True
;
11263 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
11264 /* Arrange for getting MapNotify and UnmapNotify events. */
11265 attrs
.event_mask
= StructureNotifyMask
;
11267 = FRAME_X_WINDOW (f
)
11268 = XCreateWindow (FRAME_X_DISPLAY (f
),
11269 FRAME_X_DISPLAY_INFO (f
)->root_window
,
11270 /* x, y, width, height */
11274 CopyFromParent
, InputOutput
, CopyFromParent
,
11281 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
11282 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
11283 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
11284 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
11285 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
11286 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
11288 /* Dimensions, especially f->height, must be done via change_frame_size.
11289 Change will not be effected unless different from the current
11292 height
= f
->height
;
11294 SET_FRAME_WIDTH (f
, 0);
11295 change_frame_size (f
, height
, width
, 1, 0, 0);
11297 /* Add `tooltip' frame parameter's default value. */
11298 if (NILP (Fframe_parameter (frame
, intern ("tooltip"))))
11299 Fmodify_frame_parameters (frame
, Fcons (Fcons (intern ("tooltip"), Qt
),
11302 /* Set up faces after all frame parameters are known. This call
11303 also merges in face attributes specified for new frames.
11305 Frame parameters may be changed if .Xdefaults contains
11306 specifications for the default font. For example, if there is an
11307 `Emacs.default.attributeBackground: pink', the `background-color'
11308 attribute of the frame get's set, which let's the internal border
11309 of the tooltip frame appear in pink. Prevent this. */
11311 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
11313 /* Set tip_frame here, so that */
11315 call1 (Qface_set_after_frame_default
, frame
);
11317 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
11318 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
11326 /* It is now ok to make the frame official even if we get an error
11327 below. And the frame needs to be on Vframe_list or making it
11328 visible won't work. */
11329 Vframe_list
= Fcons (frame
, Vframe_list
);
11331 /* Now that the frame is official, it counts as a reference to
11333 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
11335 /* Setting attributes of faces of the tooltip frame from resources
11336 and similar will increment face_change_count, which leads to the
11337 clearing of all current matrices. Since this isn't necessary
11338 here, avoid it by resetting face_change_count to the value it
11339 had before we created the tip frame. */
11340 face_change_count
= face_change_count_before
;
11342 /* Discard the unwind_protect. */
11343 return unbind_to (count
, frame
);
11347 /* Compute where to display tip frame F. PARMS is the list of frame
11348 parameters for F. DX and DY are specified offsets from the current
11349 location of the mouse. WIDTH and HEIGHT are the width and height
11350 of the tooltip. Return coordinates relative to the root window of
11351 the display in *ROOT_X, and *ROOT_Y. */
11354 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
11356 Lisp_Object parms
, dx
, dy
;
11358 int *root_x
, *root_y
;
11360 Lisp_Object left
, top
;
11362 Window root
, child
;
11365 /* User-specified position? */
11366 left
= Fcdr (Fassq (Qleft
, parms
));
11367 top
= Fcdr (Fassq (Qtop
, parms
));
11369 /* Move the tooltip window where the mouse pointer is. Resize and
11371 if (!INTEGERP (left
) || !INTEGERP (top
))
11374 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
11375 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
11379 if (INTEGERP (top
))
11380 *root_y
= XINT (top
);
11381 else if (*root_y
+ XINT (dy
) - height
< 0)
11382 *root_y
-= XINT (dy
);
11386 *root_y
+= XINT (dy
);
11389 if (INTEGERP (left
))
11390 *root_x
= XINT (left
);
11391 else if (*root_x
+ XINT (dx
) + width
<= FRAME_X_DISPLAY_INFO (f
)->width
)
11392 /* It fits to the right of the pointer. */
11393 *root_x
+= XINT (dx
);
11394 else if (width
+ XINT (dx
) <= *root_x
)
11395 /* It fits to the left of the pointer. */
11396 *root_x
-= width
+ XINT (dx
);
11398 /* Put it left-justified on the screen--it ought to fit that way. */
11403 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
11404 doc
: /* Show STRING in a "tooltip" window on frame FRAME.
11405 A tooltip window is a small X window displaying a string.
11407 FRAME nil or omitted means use the selected frame.
11409 PARMS is an optional list of frame parameters which can be used to
11410 change the tooltip's appearance.
11412 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
11413 means use the default timeout of 5 seconds.
11415 If the list of frame parameters PARAMS contains a `left' parameters,
11416 the tooltip is displayed at that x-position. Otherwise it is
11417 displayed at the mouse position, with offset DX added (default is 5 if
11418 DX isn't specified). Likewise for the y-position; if a `top' frame
11419 parameter is specified, it determines the y-position of the tooltip
11420 window, otherwise it is displayed at the mouse position, with offset
11421 DY added (default is -10).
11423 A tooltip's maximum size is specified by `x-max-tooltip-size'.
11424 Text larger than the specified size is clipped. */)
11425 (string
, frame
, parms
, timeout
, dx
, dy
)
11426 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
11430 int root_x
, root_y
;
11431 struct buffer
*old_buffer
;
11432 struct text_pos pos
;
11433 int i
, width
, height
;
11434 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
11435 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
11436 int count
= SPECPDL_INDEX ();
11438 specbind (Qinhibit_redisplay
, Qt
);
11440 GCPRO4 (string
, parms
, frame
, timeout
);
11442 CHECK_STRING (string
);
11443 f
= check_x_frame (frame
);
11444 if (NILP (timeout
))
11445 timeout
= make_number (5);
11447 CHECK_NATNUM (timeout
);
11450 dx
= make_number (5);
11455 dy
= make_number (-10);
11459 if (NILP (last_show_tip_args
))
11460 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
11462 if (!NILP (tip_frame
))
11464 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
11465 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
11466 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
11468 if (EQ (frame
, last_frame
)
11469 && !NILP (Fequal (last_string
, string
))
11470 && !NILP (Fequal (last_parms
, parms
)))
11472 struct frame
*f
= XFRAME (tip_frame
);
11474 /* Only DX and DY have changed. */
11475 if (!NILP (tip_timer
))
11477 Lisp_Object timer
= tip_timer
;
11479 call1 (Qcancel_timer
, timer
);
11483 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
11484 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
11485 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11492 /* Hide a previous tip, if any. */
11495 ASET (last_show_tip_args
, 0, string
);
11496 ASET (last_show_tip_args
, 1, frame
);
11497 ASET (last_show_tip_args
, 2, parms
);
11499 /* Add default values to frame parameters. */
11500 if (NILP (Fassq (Qname
, parms
)))
11501 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
11502 if (NILP (Fassq (Qinternal_border_width
, parms
)))
11503 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
11504 if (NILP (Fassq (Qborder_width
, parms
)))
11505 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
11506 if (NILP (Fassq (Qborder_color
, parms
)))
11507 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
11508 if (NILP (Fassq (Qbackground_color
, parms
)))
11509 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
11512 /* Create a frame for the tooltip, and record it in the global
11513 variable tip_frame. */
11514 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
, string
);
11515 f
= XFRAME (frame
);
11517 /* Set up the frame's root window. */
11518 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
11519 w
->left
= w
->top
= make_number (0);
11521 if (CONSP (Vx_max_tooltip_size
)
11522 && INTEGERP (XCAR (Vx_max_tooltip_size
))
11523 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
11524 && INTEGERP (XCDR (Vx_max_tooltip_size
))
11525 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
11527 w
->width
= XCAR (Vx_max_tooltip_size
);
11528 w
->height
= XCDR (Vx_max_tooltip_size
);
11532 w
->width
= make_number (80);
11533 w
->height
= make_number (40);
11536 f
->window_width
= XINT (w
->width
);
11538 w
->pseudo_window_p
= 1;
11540 /* Display the tooltip text in a temporary buffer. */
11541 old_buffer
= current_buffer
;
11542 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
11543 current_buffer
->truncate_lines
= Qnil
;
11544 clear_glyph_matrix (w
->desired_matrix
);
11545 clear_glyph_matrix (w
->current_matrix
);
11546 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
11547 try_window (FRAME_ROOT_WINDOW (f
), pos
);
11549 /* Compute width and height of the tooltip. */
11550 width
= height
= 0;
11551 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
11553 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
11554 struct glyph
*last
;
11557 /* Stop at the first empty row at the end. */
11558 if (!row
->enabled_p
|| !row
->displays_text_p
)
11561 /* Let the row go over the full width of the frame. */
11562 row
->full_width_p
= 1;
11564 /* There's a glyph at the end of rows that is used to place
11565 the cursor there. Don't include the width of this glyph. */
11566 if (row
->used
[TEXT_AREA
])
11568 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
11569 row_width
= row
->pixel_width
- last
->pixel_width
;
11572 row_width
= row
->pixel_width
;
11574 height
+= row
->height
;
11575 width
= max (width
, row_width
);
11578 /* Add the frame's internal border to the width and height the X
11579 window should have. */
11580 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11581 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
11583 /* Move the tooltip window where the mouse pointer is. Resize and
11585 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
11588 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
11589 root_x
, root_y
, width
, height
);
11590 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
11593 /* Draw into the window. */
11594 w
->must_be_updated_p
= 1;
11595 update_single_window (w
, 1);
11597 /* Restore original current buffer. */
11598 set_buffer_internal_1 (old_buffer
);
11599 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
11602 /* Let the tip disappear after timeout seconds. */
11603 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
11604 intern ("x-hide-tip"));
11607 return unbind_to (count
, Qnil
);
11611 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
11612 doc
: /* Hide the current tooltip window, if there is any.
11613 Value is t if tooltip was open, nil otherwise. */)
11617 Lisp_Object deleted
, frame
, timer
;
11618 struct gcpro gcpro1
, gcpro2
;
11620 /* Return quickly if nothing to do. */
11621 if (NILP (tip_timer
) && NILP (tip_frame
))
11626 GCPRO2 (frame
, timer
);
11627 tip_frame
= tip_timer
= deleted
= Qnil
;
11629 count
= SPECPDL_INDEX ();
11630 specbind (Qinhibit_redisplay
, Qt
);
11631 specbind (Qinhibit_quit
, Qt
);
11634 call1 (Qcancel_timer
, timer
);
11636 if (FRAMEP (frame
))
11638 Fdelete_frame (frame
, Qnil
);
11642 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11643 redisplay procedure is not called when a tip frame over menu
11644 items is unmapped. Redisplay the menu manually... */
11646 struct frame
*f
= SELECTED_FRAME ();
11647 Widget w
= f
->output_data
.x
->menubar_widget
;
11648 extern void xlwmenu_redisplay
P_ ((Widget
));
11650 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
11654 xlwmenu_redisplay (w
);
11658 #endif /* USE_LUCID */
11662 return unbind_to (count
, deleted
);
11667 /***********************************************************************
11668 File selection dialog
11669 ***********************************************************************/
11673 /* Callback for "OK" and "Cancel" on file selection dialog. */
11676 file_dialog_cb (widget
, client_data
, call_data
)
11678 XtPointer call_data
, client_data
;
11680 int *result
= (int *) client_data
;
11681 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
11682 *result
= cb
->reason
;
11686 /* Callback for unmapping a file selection dialog. This is used to
11687 capture the case where a dialog is closed via a window manager's
11688 closer button, for example. Using a XmNdestroyCallback didn't work
11692 file_dialog_unmap_cb (widget
, client_data
, call_data
)
11694 XtPointer call_data
, client_data
;
11696 int *result
= (int *) client_data
;
11697 *result
= XmCR_CANCEL
;
11701 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11702 doc
: /* Read file name, prompting with PROMPT in directory DIR.
11703 Use a file selection dialog.
11704 Select DEFAULT-FILENAME in the dialog's file selection box, if
11705 specified. Don't let the user enter a file name in the file
11706 selection dialog's entry field, if MUSTMATCH is non-nil. */)
11707 (prompt
, dir
, default_filename
, mustmatch
)
11708 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11711 struct frame
*f
= SELECTED_FRAME ();
11712 Lisp_Object file
= Qnil
;
11713 Widget dialog
, text
, list
, help
;
11716 extern XtAppContext Xt_app_con
;
11717 XmString dir_xmstring
, pattern_xmstring
;
11718 int count
= SPECPDL_INDEX ();
11719 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11721 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11722 CHECK_STRING (prompt
);
11723 CHECK_STRING (dir
);
11725 /* Prevent redisplay. */
11726 specbind (Qinhibit_redisplay
, Qt
);
11730 /* Create the dialog with PROMPT as title, using DIR as initial
11731 directory and using "*" as pattern. */
11732 dir
= Fexpand_file_name (dir
, Qnil
);
11733 dir_xmstring
= XmStringCreateLocalized (SDATA (dir
));
11734 pattern_xmstring
= XmStringCreateLocalized ("*");
11736 XtSetArg (al
[ac
], XmNtitle
, SDATA (prompt
)); ++ac
;
11737 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11738 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11739 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11740 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11741 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11743 XmStringFree (dir_xmstring
);
11744 XmStringFree (pattern_xmstring
);
11746 /* Add callbacks for OK and Cancel. */
11747 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11748 (XtPointer
) &result
);
11749 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11750 (XtPointer
) &result
);
11751 XtAddCallback (dialog
, XmNunmapCallback
, file_dialog_unmap_cb
,
11752 (XtPointer
) &result
);
11754 /* Disable the help button since we can't display help. */
11755 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11756 XtSetSensitive (help
, False
);
11758 /* Mark OK button as default. */
11759 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11760 XmNshowAsDefault
, True
, NULL
);
11762 /* If MUSTMATCH is non-nil, disable the file entry field of the
11763 dialog, so that the user must select a file from the files list
11764 box. We can't remove it because we wouldn't have a way to get at
11765 the result file name, then. */
11766 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11767 if (!NILP (mustmatch
))
11770 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11771 XtSetSensitive (text
, False
);
11772 XtSetSensitive (label
, False
);
11775 /* Manage the dialog, so that list boxes get filled. */
11776 XtManageChild (dialog
);
11778 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11779 must include the path for this to work. */
11780 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11781 if (STRINGP (default_filename
))
11783 XmString default_xmstring
;
11787 = XmStringCreateLocalized (SDATA (default_filename
));
11789 if (!XmListItemExists (list
, default_xmstring
))
11791 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11792 XmListAddItem (list
, default_xmstring
, 0);
11796 item_pos
= XmListItemPos (list
, default_xmstring
);
11797 XmStringFree (default_xmstring
);
11799 /* Select the item and scroll it into view. */
11800 XmListSelectPos (list
, item_pos
, True
);
11801 XmListSetPos (list
, item_pos
);
11804 /* Process events until the user presses Cancel or OK. */
11806 while (result
== 0)
11809 XtAppNextEvent (Xt_app_con
, &event
);
11810 (void) x_dispatch_event (&event
, FRAME_X_DISPLAY (f
) );
11813 /* Get the result. */
11814 if (result
== XmCR_OK
)
11819 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11820 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11821 XmStringFree (text
);
11822 file
= build_string (data
);
11829 XtUnmanageChild (dialog
);
11830 XtDestroyWidget (dialog
);
11834 /* Make "Cancel" equivalent to C-g. */
11836 Fsignal (Qquit
, Qnil
);
11838 return unbind_to (count
, file
);
11841 #endif /* USE_MOTIF */
11845 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
11846 "Read file name, prompting with PROMPT in directory DIR.\n\
11847 Use a file selection dialog.\n\
11848 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
11849 specified. Don't let the user enter a file name in the file\n\
11850 selection dialog's entry field, if MUSTMATCH is non-nil.")
11851 (prompt
, dir
, default_filename
, mustmatch
)
11852 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
11854 FRAME_PTR f
= SELECTED_FRAME ();
11856 Lisp_Object file
= Qnil
;
11857 int count
= specpdl_ptr
- specpdl
;
11858 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11862 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11863 CHECK_STRING (prompt
);
11864 CHECK_STRING (dir
);
11866 /* Prevent redisplay. */
11867 specbind (Qinhibit_redisplay
, Qt
);
11871 if (STRINGP (default_filename
))
11872 cdef_file
= SDATA (default_filename
);
11874 cdef_file
= SDATA (dir
);
11876 fn
= xg_get_file_name (f
, SDATA (prompt
), cdef_file
, ! NILP (mustmatch
));
11880 file
= build_string (fn
);
11887 /* Make "Cancel" equivalent to C-g. */
11889 Fsignal (Qquit
, Qnil
);
11891 return unbind_to (count
, file
);
11894 #endif /* USE_GTK */
11897 /***********************************************************************
11899 ***********************************************************************/
11901 #ifdef HAVE_XKBGETKEYBOARD
11902 #include <X11/XKBlib.h>
11903 #include <X11/keysym.h>
11906 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11907 Sx_backspace_delete_keys_p
, 0, 1, 0,
11908 doc
: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
11909 FRAME nil means use the selected frame.
11910 Value is t if we know that both keys are present, and are mapped to the
11911 usual X keysyms. */)
11915 #ifdef HAVE_XKBGETKEYBOARD
11917 struct frame
*f
= check_x_frame (frame
);
11918 Display
*dpy
= FRAME_X_DISPLAY (f
);
11919 Lisp_Object have_keys
;
11920 int major
, minor
, op
, event
, error
;
11924 /* Check library version in case we're dynamically linked. */
11925 major
= XkbMajorVersion
;
11926 minor
= XkbMinorVersion
;
11927 if (!XkbLibraryVersion (&major
, &minor
))
11933 /* Check that the server supports XKB. */
11934 major
= XkbMajorVersion
;
11935 minor
= XkbMinorVersion
;
11936 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11943 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11946 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11948 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11950 for (i
= kb
->min_key_code
;
11951 (i
< kb
->max_key_code
11952 && (delete_keycode
== 0 || backspace_keycode
== 0));
11955 /* The XKB symbolic key names can be seen most easily in
11956 the PS file generated by `xkbprint -label name
11958 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11959 delete_keycode
= i
;
11960 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11961 backspace_keycode
= i
;
11964 XkbFreeNames (kb
, 0, True
);
11967 XkbFreeClientMap (kb
, 0, True
);
11970 && backspace_keycode
11971 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11972 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11977 #else /* not HAVE_XKBGETKEYBOARD */
11979 #endif /* not HAVE_XKBGETKEYBOARD */
11984 /***********************************************************************
11986 ***********************************************************************/
11991 /* This is zero if not using X windows. */
11994 /* The section below is built by the lisp expression at the top of the file,
11995 just above where these variables are declared. */
11996 /*&&& init symbols here &&&*/
11997 Qauto_raise
= intern ("auto-raise");
11998 staticpro (&Qauto_raise
);
11999 Qauto_lower
= intern ("auto-lower");
12000 staticpro (&Qauto_lower
);
12001 Qborder_color
= intern ("border-color");
12002 staticpro (&Qborder_color
);
12003 Qborder_width
= intern ("border-width");
12004 staticpro (&Qborder_width
);
12005 Qcursor_color
= intern ("cursor-color");
12006 staticpro (&Qcursor_color
);
12007 Qcursor_type
= intern ("cursor-type");
12008 staticpro (&Qcursor_type
);
12009 Qgeometry
= intern ("geometry");
12010 staticpro (&Qgeometry
);
12011 Qicon_left
= intern ("icon-left");
12012 staticpro (&Qicon_left
);
12013 Qicon_top
= intern ("icon-top");
12014 staticpro (&Qicon_top
);
12015 Qicon_type
= intern ("icon-type");
12016 staticpro (&Qicon_type
);
12017 Qicon_name
= intern ("icon-name");
12018 staticpro (&Qicon_name
);
12019 Qinternal_border_width
= intern ("internal-border-width");
12020 staticpro (&Qinternal_border_width
);
12021 Qleft
= intern ("left");
12022 staticpro (&Qleft
);
12023 Qright
= intern ("right");
12024 staticpro (&Qright
);
12025 Qmouse_color
= intern ("mouse-color");
12026 staticpro (&Qmouse_color
);
12027 Qnone
= intern ("none");
12028 staticpro (&Qnone
);
12029 Qparent_id
= intern ("parent-id");
12030 staticpro (&Qparent_id
);
12031 Qscroll_bar_width
= intern ("scroll-bar-width");
12032 staticpro (&Qscroll_bar_width
);
12033 Qsuppress_icon
= intern ("suppress-icon");
12034 staticpro (&Qsuppress_icon
);
12035 Qundefined_color
= intern ("undefined-color");
12036 staticpro (&Qundefined_color
);
12037 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
12038 staticpro (&Qvertical_scroll_bars
);
12039 Qvisibility
= intern ("visibility");
12040 staticpro (&Qvisibility
);
12041 Qwindow_id
= intern ("window-id");
12042 staticpro (&Qwindow_id
);
12043 Qouter_window_id
= intern ("outer-window-id");
12044 staticpro (&Qouter_window_id
);
12045 Qx_frame_parameter
= intern ("x-frame-parameter");
12046 staticpro (&Qx_frame_parameter
);
12047 Qx_resource_name
= intern ("x-resource-name");
12048 staticpro (&Qx_resource_name
);
12049 Quser_position
= intern ("user-position");
12050 staticpro (&Quser_position
);
12051 Quser_size
= intern ("user-size");
12052 staticpro (&Quser_size
);
12053 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
12054 staticpro (&Qscroll_bar_foreground
);
12055 Qscroll_bar_background
= intern ("scroll-bar-background");
12056 staticpro (&Qscroll_bar_background
);
12057 Qscreen_gamma
= intern ("screen-gamma");
12058 staticpro (&Qscreen_gamma
);
12059 Qline_spacing
= intern ("line-spacing");
12060 staticpro (&Qline_spacing
);
12061 Qcenter
= intern ("center");
12062 staticpro (&Qcenter
);
12063 Qcompound_text
= intern ("compound-text");
12064 staticpro (&Qcompound_text
);
12065 Qcancel_timer
= intern ("cancel-timer");
12066 staticpro (&Qcancel_timer
);
12067 Qwait_for_wm
= intern ("wait-for-wm");
12068 staticpro (&Qwait_for_wm
);
12069 Qfullscreen
= intern ("fullscreen");
12070 staticpro (&Qfullscreen
);
12071 Qfullwidth
= intern ("fullwidth");
12072 staticpro (&Qfullwidth
);
12073 Qfullheight
= intern ("fullheight");
12074 staticpro (&Qfullheight
);
12075 Qfullboth
= intern ("fullboth");
12076 staticpro (&Qfullboth
);
12077 /* This is the end of symbol initialization. */
12079 /* Text property `display' should be nonsticky by default. */
12080 Vtext_property_default_nonsticky
12081 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
12084 Qlaplace
= intern ("laplace");
12085 staticpro (&Qlaplace
);
12086 Qemboss
= intern ("emboss");
12087 staticpro (&Qemboss
);
12088 Qedge_detection
= intern ("edge-detection");
12089 staticpro (&Qedge_detection
);
12090 Qheuristic
= intern ("heuristic");
12091 staticpro (&Qheuristic
);
12092 QCmatrix
= intern (":matrix");
12093 staticpro (&QCmatrix
);
12094 QCcolor_adjustment
= intern (":color-adjustment");
12095 staticpro (&QCcolor_adjustment
);
12096 QCmask
= intern (":mask");
12097 staticpro (&QCmask
);
12099 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
12100 staticpro (&Qface_set_after_frame_default
);
12102 Fput (Qundefined_color
, Qerror_conditions
,
12103 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
12104 Fput (Qundefined_color
, Qerror_message
,
12105 build_string ("Undefined color"));
12107 init_x_parm_symbols ();
12109 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
12110 doc
: /* Non-nil means always draw a cross over disabled images.
12111 Disabled images are those having an `:conversion disabled' property.
12112 A cross is always drawn on black & white displays. */);
12113 cross_disabled_images
= 0;
12115 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
12116 doc
: /* List of directories to search for window system bitmap files. */);
12117 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
12119 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
12120 doc
: /* The shape of the pointer when over text.
12121 Changing the value does not affect existing frames
12122 unless you set the mouse color. */);
12123 Vx_pointer_shape
= Qnil
;
12125 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
12126 doc
: /* The name Emacs uses to look up X resources.
12127 `x-get-resource' uses this as the first component of the instance name
12128 when requesting resource values.
12129 Emacs initially sets `x-resource-name' to the name under which Emacs
12130 was invoked, or to the value specified with the `-name' or `-rn'
12131 switches, if present.
12133 It may be useful to bind this variable locally around a call
12134 to `x-get-resource'. See also the variable `x-resource-class'. */);
12135 Vx_resource_name
= Qnil
;
12137 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
12138 doc
: /* The class Emacs uses to look up X resources.
12139 `x-get-resource' uses this as the first component of the instance class
12140 when requesting resource values.
12142 Emacs initially sets `x-resource-class' to "Emacs".
12144 Setting this variable permanently is not a reasonable thing to do,
12145 but binding this variable locally around a call to `x-get-resource'
12146 is a reasonable practice. See also the variable `x-resource-name'. */);
12147 Vx_resource_class
= build_string (EMACS_CLASS
);
12149 #if 0 /* This doesn't really do anything. */
12150 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
12151 doc
: /* The shape of the pointer when not over text.
12152 This variable takes effect when you create a new frame
12153 or when you set the mouse color. */);
12155 Vx_nontext_pointer_shape
= Qnil
;
12157 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
12158 doc
: /* The shape of the pointer when Emacs is busy.
12159 This variable takes effect when you create a new frame
12160 or when you set the mouse color. */);
12161 Vx_hourglass_pointer_shape
= Qnil
;
12163 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
12164 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
12165 display_hourglass_p
= 1;
12167 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
12168 doc
: /* *Seconds to wait before displaying an hourglass pointer.
12169 Value must be an integer or float. */);
12170 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
12172 #if 0 /* This doesn't really do anything. */
12173 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
12174 doc
: /* The shape of the pointer when over the mode line.
12175 This variable takes effect when you create a new frame
12176 or when you set the mouse color. */);
12178 Vx_mode_pointer_shape
= Qnil
;
12180 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
12181 &Vx_sensitive_text_pointer_shape
,
12182 doc
: /* The shape of the pointer when over mouse-sensitive text.
12183 This variable takes effect when you create a new frame
12184 or when you set the mouse color. */);
12185 Vx_sensitive_text_pointer_shape
= Qnil
;
12187 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
12188 &Vx_window_horizontal_drag_shape
,
12189 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
12190 This variable takes effect when you create a new frame
12191 or when you set the mouse color. */);
12192 Vx_window_horizontal_drag_shape
= Qnil
;
12194 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
12195 doc
: /* A string indicating the foreground color of the cursor box. */);
12196 Vx_cursor_fore_pixel
= Qnil
;
12198 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
12199 doc
: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
12200 Text larger than this is clipped. */);
12201 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
12203 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
12204 doc
: /* Non-nil if no X window manager is in use.
12205 Emacs doesn't try to figure this out; this is always nil
12206 unless you set it to something else. */);
12207 /* We don't have any way to find this out, so set it to nil
12208 and maybe the user would like to set it to t. */
12209 Vx_no_window_manager
= Qnil
;
12211 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
12212 &Vx_pixel_size_width_font_regexp
,
12213 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
12215 Since Emacs gets width of a font matching with this regexp from
12216 PIXEL_SIZE field of the name, font finding mechanism gets faster for
12217 such a font. This is especially effective for such large fonts as
12218 Chinese, Japanese, and Korean. */);
12219 Vx_pixel_size_width_font_regexp
= Qnil
;
12221 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
12222 doc
: /* Time after which cached images are removed from the cache.
12223 When an image has not been displayed this many seconds, remove it
12224 from the image cache. Value must be an integer or nil with nil
12225 meaning don't clear the cache. */);
12226 Vimage_cache_eviction_delay
= make_number (30 * 60);
12228 #ifdef USE_X_TOOLKIT
12229 Fprovide (intern ("x-toolkit"), Qnil
);
12231 Fprovide (intern ("motif"), Qnil
);
12233 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string
,
12234 doc
: /* Version info for LessTif/Motif. */);
12235 Vmotif_version_string
= build_string (XmVERSION_STRING
);
12236 #endif /* USE_MOTIF */
12237 #endif /* USE_X_TOOLKIT */
12239 defsubr (&Sx_get_resource
);
12241 /* X window properties. */
12242 defsubr (&Sx_change_window_property
);
12243 defsubr (&Sx_delete_window_property
);
12244 defsubr (&Sx_window_property
);
12246 defsubr (&Sxw_display_color_p
);
12247 defsubr (&Sx_display_grayscale_p
);
12248 defsubr (&Sxw_color_defined_p
);
12249 defsubr (&Sxw_color_values
);
12250 defsubr (&Sx_server_max_request_size
);
12251 defsubr (&Sx_server_vendor
);
12252 defsubr (&Sx_server_version
);
12253 defsubr (&Sx_display_pixel_width
);
12254 defsubr (&Sx_display_pixel_height
);
12255 defsubr (&Sx_display_mm_width
);
12256 defsubr (&Sx_display_mm_height
);
12257 defsubr (&Sx_display_screens
);
12258 defsubr (&Sx_display_planes
);
12259 defsubr (&Sx_display_color_cells
);
12260 defsubr (&Sx_display_visual_class
);
12261 defsubr (&Sx_display_backing_store
);
12262 defsubr (&Sx_display_save_under
);
12263 defsubr (&Sx_parse_geometry
);
12264 defsubr (&Sx_create_frame
);
12265 defsubr (&Sx_open_connection
);
12266 defsubr (&Sx_close_connection
);
12267 defsubr (&Sx_display_list
);
12268 defsubr (&Sx_synchronize
);
12269 defsubr (&Sx_focus_frame
);
12270 defsubr (&Sx_backspace_delete_keys_p
);
12272 /* Setting callback functions for fontset handler. */
12273 get_font_info_func
= x_get_font_info
;
12275 #if 0 /* This function pointer doesn't seem to be used anywhere.
12276 And the pointer assigned has the wrong type, anyway. */
12277 list_fonts_func
= x_list_fonts
;
12280 load_font_func
= x_load_font
;
12281 find_ccl_program_func
= x_find_ccl_program
;
12282 query_font_func
= x_query_font
;
12283 set_frame_fontset_func
= x_set_font
;
12284 check_window_system_func
= check_x
;
12287 Qxbm
= intern ("xbm");
12289 QCconversion
= intern (":conversion");
12290 staticpro (&QCconversion
);
12291 QCheuristic_mask
= intern (":heuristic-mask");
12292 staticpro (&QCheuristic_mask
);
12293 QCcolor_symbols
= intern (":color-symbols");
12294 staticpro (&QCcolor_symbols
);
12295 QCascent
= intern (":ascent");
12296 staticpro (&QCascent
);
12297 QCmargin
= intern (":margin");
12298 staticpro (&QCmargin
);
12299 QCrelief
= intern (":relief");
12300 staticpro (&QCrelief
);
12301 Qpostscript
= intern ("postscript");
12302 staticpro (&Qpostscript
);
12303 QCloader
= intern (":loader");
12304 staticpro (&QCloader
);
12305 QCbounding_box
= intern (":bounding-box");
12306 staticpro (&QCbounding_box
);
12307 QCpt_width
= intern (":pt-width");
12308 staticpro (&QCpt_width
);
12309 QCpt_height
= intern (":pt-height");
12310 staticpro (&QCpt_height
);
12311 QCindex
= intern (":index");
12312 staticpro (&QCindex
);
12313 Qpbm
= intern ("pbm");
12317 Qxpm
= intern ("xpm");
12322 Qjpeg
= intern ("jpeg");
12323 staticpro (&Qjpeg
);
12327 Qtiff
= intern ("tiff");
12328 staticpro (&Qtiff
);
12332 Qgif
= intern ("gif");
12337 Qpng
= intern ("png");
12341 defsubr (&Sclear_image_cache
);
12342 defsubr (&Simage_size
);
12343 defsubr (&Simage_mask_p
);
12345 hourglass_atimer
= NULL
;
12346 hourglass_shown_p
= 0;
12348 defsubr (&Sx_show_tip
);
12349 defsubr (&Sx_hide_tip
);
12351 staticpro (&tip_timer
);
12353 staticpro (&tip_frame
);
12355 last_show_tip_args
= Qnil
;
12356 staticpro (&last_show_tip_args
);
12359 defsubr (&Sx_file_dialog
);
12367 image_types
= NULL
;
12368 Vimage_types
= Qnil
;
12370 define_image_type (&xbm_type
);
12371 define_image_type (&gs_type
);
12372 define_image_type (&pbm_type
);
12375 define_image_type (&xpm_type
);
12379 define_image_type (&jpeg_type
);
12383 define_image_type (&tiff_type
);
12387 define_image_type (&gif_type
);
12391 define_image_type (&png_type
);
12395 #endif /* HAVE_X_WINDOWS */