1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999
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. */
27 /* This makes the fields of a Display accessible, in Xlib header files. */
29 #define XLIB_ILLEGAL_ACCESS
36 #include "intervals.h"
37 #include "dispextern.h"
39 #include "blockinput.h"
44 #include "termhooks.h"
50 #include <sys/types.h>
53 /* On some systems, the character-composition stuff is broken in X11R5. */
55 #if defined (HAVE_X11R5) && ! defined (HAVE_X11R6)
56 #ifdef X11R5_INHIBIT_I18N
57 #define X_I18N_INHIBITED
62 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
63 #include "bitmaps/gray.xbm"
65 #include <X11/bitmaps/gray>
68 #include "[.bitmaps]gray.xbm"
72 #include <X11/Shell.h>
75 #include <X11/Xaw/Paned.h>
76 #include <X11/Xaw/Label.h>
77 #endif /* USE_MOTIF */
80 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
89 #include "../lwlib/lwlib.h"
93 #include <Xm/DialogS.h>
94 #include <Xm/FileSB.h>
97 /* Do the EDITRES protocol if running X11R5
98 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
100 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
102 extern void _XEditResCheckMessages ();
103 #endif /* R5 + Athena */
105 /* Unique id counter for widgets created by the Lucid Widget Library. */
107 extern LWLIB_ID widget_id_tick
;
110 /* This is part of a kludge--see lwlib/xlwmenu.c. */
111 extern XFontStruct
*xlwmenu_default_font
;
114 extern void free_frame_menubar ();
115 extern double atof ();
117 #endif /* USE_X_TOOLKIT */
119 #define min(a,b) ((a) < (b) ? (a) : (b))
120 #define max(a,b) ((a) > (b) ? (a) : (b))
123 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
125 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
128 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
129 it, and including `bitmaps/gray' more than once is a problem when
130 config.h defines `static' as an empty replacement string. */
132 int gray_bitmap_width
= gray_width
;
133 int gray_bitmap_height
= gray_height
;
134 unsigned char *gray_bitmap_bits
= gray_bits
;
136 /* The name we're using in resource queries. Most often "emacs". */
138 Lisp_Object Vx_resource_name
;
140 /* The application class we're using in resource queries.
143 Lisp_Object Vx_resource_class
;
145 /* Non-zero means we're allowed to display a busy cursor. */
147 int display_busy_cursor_p
;
149 /* The background and shape of the mouse pointer, and shape when not
150 over text or in the modeline. */
152 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
153 Lisp_Object Vx_busy_pointer_shape
;
155 /* The shape when over mouse-sensitive text. */
157 Lisp_Object Vx_sensitive_text_pointer_shape
;
159 /* Color of chars displayed in cursor box. */
161 Lisp_Object Vx_cursor_fore_pixel
;
163 /* Nonzero if using X. */
167 /* Non nil if no window manager is in use. */
169 Lisp_Object Vx_no_window_manager
;
171 /* Search path for bitmap files. */
173 Lisp_Object Vx_bitmap_file_path
;
175 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
177 Lisp_Object Vx_pixel_size_width_font_regexp
;
179 /* Evaluate this expression to rebuild the section of syms_of_xfns
180 that initializes and staticpros the symbols declared below. Note
181 that Emacs 18 has a bug that keeps C-x C-e from being able to
182 evaluate this expression.
185 ;; Accumulate a list of the symbols we want to initialize from the
186 ;; declarations at the top of the file.
187 (goto-char (point-min))
188 (search-forward "/\*&&& symbols declared here &&&*\/\n")
190 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
192 (cons (buffer-substring (match-beginning 1) (match-end 1))
195 (setq symbol-list (nreverse symbol-list))
196 ;; Delete the section of syms_of_... where we initialize the symbols.
197 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
198 (let ((start (point)))
199 (while (looking-at "^ Q")
201 (kill-region start (point)))
202 ;; Write a new symbol initialization section.
204 (insert (format " %s = intern (\"" (car symbol-list)))
205 (let ((start (point)))
206 (insert (substring (car symbol-list) 1))
207 (subst-char-in-region start (point) ?_ ?-))
208 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
209 (setq symbol-list (cdr symbol-list)))))
213 /*&&& symbols declared here &&&*/
214 Lisp_Object Qauto_raise
;
215 Lisp_Object Qauto_lower
;
217 Lisp_Object Qborder_color
;
218 Lisp_Object Qborder_width
;
220 Lisp_Object Qcursor_color
;
221 Lisp_Object Qcursor_type
;
222 Lisp_Object Qgeometry
;
223 Lisp_Object Qicon_left
;
224 Lisp_Object Qicon_top
;
225 Lisp_Object Qicon_type
;
226 Lisp_Object Qicon_name
;
227 Lisp_Object Qinternal_border_width
;
230 Lisp_Object Qmouse_color
;
232 Lisp_Object Qouter_window_id
;
233 Lisp_Object Qparent_id
;
234 Lisp_Object Qscroll_bar_width
;
235 Lisp_Object Qsuppress_icon
;
236 extern Lisp_Object Qtop
;
237 Lisp_Object Qundefined_color
;
238 Lisp_Object Qvertical_scroll_bars
;
239 Lisp_Object Qvisibility
;
240 Lisp_Object Qwindow_id
;
241 Lisp_Object Qx_frame_parameter
;
242 Lisp_Object Qx_resource_name
;
243 Lisp_Object Quser_position
;
244 Lisp_Object Quser_size
;
245 extern Lisp_Object Qdisplay
;
246 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
247 Lisp_Object Qscreen_gamma
;
249 /* The below are defined in frame.c. */
251 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
252 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
253 extern Lisp_Object Qtool_bar_lines
;
255 extern Lisp_Object Vwindow_system_version
;
257 Lisp_Object Qface_set_after_frame_default
;
260 /* Error if we are not connected to X. */
266 error ("X windows are not in use or not initialized");
269 /* Nonzero if we can use mouse menus.
270 You should not call this unless HAVE_MENUS is defined. */
278 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
279 and checking validity for X. */
282 check_x_frame (frame
)
288 frame
= selected_frame
;
289 CHECK_LIVE_FRAME (frame
, 0);
292 error ("Non-X frame used");
296 /* Let the user specify an X display with a frame.
297 nil stands for the selected frame--or, if that is not an X frame,
298 the first X display on the list. */
300 static struct x_display_info
*
301 check_x_display_info (frame
)
306 struct frame
*sf
= XFRAME (selected_frame
);
308 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
309 return FRAME_X_DISPLAY_INFO (sf
);
310 else if (x_display_list
!= 0)
311 return x_display_list
;
313 error ("X windows are not in use or not initialized");
315 else if (STRINGP (frame
))
316 return x_display_info_for_name (frame
);
321 CHECK_LIVE_FRAME (frame
, 0);
324 error ("Non-X frame used");
325 return FRAME_X_DISPLAY_INFO (f
);
330 /* Return the Emacs frame-object corresponding to an X window.
331 It could be the frame's main window or an icon window. */
333 /* This function can be called during GC, so use GC_xxx type test macros. */
336 x_window_to_frame (dpyinfo
, wdesc
)
337 struct x_display_info
*dpyinfo
;
340 Lisp_Object tail
, frame
;
343 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
346 if (!GC_FRAMEP (frame
))
349 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
351 if (f
->output_data
.x
->busy_window
== wdesc
)
354 if ((f
->output_data
.x
->edit_widget
355 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
356 /* A tooltip frame? */
357 || (!f
->output_data
.x
->edit_widget
358 && FRAME_X_WINDOW (f
) == wdesc
)
359 || f
->output_data
.x
->icon_desc
== wdesc
)
361 #else /* not USE_X_TOOLKIT */
362 if (FRAME_X_WINDOW (f
) == wdesc
363 || f
->output_data
.x
->icon_desc
== wdesc
)
365 #endif /* not USE_X_TOOLKIT */
371 /* Like x_window_to_frame but also compares the window with the widget's
375 x_any_window_to_frame (dpyinfo
, wdesc
)
376 struct x_display_info
*dpyinfo
;
379 Lisp_Object tail
, frame
;
380 struct frame
*f
, *found
;
384 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
387 if (!GC_FRAMEP (frame
))
391 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
393 /* This frame matches if the window is any of its widgets. */
394 x
= f
->output_data
.x
;
395 if (x
->busy_window
== wdesc
)
399 if (wdesc
== XtWindow (x
->widget
)
400 || wdesc
== XtWindow (x
->column_widget
)
401 || wdesc
== XtWindow (x
->edit_widget
))
403 /* Match if the window is this frame's menubar. */
404 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
407 else if (FRAME_X_WINDOW (f
) == wdesc
)
408 /* A tooltip frame. */
416 /* Likewise, but exclude the menu bar widget. */
419 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
420 struct x_display_info
*dpyinfo
;
423 Lisp_Object tail
, frame
;
427 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
430 if (!GC_FRAMEP (frame
))
433 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
435 x
= f
->output_data
.x
;
436 /* This frame matches if the window is any of its widgets. */
437 if (x
->busy_window
== wdesc
)
441 if (wdesc
== XtWindow (x
->widget
)
442 || wdesc
== XtWindow (x
->column_widget
)
443 || wdesc
== XtWindow (x
->edit_widget
))
446 else if (FRAME_X_WINDOW (f
) == wdesc
)
447 /* A tooltip frame. */
453 /* Likewise, but consider only the menu bar widget. */
456 x_menubar_window_to_frame (dpyinfo
, wdesc
)
457 struct x_display_info
*dpyinfo
;
460 Lisp_Object tail
, frame
;
464 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
467 if (!GC_FRAMEP (frame
))
470 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
472 x
= f
->output_data
.x
;
473 /* Match if the window is this frame's menubar. */
474 if (x
->menubar_widget
475 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
481 /* Return the frame whose principal (outermost) window is WDESC.
482 If WDESC is some other (smaller) window, we return 0. */
485 x_top_window_to_frame (dpyinfo
, wdesc
)
486 struct x_display_info
*dpyinfo
;
489 Lisp_Object tail
, frame
;
493 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
496 if (!GC_FRAMEP (frame
))
499 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
501 x
= f
->output_data
.x
;
505 /* This frame matches if the window is its topmost widget. */
506 if (wdesc
== XtWindow (x
->widget
))
508 #if 0 /* I don't know why it did this,
509 but it seems logically wrong,
510 and it causes trouble for MapNotify events. */
511 /* Match if the window is this frame's menubar. */
512 if (x
->menubar_widget
513 && wdesc
== XtWindow (x
->menubar_widget
))
517 else if (FRAME_X_WINDOW (f
) == wdesc
)
523 #endif /* USE_X_TOOLKIT */
527 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
528 id, which is just an int that this section returns. Bitmaps are
529 reference counted so they can be shared among frames.
531 Bitmap indices are guaranteed to be > 0, so a negative number can
532 be used to indicate no bitmap.
534 If you use x_create_bitmap_from_data, then you must keep track of
535 the bitmaps yourself. That is, creating a bitmap from the same
536 data more than once will not be caught. */
539 /* Functions to access the contents of a bitmap, given an id. */
542 x_bitmap_height (f
, id
)
546 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
550 x_bitmap_width (f
, id
)
554 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
558 x_bitmap_pixmap (f
, id
)
562 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
566 /* Allocate a new bitmap record. Returns index of new record. */
569 x_allocate_bitmap_record (f
)
572 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
575 if (dpyinfo
->bitmaps
== NULL
)
577 dpyinfo
->bitmaps_size
= 10;
579 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
580 dpyinfo
->bitmaps_last
= 1;
584 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
585 return ++dpyinfo
->bitmaps_last
;
587 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
588 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
591 dpyinfo
->bitmaps_size
*= 2;
593 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
594 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
595 return ++dpyinfo
->bitmaps_last
;
598 /* Add one reference to the reference count of the bitmap with id ID. */
601 x_reference_bitmap (f
, id
)
605 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
608 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
611 x_create_bitmap_from_data (f
, bits
, width
, height
)
614 unsigned int width
, height
;
616 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
620 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
621 bits
, width
, height
);
626 id
= x_allocate_bitmap_record (f
);
627 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
628 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
629 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
630 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
631 dpyinfo
->bitmaps
[id
- 1].height
= height
;
632 dpyinfo
->bitmaps
[id
- 1].width
= width
;
637 /* Create bitmap from file FILE for frame F. */
640 x_create_bitmap_from_file (f
, file
)
644 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
645 unsigned int width
, height
;
647 int xhot
, yhot
, result
, id
;
652 /* Look for an existing bitmap with the same name. */
653 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
655 if (dpyinfo
->bitmaps
[id
].refcount
656 && dpyinfo
->bitmaps
[id
].file
657 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
659 ++dpyinfo
->bitmaps
[id
].refcount
;
664 /* Search bitmap-file-path for the file, if appropriate. */
665 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
668 /* XReadBitmapFile won't handle magic file names. */
673 filename
= (char *) XSTRING (found
)->data
;
675 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
676 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
677 if (result
!= BitmapSuccess
)
680 id
= x_allocate_bitmap_record (f
);
681 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
682 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
683 dpyinfo
->bitmaps
[id
- 1].file
684 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
685 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
686 dpyinfo
->bitmaps
[id
- 1].height
= height
;
687 dpyinfo
->bitmaps
[id
- 1].width
= width
;
688 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
693 /* Remove reference to bitmap with id number ID. */
696 x_destroy_bitmap (f
, id
)
700 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
704 --dpyinfo
->bitmaps
[id
- 1].refcount
;
705 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
708 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
709 if (dpyinfo
->bitmaps
[id
- 1].file
)
711 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
712 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
719 /* Free all the bitmaps for the display specified by DPYINFO. */
722 x_destroy_all_bitmaps (dpyinfo
)
723 struct x_display_info
*dpyinfo
;
726 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
727 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
729 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
730 if (dpyinfo
->bitmaps
[i
].file
)
731 xfree (dpyinfo
->bitmaps
[i
].file
);
733 dpyinfo
->bitmaps_last
= 0;
736 /* Connect the frame-parameter names for X frames
737 to the ways of passing the parameter values to the window system.
739 The name of a parameter, as a Lisp symbol,
740 has an `x-frame-parameter' property which is an integer in Lisp
741 that is an index in this table. */
743 struct x_frame_parm_table
746 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 static void x_create_im
P_ ((struct frame
*));
750 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
755 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
759 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
760 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
762 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
763 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
764 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
765 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
767 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
768 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
769 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
770 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
771 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
772 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
773 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
775 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
777 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
782 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
784 static struct x_frame_parm_table x_frame_parms
[] =
786 "auto-raise", x_set_autoraise
,
787 "auto-lower", x_set_autolower
,
788 "background-color", x_set_background_color
,
789 "border-color", x_set_border_color
,
790 "border-width", x_set_border_width
,
791 "cursor-color", x_set_cursor_color
,
792 "cursor-type", x_set_cursor_type
,
794 "foreground-color", x_set_foreground_color
,
795 "icon-name", x_set_icon_name
,
796 "icon-type", x_set_icon_type
,
797 "internal-border-width", x_set_internal_border_width
,
798 "menu-bar-lines", x_set_menu_bar_lines
,
799 "mouse-color", x_set_mouse_color
,
800 "name", x_explicitly_set_name
,
801 "scroll-bar-width", x_set_scroll_bar_width
,
802 "title", x_set_title
,
803 "unsplittable", x_set_unsplittable
,
804 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
805 "visibility", x_set_visibility
,
806 "tool-bar-lines", x_set_tool_bar_lines
,
807 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
808 "scroll-bar-background", x_set_scroll_bar_background
,
809 "screen-gamma", x_set_screen_gamma
812 /* Attach the `x-frame-parameter' properties to
813 the Lisp symbol names of parameters relevant to X. */
816 init_x_parm_symbols ()
820 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
821 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
825 /* Change the parameters of frame F as specified by ALIST.
826 If a parameter is not specially recognized, do nothing;
827 otherwise call the `x_set_...' function for that parameter. */
830 x_set_frame_parameters (f
, alist
)
836 /* If both of these parameters are present, it's more efficient to
837 set them both at once. So we wait until we've looked at the
838 entire list before we set them. */
842 Lisp_Object left
, top
;
844 /* Same with these. */
845 Lisp_Object icon_left
, icon_top
;
847 /* Record in these vectors all the parms specified. */
851 int left_no_change
= 0, top_no_change
= 0;
852 int icon_left_no_change
= 0, icon_top_no_change
= 0;
854 struct gcpro gcpro1
, gcpro2
;
857 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
860 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
861 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
863 /* Extract parm names and values into those vectors. */
866 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
871 parms
[i
] = Fcar (elt
);
872 values
[i
] = Fcdr (elt
);
875 /* TAIL and ALIST are not used again below here. */
878 GCPRO2 (*parms
, *values
);
882 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
883 because their values appear in VALUES and strings are not valid. */
884 top
= left
= Qunbound
;
885 icon_left
= icon_top
= Qunbound
;
887 /* Provide default values for HEIGHT and WIDTH. */
888 if (FRAME_NEW_WIDTH (f
))
889 width
= FRAME_NEW_WIDTH (f
);
891 width
= FRAME_WIDTH (f
);
893 if (FRAME_NEW_HEIGHT (f
))
894 height
= FRAME_NEW_HEIGHT (f
);
896 height
= FRAME_HEIGHT (f
);
898 /* Process foreground_color and background_color before anything else.
899 They are independent of other properties, but other properties (e.g.,
900 cursor_color) are dependent upon them. */
901 for (p
= 0; p
< i
; p
++)
903 Lisp_Object prop
, val
;
907 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
909 register Lisp_Object param_index
, old_value
;
911 param_index
= Fget (prop
, Qx_frame_parameter
);
912 old_value
= get_frame_param (f
, prop
);
913 store_frame_param (f
, prop
, val
);
914 if (NATNUMP (param_index
)
915 && (XFASTINT (param_index
)
916 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
917 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
921 /* Now process them in reverse of specified order. */
922 for (i
--; i
>= 0; i
--)
924 Lisp_Object prop
, val
;
929 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
930 width
= XFASTINT (val
);
931 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
932 height
= XFASTINT (val
);
933 else if (EQ (prop
, Qtop
))
935 else if (EQ (prop
, Qleft
))
937 else if (EQ (prop
, Qicon_top
))
939 else if (EQ (prop
, Qicon_left
))
941 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
942 /* Processed above. */
946 register Lisp_Object param_index
, old_value
;
948 param_index
= Fget (prop
, Qx_frame_parameter
);
949 old_value
= get_frame_param (f
, prop
);
950 store_frame_param (f
, prop
, val
);
951 if (NATNUMP (param_index
)
952 && (XFASTINT (param_index
)
953 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
954 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
958 /* Don't die if just one of these was set. */
959 if (EQ (left
, Qunbound
))
962 if (f
->output_data
.x
->left_pos
< 0)
963 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
965 XSETINT (left
, f
->output_data
.x
->left_pos
);
967 if (EQ (top
, Qunbound
))
970 if (f
->output_data
.x
->top_pos
< 0)
971 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
973 XSETINT (top
, f
->output_data
.x
->top_pos
);
976 /* If one of the icon positions was not set, preserve or default it. */
977 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
979 icon_left_no_change
= 1;
980 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
981 if (NILP (icon_left
))
982 XSETINT (icon_left
, 0);
984 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
986 icon_top_no_change
= 1;
987 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
989 XSETINT (icon_top
, 0);
992 /* Don't set these parameters unless they've been explicitly
993 specified. The window might be mapped or resized while we're in
994 this function, and we don't want to override that unless the lisp
995 code has asked for it.
997 Don't set these parameters unless they actually differ from the
998 window's current parameters; the window may not actually exist
1003 check_frame_size (f
, &height
, &width
);
1005 XSETFRAME (frame
, f
);
1007 if (width
!= FRAME_WIDTH (f
)
1008 || height
!= FRAME_HEIGHT (f
)
1009 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1010 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1012 if ((!NILP (left
) || !NILP (top
))
1013 && ! (left_no_change
&& top_no_change
)
1014 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1015 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1020 /* Record the signs. */
1021 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1022 if (EQ (left
, Qminus
))
1023 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1024 else if (INTEGERP (left
))
1026 leftpos
= XINT (left
);
1028 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1030 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1031 && CONSP (XCDR (left
))
1032 && INTEGERP (XCAR (XCDR (left
))))
1034 leftpos
= - XINT (XCAR (XCDR (left
)));
1035 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1037 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1038 && CONSP (XCDR (left
))
1039 && INTEGERP (XCAR (XCDR (left
))))
1041 leftpos
= XINT (XCAR (XCDR (left
)));
1044 if (EQ (top
, Qminus
))
1045 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1046 else if (INTEGERP (top
))
1048 toppos
= XINT (top
);
1050 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1052 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1053 && CONSP (XCDR (top
))
1054 && INTEGERP (XCAR (XCDR (top
))))
1056 toppos
= - XINT (XCAR (XCDR (top
)));
1057 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1059 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1060 && CONSP (XCDR (top
))
1061 && INTEGERP (XCAR (XCDR (top
))))
1063 toppos
= XINT (XCAR (XCDR (top
)));
1067 /* Store the numeric value of the position. */
1068 f
->output_data
.x
->top_pos
= toppos
;
1069 f
->output_data
.x
->left_pos
= leftpos
;
1071 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1073 /* Actually set that position, and convert to absolute. */
1074 x_set_offset (f
, leftpos
, toppos
, -1);
1077 if ((!NILP (icon_left
) || !NILP (icon_top
))
1078 && ! (icon_left_no_change
&& icon_top_no_change
))
1079 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1085 /* Store the screen positions of frame F into XPTR and YPTR.
1086 These are the positions of the containing window manager window,
1087 not Emacs's own window. */
1090 x_real_positions (f
, xptr
, yptr
)
1097 /* This is pretty gross, but seems to be the easiest way out of
1098 the problem that arises when restarting window-managers. */
1100 #ifdef USE_X_TOOLKIT
1101 Window outer
= (f
->output_data
.x
->widget
1102 ? XtWindow (f
->output_data
.x
->widget
)
1103 : FRAME_X_WINDOW (f
));
1105 Window outer
= f
->output_data
.x
->window_desc
;
1107 Window tmp_root_window
;
1108 Window
*tmp_children
;
1113 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1114 Window outer_window
;
1116 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1117 &f
->output_data
.x
->parent_desc
,
1118 &tmp_children
, &tmp_nchildren
);
1119 XFree ((char *) tmp_children
);
1123 /* Find the position of the outside upper-left corner of
1124 the inner window, with respect to the outer window. */
1125 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1126 outer_window
= f
->output_data
.x
->parent_desc
;
1128 outer_window
= outer
;
1130 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1132 /* From-window, to-window. */
1134 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1136 /* From-position, to-position. */
1137 0, 0, &win_x
, &win_y
,
1142 /* It is possible for the window returned by the XQueryNotify
1143 to become invalid by the time we call XTranslateCoordinates.
1144 That can happen when you restart some window managers.
1145 If so, we get an error in XTranslateCoordinates.
1146 Detect that and try the whole thing over. */
1147 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1149 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1153 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1160 /* Insert a description of internally-recorded parameters of frame X
1161 into the parameter alist *ALISTPTR that is to be given to the user.
1162 Only parameters that are specific to the X window system
1163 and whose values are not correctly recorded in the frame's
1164 param_alist need to be considered here. */
1167 x_report_frame_params (f
, alistptr
)
1169 Lisp_Object
*alistptr
;
1174 /* Represent negative positions (off the top or left screen edge)
1175 in a way that Fmodify_frame_parameters will understand correctly. */
1176 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1177 if (f
->output_data
.x
->left_pos
>= 0)
1178 store_in_alist (alistptr
, Qleft
, tem
);
1180 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1182 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1183 if (f
->output_data
.x
->top_pos
>= 0)
1184 store_in_alist (alistptr
, Qtop
, tem
);
1186 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1188 store_in_alist (alistptr
, Qborder_width
,
1189 make_number (f
->output_data
.x
->border_width
));
1190 store_in_alist (alistptr
, Qinternal_border_width
,
1191 make_number (f
->output_data
.x
->internal_border_width
));
1192 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1193 store_in_alist (alistptr
, Qwindow_id
,
1194 build_string (buf
));
1195 #ifdef USE_X_TOOLKIT
1196 /* Tooltip frame may not have this widget. */
1197 if (f
->output_data
.x
->widget
)
1199 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1200 store_in_alist (alistptr
, Qouter_window_id
,
1201 build_string (buf
));
1202 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1203 FRAME_SAMPLE_VISIBILITY (f
);
1204 store_in_alist (alistptr
, Qvisibility
,
1205 (FRAME_VISIBLE_P (f
) ? Qt
1206 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1207 store_in_alist (alistptr
, Qdisplay
,
1208 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1210 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1213 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1214 store_in_alist (alistptr
, Qparent_id
, tem
);
1219 /* Gamma-correct COLOR on frame F. */
1222 gamma_correct (f
, color
)
1228 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1229 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1230 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1235 /* Decide if color named COLOR is valid for the display associated with
1236 the selected frame; if so, return the rgb values in COLOR_DEF.
1237 If ALLOC is nonzero, allocate a new colormap cell. */
1240 x_defined_color (f
, color
, color_def
, alloc
)
1246 register int status
;
1247 Colormap screen_colormap
;
1248 Display
*display
= FRAME_X_DISPLAY (f
);
1251 screen_colormap
= DefaultColormap (display
, XDefaultScreen (display
));
1253 status
= XParseColor (display
, screen_colormap
, color
, color_def
);
1254 if (status
&& alloc
)
1256 /* Apply gamma correction. */
1257 gamma_correct (f
, color_def
);
1259 status
= XAllocColor (display
, screen_colormap
, color_def
);
1262 /* If we got to this point, the colormap is full, so we're
1263 going to try and get the next closest color.
1264 The algorithm used is a least-squares matching, which is
1265 what X uses for closest color matching with StaticColor visuals. */
1270 long nearest_delta
, trial_delta
;
1273 no_cells
= XDisplayCells (display
, XDefaultScreen (display
));
1274 cells
= (XColor
*) alloca (sizeof (XColor
) * no_cells
);
1276 for (x
= 0; x
< no_cells
; x
++)
1279 XQueryColors (display
, screen_colormap
, cells
, no_cells
);
1281 /* I'm assuming CSE so I'm not going to condense this. */
1282 nearest_delta
= ((((color_def
->red
>> 8) - (cells
[0].red
>> 8))
1283 * ((color_def
->red
>> 8) - (cells
[0].red
>> 8)))
1285 (((color_def
->green
>> 8) - (cells
[0].green
>> 8))
1286 * ((color_def
->green
>> 8) - (cells
[0].green
>> 8)))
1288 (((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))
1289 * ((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))));
1290 for (x
= 1; x
< no_cells
; x
++)
1292 trial_delta
= ((((color_def
->red
>> 8) - (cells
[x
].red
>> 8))
1293 * ((color_def
->red
>> 8) - (cells
[x
].red
>> 8)))
1295 (((color_def
->green
>> 8) - (cells
[x
].green
>> 8))
1296 * ((color_def
->green
>> 8) - (cells
[x
].green
>> 8)))
1298 (((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))
1299 * ((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))));
1300 if (trial_delta
< nearest_delta
)
1303 temp
.red
= cells
[x
].red
;
1304 temp
.green
= cells
[x
].green
;
1305 temp
.blue
= cells
[x
].blue
;
1306 status
= XAllocColor (display
, screen_colormap
, &temp
);
1310 nearest_delta
= trial_delta
;
1314 color_def
->red
= cells
[nearest
].red
;
1315 color_def
->green
= cells
[nearest
].green
;
1316 color_def
->blue
= cells
[nearest
].blue
;
1317 status
= XAllocColor (display
, screen_colormap
, color_def
);
1328 /* Given a string ARG naming a color, compute a pixel value from it
1329 suitable for screen F.
1330 If F is not a color screen, return DEF (default) regardless of what
1334 x_decode_color (f
, arg
, def
)
1341 CHECK_STRING (arg
, 0);
1343 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1344 return BLACK_PIX_DEFAULT (f
);
1345 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1346 return WHITE_PIX_DEFAULT (f
);
1348 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1351 /* x_defined_color is responsible for coping with failures
1352 by looking for a near-miss. */
1353 if (x_defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1356 Fsignal (Qerror
, Fcons (build_string ("undefined color"),
1357 Fcons (arg
, Qnil
)));
1360 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1361 the previous value of that parameter, NEW_VALUE is the new value. */
1364 x_set_screen_gamma (f
, new_value
, old_value
)
1366 Lisp_Object new_value
, old_value
;
1368 if (NILP (new_value
))
1370 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1371 /* The value 0.4545 is the normal viewing gamma. */
1372 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1374 Fsignal (Qerror
, Fcons (build_string ("Illegal screen-gamma"),
1375 Fcons (new_value
, Qnil
)));
1377 clear_face_cache (0);
1381 /* Functions called only from `x_set_frame_param'
1382 to set individual parameters.
1384 If FRAME_X_WINDOW (f) is 0,
1385 the frame is being created and its X-window does not exist yet.
1386 In that case, just record the parameter's new value
1387 in the standard place; do not attempt to change the window. */
1390 x_set_foreground_color (f
, arg
, oldval
)
1392 Lisp_Object arg
, oldval
;
1395 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1397 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1398 f
->output_data
.x
->foreground_pixel
= pixel
;
1400 if (FRAME_X_WINDOW (f
) != 0)
1403 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1404 f
->output_data
.x
->foreground_pixel
);
1405 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1406 f
->output_data
.x
->foreground_pixel
);
1408 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1409 if (FRAME_VISIBLE_P (f
))
1415 x_set_background_color (f
, arg
, oldval
)
1417 Lisp_Object arg
, oldval
;
1420 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1422 unload_color (f
, f
->output_data
.x
->background_pixel
);
1423 f
->output_data
.x
->background_pixel
= pixel
;
1425 if (FRAME_X_WINDOW (f
) != 0)
1428 /* The main frame area. */
1429 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1430 f
->output_data
.x
->background_pixel
);
1431 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1432 f
->output_data
.x
->background_pixel
);
1433 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1434 f
->output_data
.x
->background_pixel
);
1435 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1436 f
->output_data
.x
->background_pixel
);
1439 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1440 bar
= XSCROLL_BAR (bar
)->next
)
1441 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1442 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1443 f
->output_data
.x
->background_pixel
);
1447 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1449 if (FRAME_VISIBLE_P (f
))
1455 x_set_mouse_color (f
, arg
, oldval
)
1457 Lisp_Object arg
, oldval
;
1459 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1462 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1463 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1465 /* Don't let pointers be invisible. */
1466 if (mask_color
== pixel
1467 && mask_color
== f
->output_data
.x
->background_pixel
)
1468 pixel
= f
->output_data
.x
->foreground_pixel
;
1470 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1471 f
->output_data
.x
->mouse_pixel
= pixel
;
1475 /* It's not okay to crash if the user selects a screwy cursor. */
1476 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1478 if (!EQ (Qnil
, Vx_pointer_shape
))
1480 CHECK_NUMBER (Vx_pointer_shape
, 0);
1481 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1484 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1485 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1487 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1489 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1490 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1491 XINT (Vx_nontext_pointer_shape
));
1494 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1495 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1497 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1499 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1500 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1501 XINT (Vx_busy_pointer_shape
));
1504 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1505 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1507 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1508 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1510 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1511 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1512 XINT (Vx_mode_pointer_shape
));
1515 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1516 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1518 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1520 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1522 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1523 XINT (Vx_sensitive_text_pointer_shape
));
1526 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1528 /* Check and report errors with the above calls. */
1529 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1530 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1533 XColor fore_color
, back_color
;
1535 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1536 back_color
.pixel
= mask_color
;
1537 XQueryColor (FRAME_X_DISPLAY (f
),
1538 DefaultColormap (FRAME_X_DISPLAY (f
),
1539 DefaultScreen (FRAME_X_DISPLAY (f
))),
1541 XQueryColor (FRAME_X_DISPLAY (f
),
1542 DefaultColormap (FRAME_X_DISPLAY (f
),
1543 DefaultScreen (FRAME_X_DISPLAY (f
))),
1545 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1546 &fore_color
, &back_color
);
1547 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1548 &fore_color
, &back_color
);
1549 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1550 &fore_color
, &back_color
);
1551 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1552 &fore_color
, &back_color
);
1553 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1554 &fore_color
, &back_color
);
1557 if (FRAME_X_WINDOW (f
) != 0)
1558 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1560 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1561 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1562 f
->output_data
.x
->text_cursor
= cursor
;
1564 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1565 && f
->output_data
.x
->nontext_cursor
!= 0)
1566 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1567 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1569 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1570 && f
->output_data
.x
->busy_cursor
!= 0)
1571 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1572 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1574 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1575 && f
->output_data
.x
->modeline_cursor
!= 0)
1576 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1577 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1579 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1580 && f
->output_data
.x
->cross_cursor
!= 0)
1581 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1582 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1584 XFlush (FRAME_X_DISPLAY (f
));
1587 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1591 x_set_cursor_color (f
, arg
, oldval
)
1593 Lisp_Object arg
, oldval
;
1595 unsigned long fore_pixel
, pixel
;
1597 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1598 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1599 WHITE_PIX_DEFAULT (f
));
1601 fore_pixel
= f
->output_data
.x
->background_pixel
;
1602 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1604 /* Make sure that the cursor color differs from the background color. */
1605 if (pixel
== f
->output_data
.x
->background_pixel
)
1607 pixel
= f
->output_data
.x
->mouse_pixel
;
1608 if (pixel
== fore_pixel
)
1609 fore_pixel
= f
->output_data
.x
->background_pixel
;
1612 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1613 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1615 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1616 f
->output_data
.x
->cursor_pixel
= pixel
;
1618 if (FRAME_X_WINDOW (f
) != 0)
1621 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1622 f
->output_data
.x
->cursor_pixel
);
1623 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1627 if (FRAME_VISIBLE_P (f
))
1629 x_update_cursor (f
, 0);
1630 x_update_cursor (f
, 1);
1634 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1637 /* Set the border-color of frame F to value described by ARG.
1638 ARG can be a string naming a color.
1639 The border-color is used for the border that is drawn by the X server.
1640 Note that this does not fully take effect if done before
1641 F has an x-window; it must be redone when the window is created.
1643 Note: this is done in two routines because of the way X10 works.
1645 Note: under X11, this is normally the province of the window manager,
1646 and so emacs' border colors may be overridden. */
1649 x_set_border_color (f
, arg
, oldval
)
1651 Lisp_Object arg
, oldval
;
1655 CHECK_STRING (arg
, 0);
1656 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1657 x_set_border_pixel (f
, pix
);
1658 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1661 /* Set the border-color of frame F to pixel value PIX.
1662 Note that this does not fully take effect if done before
1663 F has an x-window. */
1666 x_set_border_pixel (f
, pix
)
1670 unload_color (f
, f
->output_data
.x
->border_pixel
);
1671 f
->output_data
.x
->border_pixel
= pix
;
1673 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1676 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1677 (unsigned long)pix
);
1680 if (FRAME_VISIBLE_P (f
))
1686 x_set_cursor_type (f
, arg
, oldval
)
1688 Lisp_Object arg
, oldval
;
1692 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1693 f
->output_data
.x
->cursor_width
= 2;
1695 else if (CONSP (arg
) && EQ (XCAR (arg
), Qbar
)
1696 && INTEGERP (XCDR (arg
)))
1698 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1699 f
->output_data
.x
->cursor_width
= XINT (XCDR (arg
));
1702 /* Treat anything unknown as "box cursor".
1703 It was bad to signal an error; people have trouble fixing
1704 .Xdefaults with Emacs, when it has something bad in it. */
1705 FRAME_DESIRED_CURSOR (f
) = FILLED_BOX_CURSOR
;
1707 /* Make sure the cursor gets redrawn. This is overkill, but how
1708 often do people change cursor types? */
1709 update_mode_lines
++;
1713 x_set_icon_type (f
, arg
, oldval
)
1715 Lisp_Object arg
, oldval
;
1721 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1724 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1729 result
= x_text_icon (f
,
1730 (char *) XSTRING ((!NILP (f
->icon_name
)
1734 result
= x_bitmap_icon (f
, arg
);
1739 error ("No icon window available");
1742 XFlush (FRAME_X_DISPLAY (f
));
1746 /* Return non-nil if frame F wants a bitmap icon. */
1754 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1762 x_set_icon_name (f
, arg
, oldval
)
1764 Lisp_Object arg
, oldval
;
1770 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1773 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1778 if (f
->output_data
.x
->icon_bitmap
!= 0)
1783 result
= x_text_icon (f
,
1784 (char *) XSTRING ((!NILP (f
->icon_name
)
1793 error ("No icon window available");
1796 XFlush (FRAME_X_DISPLAY (f
));
1801 x_set_font (f
, arg
, oldval
)
1803 Lisp_Object arg
, oldval
;
1806 Lisp_Object fontset_name
;
1809 CHECK_STRING (arg
, 1);
1811 fontset_name
= Fquery_fontset (arg
, Qnil
);
1814 result
= (STRINGP (fontset_name
)
1815 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1816 : x_new_font (f
, XSTRING (arg
)->data
));
1819 if (EQ (result
, Qnil
))
1820 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1821 else if (EQ (result
, Qt
))
1822 error ("The characters of the given font have varying widths");
1823 else if (STRINGP (result
))
1825 store_frame_param (f
, Qfont
, result
);
1826 recompute_basic_faces (f
);
1831 do_pending_window_change (0);
1833 /* Don't call `face-set-after-frame-default' when faces haven't been
1834 initialized yet. This is the case when called from
1835 Fx_create_frame. In that case, the X widget or window doesn't
1836 exist either, and we can end up in x_report_frame_params with a
1837 null widget which gives a segfault. */
1838 if (FRAME_FACE_CACHE (f
))
1840 XSETFRAME (frame
, f
);
1841 call1 (Qface_set_after_frame_default
, frame
);
1846 x_set_border_width (f
, arg
, oldval
)
1848 Lisp_Object arg
, oldval
;
1850 CHECK_NUMBER (arg
, 0);
1852 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1855 if (FRAME_X_WINDOW (f
) != 0)
1856 error ("Cannot change the border width of a window");
1858 f
->output_data
.x
->border_width
= XINT (arg
);
1862 x_set_internal_border_width (f
, arg
, oldval
)
1864 Lisp_Object arg
, oldval
;
1866 int old
= f
->output_data
.x
->internal_border_width
;
1868 CHECK_NUMBER (arg
, 0);
1869 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1870 if (f
->output_data
.x
->internal_border_width
< 0)
1871 f
->output_data
.x
->internal_border_width
= 0;
1873 #ifdef USE_X_TOOLKIT
1874 if (f
->output_data
.x
->edit_widget
)
1875 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1878 if (f
->output_data
.x
->internal_border_width
== old
)
1881 if (FRAME_X_WINDOW (f
) != 0)
1883 x_set_window_size (f
, 0, f
->width
, f
->height
);
1884 SET_FRAME_GARBAGED (f
);
1885 do_pending_window_change (0);
1890 x_set_visibility (f
, value
, oldval
)
1892 Lisp_Object value
, oldval
;
1895 XSETFRAME (frame
, f
);
1898 Fmake_frame_invisible (frame
, Qt
);
1899 else if (EQ (value
, Qicon
))
1900 Ficonify_frame (frame
);
1902 Fmake_frame_visible (frame
);
1906 x_set_menu_bar_lines_1 (window
, n
)
1910 struct window
*w
= XWINDOW (window
);
1912 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1913 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1915 /* Handle just the top child in a vertical split. */
1916 if (!NILP (w
->vchild
))
1917 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1919 /* Adjust all children in a horizontal split. */
1920 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1922 w
= XWINDOW (window
);
1923 x_set_menu_bar_lines_1 (window
, n
);
1928 x_set_menu_bar_lines (f
, value
, oldval
)
1930 Lisp_Object value
, oldval
;
1933 #ifndef USE_X_TOOLKIT
1934 int olines
= FRAME_MENU_BAR_LINES (f
);
1937 /* Right now, menu bars don't work properly in minibuf-only frames;
1938 most of the commands try to apply themselves to the minibuffer
1939 frame itself, and get an error because you can't switch buffers
1940 in or split the minibuffer window. */
1941 if (FRAME_MINIBUF_ONLY_P (f
))
1944 if (INTEGERP (value
))
1945 nlines
= XINT (value
);
1949 /* Make sure we redisplay all windows in this frame. */
1950 windows_or_buffers_changed
++;
1952 #ifdef USE_X_TOOLKIT
1953 FRAME_MENU_BAR_LINES (f
) = 0;
1956 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1957 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1958 /* Make sure next redisplay shows the menu bar. */
1959 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1963 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1964 free_frame_menubar (f
);
1965 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1967 f
->output_data
.x
->menubar_widget
= 0;
1969 #else /* not USE_X_TOOLKIT */
1970 FRAME_MENU_BAR_LINES (f
) = nlines
;
1971 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1972 #endif /* not USE_X_TOOLKIT */
1977 /* Set the number of lines used for the tool bar of frame F to VALUE.
1978 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1979 is the old number of tool bar lines. This function changes the
1980 height of all windows on frame F to match the new tool bar height.
1981 The frame's height doesn't change. */
1984 x_set_tool_bar_lines (f
, value
, oldval
)
1986 Lisp_Object value
, oldval
;
1990 /* Use VALUE only if an integer >= 0. */
1991 if (INTEGERP (value
) && XINT (value
) >= 0)
1992 nlines
= XFASTINT (value
);
1996 /* Make sure we redisplay all windows in this frame. */
1997 ++windows_or_buffers_changed
;
1999 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2000 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2001 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f
), delta
);
2006 /* Set the foreground color for scroll bars on frame F to VALUE.
2007 VALUE should be a string, a color name. If it isn't a string or
2008 isn't a valid color name, do nothing. OLDVAL is the old value of
2009 the frame parameter. */
2012 x_set_scroll_bar_foreground (f
, value
, oldval
)
2014 Lisp_Object value
, oldval
;
2016 unsigned long pixel
;
2018 if (STRINGP (value
))
2019 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2023 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2024 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2026 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2027 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2029 /* Remove all scroll bars because they have wrong colors. */
2030 if (condemn_scroll_bars_hook
)
2031 (*condemn_scroll_bars_hook
) (f
);
2032 if (judge_scroll_bars_hook
)
2033 (*judge_scroll_bars_hook
) (f
);
2035 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2041 /* Set the background color for scroll bars on frame F to VALUE VALUE
2042 should be a string, a color name. If it isn't a string or isn't a
2043 valid color name, do nothing. OLDVAL is the old value of the frame
2047 x_set_scroll_bar_background (f
, value
, oldval
)
2049 Lisp_Object value
, oldval
;
2051 unsigned long pixel
;
2053 if (STRINGP (value
))
2054 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2058 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2059 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2061 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2062 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2064 /* Remove all scroll bars because they have wrong colors. */
2065 if (condemn_scroll_bars_hook
)
2066 (*condemn_scroll_bars_hook
) (f
);
2067 if (judge_scroll_bars_hook
)
2068 (*judge_scroll_bars_hook
) (f
);
2070 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2076 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2079 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2080 name; if NAME is a string, set F's name to NAME and set
2081 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2083 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2084 suggesting a new name, which lisp code should override; if
2085 F->explicit_name is set, ignore the new name; otherwise, set it. */
2088 x_set_name (f
, name
, explicit)
2093 /* Make sure that requests from lisp code override requests from
2094 Emacs redisplay code. */
2097 /* If we're switching from explicit to implicit, we had better
2098 update the mode lines and thereby update the title. */
2099 if (f
->explicit_name
&& NILP (name
))
2100 update_mode_lines
= 1;
2102 f
->explicit_name
= ! NILP (name
);
2104 else if (f
->explicit_name
)
2107 /* If NAME is nil, set the name to the x_id_name. */
2110 /* Check for no change needed in this very common case
2111 before we do any consing. */
2112 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2113 XSTRING (f
->name
)->data
))
2115 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2118 CHECK_STRING (name
, 0);
2120 /* Don't change the name if it's already NAME. */
2121 if (! NILP (Fstring_equal (name
, f
->name
)))
2126 /* For setting the frame title, the title parameter should override
2127 the name parameter. */
2128 if (! NILP (f
->title
))
2131 if (FRAME_X_WINDOW (f
))
2136 XTextProperty text
, icon
;
2137 Lisp_Object icon_name
;
2139 text
.value
= XSTRING (name
)->data
;
2140 text
.encoding
= XA_STRING
;
2142 text
.nitems
= STRING_BYTES (XSTRING (name
));
2144 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2146 icon
.value
= XSTRING (icon_name
)->data
;
2147 icon
.encoding
= XA_STRING
;
2149 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2150 #ifdef USE_X_TOOLKIT
2151 XSetWMName (FRAME_X_DISPLAY (f
),
2152 XtWindow (f
->output_data
.x
->widget
), &text
);
2153 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2155 #else /* not USE_X_TOOLKIT */
2156 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2157 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2158 #endif /* not USE_X_TOOLKIT */
2160 #else /* not HAVE_X11R4 */
2161 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2162 XSTRING (name
)->data
);
2163 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2164 XSTRING (name
)->data
);
2165 #endif /* not HAVE_X11R4 */
2170 /* This function should be called when the user's lisp code has
2171 specified a name for the frame; the name will override any set by the
2174 x_explicitly_set_name (f
, arg
, oldval
)
2176 Lisp_Object arg
, oldval
;
2178 x_set_name (f
, arg
, 1);
2181 /* This function should be called by Emacs redisplay code to set the
2182 name; names set this way will never override names set by the user's
2185 x_implicitly_set_name (f
, arg
, oldval
)
2187 Lisp_Object arg
, oldval
;
2189 x_set_name (f
, arg
, 0);
2192 /* Change the title of frame F to NAME.
2193 If NAME is nil, use the frame name as the title.
2195 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2196 name; if NAME is a string, set F's name to NAME and set
2197 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2199 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2200 suggesting a new name, which lisp code should override; if
2201 F->explicit_name is set, ignore the new name; otherwise, set it. */
2204 x_set_title (f
, name
, old_name
)
2206 Lisp_Object name
, old_name
;
2208 /* Don't change the title if it's already NAME. */
2209 if (EQ (name
, f
->title
))
2212 update_mode_lines
= 1;
2219 CHECK_STRING (name
, 0);
2221 if (FRAME_X_WINDOW (f
))
2226 XTextProperty text
, icon
;
2227 Lisp_Object icon_name
;
2229 text
.value
= XSTRING (name
)->data
;
2230 text
.encoding
= XA_STRING
;
2232 text
.nitems
= STRING_BYTES (XSTRING (name
));
2234 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2236 icon
.value
= XSTRING (icon_name
)->data
;
2237 icon
.encoding
= XA_STRING
;
2239 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2240 #ifdef USE_X_TOOLKIT
2241 XSetWMName (FRAME_X_DISPLAY (f
),
2242 XtWindow (f
->output_data
.x
->widget
), &text
);
2243 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2245 #else /* not USE_X_TOOLKIT */
2246 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2247 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2248 #endif /* not USE_X_TOOLKIT */
2250 #else /* not HAVE_X11R4 */
2251 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2252 XSTRING (name
)->data
);
2253 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2254 XSTRING (name
)->data
);
2255 #endif /* not HAVE_X11R4 */
2261 x_set_autoraise (f
, arg
, oldval
)
2263 Lisp_Object arg
, oldval
;
2265 f
->auto_raise
= !EQ (Qnil
, arg
);
2269 x_set_autolower (f
, arg
, oldval
)
2271 Lisp_Object arg
, oldval
;
2273 f
->auto_lower
= !EQ (Qnil
, arg
);
2277 x_set_unsplittable (f
, arg
, oldval
)
2279 Lisp_Object arg
, oldval
;
2281 f
->no_split
= !NILP (arg
);
2285 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2287 Lisp_Object arg
, oldval
;
2289 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2290 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2291 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2292 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2294 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2296 ? vertical_scroll_bar_none
2298 ? vertical_scroll_bar_right
2299 : vertical_scroll_bar_left
);
2301 /* We set this parameter before creating the X window for the
2302 frame, so we can get the geometry right from the start.
2303 However, if the window hasn't been created yet, we shouldn't
2304 call x_set_window_size. */
2305 if (FRAME_X_WINDOW (f
))
2306 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2307 do_pending_window_change (0);
2312 x_set_scroll_bar_width (f
, arg
, oldval
)
2314 Lisp_Object arg
, oldval
;
2316 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2320 #ifdef USE_TOOLKIT_SCROLL_BARS
2321 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2322 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2323 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2324 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2326 /* Make the actual width at least 14 pixels and a multiple of a
2328 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2330 /* Use all of that space (aside from required margins) for the
2332 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2335 if (FRAME_X_WINDOW (f
))
2336 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2337 do_pending_window_change (0);
2339 else if (INTEGERP (arg
) && XINT (arg
) > 0
2340 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2342 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2343 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2345 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2346 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2347 if (FRAME_X_WINDOW (f
))
2348 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2351 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2352 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2353 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2358 /* Subroutines of creating an X frame. */
2360 /* Make sure that Vx_resource_name is set to a reasonable value.
2361 Fix it up, or set it to `emacs' if it is too hopeless. */
2364 validate_x_resource_name ()
2367 /* Number of valid characters in the resource name. */
2369 /* Number of invalid characters in the resource name. */
2374 if (!STRINGP (Vx_resource_class
))
2375 Vx_resource_class
= build_string (EMACS_CLASS
);
2377 if (STRINGP (Vx_resource_name
))
2379 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2382 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2384 /* Only letters, digits, - and _ are valid in resource names.
2385 Count the valid characters and count the invalid ones. */
2386 for (i
= 0; i
< len
; i
++)
2389 if (! ((c
>= 'a' && c
<= 'z')
2390 || (c
>= 'A' && c
<= 'Z')
2391 || (c
>= '0' && c
<= '9')
2392 || c
== '-' || c
== '_'))
2399 /* Not a string => completely invalid. */
2400 bad_count
= 5, good_count
= 0;
2402 /* If name is valid already, return. */
2406 /* If name is entirely invalid, or nearly so, use `emacs'. */
2408 || (good_count
== 1 && bad_count
> 0))
2410 Vx_resource_name
= build_string ("emacs");
2414 /* Name is partly valid. Copy it and replace the invalid characters
2415 with underscores. */
2417 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2419 for (i
= 0; i
< len
; i
++)
2421 int c
= XSTRING (new)->data
[i
];
2422 if (! ((c
>= 'a' && c
<= 'z')
2423 || (c
>= 'A' && c
<= 'Z')
2424 || (c
>= '0' && c
<= '9')
2425 || c
== '-' || c
== '_'))
2426 XSTRING (new)->data
[i
] = '_';
2431 extern char *x_get_string_resource ();
2433 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2434 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2435 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2436 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2437 the name specified by the `-name' or `-rn' command-line arguments.\n\
2439 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2440 class, respectively. You must specify both of them or neither.\n\
2441 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2442 and the class is `Emacs.CLASS.SUBCLASS'.")
2443 (attribute
, class, component
, subclass
)
2444 Lisp_Object attribute
, class, component
, subclass
;
2446 register char *value
;
2452 CHECK_STRING (attribute
, 0);
2453 CHECK_STRING (class, 0);
2455 if (!NILP (component
))
2456 CHECK_STRING (component
, 1);
2457 if (!NILP (subclass
))
2458 CHECK_STRING (subclass
, 2);
2459 if (NILP (component
) != NILP (subclass
))
2460 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2462 validate_x_resource_name ();
2464 /* Allocate space for the components, the dots which separate them,
2465 and the final '\0'. Make them big enough for the worst case. */
2466 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2467 + (STRINGP (component
)
2468 ? STRING_BYTES (XSTRING (component
)) : 0)
2469 + STRING_BYTES (XSTRING (attribute
))
2472 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2473 + STRING_BYTES (XSTRING (class))
2474 + (STRINGP (subclass
)
2475 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2478 /* Start with emacs.FRAMENAME for the name (the specific one)
2479 and with `Emacs' for the class key (the general one). */
2480 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2481 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2483 strcat (class_key
, ".");
2484 strcat (class_key
, XSTRING (class)->data
);
2486 if (!NILP (component
))
2488 strcat (class_key
, ".");
2489 strcat (class_key
, XSTRING (subclass
)->data
);
2491 strcat (name_key
, ".");
2492 strcat (name_key
, XSTRING (component
)->data
);
2495 strcat (name_key
, ".");
2496 strcat (name_key
, XSTRING (attribute
)->data
);
2498 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2499 name_key
, class_key
);
2501 if (value
!= (char *) 0)
2502 return build_string (value
);
2507 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2510 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2511 struct x_display_info
*dpyinfo
;
2512 Lisp_Object attribute
, class, component
, subclass
;
2514 register char *value
;
2520 CHECK_STRING (attribute
, 0);
2521 CHECK_STRING (class, 0);
2523 if (!NILP (component
))
2524 CHECK_STRING (component
, 1);
2525 if (!NILP (subclass
))
2526 CHECK_STRING (subclass
, 2);
2527 if (NILP (component
) != NILP (subclass
))
2528 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2530 validate_x_resource_name ();
2532 /* Allocate space for the components, the dots which separate them,
2533 and the final '\0'. Make them big enough for the worst case. */
2534 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2535 + (STRINGP (component
)
2536 ? STRING_BYTES (XSTRING (component
)) : 0)
2537 + STRING_BYTES (XSTRING (attribute
))
2540 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2541 + STRING_BYTES (XSTRING (class))
2542 + (STRINGP (subclass
)
2543 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2546 /* Start with emacs.FRAMENAME for the name (the specific one)
2547 and with `Emacs' for the class key (the general one). */
2548 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2549 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2551 strcat (class_key
, ".");
2552 strcat (class_key
, XSTRING (class)->data
);
2554 if (!NILP (component
))
2556 strcat (class_key
, ".");
2557 strcat (class_key
, XSTRING (subclass
)->data
);
2559 strcat (name_key
, ".");
2560 strcat (name_key
, XSTRING (component
)->data
);
2563 strcat (name_key
, ".");
2564 strcat (name_key
, XSTRING (attribute
)->data
);
2566 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2568 if (value
!= (char *) 0)
2569 return build_string (value
);
2574 /* Used when C code wants a resource value. */
2577 x_get_resource_string (attribute
, class)
2578 char *attribute
, *class;
2582 struct frame
*sf
= SELECTED_FRAME ();
2584 /* Allocate space for the components, the dots which separate them,
2585 and the final '\0'. */
2586 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2587 + strlen (attribute
) + 2);
2588 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2589 + strlen (class) + 2);
2591 sprintf (name_key
, "%s.%s",
2592 XSTRING (Vinvocation_name
)->data
,
2594 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2596 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2597 name_key
, class_key
);
2600 /* Types we might convert a resource string into. */
2610 /* Return the value of parameter PARAM.
2612 First search ALIST, then Vdefault_frame_alist, then the X defaults
2613 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2615 Convert the resource to the type specified by desired_type.
2617 If no default is specified, return Qunbound. If you call
2618 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2619 and don't let it get stored in any Lisp-visible variables! */
2622 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2623 struct x_display_info
*dpyinfo
;
2624 Lisp_Object alist
, param
;
2627 enum resource_types type
;
2629 register Lisp_Object tem
;
2631 tem
= Fassq (param
, alist
);
2633 tem
= Fassq (param
, Vdefault_frame_alist
);
2639 tem
= display_x_get_resource (dpyinfo
,
2640 build_string (attribute
),
2641 build_string (class),
2649 case RES_TYPE_NUMBER
:
2650 return make_number (atoi (XSTRING (tem
)->data
));
2652 case RES_TYPE_FLOAT
:
2653 return make_float (atof (XSTRING (tem
)->data
));
2655 case RES_TYPE_BOOLEAN
:
2656 tem
= Fdowncase (tem
);
2657 if (!strcmp (XSTRING (tem
)->data
, "on")
2658 || !strcmp (XSTRING (tem
)->data
, "true"))
2663 case RES_TYPE_STRING
:
2666 case RES_TYPE_SYMBOL
:
2667 /* As a special case, we map the values `true' and `on'
2668 to Qt, and `false' and `off' to Qnil. */
2671 lower
= Fdowncase (tem
);
2672 if (!strcmp (XSTRING (lower
)->data
, "on")
2673 || !strcmp (XSTRING (lower
)->data
, "true"))
2675 else if (!strcmp (XSTRING (lower
)->data
, "off")
2676 || !strcmp (XSTRING (lower
)->data
, "false"))
2679 return Fintern (tem
, Qnil
);
2692 /* Like x_get_arg, but also record the value in f->param_alist. */
2695 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2697 Lisp_Object alist
, param
;
2700 enum resource_types type
;
2704 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2705 attribute
, class, type
);
2707 store_frame_param (f
, param
, value
);
2712 /* Record in frame F the specified or default value according to ALIST
2713 of the parameter named PROP (a Lisp symbol).
2714 If no value is specified for PROP, look for an X default for XPROP
2715 on the frame named NAME.
2716 If that is not found either, use the value DEFLT. */
2719 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2726 enum resource_types type
;
2730 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2731 if (EQ (tem
, Qunbound
))
2733 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2738 /* Record in frame F the specified or default value according to ALIST
2739 of the parameter named PROP (a Lisp symbol). If no value is
2740 specified for PROP, look for an X default for XPROP on the frame
2741 named NAME. If that is not found either, use the value DEFLT. */
2744 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2753 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2756 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2757 if (EQ (tem
, Qunbound
))
2759 #ifdef USE_TOOLKIT_SCROLL_BARS
2761 /* See if an X resource for the scroll bar color has been
2763 tem
= display_x_get_resource (dpyinfo
,
2764 build_string (foreground_p
2768 build_string ("verticalScrollBar"),
2772 /* If nothing has been specified, scroll bars will use a
2773 toolkit-dependent default. Because these defaults are
2774 difficult to get at without actually creating a scroll
2775 bar, use nil to indicate that no color has been
2780 #else /* not USE_TOOLKIT_SCROLL_BARS */
2784 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2787 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2793 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2794 "Parse an X-style geometry string STRING.\n\
2795 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2796 The properties returned may include `top', `left', `height', and `width'.\n\
2797 The value of `left' or `top' may be an integer,\n\
2798 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2799 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2804 unsigned int width
, height
;
2807 CHECK_STRING (string
, 0);
2809 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2810 &x
, &y
, &width
, &height
);
2813 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2814 error ("Must specify both x and y position, or neither");
2818 if (geometry
& XValue
)
2820 Lisp_Object element
;
2822 if (x
>= 0 && (geometry
& XNegative
))
2823 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2824 else if (x
< 0 && ! (geometry
& XNegative
))
2825 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2827 element
= Fcons (Qleft
, make_number (x
));
2828 result
= Fcons (element
, result
);
2831 if (geometry
& YValue
)
2833 Lisp_Object element
;
2835 if (y
>= 0 && (geometry
& YNegative
))
2836 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2837 else if (y
< 0 && ! (geometry
& YNegative
))
2838 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2840 element
= Fcons (Qtop
, make_number (y
));
2841 result
= Fcons (element
, result
);
2844 if (geometry
& WidthValue
)
2845 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2846 if (geometry
& HeightValue
)
2847 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2852 /* Calculate the desired size and position of this window,
2853 and return the flags saying which aspects were specified.
2855 This function does not make the coordinates positive. */
2857 #define DEFAULT_ROWS 40
2858 #define DEFAULT_COLS 80
2861 x_figure_window_size (f
, parms
)
2865 register Lisp_Object tem0
, tem1
, tem2
;
2866 long window_prompting
= 0;
2867 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2869 /* Default values if we fall through.
2870 Actually, if that happens we should get
2871 window manager prompting. */
2872 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2873 f
->height
= DEFAULT_ROWS
;
2874 /* Window managers expect that if program-specified
2875 positions are not (0,0), they're intentional, not defaults. */
2876 f
->output_data
.x
->top_pos
= 0;
2877 f
->output_data
.x
->left_pos
= 0;
2879 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
2880 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
2881 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
2882 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2884 if (!EQ (tem0
, Qunbound
))
2886 CHECK_NUMBER (tem0
, 0);
2887 f
->height
= XINT (tem0
);
2889 if (!EQ (tem1
, Qunbound
))
2891 CHECK_NUMBER (tem1
, 0);
2892 SET_FRAME_WIDTH (f
, XINT (tem1
));
2894 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2895 window_prompting
|= USSize
;
2897 window_prompting
|= PSize
;
2900 f
->output_data
.x
->vertical_scroll_bar_extra
2901 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2903 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2904 f
->output_data
.x
->flags_areas_extra
2905 = FRAME_FLAGS_AREA_WIDTH (f
);
2906 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2907 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2909 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
2910 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
2911 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
2912 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2914 if (EQ (tem0
, Qminus
))
2916 f
->output_data
.x
->top_pos
= 0;
2917 window_prompting
|= YNegative
;
2919 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
2920 && CONSP (XCDR (tem0
))
2921 && INTEGERP (XCAR (XCDR (tem0
))))
2923 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
2924 window_prompting
|= YNegative
;
2926 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
2927 && CONSP (XCDR (tem0
))
2928 && INTEGERP (XCAR (XCDR (tem0
))))
2930 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
2932 else if (EQ (tem0
, Qunbound
))
2933 f
->output_data
.x
->top_pos
= 0;
2936 CHECK_NUMBER (tem0
, 0);
2937 f
->output_data
.x
->top_pos
= XINT (tem0
);
2938 if (f
->output_data
.x
->top_pos
< 0)
2939 window_prompting
|= YNegative
;
2942 if (EQ (tem1
, Qminus
))
2944 f
->output_data
.x
->left_pos
= 0;
2945 window_prompting
|= XNegative
;
2947 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
2948 && CONSP (XCDR (tem1
))
2949 && INTEGERP (XCAR (XCDR (tem1
))))
2951 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
2952 window_prompting
|= XNegative
;
2954 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
2955 && CONSP (XCDR (tem1
))
2956 && INTEGERP (XCAR (XCDR (tem1
))))
2958 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
2960 else if (EQ (tem1
, Qunbound
))
2961 f
->output_data
.x
->left_pos
= 0;
2964 CHECK_NUMBER (tem1
, 0);
2965 f
->output_data
.x
->left_pos
= XINT (tem1
);
2966 if (f
->output_data
.x
->left_pos
< 0)
2967 window_prompting
|= XNegative
;
2970 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2971 window_prompting
|= USPosition
;
2973 window_prompting
|= PPosition
;
2976 return window_prompting
;
2979 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2982 XSetWMProtocols (dpy
, w
, protocols
, count
)
2989 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
2990 if (prop
== None
) return False
;
2991 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
2992 (unsigned char *) protocols
, count
);
2995 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2997 #ifdef USE_X_TOOLKIT
2999 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3000 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3001 already be present because of the toolkit (Motif adds some of them,
3002 for example, but Xt doesn't). */
3005 hack_wm_protocols (f
, widget
)
3009 Display
*dpy
= XtDisplay (widget
);
3010 Window w
= XtWindow (widget
);
3011 int need_delete
= 1;
3017 Atom type
, *atoms
= 0;
3019 unsigned long nitems
= 0;
3020 unsigned long bytes_after
;
3022 if ((XGetWindowProperty (dpy
, w
,
3023 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3024 (long)0, (long)100, False
, XA_ATOM
,
3025 &type
, &format
, &nitems
, &bytes_after
,
3026 (unsigned char **) &atoms
)
3028 && format
== 32 && type
== XA_ATOM
)
3032 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3034 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3036 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3039 if (atoms
) XFree ((char *) atoms
);
3045 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3047 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3049 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3051 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3052 XA_ATOM
, 32, PropModeAppend
,
3053 (unsigned char *) props
, count
);
3061 /* Support routines for XIC (X Input Context). */
3065 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3066 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3069 /* Supported XIM styles, ordered by preferenc. */
3071 static XIMStyle supported_xim_styles
[] =
3073 XIMPreeditPosition
| XIMStatusArea
,
3074 XIMPreeditPosition
| XIMStatusNothing
,
3075 XIMPreeditPosition
| XIMStatusNone
,
3076 XIMPreeditNothing
| XIMStatusArea
,
3077 XIMPreeditNothing
| XIMStatusNothing
,
3078 XIMPreeditNothing
| XIMStatusNone
,
3079 XIMPreeditNone
| XIMStatusArea
,
3080 XIMPreeditNone
| XIMStatusNothing
,
3081 XIMPreeditNone
| XIMStatusNone
,
3086 /* Create an X fontset on frame F with base font name
3090 xic_create_xfontset (f
, base_fontname
)
3092 char *base_fontname
;
3095 char **missing_list
;
3099 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3100 base_fontname
, &missing_list
,
3101 &missing_count
, &def_string
);
3103 XFreeStringList (missing_list
);
3105 /* No need to free def_string. */
3110 /* Value is the best input style, given user preferences USER (already
3111 checked to be supported by Emacs), and styles supported by the
3112 input method XIM. */
3115 best_xim_style (user
, xim
)
3121 for (i
= 0; i
< user
->count_styles
; ++i
)
3122 for (j
= 0; j
< xim
->count_styles
; ++j
)
3123 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3124 return user
->supported_styles
[i
];
3126 /* Return the default style. */
3127 return XIMPreeditNothing
| XIMStatusNothing
;
3130 /* Create XIC for frame F. */
3133 create_frame_xic (f
)
3136 #ifndef X_I18N_INHIBITED
3139 XFontSet xfs
= NULL
;
3140 static XIMStyle xic_style
;
3145 xim
= FRAME_X_XIM (f
);
3150 XVaNestedList preedit_attr
;
3151 XVaNestedList status_attr
;
3152 char *base_fontname
;
3155 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3156 spot
.x
= 0; spot
.y
= 1;
3157 /* Create X fontset. */
3158 fontset
= FRAME_FONTSET (f
);
3160 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3163 struct fontset_info
*fontsetp
;
3167 fontsetp
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
3168 for (i
= 0; i
<= MAX_CHARSET
; i
++)
3169 if (fontsetp
->fontname
[i
])
3170 len
+= strlen (fontsetp
->fontname
[i
]) + 1;
3171 base_fontname
= alloca (len
);
3172 strcpy (base_fontname
, fontsetp
->fontname
[CHARSET_ASCII
]);
3173 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
<= MAX_CHARSET
; i
++)
3174 if (fontsetp
->fontname
[i
])
3176 strcat (base_fontname
, ",");
3177 strcat (base_fontname
, fontsetp
->fontname
[i
]);
3180 xfs
= xic_create_xfontset (f
, base_fontname
);
3182 /* Determine XIC style. */
3185 XIMStyles supported_list
;
3186 supported_list
.count_styles
= (sizeof supported_xim_styles
3187 / sizeof supported_xim_styles
[0]);
3188 supported_list
.supported_styles
= supported_xim_styles
;
3189 xic_style
= best_xim_style (&supported_list
,
3190 FRAME_X_XIM_STYLES (f
));
3193 preedit_attr
= XVaCreateNestedList (0,
3196 FRAME_FOREGROUND_PIXEL (f
),
3198 FRAME_BACKGROUND_PIXEL (f
),
3199 (xic_style
& XIMPreeditPosition
3204 status_attr
= XVaCreateNestedList (0,
3210 FRAME_FOREGROUND_PIXEL (f
),
3212 FRAME_BACKGROUND_PIXEL (f
),
3215 xic
= XCreateIC (xim
,
3216 XNInputStyle
, xic_style
,
3217 XNClientWindow
, FRAME_X_WINDOW(f
),
3218 XNFocusWindow
, FRAME_X_WINDOW(f
),
3219 XNStatusAttributes
, status_attr
,
3220 XNPreeditAttributes
, preedit_attr
,
3222 XFree (preedit_attr
);
3223 XFree (status_attr
);
3226 FRAME_XIC (f
) = xic
;
3227 FRAME_XIC_STYLE (f
) = xic_style
;
3228 FRAME_XIC_FONTSET (f
) = xfs
;
3229 #else /* X_I18N_INHIBITED */
3230 FRAME_XIC (f
) = NULL
;
3231 FRAME_XIC_STYLE (f
) = 0;
3232 FRAME_XIC_FONTSET (f
) = NULL
;
3233 #endif /* X_I18N_INHIBITED */
3237 /* Destroy XIC and free XIC fontset of frame F, if any. */
3243 if (FRAME_XIC (f
) == NULL
)
3246 XDestroyIC (FRAME_XIC (f
));
3247 if (FRAME_XIC_FONTSET (f
))
3248 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3250 FRAME_XIC (f
) = NULL
;
3251 FRAME_XIC_FONTSET (f
) = NULL
;
3255 /* Place preedit area for XIC of window W's frame to specified
3256 pixel position X/Y. X and Y are relative to window W. */
3259 xic_set_preeditarea (w
, x
, y
)
3263 struct frame
*f
= XFRAME (w
->frame
);
3267 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3268 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3269 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3270 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3275 /* Place status area for XIC in bottom right corner of frame F.. */
3278 xic_set_statusarea (f
)
3281 XIC xic
= FRAME_XIC (f
);
3286 /* Negotiate geometry of status area. If input method has existing
3287 status area, use its current size. */
3288 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3289 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3290 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3293 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3294 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3297 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3299 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3300 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3304 area
.width
= needed
->width
;
3305 area
.height
= needed
->height
;
3306 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3307 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3308 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3311 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3312 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3317 /* Set X fontset for XIC of frame F, using base font name
3318 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3321 xic_set_xfontset (f
, base_fontname
)
3323 char *base_fontname
;
3328 xfs
= xic_create_xfontset (f
, base_fontname
);
3330 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3331 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3332 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3333 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3334 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3337 if (FRAME_XIC_FONTSET (f
))
3338 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3339 FRAME_XIC_FONTSET (f
) = xfs
;
3342 #endif /* HAVE_X_I18N */
3346 #ifdef USE_X_TOOLKIT
3348 /* Create and set up the X widget for frame F. */
3351 x_window (f
, window_prompting
, minibuffer_only
)
3353 long window_prompting
;
3354 int minibuffer_only
;
3356 XClassHint class_hints
;
3357 XSetWindowAttributes attributes
;
3358 unsigned long attribute_mask
;
3360 Widget shell_widget
;
3362 Widget frame_widget
;
3368 /* Use the resource name as the top-level widget name
3369 for looking up resources. Make a non-Lisp copy
3370 for the window manager, so GC relocation won't bother it.
3372 Elsewhere we specify the window name for the window manager. */
3375 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3376 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3377 strcpy (f
->namebuf
, str
);
3381 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3382 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3383 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3384 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3385 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3386 applicationShellWidgetClass
,
3387 FRAME_X_DISPLAY (f
), al
, ac
);
3389 f
->output_data
.x
->widget
= shell_widget
;
3390 /* maybe_set_screen_title_format (shell_widget); */
3392 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3393 (widget_value
*) NULL
,
3394 shell_widget
, False
,
3398 (lw_callback
) NULL
);
3400 f
->output_data
.x
->column_widget
= pane_widget
;
3402 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3403 the emacs screen when changing menubar. This reduces flickering. */
3406 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3407 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3408 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3409 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3410 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3411 frame_widget
= XtCreateWidget (f
->namebuf
,
3413 pane_widget
, al
, ac
);
3415 f
->output_data
.x
->edit_widget
= frame_widget
;
3417 XtManageChild (frame_widget
);
3419 /* Do some needed geometry management. */
3422 char *tem
, shell_position
[32];
3425 int extra_borders
= 0;
3427 = (f
->output_data
.x
->menubar_widget
3428 ? (f
->output_data
.x
->menubar_widget
->core
.height
3429 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3432 #if 0 /* Experimentally, we now get the right results
3433 for -geometry -0-0 without this. 24 Aug 96, rms. */
3434 if (FRAME_EXTERNAL_MENU_BAR (f
))
3437 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3438 menubar_size
+= ibw
;
3442 f
->output_data
.x
->menubar_height
= menubar_size
;
3445 /* Motif seems to need this amount added to the sizes
3446 specified for the shell widget. The Athena/Lucid widgets don't.
3447 Both conclusions reached experimentally. -- rms. */
3448 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3449 &extra_borders
, NULL
);
3453 /* Convert our geometry parameters into a geometry string
3455 Note that we do not specify here whether the position
3456 is a user-specified or program-specified one.
3457 We pass that information later, in x_wm_set_size_hints. */
3459 int left
= f
->output_data
.x
->left_pos
;
3460 int xneg
= window_prompting
& XNegative
;
3461 int top
= f
->output_data
.x
->top_pos
;
3462 int yneg
= window_prompting
& YNegative
;
3468 if (window_prompting
& USPosition
)
3469 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3470 PIXEL_WIDTH (f
) + extra_borders
,
3471 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3472 (xneg
? '-' : '+'), left
,
3473 (yneg
? '-' : '+'), top
);
3475 sprintf (shell_position
, "=%dx%d",
3476 PIXEL_WIDTH (f
) + extra_borders
,
3477 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3480 len
= strlen (shell_position
) + 1;
3481 /* We don't free this because we don't know whether
3482 it is safe to free it while the frame exists.
3483 It isn't worth the trouble of arranging to free it
3484 when the frame is deleted. */
3485 tem
= (char *) xmalloc (len
);
3486 strncpy (tem
, shell_position
, len
);
3487 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3488 XtSetValues (shell_widget
, al
, ac
);
3491 XtManageChild (pane_widget
);
3492 XtRealizeWidget (shell_widget
);
3494 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3496 validate_x_resource_name ();
3498 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3499 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3500 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3503 FRAME_XIC (f
) = NULL
;
3504 create_frame_xic (f
);
3507 f
->output_data
.x
->wm_hints
.input
= True
;
3508 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3509 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3510 &f
->output_data
.x
->wm_hints
);
3512 hack_wm_protocols (f
, shell_widget
);
3515 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3518 /* Do a stupid property change to force the server to generate a
3519 PropertyNotify event so that the event_stream server timestamp will
3520 be initialized to something relevant to the time we created the window.
3522 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3523 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3524 XA_ATOM
, 32, PropModeAppend
,
3525 (unsigned char*) NULL
, 0);
3527 /* Make all the standard events reach the Emacs frame. */
3528 attributes
.event_mask
= STANDARD_EVENT_SET
;
3533 /* XIM server might require some X events. */
3534 unsigned long fevent
= NoEventMask
;
3535 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3536 attributes
.event_mask
|= fevent
;
3538 #endif /* HAVE_X_I18N */
3540 attribute_mask
= CWEventMask
;
3541 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3542 attribute_mask
, &attributes
);
3544 XtMapWidget (frame_widget
);
3546 /* x_set_name normally ignores requests to set the name if the
3547 requested name is the same as the current name. This is the one
3548 place where that assumption isn't correct; f->name is set, but
3549 the X server hasn't been told. */
3552 int explicit = f
->explicit_name
;
3554 f
->explicit_name
= 0;
3557 x_set_name (f
, name
, explicit);
3560 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3561 f
->output_data
.x
->text_cursor
);
3565 /* This is a no-op, except under Motif. Make sure main areas are
3566 set to something reasonable, in case we get an error later. */
3567 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3570 #else /* not USE_X_TOOLKIT */
3572 /* Create and set up the X window for frame F. */
3579 XClassHint class_hints
;
3580 XSetWindowAttributes attributes
;
3581 unsigned long attribute_mask
;
3583 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3584 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3585 attributes
.bit_gravity
= StaticGravity
;
3586 attributes
.backing_store
= NotUseful
;
3587 attributes
.save_under
= True
;
3588 attributes
.event_mask
= STANDARD_EVENT_SET
;
3589 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
3591 | CWBackingStore
| CWSaveUnder
3597 = XCreateWindow (FRAME_X_DISPLAY (f
),
3598 f
->output_data
.x
->parent_desc
,
3599 f
->output_data
.x
->left_pos
,
3600 f
->output_data
.x
->top_pos
,
3601 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3602 f
->output_data
.x
->border_width
,
3603 CopyFromParent
, /* depth */
3604 InputOutput
, /* class */
3605 FRAME_X_DISPLAY_INFO (f
)->visual
,
3606 attribute_mask
, &attributes
);
3609 create_frame_xic (f
);
3612 /* XIM server might require some X events. */
3613 unsigned long fevent
= NoEventMask
;
3614 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3615 attributes
.event_mask
|= fevent
;
3616 attribute_mask
= CWEventMask
;
3617 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3618 attribute_mask
, &attributes
);
3620 #endif /* HAVE_X_I18N */
3622 validate_x_resource_name ();
3624 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3625 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3626 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3628 /* The menubar is part of the ordinary display;
3629 it does not count in addition to the height of the window. */
3630 f
->output_data
.x
->menubar_height
= 0;
3632 /* This indicates that we use the "Passive Input" input model.
3633 Unless we do this, we don't get the Focus{In,Out} events that we
3634 need to draw the cursor correctly. Accursed bureaucrats.
3635 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3637 f
->output_data
.x
->wm_hints
.input
= True
;
3638 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3639 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3640 &f
->output_data
.x
->wm_hints
);
3641 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3643 /* Request "save yourself" and "delete window" commands from wm. */
3646 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3647 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3648 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3651 /* x_set_name normally ignores requests to set the name if the
3652 requested name is the same as the current name. This is the one
3653 place where that assumption isn't correct; f->name is set, but
3654 the X server hasn't been told. */
3657 int explicit = f
->explicit_name
;
3659 f
->explicit_name
= 0;
3662 x_set_name (f
, name
, explicit);
3665 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3666 f
->output_data
.x
->text_cursor
);
3670 if (FRAME_X_WINDOW (f
) == 0)
3671 error ("Unable to create window");
3674 #endif /* not USE_X_TOOLKIT */
3676 /* Handle the icon stuff for this window. Perhaps later we might
3677 want an x_set_icon_position which can be called interactively as
3685 Lisp_Object icon_x
, icon_y
;
3686 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3688 /* Set the position of the icon. Note that twm groups all
3689 icons in an icon window. */
3690 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3691 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3692 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3694 CHECK_NUMBER (icon_x
, 0);
3695 CHECK_NUMBER (icon_y
, 0);
3697 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3698 error ("Both left and top icon corners of icon must be specified");
3702 if (! EQ (icon_x
, Qunbound
))
3703 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3705 /* Start up iconic or window? */
3706 x_wm_set_window_state
3707 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3712 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3719 /* Make the GC's needed for this window, setting the
3720 background, border and mouse colors; also create the
3721 mouse cursor and the gray border tile. */
3723 static char cursor_bits
[] =
3725 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3726 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3727 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3728 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3735 XGCValues gc_values
;
3739 /* Create the GC's of this frame.
3740 Note that many default values are used. */
3743 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3744 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3745 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3746 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3747 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3749 GCLineWidth
| GCFont
3750 | GCForeground
| GCBackground
,
3753 /* Reverse video style. */
3754 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3755 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3756 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3758 GCFont
| GCForeground
| GCBackground
3762 /* Cursor has cursor-color background, background-color foreground. */
3763 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3764 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3765 gc_values
.fill_style
= FillOpaqueStippled
;
3767 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3768 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3769 cursor_bits
, 16, 16);
3770 f
->output_data
.x
->cursor_gc
3771 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3772 (GCFont
| GCForeground
| GCBackground
3773 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3777 f
->output_data
.x
->white_relief
.gc
= 0;
3778 f
->output_data
.x
->black_relief
.gc
= 0;
3780 /* Create the gray border tile used when the pointer is not in
3781 the frame. Since this depends on the frame's pixel values,
3782 this must be done on a per-frame basis. */
3783 f
->output_data
.x
->border_tile
3784 = (XCreatePixmapFromBitmapData
3785 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3786 gray_bits
, gray_width
, gray_height
,
3787 f
->output_data
.x
->foreground_pixel
,
3788 f
->output_data
.x
->background_pixel
,
3789 DefaultDepth (FRAME_X_DISPLAY (f
),
3790 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3795 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3797 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3798 Returns an Emacs frame object.\n\
3799 ALIST is an alist of frame parameters.\n\
3800 If the parameters specify that the frame should not have a minibuffer,\n\
3801 and do not specify a specific minibuffer window to use,\n\
3802 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3803 be shared by the new frame.\n\
3805 This function is an internal primitive--use `make-frame' instead.")
3810 Lisp_Object frame
, tem
;
3812 int minibuffer_only
= 0;
3813 long window_prompting
= 0;
3815 int count
= specpdl_ptr
- specpdl
;
3816 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3817 Lisp_Object display
;
3818 struct x_display_info
*dpyinfo
= NULL
;
3824 /* Use this general default value to start with
3825 until we know if this frame has a specified name. */
3826 Vx_resource_name
= Vinvocation_name
;
3828 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3829 if (EQ (display
, Qunbound
))
3831 dpyinfo
= check_x_display_info (display
);
3833 kb
= dpyinfo
->kboard
;
3835 kb
= &the_only_kboard
;
3838 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3840 && ! EQ (name
, Qunbound
)
3842 error ("Invalid frame name--not a string or nil");
3845 Vx_resource_name
= name
;
3847 /* See if parent window is specified. */
3848 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
3849 if (EQ (parent
, Qunbound
))
3851 if (! NILP (parent
))
3852 CHECK_NUMBER (parent
, 0);
3854 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3855 /* No need to protect DISPLAY because that's not used after passing
3856 it to make_frame_without_minibuffer. */
3858 GCPRO4 (parms
, parent
, name
, frame
);
3859 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
3861 if (EQ (tem
, Qnone
) || NILP (tem
))
3862 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3863 else if (EQ (tem
, Qonly
))
3865 f
= make_minibuffer_frame ();
3866 minibuffer_only
= 1;
3868 else if (WINDOWP (tem
))
3869 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3873 XSETFRAME (frame
, f
);
3875 /* Note that X Windows does support scroll bars. */
3876 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3878 f
->output_method
= output_x_window
;
3879 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
3880 bzero (f
->output_data
.x
, sizeof (struct x_output
));
3881 f
->output_data
.x
->icon_bitmap
= -1;
3882 f
->output_data
.x
->fontset
= -1;
3883 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
3884 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
3887 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
3889 if (! STRINGP (f
->icon_name
))
3890 f
->icon_name
= Qnil
;
3892 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
3894 FRAME_KBOARD (f
) = kb
;
3897 /* Specify the parent under which to make this X window. */
3901 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
3902 f
->output_data
.x
->explicit_parent
= 1;
3906 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3907 f
->output_data
.x
->explicit_parent
= 0;
3910 /* Set the name; the functions to which we pass f expect the name to
3912 if (EQ (name
, Qunbound
) || NILP (name
))
3914 f
->name
= build_string (dpyinfo
->x_id_name
);
3915 f
->explicit_name
= 0;
3920 f
->explicit_name
= 1;
3921 /* use the frame's title when getting resources for this frame. */
3922 specbind (Qx_resource_name
, name
);
3925 /* Create fontsets from `global_fontset_alist' before handling fonts. */
3926 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
3927 fs_register_fontset (f
, XCAR (tem
));
3929 /* Extract the window parameters from the supplied values
3930 that are needed to determine window geometry. */
3934 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
3937 /* First, try whatever font the caller has specified. */
3940 tem
= Fquery_fontset (font
, Qnil
);
3942 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
3944 font
= x_new_font (f
, XSTRING (font
)->data
);
3947 /* Try out a font which we hope has bold and italic variations. */
3948 if (!STRINGP (font
))
3949 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3950 if (!STRINGP (font
))
3951 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3952 if (! STRINGP (font
))
3953 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3954 if (! STRINGP (font
))
3955 /* This was formerly the first thing tried, but it finds too many fonts
3956 and takes too long. */
3957 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3958 /* If those didn't work, look for something which will at least work. */
3959 if (! STRINGP (font
))
3960 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3962 if (! STRINGP (font
))
3963 font
= build_string ("fixed");
3965 x_default_parameter (f
, parms
, Qfont
, font
,
3966 "font", "Font", RES_TYPE_STRING
);
3970 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3971 whereby it fails to get any font. */
3972 xlwmenu_default_font
= f
->output_data
.x
->font
;
3975 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3976 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
3978 /* This defaults to 2 in order to match xterm. We recognize either
3979 internalBorderWidth or internalBorder (which is what xterm calls
3981 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3985 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
3986 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
3987 if (! EQ (value
, Qunbound
))
3988 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3991 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
3992 "internalBorderWidth", "internalBorderWidth",
3994 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
3995 "verticalScrollBars", "ScrollBars",
3998 /* Also do the stuff which must be set before the window exists. */
3999 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4000 "foreground", "Foreground", RES_TYPE_STRING
);
4001 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4002 "background", "Background", RES_TYPE_STRING
);
4003 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4004 "pointerColor", "Foreground", RES_TYPE_STRING
);
4005 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4006 "cursorColor", "Foreground", RES_TYPE_STRING
);
4007 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4008 "borderColor", "BorderColor", RES_TYPE_STRING
);
4009 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4010 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4012 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4013 "scrollBarForeground",
4014 "ScrollBarForeground", 1);
4015 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4016 "scrollBarBackground",
4017 "ScrollBarBackground", 0);
4019 /* Init faces before x_default_parameter is called for scroll-bar
4020 parameters because that function calls x_set_scroll_bar_width,
4021 which calls change_frame_size, which calls Fset_window_buffer,
4022 which runs hooks, which call Fvertical_motion. At the end, we
4023 end up in init_iterator with a null face cache, which should not
4025 init_frame_faces (f
);
4027 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4028 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4029 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
4030 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4031 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4032 "bufferPredicate", "BufferPredicate",
4034 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4035 "title", "Title", RES_TYPE_STRING
);
4037 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4038 window_prompting
= x_figure_window_size (f
, parms
);
4040 if (window_prompting
& XNegative
)
4042 if (window_prompting
& YNegative
)
4043 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4045 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4049 if (window_prompting
& YNegative
)
4050 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4052 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4055 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4057 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4058 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4060 /* Create the X widget or window. Add the tool-bar height to the
4061 initial frame height so that the user gets a text display area of
4062 the size he specified with -g or via .Xdefaults. Later changes
4063 of the tool-bar height don't change the frame size. This is done
4064 so that users can create tall Emacs frames without having to
4065 guess how tall the tool-bar will get. */
4066 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
4068 #ifdef USE_X_TOOLKIT
4069 x_window (f
, window_prompting
, minibuffer_only
);
4077 /* Now consider the frame official. */
4078 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4079 Vframe_list
= Fcons (frame
, Vframe_list
);
4081 /* We need to do this after creating the X window, so that the
4082 icon-creation functions can say whose icon they're describing. */
4083 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4084 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4086 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4087 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4088 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4089 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4090 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4091 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4092 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4093 "scrollBarWidth", "ScrollBarWidth",
4096 /* Dimensions, especially f->height, must be done via change_frame_size.
4097 Change will not be effected unless different from the current
4102 SET_FRAME_WIDTH (f
, 0);
4103 change_frame_size (f
, height
, width
, 1, 0, 0);
4105 /* Set up faces after all frame parameters are known. */
4106 call1 (Qface_set_after_frame_default
, frame
);
4108 #ifdef USE_X_TOOLKIT
4109 /* Create the menu bar. */
4110 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4112 /* If this signals an error, we haven't set size hints for the
4113 frame and we didn't make it visible. */
4114 initialize_frame_menubar (f
);
4116 /* This is a no-op, except under Motif where it arranges the
4117 main window for the widgets on it. */
4118 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4119 f
->output_data
.x
->menubar_widget
,
4120 f
->output_data
.x
->edit_widget
);
4122 #endif /* USE_X_TOOLKIT */
4124 /* Tell the server what size and position, etc, we want, and how
4125 badly we want them. This should be done after we have the menu
4126 bar so that its size can be taken into account. */
4128 x_wm_set_size_hint (f
, window_prompting
, 0);
4131 /* Make the window appear on the frame and enable display, unless
4132 the caller says not to. However, with explicit parent, Emacs
4133 cannot control visibility, so don't try. */
4134 if (! f
->output_data
.x
->explicit_parent
)
4136 Lisp_Object visibility
;
4138 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4140 if (EQ (visibility
, Qunbound
))
4143 if (EQ (visibility
, Qicon
))
4144 x_iconify_frame (f
);
4145 else if (! NILP (visibility
))
4146 x_make_frame_visible (f
);
4148 /* Must have been Qnil. */
4153 return unbind_to (count
, frame
);
4156 /* FRAME is used only to get a handle on the X display. We don't pass the
4157 display info directly because we're called from frame.c, which doesn't
4158 know about that structure. */
4161 x_get_focus_frame (frame
)
4162 struct frame
*frame
;
4164 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4166 if (! dpyinfo
->x_focus_frame
)
4169 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4174 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4175 "Internal function called by `color-defined-p', which see.")
4177 Lisp_Object color
, frame
;
4180 FRAME_PTR f
= check_x_frame (frame
);
4182 CHECK_STRING (color
, 1);
4184 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4190 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4191 "Internal function called by `color-values', which see.")
4193 Lisp_Object color
, frame
;
4196 FRAME_PTR f
= check_x_frame (frame
);
4198 CHECK_STRING (color
, 1);
4200 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4204 rgb
[0] = make_number (foo
.red
);
4205 rgb
[1] = make_number (foo
.green
);
4206 rgb
[2] = make_number (foo
.blue
);
4207 return Flist (3, rgb
);
4213 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4214 "Internal function called by `display-color-p', which see.")
4216 Lisp_Object display
;
4218 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4220 if (dpyinfo
->n_planes
<= 2)
4223 switch (dpyinfo
->visual
->class)
4236 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4238 "Return t if the X display supports shades of gray.\n\
4239 Note that color displays do support shades of gray.\n\
4240 The optional argument DISPLAY specifies which display to ask about.\n\
4241 DISPLAY should be either a frame or a display name (a string).\n\
4242 If omitted or nil, that stands for the selected frame's display.")
4244 Lisp_Object display
;
4246 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4248 if (dpyinfo
->n_planes
<= 1)
4251 switch (dpyinfo
->visual
->class)
4266 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4268 "Returns the width in pixels of the X display DISPLAY.\n\
4269 The optional argument DISPLAY specifies which display to ask about.\n\
4270 DISPLAY should be either a frame or a display name (a string).\n\
4271 If omitted or nil, that stands for the selected frame's display.")
4273 Lisp_Object display
;
4275 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4277 return make_number (dpyinfo
->width
);
4280 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4281 Sx_display_pixel_height
, 0, 1, 0,
4282 "Returns the height in pixels of the X display DISPLAY.\n\
4283 The optional argument DISPLAY specifies which display to ask about.\n\
4284 DISPLAY should be either a frame or a display name (a string).\n\
4285 If omitted or nil, that stands for the selected frame's display.")
4287 Lisp_Object display
;
4289 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4291 return make_number (dpyinfo
->height
);
4294 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4296 "Returns the number of bitplanes of the X display DISPLAY.\n\
4297 The optional argument DISPLAY specifies which display to ask about.\n\
4298 DISPLAY should be either a frame or a display name (a string).\n\
4299 If omitted or nil, that stands for the selected frame's display.")
4301 Lisp_Object display
;
4303 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4305 return make_number (dpyinfo
->n_planes
);
4308 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4310 "Returns the number of color cells of the X display DISPLAY.\n\
4311 The optional argument DISPLAY specifies which display to ask about.\n\
4312 DISPLAY should be either a frame or a display name (a string).\n\
4313 If omitted or nil, that stands for the selected frame's display.")
4315 Lisp_Object display
;
4317 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4319 return make_number (DisplayCells (dpyinfo
->display
,
4320 XScreenNumberOfScreen (dpyinfo
->screen
)));
4323 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4324 Sx_server_max_request_size
,
4326 "Returns the maximum request size of the X server of display DISPLAY.\n\
4327 The optional argument DISPLAY specifies which display to ask about.\n\
4328 DISPLAY should be either a frame or a display name (a string).\n\
4329 If omitted or nil, that stands for the selected frame's display.")
4331 Lisp_Object display
;
4333 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4335 return make_number (MAXREQUEST (dpyinfo
->display
));
4338 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4339 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4340 The optional argument DISPLAY specifies which display to ask about.\n\
4341 DISPLAY should be either a frame or a display name (a string).\n\
4342 If omitted or nil, that stands for the selected frame's display.")
4344 Lisp_Object display
;
4346 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4347 char *vendor
= ServerVendor (dpyinfo
->display
);
4349 if (! vendor
) vendor
= "";
4350 return build_string (vendor
);
4353 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4354 "Returns the version numbers of the X server of display DISPLAY.\n\
4355 The value is a list of three integers: the major and minor\n\
4356 version numbers of the X Protocol in use, and the vendor-specific release\n\
4357 number. See also the function `x-server-vendor'.\n\n\
4358 The optional argument DISPLAY specifies which display to ask about.\n\
4359 DISPLAY should be either a frame or a display name (a string).\n\
4360 If omitted or nil, that stands for the selected frame's display.")
4362 Lisp_Object display
;
4364 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4365 Display
*dpy
= dpyinfo
->display
;
4367 return Fcons (make_number (ProtocolVersion (dpy
)),
4368 Fcons (make_number (ProtocolRevision (dpy
)),
4369 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4372 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4373 "Returns the number of screens on the X server of display DISPLAY.\n\
4374 The optional argument DISPLAY specifies which display to ask about.\n\
4375 DISPLAY should be either a frame or a display name (a string).\n\
4376 If omitted or nil, that stands for the selected frame's display.")
4378 Lisp_Object display
;
4380 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4382 return make_number (ScreenCount (dpyinfo
->display
));
4385 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4386 "Returns the height in millimeters of the X display DISPLAY.\n\
4387 The optional argument DISPLAY specifies which display to ask about.\n\
4388 DISPLAY should be either a frame or a display name (a string).\n\
4389 If omitted or nil, that stands for the selected frame's display.")
4391 Lisp_Object display
;
4393 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4395 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4398 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4399 "Returns the width in millimeters of the X display DISPLAY.\n\
4400 The optional argument DISPLAY specifies which display to ask about.\n\
4401 DISPLAY should be either a frame or a display name (a string).\n\
4402 If omitted or nil, that stands for the selected frame's display.")
4404 Lisp_Object display
;
4406 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4408 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4411 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4412 Sx_display_backing_store
, 0, 1, 0,
4413 "Returns an indication of whether X display DISPLAY does backing store.\n\
4414 The value may be `always', `when-mapped', or `not-useful'.\n\
4415 The optional argument DISPLAY specifies which display to ask about.\n\
4416 DISPLAY should be either a frame or a display name (a string).\n\
4417 If omitted or nil, that stands for the selected frame's display.")
4419 Lisp_Object display
;
4421 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4423 switch (DoesBackingStore (dpyinfo
->screen
))
4426 return intern ("always");
4429 return intern ("when-mapped");
4432 return intern ("not-useful");
4435 error ("Strange value for BackingStore parameter of screen");
4439 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4440 Sx_display_visual_class
, 0, 1, 0,
4441 "Returns the visual class of the X display DISPLAY.\n\
4442 The value is one of the symbols `static-gray', `gray-scale',\n\
4443 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4444 The optional argument DISPLAY specifies which display to ask about.\n\
4445 DISPLAY should be either a frame or a display name (a string).\n\
4446 If omitted or nil, that stands for the selected frame's display.")
4448 Lisp_Object display
;
4450 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4452 switch (dpyinfo
->visual
->class)
4454 case StaticGray
: return (intern ("static-gray"));
4455 case GrayScale
: return (intern ("gray-scale"));
4456 case StaticColor
: return (intern ("static-color"));
4457 case PseudoColor
: return (intern ("pseudo-color"));
4458 case TrueColor
: return (intern ("true-color"));
4459 case DirectColor
: return (intern ("direct-color"));
4461 error ("Display has an unknown visual class");
4465 DEFUN ("x-display-save-under", Fx_display_save_under
,
4466 Sx_display_save_under
, 0, 1, 0,
4467 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4468 The optional argument DISPLAY specifies which display to ask about.\n\
4469 DISPLAY should be either a frame or a display name (a string).\n\
4470 If omitted or nil, that stands for the selected frame's display.")
4472 Lisp_Object display
;
4474 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4476 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4484 register struct frame
*f
;
4486 return PIXEL_WIDTH (f
);
4491 register struct frame
*f
;
4493 return PIXEL_HEIGHT (f
);
4498 register struct frame
*f
;
4500 return FONT_WIDTH (f
->output_data
.x
->font
);
4505 register struct frame
*f
;
4507 return f
->output_data
.x
->line_height
;
4512 register struct frame
*f
;
4514 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4517 #if 0 /* These no longer seem like the right way to do things. */
4519 /* Draw a rectangle on the frame with left top corner including
4520 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
4521 CHARS by LINES wide and long and is the color of the cursor. */
4524 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
4525 register struct frame
*f
;
4527 register int top_char
, left_char
, chars
, lines
;
4531 int left
= (left_char
* FONT_WIDTH (f
->output_data
.x
->font
)
4532 + f
->output_data
.x
->internal_border_width
);
4533 int top
= (top_char
* f
->output_data
.x
->line_height
4534 + f
->output_data
.x
->internal_border_width
);
4537 width
= FONT_WIDTH (f
->output_data
.x
->font
) / 2;
4539 width
= FONT_WIDTH (f
->output_data
.x
->font
) * chars
;
4541 height
= f
->output_data
.x
->line_height
/ 2;
4543 height
= f
->output_data
.x
->line_height
* lines
;
4545 XDrawRectangle (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4546 gc
, left
, top
, width
, height
);
4549 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
4550 "Draw a rectangle on FRAME between coordinates specified by\n\
4551 numbers X0, Y0, X1, Y1 in the cursor pixel.")
4552 (frame
, X0
, Y0
, X1
, Y1
)
4553 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
4555 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4557 CHECK_LIVE_FRAME (frame
, 0);
4558 CHECK_NUMBER (X0
, 0);
4559 CHECK_NUMBER (Y0
, 1);
4560 CHECK_NUMBER (X1
, 2);
4561 CHECK_NUMBER (Y1
, 3);
4571 n_lines
= y1
- y0
+ 1;
4576 n_lines
= y0
- y1
+ 1;
4582 n_chars
= x1
- x0
+ 1;
4587 n_chars
= x0
- x1
+ 1;
4591 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->cursor_gc
,
4592 left
, top
, n_chars
, n_lines
);
4598 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
4599 "Draw a rectangle drawn on FRAME between coordinates\n\
4600 X0, Y0, X1, Y1 in the regular background-pixel.")
4601 (frame
, X0
, Y0
, X1
, Y1
)
4602 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
4604 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4606 CHECK_LIVE_FRAME (frame
, 0);
4607 CHECK_NUMBER (X0
, 0);
4608 CHECK_NUMBER (Y0
, 1);
4609 CHECK_NUMBER (X1
, 2);
4610 CHECK_NUMBER (Y1
, 3);
4620 n_lines
= y1
- y0
+ 1;
4625 n_lines
= y0
- y1
+ 1;
4631 n_chars
= x1
- x0
+ 1;
4636 n_chars
= x0
- x1
+ 1;
4640 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->reverse_gc
,
4641 left
, top
, n_chars
, n_lines
);
4647 /* Draw lines around the text region beginning at the character position
4648 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4649 pixel and line characteristics. */
4651 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4654 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
4655 register struct frame
*f
;
4657 int top_x
, top_y
, bottom_x
, bottom_y
;
4659 register int ibw
= f
->output_data
.x
->internal_border_width
;
4660 register int font_w
= FONT_WIDTH (f
->output_data
.x
->font
);
4661 register int font_h
= f
->output_data
.x
->line_height
;
4663 int x
= line_len (y
);
4664 XPoint
*pixel_points
4665 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
4666 register XPoint
*this_point
= pixel_points
;
4668 /* Do the horizontal top line/lines */
4671 this_point
->x
= ibw
;
4672 this_point
->y
= ibw
+ (font_h
* top_y
);
4675 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
4677 this_point
->x
= ibw
+ (font_w
* x
);
4678 this_point
->y
= (this_point
- 1)->y
;
4682 this_point
->x
= ibw
;
4683 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
4685 this_point
->x
= ibw
+ (font_w
* top_x
);
4686 this_point
->y
= (this_point
- 1)->y
;
4688 this_point
->x
= (this_point
- 1)->x
;
4689 this_point
->y
= ibw
+ (font_h
* top_y
);
4691 this_point
->x
= ibw
+ (font_w
* x
);
4692 this_point
->y
= (this_point
- 1)->y
;
4695 /* Now do the right side. */
4696 while (y
< bottom_y
)
4697 { /* Right vertical edge */
4699 this_point
->x
= (this_point
- 1)->x
;
4700 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
4703 y
++; /* Horizontal connection to next line */
4706 this_point
->x
= ibw
+ (font_w
/ 2);
4708 this_point
->x
= ibw
+ (font_w
* x
);
4710 this_point
->y
= (this_point
- 1)->y
;
4713 /* Now do the bottom and connect to the top left point. */
4714 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
4717 this_point
->x
= (this_point
- 1)->x
;
4718 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
4720 this_point
->x
= ibw
;
4721 this_point
->y
= (this_point
- 1)->y
;
4723 this_point
->x
= pixel_points
->x
;
4724 this_point
->y
= pixel_points
->y
;
4726 XDrawLines (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4728 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
4731 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
4732 "Highlight the region between point and the character under the mouse\n\
4735 register Lisp_Object event
;
4737 register int x0
, y0
, x1
, y1
;
4738 register struct frame
*f
= selected_frame
;
4739 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4740 register int p1
, p2
;
4742 CHECK_CONS (event
, 0);
4745 x0
= XINT (Fcar (Fcar (event
)));
4746 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4748 /* If the mouse is past the end of the line, don't that area. */
4749 /* ReWrite this... */
4751 /* Where the cursor is. */
4752 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4753 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4755 if (y1
> y0
) /* point below mouse */
4756 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4758 else if (y1
< y0
) /* point above mouse */
4759 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4761 else /* same line: draw horizontal rectangle */
4764 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4765 x0
, y0
, (x1
- x0
+ 1), 1);
4767 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4768 x1
, y1
, (x0
- x1
+ 1), 1);
4771 XFlush (FRAME_X_DISPLAY (f
));
4777 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
4778 "Erase any highlighting of the region between point and the character\n\
4779 at X, Y on the selected frame.")
4781 register Lisp_Object event
;
4783 register int x0
, y0
, x1
, y1
;
4784 register struct frame
*f
= selected_frame
;
4785 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4788 x0
= XINT (Fcar (Fcar (event
)));
4789 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4790 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4791 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4793 if (y1
> y0
) /* point below mouse */
4794 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4796 else if (y1
< y0
) /* point above mouse */
4797 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4799 else /* same line: draw horizontal rectangle */
4802 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4803 x0
, y0
, (x1
- x0
+ 1), 1);
4805 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4806 x1
, y1
, (x0
- x1
+ 1), 1);
4814 int contour_begin_x
, contour_begin_y
;
4815 int contour_end_x
, contour_end_y
;
4816 int contour_npoints
;
4818 /* Clip the top part of the contour lines down (and including) line Y_POS.
4819 If X_POS is in the middle (rather than at the end) of the line, drop
4820 down a line at that character. */
4823 clip_contour_top (y_pos
, x_pos
)
4825 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
4826 register XPoint
*end
;
4827 register int npoints
;
4828 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
4830 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
4832 end
= contour_lines
[y_pos
].top_right
;
4833 npoints
= (end
- begin
+ 1);
4834 XDrawLines (x_current_display
, contour_window
,
4835 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4837 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
4838 contour_last_point
-= (npoints
- 2);
4839 XDrawLines (x_current_display
, contour_window
,
4840 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
4841 XFlush (x_current_display
);
4843 /* Now, update contour_lines structure. */
4848 register XPoint
*p
= begin
+ 1;
4849 end
= contour_lines
[y_pos
].bottom_right
;
4850 npoints
= (end
- begin
+ 1);
4851 XDrawLines (x_current_display
, contour_window
,
4852 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4855 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
4857 p
->y
= begin
->y
+ font_h
;
4859 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
4860 contour_last_point
-= (npoints
- 5);
4861 XDrawLines (x_current_display
, contour_window
,
4862 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
4863 XFlush (x_current_display
);
4865 /* Now, update contour_lines structure. */
4869 /* Erase the top horizontal lines of the contour, and then extend
4870 the contour upwards. */
4873 extend_contour_top (line
)
4878 clip_contour_bottom (x_pos
, y_pos
)
4884 extend_contour_bottom (x_pos
, y_pos
)
4888 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
4893 register struct frame
*f
= selected_frame
;
4894 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4895 register int point_x
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4896 register int point_y
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4897 register int mouse_below_point
;
4898 register Lisp_Object obj
;
4899 register int x_contour_x
, x_contour_y
;
4901 x_contour_x
= x_mouse_x
;
4902 x_contour_y
= x_mouse_y
;
4903 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
4904 && x_contour_x
> point_x
))
4906 mouse_below_point
= 1;
4907 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4908 x_contour_x
, x_contour_y
);
4912 mouse_below_point
= 0;
4913 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
4919 obj
= read_char (-1, 0, 0, Qnil
, 0);
4923 if (mouse_below_point
)
4925 if (x_mouse_y
<= point_y
) /* Flipped. */
4927 mouse_below_point
= 0;
4929 outline_region (f
, f
->output_data
.x
->reverse_gc
, point_x
, point_y
,
4930 x_contour_x
, x_contour_y
);
4931 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
4934 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
4936 clip_contour_bottom (x_mouse_y
);
4938 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
4940 extend_bottom_contour (x_mouse_y
);
4943 x_contour_x
= x_mouse_x
;
4944 x_contour_y
= x_mouse_y
;
4946 else /* mouse above or same line as point */
4948 if (x_mouse_y
>= point_y
) /* Flipped. */
4950 mouse_below_point
= 1;
4952 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4953 x_contour_x
, x_contour_y
, point_x
, point_y
);
4954 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4955 x_mouse_x
, x_mouse_y
);
4957 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
4959 clip_contour_top (x_mouse_y
);
4961 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
4963 extend_contour_top (x_mouse_y
);
4968 unread_command_event
= obj
;
4969 if (mouse_below_point
)
4971 contour_begin_x
= point_x
;
4972 contour_begin_y
= point_y
;
4973 contour_end_x
= x_contour_x
;
4974 contour_end_y
= x_contour_y
;
4978 contour_begin_x
= x_contour_x
;
4979 contour_begin_y
= x_contour_y
;
4980 contour_end_x
= point_x
;
4981 contour_end_y
= point_y
;
4986 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
4991 register Lisp_Object obj
;
4992 struct frame
*f
= selected_frame
;
4993 register struct window
*w
= XWINDOW (selected_window
);
4994 register GC line_gc
= f
->output_data
.x
->cursor_gc
;
4995 register GC erase_gc
= f
->output_data
.x
->reverse_gc
;
4997 char dash_list
[] = {6, 4, 6, 4};
4999 XGCValues gc_values
;
5001 register int previous_y
;
5002 register int line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
5003 + f
->output_data
.x
->internal_border_width
;
5004 register int left
= f
->output_data
.x
->internal_border_width
5005 + (WINDOW_LEFT_MARGIN (w
)
5006 * FONT_WIDTH (f
->output_data
.x
->font
));
5007 register int right
= left
+ (w
->width
5008 * FONT_WIDTH (f
->output_data
.x
->font
))
5009 - f
->output_data
.x
->internal_border_width
;
5013 gc_values
.foreground
= f
->output_data
.x
->cursor_pixel
;
5014 gc_values
.background
= f
->output_data
.x
->background_pixel
;
5015 gc_values
.line_width
= 1;
5016 gc_values
.line_style
= LineOnOffDash
;
5017 gc_values
.cap_style
= CapRound
;
5018 gc_values
.join_style
= JoinRound
;
5020 line_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
5021 GCLineStyle
| GCJoinStyle
| GCCapStyle
5022 | GCLineWidth
| GCForeground
| GCBackground
,
5024 XSetDashes (FRAME_X_DISPLAY (f
), line_gc
, 0, dash_list
, dashes
);
5025 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
5026 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
5027 erase_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
5028 GCLineStyle
| GCJoinStyle
| GCCapStyle
5029 | GCLineWidth
| GCForeground
| GCBackground
,
5031 XSetDashes (FRAME_X_DISPLAY (f
), erase_gc
, 0, dash_list
, dashes
);
5038 if (x_mouse_y
>= XINT (w
->top
)
5039 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
5041 previous_y
= x_mouse_y
;
5042 line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
5043 + f
->output_data
.x
->internal_border_width
;
5044 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
5045 line_gc
, left
, line
, right
, line
);
5047 XFlush (FRAME_X_DISPLAY (f
));
5052 obj
= read_char (-1, 0, 0, Qnil
, 0);
5054 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
5055 Qvertical_scroll_bar
))
5059 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
5060 erase_gc
, left
, line
, right
, line
);
5061 unread_command_event
= obj
;
5063 XFreeGC (FRAME_X_DISPLAY (f
), line_gc
);
5064 XFreeGC (FRAME_X_DISPLAY (f
), erase_gc
);
5070 while (x_mouse_y
== previous_y
);
5073 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
5074 erase_gc
, left
, line
, right
, line
);
5081 /* These keep track of the rectangle following the pointer. */
5082 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
5084 /* Offset in buffer of character under the pointer, or 0. */
5085 int mouse_buffer_offset
;
5087 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
5088 "Track the pointer.")
5091 static Cursor current_pointer_shape
;
5092 FRAME_PTR f
= x_mouse_frame
;
5095 if (EQ (Vmouse_frame_part
, Qtext_part
)
5096 && (current_pointer_shape
!= f
->output_data
.x
->nontext_cursor
))
5101 current_pointer_shape
= f
->output_data
.x
->nontext_cursor
;
5102 XDefineCursor (FRAME_X_DISPLAY (f
),
5104 current_pointer_shape
);
5106 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
5107 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
5109 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
5110 && (current_pointer_shape
!= f
->output_data
.x
->modeline_cursor
))
5112 current_pointer_shape
= f
->output_data
.x
->modeline_cursor
;
5113 XDefineCursor (FRAME_X_DISPLAY (f
),
5115 current_pointer_shape
);
5118 XFlush (FRAME_X_DISPLAY (f
));
5124 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
5125 "Draw rectangle around character under mouse pointer, if there is one.")
5129 struct window
*w
= XWINDOW (Vmouse_window
);
5130 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
5131 struct buffer
*b
= XBUFFER (w
->buffer
);
5134 if (! EQ (Vmouse_window
, selected_window
))
5137 if (EQ (event
, Qnil
))
5141 x_read_mouse_position (selected_frame
, &x
, &y
);
5145 mouse_track_width
= 0;
5146 mouse_track_left
= mouse_track_top
= -1;
5150 if ((x_mouse_x
!= mouse_track_left
5151 && (x_mouse_x
< mouse_track_left
5152 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
5153 || x_mouse_y
!= mouse_track_top
)
5155 int hp
= 0; /* Horizontal position */
5156 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
5157 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
5158 int tab_width
= XINT (b
->tab_width
);
5159 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
5161 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
5162 int in_mode_line
= 0;
5164 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
5167 /* Erase previous rectangle. */
5168 if (mouse_track_width
)
5170 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
5171 mouse_track_left
, mouse_track_top
,
5172 mouse_track_width
, 1);
5174 if ((mouse_track_left
== f
->phys_cursor_x
5175 || mouse_track_left
== f
->phys_cursor_x
- 1)
5176 && mouse_track_top
== f
->phys_cursor_y
)
5178 x_display_cursor (f
, 1);
5182 mouse_track_left
= x_mouse_x
;
5183 mouse_track_top
= x_mouse_y
;
5184 mouse_track_width
= 0;
5186 if (mouse_track_left
> len
) /* Past the end of line. */
5189 if (mouse_track_top
== mode_line_vpos
)
5195 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
5199 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
5205 mouse_track_width
= tab_width
- (hp
% tab_width
);
5207 hp
+= mouse_track_width
;
5210 mouse_track_left
= hp
- mouse_track_width
;
5216 mouse_track_width
= -1;
5220 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
5225 mouse_track_width
= 2;
5230 mouse_track_left
= hp
- mouse_track_width
;
5236 mouse_track_width
= 1;
5243 while (hp
<= x_mouse_x
);
5246 if (mouse_track_width
) /* Over text; use text pointer shape. */
5248 XDefineCursor (FRAME_X_DISPLAY (f
),
5250 f
->output_data
.x
->text_cursor
);
5251 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
5252 mouse_track_left
, mouse_track_top
,
5253 mouse_track_width
, 1);
5255 else if (in_mode_line
)
5256 XDefineCursor (FRAME_X_DISPLAY (f
),
5258 f
->output_data
.x
->modeline_cursor
);
5260 XDefineCursor (FRAME_X_DISPLAY (f
),
5262 f
->output_data
.x
->nontext_cursor
);
5265 XFlush (FRAME_X_DISPLAY (f
));
5268 obj
= read_char (-1, 0, 0, Qnil
, 0);
5271 while (CONSP (obj
) /* Mouse event */
5272 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
5273 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
5274 && EQ (Vmouse_window
, selected_window
) /* In this window */
5277 unread_command_event
= obj
;
5279 if (mouse_track_width
)
5281 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
5282 mouse_track_left
, mouse_track_top
,
5283 mouse_track_width
, 1);
5284 mouse_track_width
= 0;
5285 if ((mouse_track_left
== f
->phys_cursor_x
5286 || mouse_track_left
- 1 == f
->phys_cursor_x
)
5287 && mouse_track_top
== f
->phys_cursor_y
)
5289 x_display_cursor (f
, 1);
5292 XDefineCursor (FRAME_X_DISPLAY (f
),
5294 f
->output_data
.x
->nontext_cursor
);
5295 XFlush (FRAME_X_DISPLAY (f
));
5305 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
5306 on the frame F at position X, Y. */
5308 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
5310 int x
, y
, width
, height
;
5315 image
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
5316 FRAME_X_WINDOW (f
), image_data
,
5318 XCopyPlane (FRAME_X_DISPLAY (f
), image
, FRAME_X_WINDOW (f
),
5319 f
->output_data
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
5323 #if 0 /* I'm told these functions are superfluous
5324 given the ability to bind function keys. */
5327 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
5328 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
5329 KEYSYM is a string which conforms to the X keysym definitions found\n\
5330 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
5331 list of strings specifying modifier keys such as Control_L, which must\n\
5332 also be depressed for NEWSTRING to appear.")
5333 (x_keysym
, modifiers
, newstring
)
5334 register Lisp_Object x_keysym
;
5335 register Lisp_Object modifiers
;
5336 register Lisp_Object newstring
;
5339 register KeySym keysym
;
5340 KeySym modifier_list
[16];
5343 CHECK_STRING (x_keysym
, 1);
5344 CHECK_STRING (newstring
, 3);
5346 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
5347 if (keysym
== NoSymbol
)
5348 error ("Keysym does not exist");
5350 if (NILP (modifiers
))
5351 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
5352 XSTRING (newstring
)->data
,
5353 STRING_BYTES (XSTRING (newstring
)));
5356 register Lisp_Object rest
, mod
;
5359 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
5362 error ("Can't have more than 16 modifiers");
5365 CHECK_STRING (mod
, 3);
5366 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
5368 if (modifier_list
[i
] == NoSymbol
5369 || !(IsModifierKey (modifier_list
[i
])
5370 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
5371 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
5373 if (modifier_list
[i
] == NoSymbol
5374 || !IsModifierKey (modifier_list
[i
]))
5376 error ("Element is not a modifier keysym");
5380 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
5381 XSTRING (newstring
)->data
,
5382 STRING_BYTES (XSTRING (newstring
)));
5388 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
5389 "Rebind KEYCODE to list of strings STRINGS.\n\
5390 STRINGS should be a list of 16 elements, one for each shift combination.\n\
5391 nil as element means don't change.\n\
5392 See the documentation of `x-rebind-key' for more information.")
5394 register Lisp_Object keycode
;
5395 register Lisp_Object strings
;
5397 register Lisp_Object item
;
5398 register unsigned char *rawstring
;
5399 KeySym rawkey
, modifier
[1];
5401 register unsigned i
;
5404 CHECK_NUMBER (keycode
, 1);
5405 CHECK_CONS (strings
, 2);
5406 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
5407 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
5409 item
= Fcar (strings
);
5412 CHECK_STRING (item
, 2);
5413 strsize
= STRING_BYTES (XSTRING (item
));
5414 rawstring
= (unsigned char *) xmalloc (strsize
);
5415 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
5416 modifier
[1] = 1 << i
;
5417 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
5418 rawstring
, strsize
);
5423 #endif /* HAVE_X11 */
5426 #ifndef HAVE_XSCREENNUMBEROFSCREEN
5428 XScreenNumberOfScreen (scr
)
5429 register Screen
*scr
;
5431 register Display
*dpy
;
5432 register Screen
*dpyscr
;
5436 dpyscr
= dpy
->screens
;
5438 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
5444 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5447 select_visual (dpy
, screen
, depth
)
5450 unsigned int *depth
;
5453 XVisualInfo
*vinfo
, vinfo_template
;
5456 v
= DefaultVisualOfScreen (screen
);
5459 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
5461 vinfo_template
.visualid
= v
->visualid
;
5464 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5466 vinfo
= XGetVisualInfo (dpy
,
5467 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
5470 fatal ("Can't get proper X visual info");
5472 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
5473 *depth
= vinfo
->depth
;
5477 int n
= vinfo
->colormap_size
- 1;
5486 XFree ((char *) vinfo
);
5490 /* Return the X display structure for the display named NAME.
5491 Open a new connection if necessary. */
5493 struct x_display_info
*
5494 x_display_info_for_name (name
)
5498 struct x_display_info
*dpyinfo
;
5500 CHECK_STRING (name
, 0);
5502 if (! EQ (Vwindow_system
, intern ("x")))
5503 error ("Not using X Windows");
5505 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5507 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5510 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5515 /* Use this general default value to start with. */
5516 Vx_resource_name
= Vinvocation_name
;
5518 validate_x_resource_name ();
5520 dpyinfo
= x_term_init (name
, (unsigned char *)0,
5521 (char *) XSTRING (Vx_resource_name
)->data
);
5524 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5527 XSETFASTINT (Vwindow_system_version
, 11);
5532 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5533 1, 3, 0, "Open a connection to an X server.\n\
5534 DISPLAY is the name of the display to connect to.\n\
5535 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5536 If the optional third arg MUST-SUCCEED is non-nil,\n\
5537 terminate Emacs if we can't open the connection.")
5538 (display
, xrm_string
, must_succeed
)
5539 Lisp_Object display
, xrm_string
, must_succeed
;
5541 unsigned char *xrm_option
;
5542 struct x_display_info
*dpyinfo
;
5544 CHECK_STRING (display
, 0);
5545 if (! NILP (xrm_string
))
5546 CHECK_STRING (xrm_string
, 1);
5548 if (! EQ (Vwindow_system
, intern ("x")))
5549 error ("Not using X Windows");
5551 if (! NILP (xrm_string
))
5552 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5554 xrm_option
= (unsigned char *) 0;
5556 validate_x_resource_name ();
5558 /* This is what opens the connection and sets x_current_display.
5559 This also initializes many symbols, such as those used for input. */
5560 dpyinfo
= x_term_init (display
, xrm_option
,
5561 (char *) XSTRING (Vx_resource_name
)->data
);
5565 if (!NILP (must_succeed
))
5566 fatal ("Cannot connect to X server %s.\n\
5567 Check the DISPLAY environment variable or use `-d'.\n\
5568 Also use the `xhost' program to verify that it is set to permit\n\
5569 connections from your machine.\n",
5570 XSTRING (display
)->data
);
5572 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5577 XSETFASTINT (Vwindow_system_version
, 11);
5581 DEFUN ("x-close-connection", Fx_close_connection
,
5582 Sx_close_connection
, 1, 1, 0,
5583 "Close the connection to DISPLAY's X server.\n\
5584 For DISPLAY, specify either a frame or a display name (a string).\n\
5585 If DISPLAY is nil, that stands for the selected frame's display.")
5587 Lisp_Object display
;
5589 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5592 if (dpyinfo
->reference_count
> 0)
5593 error ("Display still has frames on it");
5596 /* Free the fonts in the font table. */
5597 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5598 if (dpyinfo
->font_table
[i
].name
)
5600 xfree (dpyinfo
->font_table
[i
].name
);
5601 /* Don't free the full_name string;
5602 it is always shared with something else. */
5603 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5606 x_destroy_all_bitmaps (dpyinfo
);
5607 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5609 #ifdef USE_X_TOOLKIT
5610 XtCloseDisplay (dpyinfo
->display
);
5612 XCloseDisplay (dpyinfo
->display
);
5615 x_delete_display (dpyinfo
);
5621 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5622 "Return the list of display names that Emacs has connections to.")
5625 Lisp_Object tail
, result
;
5628 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5629 result
= Fcons (XCAR (XCAR (tail
)), result
);
5634 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5635 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5636 If ON is nil, allow buffering of requests.\n\
5637 Turning on synchronization prohibits the Xlib routines from buffering\n\
5638 requests and seriously degrades performance, but makes debugging much\n\
5640 The optional second argument DISPLAY specifies which display to act on.\n\
5641 DISPLAY should be either a frame or a display name (a string).\n\
5642 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5644 Lisp_Object display
, on
;
5646 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5648 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5653 /* Wait for responses to all X commands issued so far for frame F. */
5660 XSync (FRAME_X_DISPLAY (f
), False
);
5665 /***********************************************************************
5667 ***********************************************************************/
5669 /* Value is the number of elements of vector VECTOR. */
5671 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5673 /* List of supported image types. Use define_image_type to add new
5674 types. Use lookup_image_type to find a type for a given symbol. */
5676 static struct image_type
*image_types
;
5678 /* A list of symbols, one for each supported image type. */
5680 Lisp_Object Vimage_types
;
5682 /* The symbol `image' which is the car of the lists used to represent
5685 extern Lisp_Object Qimage
;
5687 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5693 Lisp_Object QCtype
, QCdata
, QCascent
, QCmargin
, QCrelief
;
5694 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5695 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
5696 Lisp_Object QCindex
;
5698 /* Other symbols. */
5700 Lisp_Object Qlaplace
;
5702 /* Time in seconds after which images should be removed from the cache
5703 if not displayed. */
5705 Lisp_Object Vimage_cache_eviction_delay
;
5707 /* Function prototypes. */
5709 static void define_image_type
P_ ((struct image_type
*type
));
5710 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5711 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5712 static void x_laplace
P_ ((struct frame
*, struct image
*));
5713 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5717 /* Define a new image type from TYPE. This adds a copy of TYPE to
5718 image_types and adds the symbol *TYPE->type to Vimage_types. */
5721 define_image_type (type
)
5722 struct image_type
*type
;
5724 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5725 The initialized data segment is read-only. */
5726 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5727 bcopy (type
, p
, sizeof *p
);
5728 p
->next
= image_types
;
5730 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5734 /* Look up image type SYMBOL, and return a pointer to its image_type
5735 structure. Value is null if SYMBOL is not a known image type. */
5737 static INLINE
struct image_type
*
5738 lookup_image_type (symbol
)
5741 struct image_type
*type
;
5743 for (type
= image_types
; type
; type
= type
->next
)
5744 if (EQ (symbol
, *type
->type
))
5751 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5752 valid image specification is a list whose car is the symbol
5753 `image', and whose rest is a property list. The property list must
5754 contain a value for key `:type'. That value must be the name of a
5755 supported image type. The rest of the property list depends on the
5759 valid_image_p (object
)
5764 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5766 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5767 struct image_type
*type
= lookup_image_type (symbol
);
5770 valid_p
= type
->valid_p (object
);
5777 /* Log error message with format string FORMAT and argument ARG.
5778 Signaling an error, e.g. when an image cannot be loaded, is not a
5779 good idea because this would interrupt redisplay, and the error
5780 message display would lead to another redisplay. This function
5781 therefore simply displays a message. */
5784 image_error (format
, arg1
, arg2
)
5786 Lisp_Object arg1
, arg2
;
5788 add_to_log (format
, arg1
, arg2
);
5793 /***********************************************************************
5794 Image specifications
5795 ***********************************************************************/
5797 enum image_value_type
5799 IMAGE_DONT_CHECK_VALUE_TYPE
,
5802 IMAGE_POSITIVE_INTEGER_VALUE
,
5803 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5804 IMAGE_INTEGER_VALUE
,
5805 IMAGE_FUNCTION_VALUE
,
5810 /* Structure used when parsing image specifications. */
5812 struct image_keyword
5814 /* Name of keyword. */
5817 /* The type of value allowed. */
5818 enum image_value_type type
;
5820 /* Non-zero means key must be present. */
5823 /* Used to recognize duplicate keywords in a property list. */
5826 /* The value that was found. */
5831 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5833 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5836 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5837 has the format (image KEYWORD VALUE ...). One of the keyword/
5838 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5839 image_keywords structures of size NKEYWORDS describing other
5840 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5843 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5845 struct image_keyword
*keywords
;
5852 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5855 plist
= XCDR (spec
);
5856 while (CONSP (plist
))
5858 Lisp_Object key
, value
;
5860 /* First element of a pair must be a symbol. */
5862 plist
= XCDR (plist
);
5866 /* There must follow a value. */
5869 value
= XCAR (plist
);
5870 plist
= XCDR (plist
);
5872 /* Find key in KEYWORDS. Error if not found. */
5873 for (i
= 0; i
< nkeywords
; ++i
)
5874 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5880 /* Record that we recognized the keyword. If a keywords
5881 was found more than once, it's an error. */
5882 keywords
[i
].value
= value
;
5883 ++keywords
[i
].count
;
5885 if (keywords
[i
].count
> 1)
5888 /* Check type of value against allowed type. */
5889 switch (keywords
[i
].type
)
5891 case IMAGE_STRING_VALUE
:
5892 if (!STRINGP (value
))
5896 case IMAGE_SYMBOL_VALUE
:
5897 if (!SYMBOLP (value
))
5901 case IMAGE_POSITIVE_INTEGER_VALUE
:
5902 if (!INTEGERP (value
) || XINT (value
) <= 0)
5906 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5907 if (!INTEGERP (value
) || XINT (value
) < 0)
5911 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5914 case IMAGE_FUNCTION_VALUE
:
5915 value
= indirect_function (value
);
5917 || COMPILEDP (value
)
5918 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5922 case IMAGE_NUMBER_VALUE
:
5923 if (!INTEGERP (value
) && !FLOATP (value
))
5927 case IMAGE_INTEGER_VALUE
:
5928 if (!INTEGERP (value
))
5932 case IMAGE_BOOL_VALUE
:
5933 if (!NILP (value
) && !EQ (value
, Qt
))
5942 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5946 /* Check that all mandatory fields are present. */
5947 for (i
= 0; i
< nkeywords
; ++i
)
5948 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5951 return NILP (plist
);
5955 /* Return the value of KEY in image specification SPEC. Value is nil
5956 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5957 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5960 image_spec_value (spec
, key
, found
)
5961 Lisp_Object spec
, key
;
5966 xassert (valid_image_p (spec
));
5968 for (tail
= XCDR (spec
);
5969 CONSP (tail
) && CONSP (XCDR (tail
));
5970 tail
= XCDR (XCDR (tail
)))
5972 if (EQ (XCAR (tail
), key
))
5976 return XCAR (XCDR (tail
));
5988 /***********************************************************************
5989 Image type independent image structures
5990 ***********************************************************************/
5992 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5993 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5996 /* Allocate and return a new image structure for image specification
5997 SPEC. SPEC has a hash value of HASH. */
5999 static struct image
*
6000 make_image (spec
, hash
)
6004 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
6006 xassert (valid_image_p (spec
));
6007 bzero (img
, sizeof *img
);
6008 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
6009 xassert (img
->type
!= NULL
);
6011 img
->data
.lisp_val
= Qnil
;
6012 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
6018 /* Free image IMG which was used on frame F, including its resources. */
6027 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6029 /* Remove IMG from the hash table of its cache. */
6031 img
->prev
->next
= img
->next
;
6033 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
6036 img
->next
->prev
= img
->prev
;
6038 c
->images
[img
->id
] = NULL
;
6040 /* Free resources, then free IMG. */
6041 img
->type
->free (f
, img
);
6047 /* Prepare image IMG for display on frame F. Must be called before
6048 drawing an image. */
6051 prepare_image_for_display (f
, img
)
6057 /* We're about to display IMG, so set its timestamp to `now'. */
6059 img
->timestamp
= EMACS_SECS (t
);
6061 /* If IMG doesn't have a pixmap yet, load it now, using the image
6062 type dependent loader function. */
6063 if (img
->pixmap
== 0 && !img
->load_failed_p
)
6064 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6069 /***********************************************************************
6070 Helper functions for X image types
6071 ***********************************************************************/
6073 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
6074 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
6076 Lisp_Object color_name
,
6077 unsigned long dflt
));
6079 /* Free X resources of image IMG which is used on frame F. */
6082 x_clear_image (f
, img
)
6089 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
6096 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
6098 /* If display has an immutable color map, freeing colors is not
6099 necessary and some servers don't allow it. So don't do it. */
6100 if (class != StaticColor
6101 && class != StaticGray
6102 && class != TrueColor
)
6106 cmap
= DefaultColormapOfScreen (FRAME_X_DISPLAY_INFO (f
)->screen
);
6107 XFreeColors (FRAME_X_DISPLAY (f
), cmap
, img
->colors
,
6112 xfree (img
->colors
);
6119 /* Allocate color COLOR_NAME for image IMG on frame F. If color
6120 cannot be allocated, use DFLT. Add a newly allocated color to
6121 IMG->colors, so that it can be freed again. Value is the pixel
6124 static unsigned long
6125 x_alloc_image_color (f
, img
, color_name
, dflt
)
6128 Lisp_Object color_name
;
6132 unsigned long result
;
6134 xassert (STRINGP (color_name
));
6136 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
6138 /* This isn't called frequently so we get away with simply
6139 reallocating the color vector to the needed size, here. */
6142 (unsigned long *) xrealloc (img
->colors
,
6143 img
->ncolors
* sizeof *img
->colors
);
6144 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
6145 result
= color
.pixel
;
6155 /***********************************************************************
6157 ***********************************************************************/
6159 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
6162 /* Return a new, initialized image cache that is allocated from the
6163 heap. Call free_image_cache to free an image cache. */
6165 struct image_cache
*
6168 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
6171 bzero (c
, sizeof *c
);
6173 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
6174 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
6175 c
->buckets
= (struct image
**) xmalloc (size
);
6176 bzero (c
->buckets
, size
);
6181 /* Free image cache of frame F. Be aware that X frames share images
6185 free_image_cache (f
)
6188 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6193 /* Cache should not be referenced by any frame when freed. */
6194 xassert (c
->refcount
== 0);
6196 for (i
= 0; i
< c
->used
; ++i
)
6197 free_image (f
, c
->images
[i
]);
6201 FRAME_X_IMAGE_CACHE (f
) = NULL
;
6206 /* Clear image cache of frame F. FORCE_P non-zero means free all
6207 images. FORCE_P zero means clear only images that haven't been
6208 displayed for some time. Should be called from time to time to
6209 reduce the number of loaded images. If image-eviction-seconds is
6210 non-nil, this frees images in the cache which weren't displayed for
6211 at least that many seconds. */
6214 clear_image_cache (f
, force_p
)
6218 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6220 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
6224 int i
, any_freed_p
= 0;
6227 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
6229 for (i
= 0; i
< c
->used
; ++i
)
6231 struct image
*img
= c
->images
[i
];
6234 || (img
->timestamp
> old
)))
6236 free_image (f
, img
);
6241 /* We may be clearing the image cache because, for example,
6242 Emacs was iconified for a longer period of time. In that
6243 case, current matrices may still contain references to
6244 images freed above. So, clear these matrices. */
6247 clear_current_matrices (f
);
6248 ++windows_or_buffers_changed
;
6254 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
6256 "Clear the image cache of FRAME.\n\
6257 FRAME nil or omitted means use the selected frame.\n\
6258 FRAME t means clear the image caches of all frames.")
6266 FOR_EACH_FRAME (tail
, frame
)
6267 if (FRAME_X_P (XFRAME (frame
)))
6268 clear_image_cache (XFRAME (frame
), 1);
6271 clear_image_cache (check_x_frame (frame
), 1);
6277 /* Return the id of image with Lisp specification SPEC on frame F.
6278 SPEC must be a valid Lisp image specification (see valid_image_p). */
6281 lookup_image (f
, spec
)
6285 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6289 struct gcpro gcpro1
;
6292 /* F must be a window-system frame, and SPEC must be a valid image
6294 xassert (FRAME_WINDOW_P (f
));
6295 xassert (valid_image_p (spec
));
6299 /* Look up SPEC in the hash table of the image cache. */
6300 hash
= sxhash (spec
, 0);
6301 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6303 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6304 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6307 /* If not found, create a new image and cache it. */
6310 img
= make_image (spec
, hash
);
6311 cache_image (f
, img
);
6312 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6313 xassert (!interrupt_input_blocked
);
6315 /* If we can't load the image, and we don't have a width and
6316 height, use some arbitrary width and height so that we can
6317 draw a rectangle for it. */
6318 if (img
->load_failed_p
)
6322 value
= image_spec_value (spec
, QCwidth
, NULL
);
6323 img
->width
= (INTEGERP (value
)
6324 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6325 value
= image_spec_value (spec
, QCheight
, NULL
);
6326 img
->height
= (INTEGERP (value
)
6327 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6331 /* Handle image type independent image attributes
6332 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
6333 Lisp_Object ascent
, margin
, relief
, algorithm
, heuristic_mask
;
6336 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6337 if (INTEGERP (ascent
))
6338 img
->ascent
= XFASTINT (ascent
);
6340 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6341 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6342 img
->margin
= XFASTINT (margin
);
6344 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6345 if (INTEGERP (relief
))
6347 img
->relief
= XINT (relief
);
6348 img
->margin
+= abs (img
->relief
);
6351 /* Should we apply a Laplace edge-detection algorithm? */
6352 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
6353 if (img
->pixmap
&& EQ (algorithm
, Qlaplace
))
6356 /* Should we built a mask heuristically? */
6357 heuristic_mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6358 if (img
->pixmap
&& !img
->mask
&& !NILP (heuristic_mask
))
6359 x_build_heuristic_mask (f
, img
, heuristic_mask
);
6363 /* We're using IMG, so set its timestamp to `now'. */
6364 EMACS_GET_TIME (now
);
6365 img
->timestamp
= EMACS_SECS (now
);
6369 /* Value is the image id. */
6374 /* Cache image IMG in the image cache of frame F. */
6377 cache_image (f
, img
)
6381 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6384 /* Find a free slot in c->images. */
6385 for (i
= 0; i
< c
->used
; ++i
)
6386 if (c
->images
[i
] == NULL
)
6389 /* If no free slot found, maybe enlarge c->images. */
6390 if (i
== c
->used
&& c
->used
== c
->size
)
6393 c
->images
= (struct image
**) xrealloc (c
->images
,
6394 c
->size
* sizeof *c
->images
);
6397 /* Add IMG to c->images, and assign IMG an id. */
6403 /* Add IMG to the cache's hash table. */
6404 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6405 img
->next
= c
->buckets
[i
];
6407 img
->next
->prev
= img
;
6409 c
->buckets
[i
] = img
;
6413 /* Call FN on every image in the image cache of frame F. Used to mark
6414 Lisp Objects in the image cache. */
6417 forall_images_in_image_cache (f
, fn
)
6419 void (*fn
) P_ ((struct image
*img
));
6421 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6423 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6427 for (i
= 0; i
< c
->used
; ++i
)
6436 /***********************************************************************
6438 ***********************************************************************/
6440 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6441 XImage
**, Pixmap
*));
6442 static void x_destroy_x_image
P_ ((XImage
*));
6443 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6446 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6447 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6448 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6449 via xmalloc. Print error messages via image_error if an error
6450 occurs. Value is non-zero if successful. */
6453 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6455 int width
, height
, depth
;
6459 Display
*display
= FRAME_X_DISPLAY (f
);
6460 Screen
*screen
= FRAME_X_SCREEN (f
);
6461 Window window
= FRAME_X_WINDOW (f
);
6463 xassert (interrupt_input_blocked
);
6466 depth
= DefaultDepthOfScreen (screen
);
6467 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6468 depth
, ZPixmap
, 0, NULL
, width
, height
,
6469 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6472 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6476 /* Allocate image raster. */
6477 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6479 /* Allocate a pixmap of the same size. */
6480 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6483 x_destroy_x_image (*ximg
);
6485 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6493 /* Destroy XImage XIMG. Free XIMG->data. */
6496 x_destroy_x_image (ximg
)
6499 xassert (interrupt_input_blocked
);
6504 XDestroyImage (ximg
);
6509 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6510 are width and height of both the image and pixmap. */
6513 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6520 xassert (interrupt_input_blocked
);
6521 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6522 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6523 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6528 /***********************************************************************
6530 ***********************************************************************/
6532 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6534 /* Find image file FILE. Look in data-directory, then
6535 x-bitmap-file-path. Value is the full name of the file found, or
6536 nil if not found. */
6539 x_find_image_file (file
)
6542 Lisp_Object file_found
, search_path
;
6543 struct gcpro gcpro1
, gcpro2
;
6547 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6548 GCPRO2 (file_found
, search_path
);
6550 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6551 fd
= openp (search_path
, file
, "", &file_found
, 0);
6564 /***********************************************************************
6566 ***********************************************************************/
6568 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6569 static int xbm_load_image_from_file
P_ ((struct frame
*f
, struct image
*img
,
6571 static int xbm_image_p
P_ ((Lisp_Object object
));
6572 static int xbm_read_bitmap_file_data
P_ ((char *, int *, int *,
6576 /* Indices of image specification fields in xbm_format, below. */
6578 enum xbm_keyword_index
6595 /* Vector of image_keyword structures describing the format
6596 of valid XBM image specifications. */
6598 static struct image_keyword xbm_format
[XBM_LAST
] =
6600 {":type", IMAGE_SYMBOL_VALUE
, 1},
6601 {":file", IMAGE_STRING_VALUE
, 0},
6602 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6603 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6604 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6605 {":foreground", IMAGE_STRING_VALUE
, 0},
6606 {":background", IMAGE_STRING_VALUE
, 0},
6607 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6608 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6609 {":relief", IMAGE_INTEGER_VALUE
, 0},
6610 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6611 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6614 /* Structure describing the image type XBM. */
6616 static struct image_type xbm_type
=
6625 /* Tokens returned from xbm_scan. */
6634 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6635 A valid specification is a list starting with the symbol `image'
6636 The rest of the list is a property list which must contain an
6639 If the specification specifies a file to load, it must contain
6640 an entry `:file FILENAME' where FILENAME is a string.
6642 If the specification is for a bitmap loaded from memory it must
6643 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6644 WIDTH and HEIGHT are integers > 0. DATA may be:
6646 1. a string large enough to hold the bitmap data, i.e. it must
6647 have a size >= (WIDTH + 7) / 8 * HEIGHT
6649 2. a bool-vector of size >= WIDTH * HEIGHT
6651 3. a vector of strings or bool-vectors, one for each line of the
6654 Both the file and data forms may contain the additional entries
6655 `:background COLOR' and `:foreground COLOR'. If not present,
6656 foreground and background of the frame on which the image is
6657 displayed, is used. */
6660 xbm_image_p (object
)
6663 struct image_keyword kw
[XBM_LAST
];
6665 bcopy (xbm_format
, kw
, sizeof kw
);
6666 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6669 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6671 if (kw
[XBM_FILE
].count
)
6673 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6681 /* Entries for `:width', `:height' and `:data' must be present. */
6682 if (!kw
[XBM_WIDTH
].count
6683 || !kw
[XBM_HEIGHT
].count
6684 || !kw
[XBM_DATA
].count
)
6687 data
= kw
[XBM_DATA
].value
;
6688 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6689 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6691 /* Check type of data, and width and height against contents of
6697 /* Number of elements of the vector must be >= height. */
6698 if (XVECTOR (data
)->size
< height
)
6701 /* Each string or bool-vector in data must be large enough
6702 for one line of the image. */
6703 for (i
= 0; i
< height
; ++i
)
6705 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6709 if (XSTRING (elt
)->size
6710 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6713 else if (BOOL_VECTOR_P (elt
))
6715 if (XBOOL_VECTOR (elt
)->size
< width
)
6722 else if (STRINGP (data
))
6724 if (XSTRING (data
)->size
6725 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6728 else if (BOOL_VECTOR_P (data
))
6730 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6737 /* Baseline must be a value between 0 and 100 (a percentage). */
6738 if (kw
[XBM_ASCENT
].count
6739 && XFASTINT (kw
[XBM_ASCENT
].value
) > 100)
6746 /* Scan a bitmap file. FP is the stream to read from. Value is
6747 either an enumerator from enum xbm_token, or a character for a
6748 single-character token, or 0 at end of file. If scanning an
6749 identifier, store the lexeme of the identifier in SVAL. If
6750 scanning a number, store its value in *IVAL. */
6753 xbm_scan (fp
, sval
, ival
)
6760 /* Skip white space. */
6761 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
6766 else if (isdigit (c
))
6768 int value
= 0, digit
;
6773 if (c
== 'x' || c
== 'X')
6775 while ((c
= fgetc (fp
)) != EOF
)
6779 else if (c
>= 'a' && c
<= 'f')
6780 digit
= c
- 'a' + 10;
6781 else if (c
>= 'A' && c
<= 'F')
6782 digit
= c
- 'A' + 10;
6785 value
= 16 * value
+ digit
;
6788 else if (isdigit (c
))
6791 while ((c
= fgetc (fp
)) != EOF
6793 value
= 8 * value
+ c
- '0';
6799 while ((c
= fgetc (fp
)) != EOF
6801 value
= 10 * value
+ c
- '0';
6809 else if (isalpha (c
) || c
== '_')
6812 while ((c
= fgetc (fp
)) != EOF
6813 && (isalnum (c
) || c
== '_'))
6825 /* Replacement for XReadBitmapFileData which isn't available under old
6826 X versions. FILE is the name of the bitmap file to read. Set
6827 *WIDTH and *HEIGHT to the width and height of the image. Return in
6828 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
6832 xbm_read_bitmap_file_data (file
, width
, height
, data
)
6834 int *width
, *height
;
6835 unsigned char **data
;
6838 char buffer
[BUFSIZ
];
6841 int bytes_per_line
, i
, nbytes
;
6847 LA1 = xbm_scan (fp, buffer, &value)
6849 #define expect(TOKEN) \
6850 if (LA1 != (TOKEN)) \
6855 #define expect_ident(IDENT) \
6856 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6861 fp
= fopen (file
, "r");
6865 *width
= *height
= -1;
6867 LA1
= xbm_scan (fp
, buffer
, &value
);
6869 /* Parse defines for width, height and hot-spots. */
6873 expect_ident ("define");
6874 expect (XBM_TK_IDENT
);
6876 if (LA1
== XBM_TK_NUMBER
);
6878 char *p
= strrchr (buffer
, '_');
6879 p
= p
? p
+ 1 : buffer
;
6880 if (strcmp (p
, "width") == 0)
6882 else if (strcmp (p
, "height") == 0)
6885 expect (XBM_TK_NUMBER
);
6888 if (*width
< 0 || *height
< 0)
6891 /* Parse bits. Must start with `static'. */
6892 expect_ident ("static");
6893 if (LA1
== XBM_TK_IDENT
)
6895 if (strcmp (buffer
, "unsigned") == 0)
6898 expect_ident ("char");
6900 else if (strcmp (buffer
, "short") == 0)
6904 if (*width
% 16 && *width
% 16 < 9)
6907 else if (strcmp (buffer
, "char") == 0)
6915 expect (XBM_TK_IDENT
);
6921 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6922 nbytes
= bytes_per_line
* *height
;
6923 p
= *data
= (char *) xmalloc (nbytes
);
6928 for (i
= 0; i
< nbytes
; i
+= 2)
6931 expect (XBM_TK_NUMBER
);
6934 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6937 if (LA1
== ',' || LA1
== '}')
6945 for (i
= 0; i
< nbytes
; ++i
)
6948 expect (XBM_TK_NUMBER
);
6952 if (LA1
== ',' || LA1
== '}')
6978 /* Load XBM image IMG which will be displayed on frame F from file
6979 SPECIFIED_FILE. Value is non-zero if successful. */
6982 xbm_load_image_from_file (f
, img
, specified_file
)
6985 Lisp_Object specified_file
;
6988 unsigned char *data
;
6991 struct gcpro gcpro1
;
6993 xassert (STRINGP (specified_file
));
6997 file
= x_find_image_file (specified_file
);
6998 if (!STRINGP (file
))
7000 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7005 rc
= xbm_read_bitmap_file_data (XSTRING (file
)->data
, &img
->width
,
7006 &img
->height
, &data
);
7009 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7010 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7011 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7014 xassert (img
->width
> 0 && img
->height
> 0);
7016 /* Get foreground and background colors, maybe allocate colors. */
7017 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
7019 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
7021 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
7023 background
= x_alloc_image_color (f
, img
, value
, background
);
7027 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7030 img
->width
, img
->height
,
7031 foreground
, background
,
7035 if (img
->pixmap
== 0)
7037 x_clear_image (f
, img
);
7038 image_error ("Unable to create X pixmap for `%s'", file
, Qnil
);
7046 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7053 /* Fill image IMG which is used on frame F with pixmap data. Value is
7054 non-zero if successful. */
7062 Lisp_Object file_name
;
7064 xassert (xbm_image_p (img
->spec
));
7066 /* If IMG->spec specifies a file name, create a non-file spec from it. */
7067 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
7068 if (STRINGP (file_name
))
7069 success_p
= xbm_load_image_from_file (f
, img
, file_name
);
7072 struct image_keyword fmt
[XBM_LAST
];
7075 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7076 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7080 /* Parse the list specification. */
7081 bcopy (xbm_format
, fmt
, sizeof fmt
);
7082 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
7085 /* Get specified width, and height. */
7086 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
7087 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
7088 xassert (img
->width
> 0 && img
->height
> 0);
7092 if (fmt
[XBM_ASCENT
].count
)
7093 img
->ascent
= XFASTINT (fmt
[XBM_ASCENT
].value
);
7095 /* Get foreground and background colors, maybe allocate colors. */
7096 if (fmt
[XBM_FOREGROUND
].count
)
7097 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
7099 if (fmt
[XBM_BACKGROUND
].count
)
7100 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
7103 /* Set bits to the bitmap image data. */
7104 data
= fmt
[XBM_DATA
].value
;
7109 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
7111 p
= bits
= (char *) alloca (nbytes
* img
->height
);
7112 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
7114 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
7116 bcopy (XSTRING (line
)->data
, p
, nbytes
);
7118 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
7121 else if (STRINGP (data
))
7122 bits
= XSTRING (data
)->data
;
7124 bits
= XBOOL_VECTOR (data
)->data
;
7126 /* Create the pixmap. */
7127 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7129 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7132 img
->width
, img
->height
,
7133 foreground
, background
,
7139 image_error ("Unable to create pixmap for XBM image `%s'",
7141 x_clear_image (f
, img
);
7152 /***********************************************************************
7154 ***********************************************************************/
7158 static int xpm_image_p
P_ ((Lisp_Object object
));
7159 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
7160 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
7162 #include "X11/xpm.h"
7164 /* The symbol `xpm' identifying XPM-format images. */
7168 /* Indices of image specification fields in xpm_format, below. */
7170 enum xpm_keyword_index
7184 /* Vector of image_keyword structures describing the format
7185 of valid XPM image specifications. */
7187 static struct image_keyword xpm_format
[XPM_LAST
] =
7189 {":type", IMAGE_SYMBOL_VALUE
, 1},
7190 {":file", IMAGE_STRING_VALUE
, 0},
7191 {":data", IMAGE_STRING_VALUE
, 0},
7192 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7193 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7194 {":relief", IMAGE_INTEGER_VALUE
, 0},
7195 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7196 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7197 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7200 /* Structure describing the image type XBM. */
7202 static struct image_type xpm_type
=
7212 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7213 for XPM images. Such a list must consist of conses whose car and
7217 xpm_valid_color_symbols_p (color_symbols
)
7218 Lisp_Object color_symbols
;
7220 while (CONSP (color_symbols
))
7222 Lisp_Object sym
= XCAR (color_symbols
);
7224 || !STRINGP (XCAR (sym
))
7225 || !STRINGP (XCDR (sym
)))
7227 color_symbols
= XCDR (color_symbols
);
7230 return NILP (color_symbols
);
7234 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7237 xpm_image_p (object
)
7240 struct image_keyword fmt
[XPM_LAST
];
7241 bcopy (xpm_format
, fmt
, sizeof fmt
);
7242 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7243 /* Either `:file' or `:data' must be present. */
7244 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7245 /* Either no `:color-symbols' or it's a list of conses
7246 whose car and cdr are strings. */
7247 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7248 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
7249 && (fmt
[XPM_ASCENT
].count
== 0
7250 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
7254 /* Load image IMG which will be displayed on frame F. Value is
7255 non-zero if successful. */
7263 XpmAttributes attrs
;
7264 Lisp_Object specified_file
, color_symbols
;
7266 /* Configure the XPM lib. Use the visual of frame F. Allocate
7267 close colors. Return colors allocated. */
7268 bzero (&attrs
, sizeof attrs
);
7269 attrs
.visual
= FRAME_X_DISPLAY_INFO (f
)->visual
;
7270 attrs
.valuemask
|= XpmVisual
;
7271 attrs
.valuemask
|= XpmReturnAllocPixels
;
7272 #ifdef XpmAllocCloseColors
7273 attrs
.alloc_close_colors
= 1;
7274 attrs
.valuemask
|= XpmAllocCloseColors
;
7276 attrs
.closeness
= 600;
7277 attrs
.valuemask
|= XpmCloseness
;
7280 /* If image specification contains symbolic color definitions, add
7281 these to `attrs'. */
7282 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7283 if (CONSP (color_symbols
))
7286 XpmColorSymbol
*xpm_syms
;
7289 attrs
.valuemask
|= XpmColorSymbols
;
7291 /* Count number of symbols. */
7292 attrs
.numsymbols
= 0;
7293 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7296 /* Allocate an XpmColorSymbol array. */
7297 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7298 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7299 bzero (xpm_syms
, size
);
7300 attrs
.colorsymbols
= xpm_syms
;
7302 /* Fill the color symbol array. */
7303 for (tail
= color_symbols
, i
= 0;
7305 ++i
, tail
= XCDR (tail
))
7307 Lisp_Object name
= XCAR (XCAR (tail
));
7308 Lisp_Object color
= XCDR (XCAR (tail
));
7309 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7310 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7311 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7312 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7316 /* Create a pixmap for the image, either from a file, or from a
7317 string buffer containing data in the same format as an XPM file. */
7319 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7320 if (STRINGP (specified_file
))
7322 Lisp_Object file
= x_find_image_file (specified_file
);
7323 if (!STRINGP (file
))
7325 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7330 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7331 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7336 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7337 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7338 XSTRING (buffer
)->data
,
7339 &img
->pixmap
, &img
->mask
,
7344 if (rc
== XpmSuccess
)
7346 /* Remember allocated colors. */
7347 img
->ncolors
= attrs
.nalloc_pixels
;
7348 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7349 * sizeof *img
->colors
);
7350 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7351 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7353 img
->width
= attrs
.width
;
7354 img
->height
= attrs
.height
;
7355 xassert (img
->width
> 0 && img
->height
> 0);
7357 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7359 XpmFreeAttributes (&attrs
);
7367 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7370 case XpmFileInvalid
:
7371 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7375 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7378 case XpmColorFailed
:
7379 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7383 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7388 return rc
== XpmSuccess
;
7391 #endif /* HAVE_XPM != 0 */
7394 /***********************************************************************
7396 ***********************************************************************/
7398 /* An entry in the color table mapping an RGB color to a pixel color. */
7403 unsigned long pixel
;
7405 /* Next in color table collision list. */
7406 struct ct_color
*next
;
7409 /* The bucket vector size to use. Must be prime. */
7413 /* Value is a hash of the RGB color given by R, G, and B. */
7415 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7417 /* The color hash table. */
7419 struct ct_color
**ct_table
;
7421 /* Number of entries in the color table. */
7423 int ct_colors_allocated
;
7425 /* Function prototypes. */
7427 static void init_color_table
P_ ((void));
7428 static void free_color_table
P_ ((void));
7429 static unsigned long *colors_in_color_table
P_ ((int *n
));
7430 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
7431 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
7434 /* Initialize the color table. */
7439 int size
= CT_SIZE
* sizeof (*ct_table
);
7440 ct_table
= (struct ct_color
**) xmalloc (size
);
7441 bzero (ct_table
, size
);
7442 ct_colors_allocated
= 0;
7446 /* Free memory associated with the color table. */
7452 struct ct_color
*p
, *next
;
7454 for (i
= 0; i
< CT_SIZE
; ++i
)
7455 for (p
= ct_table
[i
]; p
; p
= next
)
7466 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7467 entry for that color already is in the color table, return the
7468 pixel color of that entry. Otherwise, allocate a new color for R,
7469 G, B, and make an entry in the color table. */
7471 static unsigned long
7472 lookup_rgb_color (f
, r
, g
, b
)
7476 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7477 int i
= hash
% CT_SIZE
;
7480 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7481 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7495 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7496 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7501 ++ct_colors_allocated
;
7503 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7507 p
->pixel
= color
.pixel
;
7508 p
->next
= ct_table
[i
];
7512 return FRAME_FOREGROUND_PIXEL (f
);
7519 /* Look up pixel color PIXEL which is used on frame F in the color
7520 table. If not already present, allocate it. Value is PIXEL. */
7522 static unsigned long
7523 lookup_pixel_color (f
, pixel
)
7525 unsigned long pixel
;
7527 int i
= pixel
% CT_SIZE
;
7530 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7531 if (p
->pixel
== pixel
)
7542 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7543 color
.pixel
= pixel
;
7544 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
7545 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7550 ++ct_colors_allocated
;
7552 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7557 p
->next
= ct_table
[i
];
7561 return FRAME_FOREGROUND_PIXEL (f
);
7568 /* Value is a vector of all pixel colors contained in the color table,
7569 allocated via xmalloc. Set *N to the number of colors. */
7571 static unsigned long *
7572 colors_in_color_table (n
)
7577 unsigned long *colors
;
7579 if (ct_colors_allocated
== 0)
7586 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7588 *n
= ct_colors_allocated
;
7590 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7591 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7592 colors
[j
++] = p
->pixel
;
7600 /***********************************************************************
7602 ***********************************************************************/
7604 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7605 int, XImage
*, int));
7606 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7607 XColor
*, int, XImage
*, int));
7610 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
7611 frame we operate on, CMAP is the color-map in effect, and WIDTH is
7612 the width of one row in the image. */
7615 x_laplace_read_row (f
, cmap
, colors
, width
, ximg
, y
)
7625 for (x
= 0; x
< width
; ++x
)
7626 colors
[x
].pixel
= XGetPixel (ximg
, x
, y
);
7628 XQueryColors (FRAME_X_DISPLAY (f
), cmap
, colors
, width
);
7632 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
7633 containing the pixel colors to write. F is the frame we are
7637 x_laplace_write_row (f
, pixels
, width
, ximg
, y
)
7646 for (x
= 0; x
< width
; ++x
)
7647 XPutPixel (ximg
, x
, y
, pixels
[x
]);
7651 /* Transform image IMG which is used on frame F with a Laplace
7652 edge-detection algorithm. The result is an image that can be used
7653 to draw disabled buttons, for example. */
7660 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7661 XImage
*ximg
, *oimg
;
7667 int in_y
, out_y
, rc
;
7672 /* Get the X image IMG->pixmap. */
7673 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7674 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7676 /* Allocate 3 input rows, and one output row of colors. */
7677 for (i
= 0; i
< 3; ++i
)
7678 in
[i
] = (XColor
*) alloca (img
->width
* sizeof (XColor
));
7679 out
= (long *) alloca (img
->width
* sizeof (long));
7681 /* Create an X image for output. */
7682 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7685 /* Fill first two rows. */
7686 x_laplace_read_row (f
, cmap
, in
[0], img
->width
, ximg
, 0);
7687 x_laplace_read_row (f
, cmap
, in
[1], img
->width
, ximg
, 1);
7690 /* Write first row, all zeros. */
7691 init_color_table ();
7692 pixel
= lookup_rgb_color (f
, 0, 0, 0);
7693 for (x
= 0; x
< img
->width
; ++x
)
7695 x_laplace_write_row (f
, out
, img
->width
, oimg
, 0);
7698 for (y
= 2; y
< img
->height
; ++y
)
7701 int rowb
= (y
+ 2) % 3;
7703 x_laplace_read_row (f
, cmap
, in
[rowa
], img
->width
, ximg
, in_y
++);
7705 for (x
= 0; x
< img
->width
- 2; ++x
)
7707 int r
= in
[rowa
][x
].red
+ mv2
- in
[rowb
][x
+ 2].red
;
7708 int g
= in
[rowa
][x
].green
+ mv2
- in
[rowb
][x
+ 2].green
;
7709 int b
= in
[rowa
][x
].blue
+ mv2
- in
[rowb
][x
+ 2].blue
;
7711 out
[x
+ 1] = lookup_rgb_color (f
, r
& 0xffff, g
& 0xffff,
7715 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
++);
7718 /* Write last line, all zeros. */
7719 for (x
= 0; x
< img
->width
; ++x
)
7721 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
);
7723 /* Free the input image, and free resources of IMG. */
7724 XDestroyImage (ximg
);
7725 x_clear_image (f
, img
);
7727 /* Put the output image into pixmap, and destroy it. */
7728 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7729 x_destroy_x_image (oimg
);
7731 /* Remember new pixmap and colors in IMG. */
7732 img
->pixmap
= pixmap
;
7733 img
->colors
= colors_in_color_table (&img
->ncolors
);
7734 free_color_table ();
7740 /* Build a mask for image IMG which is used on frame F. FILE is the
7741 name of an image file, for error messages. HOW determines how to
7742 determine the background color of IMG. If it is a list '(R G B)',
7743 with R, G, and B being integers >= 0, take that as the color of the
7744 background. Otherwise, determine the background color of IMG
7745 heuristically. Value is non-zero if successful. */
7748 x_build_heuristic_mask (f
, img
, how
)
7753 Display
*dpy
= FRAME_X_DISPLAY (f
);
7754 XImage
*ximg
, *mask_img
;
7755 int x
, y
, rc
, look_at_corners_p
;
7760 /* Create an image and pixmap serving as mask. */
7761 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7762 &mask_img
, &img
->mask
);
7769 /* Get the X image of IMG->pixmap. */
7770 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7773 /* Determine the background color of ximg. If HOW is `(R G B)'
7774 take that as color. Otherwise, try to determine the color
7776 look_at_corners_p
= 1;
7784 && NATNUMP (XCAR (how
)))
7786 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7790 if (i
== 3 && NILP (how
))
7792 char color_name
[30];
7793 XColor exact
, color
;
7796 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7798 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7799 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7802 look_at_corners_p
= 0;
7807 if (look_at_corners_p
)
7809 unsigned long corners
[4];
7812 /* Get the colors at the corners of ximg. */
7813 corners
[0] = XGetPixel (ximg
, 0, 0);
7814 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7815 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7816 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7818 /* Choose the most frequently found color as background. */
7819 for (i
= best_count
= 0; i
< 4; ++i
)
7823 for (j
= n
= 0; j
< 4; ++j
)
7824 if (corners
[i
] == corners
[j
])
7828 bg
= corners
[i
], best_count
= n
;
7832 /* Set all bits in mask_img to 1 whose color in ximg is different
7833 from the background color bg. */
7834 for (y
= 0; y
< img
->height
; ++y
)
7835 for (x
= 0; x
< img
->width
; ++x
)
7836 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7838 /* Put mask_img into img->mask. */
7839 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7840 x_destroy_x_image (mask_img
);
7841 XDestroyImage (ximg
);
7849 /***********************************************************************
7850 PBM (mono, gray, color)
7851 ***********************************************************************/
7853 static int pbm_image_p
P_ ((Lisp_Object object
));
7854 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7855 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
7857 /* The symbol `pbm' identifying images of this type. */
7861 /* Indices of image specification fields in gs_format, below. */
7863 enum pbm_keyword_index
7876 /* Vector of image_keyword structures describing the format
7877 of valid user-defined image specifications. */
7879 static struct image_keyword pbm_format
[PBM_LAST
] =
7881 {":type", IMAGE_SYMBOL_VALUE
, 1},
7882 {":file", IMAGE_STRING_VALUE
, 0},
7883 {":data", IMAGE_STRING_VALUE
, 0},
7884 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7885 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7886 {":relief", IMAGE_INTEGER_VALUE
, 0},
7887 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7888 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7891 /* Structure describing the image type `pbm'. */
7893 static struct image_type pbm_type
=
7903 /* Return non-zero if OBJECT is a valid PBM image specification. */
7906 pbm_image_p (object
)
7909 struct image_keyword fmt
[PBM_LAST
];
7911 bcopy (pbm_format
, fmt
, sizeof fmt
);
7913 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
)
7914 || (fmt
[PBM_ASCENT
].count
7915 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
7918 /* Must specify either :data or :file. */
7919 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
7923 /* Scan a decimal number from *S and return it. Advance *S while
7924 reading the number. END is the end of the string. Value is -1 at
7928 pbm_scan_number (s
, end
)
7929 unsigned char **s
, *end
;
7935 /* Skip white-space. */
7936 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
7941 /* Skip comment to end of line. */
7942 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
7945 else if (isdigit (c
))
7947 /* Read decimal number. */
7949 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
7950 val
= 10 * val
+ c
- '0';
7961 /* Read FILE into memory. Value is a pointer to a buffer allocated
7962 with xmalloc holding FILE's contents. Value is null if an error
7963 occured. *SIZE is set to the size of the file. */
7966 pbm_read_file (file
, size
)
7974 if (stat (XSTRING (file
)->data
, &st
) == 0
7975 && (fp
= fopen (XSTRING (file
)->data
, "r")) != NULL
7976 && (buf
= (char *) xmalloc (st
.st_size
),
7977 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
7997 /* Load PBM image IMG for use on frame F. */
8005 int width
, height
, max_color_idx
= 0;
8007 Lisp_Object file
, specified_file
;
8008 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8009 struct gcpro gcpro1
;
8010 unsigned char *contents
= NULL
;
8011 unsigned char *end
, *p
;
8014 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8018 if (STRINGP (specified_file
))
8020 file
= x_find_image_file (specified_file
);
8021 if (!STRINGP (file
))
8023 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8028 contents
= pbm_read_file (file
, &size
);
8029 if (contents
== NULL
)
8031 image_error ("Error reading `%s'", file
, Qnil
);
8037 end
= contents
+ size
;
8042 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8043 p
= XSTRING (data
)->data
;
8044 end
= p
+ STRING_BYTES (XSTRING (data
));
8047 /* Check magic number. */
8048 if (end
- p
< 2 || *p
++ != 'P')
8050 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8060 raw_p
= 0, type
= PBM_MONO
;
8064 raw_p
= 0, type
= PBM_GRAY
;
8068 raw_p
= 0, type
= PBM_COLOR
;
8072 raw_p
= 1, type
= PBM_MONO
;
8076 raw_p
= 1, type
= PBM_GRAY
;
8080 raw_p
= 1, type
= PBM_COLOR
;
8084 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8088 /* Read width, height, maximum color-component. Characters
8089 starting with `#' up to the end of a line are ignored. */
8090 width
= pbm_scan_number (&p
, end
);
8091 height
= pbm_scan_number (&p
, end
);
8093 if (type
!= PBM_MONO
)
8095 max_color_idx
= pbm_scan_number (&p
, end
);
8096 if (raw_p
&& max_color_idx
> 255)
8097 max_color_idx
= 255;
8102 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8106 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8107 &ximg
, &img
->pixmap
))
8113 /* Initialize the color hash table. */
8114 init_color_table ();
8116 if (type
== PBM_MONO
)
8120 for (y
= 0; y
< height
; ++y
)
8121 for (x
= 0; x
< width
; ++x
)
8131 g
= pbm_scan_number (&p
, end
);
8133 XPutPixel (ximg
, x
, y
, (g
8134 ? FRAME_FOREGROUND_PIXEL (f
)
8135 : FRAME_BACKGROUND_PIXEL (f
)));
8140 for (y
= 0; y
< height
; ++y
)
8141 for (x
= 0; x
< width
; ++x
)
8145 if (type
== PBM_GRAY
)
8146 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8155 r
= pbm_scan_number (&p
, end
);
8156 g
= pbm_scan_number (&p
, end
);
8157 b
= pbm_scan_number (&p
, end
);
8160 if (r
< 0 || g
< 0 || b
< 0)
8164 XDestroyImage (ximg
);
8166 image_error ("Invalid pixel value in image `%s'",
8171 /* RGB values are now in the range 0..max_color_idx.
8172 Scale this to the range 0..0xffff supported by X. */
8173 r
= (double) r
* 65535 / max_color_idx
;
8174 g
= (double) g
* 65535 / max_color_idx
;
8175 b
= (double) b
* 65535 / max_color_idx
;
8176 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8180 /* Store in IMG->colors the colors allocated for the image, and
8181 free the color table. */
8182 img
->colors
= colors_in_color_table (&img
->ncolors
);
8183 free_color_table ();
8185 /* Put the image into a pixmap. */
8186 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8187 x_destroy_x_image (ximg
);
8191 img
->height
= height
;
8200 /***********************************************************************
8202 ***********************************************************************/
8208 /* Function prototypes. */
8210 static int png_image_p
P_ ((Lisp_Object object
));
8211 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8213 /* The symbol `png' identifying images of this type. */
8217 /* Indices of image specification fields in png_format, below. */
8219 enum png_keyword_index
8232 /* Vector of image_keyword structures describing the format
8233 of valid user-defined image specifications. */
8235 static struct image_keyword png_format
[PNG_LAST
] =
8237 {":type", IMAGE_SYMBOL_VALUE
, 1},
8238 {":data", IMAGE_STRING_VALUE
, 0},
8239 {":file", IMAGE_STRING_VALUE
, 0},
8240 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8241 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8242 {":relief", IMAGE_INTEGER_VALUE
, 0},
8243 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8244 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8247 /* Structure describing the image type `png'. */
8249 static struct image_type png_type
=
8259 /* Return non-zero if OBJECT is a valid PNG image specification. */
8262 png_image_p (object
)
8265 struct image_keyword fmt
[PNG_LAST
];
8266 bcopy (png_format
, fmt
, sizeof fmt
);
8268 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
)
8269 || (fmt
[PNG_ASCENT
].count
8270 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
8273 /* Must specify either the :data or :file keyword. */
8274 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8278 /* Error and warning handlers installed when the PNG library
8282 my_png_error (png_ptr
, msg
)
8283 png_struct
*png_ptr
;
8286 xassert (png_ptr
!= NULL
);
8287 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8288 longjmp (png_ptr
->jmpbuf
, 1);
8293 my_png_warning (png_ptr
, msg
)
8294 png_struct
*png_ptr
;
8297 xassert (png_ptr
!= NULL
);
8298 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8301 /* Memory source for PNG decoding. */
8303 struct png_memory_storage
8305 unsigned char *bytes
; /* The data */
8306 size_t len
; /* How big is it? */
8307 int index
; /* Where are we? */
8311 /* Function set as reader function when reading PNG image from memory.
8312 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8313 bytes from the input to DATA. */
8316 png_read_from_memory (png_ptr
, data
, length
)
8317 png_structp png_ptr
;
8321 struct png_memory_storage
*tbr
8322 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8324 if (length
> tbr
->len
- tbr
->index
)
8325 png_error (png_ptr
, "Read error");
8327 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8328 tbr
->index
= tbr
->index
+ length
;
8331 /* Load PNG image IMG for use on frame F. Value is non-zero if
8339 Lisp_Object file
, specified_file
;
8340 Lisp_Object specified_data
;
8342 XImage
*ximg
, *mask_img
= NULL
;
8343 struct gcpro gcpro1
;
8344 png_struct
*png_ptr
= NULL
;
8345 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8348 png_byte
*pixels
= NULL
;
8349 png_byte
**rows
= NULL
;
8350 png_uint_32 width
, height
;
8351 int bit_depth
, color_type
, interlace_type
;
8353 png_uint_32 row_bytes
;
8356 double screen_gamma
, image_gamma
;
8358 struct png_memory_storage tbr
; /* Data to be read */
8360 /* Find out what file to load. */
8361 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8362 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8366 if (NILP (specified_data
))
8368 file
= x_find_image_file (specified_file
);
8369 if (!STRINGP (file
))
8371 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8376 /* Open the image file. */
8377 fp
= fopen (XSTRING (file
)->data
, "rb");
8380 image_error ("Cannot open image file `%s'", file
, Qnil
);
8386 /* Check PNG signature. */
8387 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8388 || !png_check_sig (sig
, sizeof sig
))
8390 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8398 /* Read from memory. */
8399 tbr
.bytes
= XSTRING (specified_data
)->data
;
8400 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8403 /* Check PNG signature. */
8404 if (tbr
.len
< sizeof sig
8405 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8407 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8412 /* Need to skip past the signature. */
8413 tbr
.bytes
+= sizeof (sig
);
8416 /* Initialize read and info structs for PNG lib. */
8417 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8418 my_png_error
, my_png_warning
);
8421 if (fp
) fclose (fp
);
8426 info_ptr
= png_create_info_struct (png_ptr
);
8429 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8430 if (fp
) fclose (fp
);
8435 end_info
= png_create_info_struct (png_ptr
);
8438 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8439 if (fp
) fclose (fp
);
8444 /* Set error jump-back. We come back here when the PNG library
8445 detects an error. */
8446 if (setjmp (png_ptr
->jmpbuf
))
8450 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8453 if (fp
) fclose (fp
);
8458 /* Read image info. */
8459 if (!NILP (specified_data
))
8460 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8462 png_init_io (png_ptr
, fp
);
8464 png_set_sig_bytes (png_ptr
, sizeof sig
);
8465 png_read_info (png_ptr
, info_ptr
);
8466 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8467 &interlace_type
, NULL
, NULL
);
8469 /* If image contains simply transparency data, we prefer to
8470 construct a clipping mask. */
8471 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8476 /* This function is easier to write if we only have to handle
8477 one data format: RGB or RGBA with 8 bits per channel. Let's
8478 transform other formats into that format. */
8480 /* Strip more than 8 bits per channel. */
8481 if (bit_depth
== 16)
8482 png_set_strip_16 (png_ptr
);
8484 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8486 png_set_expand (png_ptr
);
8488 /* Convert grayscale images to RGB. */
8489 if (color_type
== PNG_COLOR_TYPE_GRAY
8490 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8491 png_set_gray_to_rgb (png_ptr
);
8493 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8494 gamma_str
= getenv ("SCREEN_GAMMA");
8495 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8497 /* Tell the PNG lib to handle gamma correction for us. */
8499 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8500 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8501 /* There is a special chunk in the image specifying the gamma. */
8502 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8505 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8506 /* Image contains gamma information. */
8507 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8509 /* Use a default of 0.5 for the image gamma. */
8510 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8512 /* Handle alpha channel by combining the image with a background
8513 color. Do this only if a real alpha channel is supplied. For
8514 simple transparency, we prefer a clipping mask. */
8517 png_color_16
*image_background
;
8519 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8520 /* Image contains a background color with which to
8521 combine the image. */
8522 png_set_background (png_ptr
, image_background
,
8523 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8526 /* Image does not contain a background color with which
8527 to combine the image data via an alpha channel. Use
8528 the frame's background instead. */
8531 png_color_16 frame_background
;
8534 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
8535 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8536 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
8539 bzero (&frame_background
, sizeof frame_background
);
8540 frame_background
.red
= color
.red
;
8541 frame_background
.green
= color
.green
;
8542 frame_background
.blue
= color
.blue
;
8544 png_set_background (png_ptr
, &frame_background
,
8545 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8549 /* Update info structure. */
8550 png_read_update_info (png_ptr
, info_ptr
);
8552 /* Get number of channels. Valid values are 1 for grayscale images
8553 and images with a palette, 2 for grayscale images with transparency
8554 information (alpha channel), 3 for RGB images, and 4 for RGB
8555 images with alpha channel, i.e. RGBA. If conversions above were
8556 sufficient we should only have 3 or 4 channels here. */
8557 channels
= png_get_channels (png_ptr
, info_ptr
);
8558 xassert (channels
== 3 || channels
== 4);
8560 /* Number of bytes needed for one row of the image. */
8561 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8563 /* Allocate memory for the image. */
8564 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8565 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8566 for (i
= 0; i
< height
; ++i
)
8567 rows
[i
] = pixels
+ i
* row_bytes
;
8569 /* Read the entire image. */
8570 png_read_image (png_ptr
, rows
);
8571 png_read_end (png_ptr
, info_ptr
);
8580 /* Create the X image and pixmap. */
8581 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8588 /* Create an image and pixmap serving as mask if the PNG image
8589 contains an alpha channel. */
8592 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8593 &mask_img
, &img
->mask
))
8595 x_destroy_x_image (ximg
);
8596 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8602 /* Fill the X image and mask from PNG data. */
8603 init_color_table ();
8605 for (y
= 0; y
< height
; ++y
)
8607 png_byte
*p
= rows
[y
];
8609 for (x
= 0; x
< width
; ++x
)
8616 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8618 /* An alpha channel, aka mask channel, associates variable
8619 transparency with an image. Where other image formats
8620 support binary transparency---fully transparent or fully
8621 opaque---PNG allows up to 254 levels of partial transparency.
8622 The PNG library implements partial transparency by combining
8623 the image with a specified background color.
8625 I'm not sure how to handle this here nicely: because the
8626 background on which the image is displayed may change, for
8627 real alpha channel support, it would be necessary to create
8628 a new image for each possible background.
8630 What I'm doing now is that a mask is created if we have
8631 boolean transparency information. Otherwise I'm using
8632 the frame's background color to combine the image with. */
8637 XPutPixel (mask_img
, x
, y
, *p
> 0);
8643 /* Remember colors allocated for this image. */
8644 img
->colors
= colors_in_color_table (&img
->ncolors
);
8645 free_color_table ();
8648 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8653 img
->height
= height
;
8655 /* Put the image into the pixmap, then free the X image and its buffer. */
8656 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8657 x_destroy_x_image (ximg
);
8659 /* Same for the mask. */
8662 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8663 x_destroy_x_image (mask_img
);
8671 #endif /* HAVE_PNG != 0 */
8675 /***********************************************************************
8677 ***********************************************************************/
8681 /* Work around a warning about HAVE_STDLIB_H being redefined in
8683 #ifdef HAVE_STDLIB_H
8684 #define HAVE_STDLIB_H_1
8685 #undef HAVE_STDLIB_H
8686 #endif /* HAVE_STLIB_H */
8688 #include <jpeglib.h>
8692 #ifdef HAVE_STLIB_H_1
8693 #define HAVE_STDLIB_H 1
8696 static int jpeg_image_p
P_ ((Lisp_Object object
));
8697 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8699 /* The symbol `jpeg' identifying images of this type. */
8703 /* Indices of image specification fields in gs_format, below. */
8705 enum jpeg_keyword_index
8714 JPEG_HEURISTIC_MASK
,
8718 /* Vector of image_keyword structures describing the format
8719 of valid user-defined image specifications. */
8721 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8723 {":type", IMAGE_SYMBOL_VALUE
, 1},
8724 {":data", IMAGE_STRING_VALUE
, 0},
8725 {":file", IMAGE_STRING_VALUE
, 0},
8726 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8727 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8728 {":relief", IMAGE_INTEGER_VALUE
, 0},
8729 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8730 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8733 /* Structure describing the image type `jpeg'. */
8735 static struct image_type jpeg_type
=
8745 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8748 jpeg_image_p (object
)
8751 struct image_keyword fmt
[JPEG_LAST
];
8753 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8755 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
)
8756 || (fmt
[JPEG_ASCENT
].count
8757 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
8760 /* Must specify either the :data or :file keyword. */
8761 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8765 struct my_jpeg_error_mgr
8767 struct jpeg_error_mgr pub
;
8768 jmp_buf setjmp_buffer
;
8772 my_error_exit (cinfo
)
8775 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8776 longjmp (mgr
->setjmp_buffer
, 1);
8779 /* Init source method for JPEG data source manager. Called by
8780 jpeg_read_header() before any data is actually read. See
8781 libjpeg.doc from the JPEG lib distribution. */
8784 our_init_source (cinfo
)
8785 j_decompress_ptr cinfo
;
8790 /* Fill input buffer method for JPEG data source manager. Called
8791 whenever more data is needed. We read the whole image in one step,
8792 so this only adds a fake end of input marker at the end. */
8795 our_fill_input_buffer (cinfo
)
8796 j_decompress_ptr cinfo
;
8798 /* Insert a fake EOI marker. */
8799 struct jpeg_source_mgr
*src
= cinfo
->src
;
8800 static JOCTET buffer
[2];
8802 buffer
[0] = (JOCTET
) 0xFF;
8803 buffer
[1] = (JOCTET
) JPEG_EOI
;
8805 src
->next_input_byte
= buffer
;
8806 src
->bytes_in_buffer
= 2;
8811 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8812 is the JPEG data source manager. */
8815 our_skip_input_data (cinfo
, num_bytes
)
8816 j_decompress_ptr cinfo
;
8819 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8823 if (num_bytes
> src
->bytes_in_buffer
)
8824 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8826 src
->bytes_in_buffer
-= num_bytes
;
8827 src
->next_input_byte
+= num_bytes
;
8832 /* Method to terminate data source. Called by
8833 jpeg_finish_decompress() after all data has been processed. */
8836 our_term_source (cinfo
)
8837 j_decompress_ptr cinfo
;
8842 /* Set up the JPEG lib for reading an image from DATA which contains
8843 LEN bytes. CINFO is the decompression info structure created for
8844 reading the image. */
8847 jpeg_memory_src (cinfo
, data
, len
)
8848 j_decompress_ptr cinfo
;
8852 struct jpeg_source_mgr
*src
;
8854 if (cinfo
->src
== NULL
)
8856 /* First time for this JPEG object? */
8857 cinfo
->src
= (struct jpeg_source_mgr
*)
8858 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8859 sizeof (struct jpeg_source_mgr
));
8860 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8861 src
->next_input_byte
= data
;
8864 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8865 src
->init_source
= our_init_source
;
8866 src
->fill_input_buffer
= our_fill_input_buffer
;
8867 src
->skip_input_data
= our_skip_input_data
;
8868 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
8869 src
->term_source
= our_term_source
;
8870 src
->bytes_in_buffer
= len
;
8871 src
->next_input_byte
= data
;
8875 /* Load image IMG for use on frame F. Patterned after example.c
8876 from the JPEG lib. */
8883 struct jpeg_decompress_struct cinfo
;
8884 struct my_jpeg_error_mgr mgr
;
8885 Lisp_Object file
, specified_file
;
8886 Lisp_Object specified_data
;
8889 int row_stride
, x
, y
;
8890 XImage
*ximg
= NULL
;
8892 unsigned long *colors
;
8894 struct gcpro gcpro1
;
8896 /* Open the JPEG file. */
8897 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8898 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8902 if (NILP (specified_data
))
8904 file
= x_find_image_file (specified_file
);
8905 if (!STRINGP (file
))
8907 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8912 fp
= fopen (XSTRING (file
)->data
, "r");
8915 image_error ("Cannot open `%s'", file
, Qnil
);
8921 /* Customize libjpeg's error handling to call my_error_exit when an
8922 error is detected. This function will perform a longjmp. */
8923 mgr
.pub
.error_exit
= my_error_exit
;
8924 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8926 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8930 /* Called from my_error_exit. Display a JPEG error. */
8931 char buffer
[JMSG_LENGTH_MAX
];
8932 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8933 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
8934 build_string (buffer
));
8937 /* Close the input file and destroy the JPEG object. */
8940 jpeg_destroy_decompress (&cinfo
);
8944 /* If we already have an XImage, free that. */
8945 x_destroy_x_image (ximg
);
8947 /* Free pixmap and colors. */
8948 x_clear_image (f
, img
);
8955 /* Create the JPEG decompression object. Let it read from fp.
8956 Read the JPEG image header. */
8957 jpeg_create_decompress (&cinfo
);
8959 if (NILP (specified_data
))
8960 jpeg_stdio_src (&cinfo
, fp
);
8962 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
8963 STRING_BYTES (XSTRING (specified_data
)));
8965 jpeg_read_header (&cinfo
, TRUE
);
8967 /* Customize decompression so that color quantization will be used.
8968 Start decompression. */
8969 cinfo
.quantize_colors
= TRUE
;
8970 jpeg_start_decompress (&cinfo
);
8971 width
= img
->width
= cinfo
.output_width
;
8972 height
= img
->height
= cinfo
.output_height
;
8976 /* Create X image and pixmap. */
8977 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8980 longjmp (mgr
.setjmp_buffer
, 2);
8983 /* Allocate colors. When color quantization is used,
8984 cinfo.actual_number_of_colors has been set with the number of
8985 colors generated, and cinfo.colormap is a two-dimensional array
8986 of color indices in the range 0..cinfo.actual_number_of_colors.
8987 No more than 255 colors will be generated. */
8991 if (cinfo
.out_color_components
> 2)
8992 ir
= 0, ig
= 1, ib
= 2;
8993 else if (cinfo
.out_color_components
> 1)
8994 ir
= 0, ig
= 1, ib
= 0;
8996 ir
= 0, ig
= 0, ib
= 0;
8998 /* Use the color table mechanism because it handles colors that
8999 cannot be allocated nicely. Such colors will be replaced with
9000 a default color, and we don't have to care about which colors
9001 can be freed safely, and which can't. */
9002 init_color_table ();
9003 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9006 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9008 /* Multiply RGB values with 255 because X expects RGB values
9009 in the range 0..0xffff. */
9010 int r
= cinfo
.colormap
[ir
][i
] << 8;
9011 int g
= cinfo
.colormap
[ig
][i
] << 8;
9012 int b
= cinfo
.colormap
[ib
][i
] << 8;
9013 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9016 /* Remember those colors actually allocated. */
9017 img
->colors
= colors_in_color_table (&img
->ncolors
);
9018 free_color_table ();
9022 row_stride
= width
* cinfo
.output_components
;
9023 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9025 for (y
= 0; y
< height
; ++y
)
9027 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9028 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9029 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9033 jpeg_finish_decompress (&cinfo
);
9034 jpeg_destroy_decompress (&cinfo
);
9038 /* Put the image into the pixmap. */
9039 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9040 x_destroy_x_image (ximg
);
9046 #endif /* HAVE_JPEG */
9050 /***********************************************************************
9052 ***********************************************************************/
9058 static int tiff_image_p
P_ ((Lisp_Object object
));
9059 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9061 /* The symbol `tiff' identifying images of this type. */
9065 /* Indices of image specification fields in tiff_format, below. */
9067 enum tiff_keyword_index
9076 TIFF_HEURISTIC_MASK
,
9080 /* Vector of image_keyword structures describing the format
9081 of valid user-defined image specifications. */
9083 static struct image_keyword tiff_format
[TIFF_LAST
] =
9085 {":type", IMAGE_SYMBOL_VALUE
, 1},
9086 {":data", IMAGE_STRING_VALUE
, 0},
9087 {":file", IMAGE_STRING_VALUE
, 0},
9088 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9089 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9090 {":relief", IMAGE_INTEGER_VALUE
, 0},
9091 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9092 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9095 /* Structure describing the image type `tiff'. */
9097 static struct image_type tiff_type
=
9107 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9110 tiff_image_p (object
)
9113 struct image_keyword fmt
[TIFF_LAST
];
9114 bcopy (tiff_format
, fmt
, sizeof fmt
);
9116 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
)
9117 || (fmt
[TIFF_ASCENT
].count
9118 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
9121 /* Must specify either the :data or :file keyword. */
9122 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9126 /* Reading from a memory buffer for TIFF images Based on the PNG
9127 memory source, but we have to provide a lot of extra functions.
9130 We really only need to implement read and seek, but I am not
9131 convinced that the TIFF library is smart enough not to destroy
9132 itself if we only hand it the function pointers we need to
9137 unsigned char *bytes
;
9144 tiff_read_from_memory (data
, buf
, size
)
9149 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9151 if (size
> src
->len
- src
->index
)
9153 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9159 tiff_write_from_memory (data
, buf
, size
)
9168 tiff_seek_in_memory (data
, off
, whence
)
9173 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9178 case SEEK_SET
: /* Go from beginning of source. */
9182 case SEEK_END
: /* Go from end of source. */
9183 idx
= src
->len
+ off
;
9186 case SEEK_CUR
: /* Go from current position. */
9187 idx
= src
->index
+ off
;
9190 default: /* Invalid `whence'. */
9194 if (idx
> src
->len
|| idx
< 0)
9202 tiff_close_memory (data
)
9210 tiff_mmap_memory (data
, pbase
, psize
)
9215 /* It is already _IN_ memory. */
9220 tiff_unmap_memory (data
, base
, size
)
9225 /* We don't need to do this. */
9229 tiff_size_of_memory (data
)
9232 return ((tiff_memory_source
*) data
)->len
;
9235 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9243 Lisp_Object file
, specified_file
;
9244 Lisp_Object specified_data
;
9246 int width
, height
, x
, y
;
9250 struct gcpro gcpro1
;
9251 tiff_memory_source memsrc
;
9253 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9254 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9258 if (NILP (specified_data
))
9260 /* Read from a file */
9261 file
= x_find_image_file (specified_file
);
9262 if (!STRINGP (file
))
9264 image_error ("Cannot find image file `%s'", file
, Qnil
);
9269 /* Try to open the image file. */
9270 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9273 image_error ("Cannot open `%s'", file
, Qnil
);
9280 /* Memory source! */
9281 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9282 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9285 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9286 (TIFFReadWriteProc
) tiff_read_from_memory
,
9287 (TIFFReadWriteProc
) tiff_write_from_memory
,
9288 tiff_seek_in_memory
,
9290 tiff_size_of_memory
,
9296 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9302 /* Get width and height of the image, and allocate a raster buffer
9303 of width x height 32-bit values. */
9304 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9305 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9306 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9308 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9312 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9320 /* Create the X image and pixmap. */
9321 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9329 /* Initialize the color table. */
9330 init_color_table ();
9332 /* Process the pixel raster. Origin is in the lower-left corner. */
9333 for (y
= 0; y
< height
; ++y
)
9335 uint32
*row
= buf
+ y
* width
;
9337 for (x
= 0; x
< width
; ++x
)
9339 uint32 abgr
= row
[x
];
9340 int r
= TIFFGetR (abgr
) << 8;
9341 int g
= TIFFGetG (abgr
) << 8;
9342 int b
= TIFFGetB (abgr
) << 8;
9343 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9347 /* Remember the colors allocated for the image. Free the color table. */
9348 img
->colors
= colors_in_color_table (&img
->ncolors
);
9349 free_color_table ();
9351 /* Put the image into the pixmap, then free the X image and its buffer. */
9352 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9353 x_destroy_x_image (ximg
);
9358 img
->height
= height
;
9364 #endif /* HAVE_TIFF != 0 */
9368 /***********************************************************************
9370 ***********************************************************************/
9374 #include <gif_lib.h>
9376 static int gif_image_p
P_ ((Lisp_Object object
));
9377 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9379 /* The symbol `gif' identifying images of this type. */
9383 /* Indices of image specification fields in gif_format, below. */
9385 enum gif_keyword_index
9399 /* Vector of image_keyword structures describing the format
9400 of valid user-defined image specifications. */
9402 static struct image_keyword gif_format
[GIF_LAST
] =
9404 {":type", IMAGE_SYMBOL_VALUE
, 1},
9405 {":data", IMAGE_STRING_VALUE
, 0},
9406 {":file", IMAGE_STRING_VALUE
, 0},
9407 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9408 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9409 {":relief", IMAGE_INTEGER_VALUE
, 0},
9410 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9411 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9412 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9415 /* Structure describing the image type `gif'. */
9417 static struct image_type gif_type
=
9426 /* Return non-zero if OBJECT is a valid GIF image specification. */
9429 gif_image_p (object
)
9432 struct image_keyword fmt
[GIF_LAST
];
9433 bcopy (gif_format
, fmt
, sizeof fmt
);
9435 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
)
9436 || (fmt
[GIF_ASCENT
].count
9437 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
9440 /* Must specify either the :data or :file keyword. */
9441 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9444 /* Reading a GIF image from memory
9445 Based on the PNG memory stuff to a certain extent. */
9449 unsigned char *bytes
;
9455 /* Make the current memory source available to gif_read_from_memory.
9456 It's done this way because not all versions of libungif support
9457 a UserData field in the GifFileType structure. */
9458 static gif_memory_source
*current_gif_memory_src
;
9461 gif_read_from_memory (file
, buf
, len
)
9466 gif_memory_source
*src
= current_gif_memory_src
;
9468 if (len
> src
->len
- src
->index
)
9471 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9477 /* Load GIF image IMG for use on frame F. Value is non-zero if
9485 Lisp_Object file
, specified_file
;
9486 Lisp_Object specified_data
;
9487 int rc
, width
, height
, x
, y
, i
;
9489 ColorMapObject
*gif_color_map
;
9490 unsigned long pixel_colors
[256];
9492 struct gcpro gcpro1
;
9494 int ino
, image_left
, image_top
, image_width
, image_height
;
9495 gif_memory_source memsrc
;
9496 unsigned char *raster
;
9498 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9499 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9503 if (NILP (specified_data
))
9505 file
= x_find_image_file (specified_file
);
9506 if (!STRINGP (file
))
9508 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9513 /* Open the GIF file. */
9514 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9517 image_error ("Cannot open `%s'", file
, Qnil
);
9524 /* Read from memory! */
9525 current_gif_memory_src
= &memsrc
;
9526 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9527 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9530 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9533 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9539 /* Read entire contents. */
9540 rc
= DGifSlurp (gif
);
9541 if (rc
== GIF_ERROR
)
9543 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9544 DGifCloseFile (gif
);
9549 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9550 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9551 if (ino
>= gif
->ImageCount
)
9553 image_error ("Invalid image number `%s' in image `%s'",
9555 DGifCloseFile (gif
);
9560 width
= img
->width
= gif
->SWidth
;
9561 height
= img
->height
= gif
->SHeight
;
9565 /* Create the X image and pixmap. */
9566 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9569 DGifCloseFile (gif
);
9574 /* Allocate colors. */
9575 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9577 gif_color_map
= gif
->SColorMap
;
9578 init_color_table ();
9579 bzero (pixel_colors
, sizeof pixel_colors
);
9581 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9583 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9584 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9585 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9586 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9589 img
->colors
= colors_in_color_table (&img
->ncolors
);
9590 free_color_table ();
9592 /* Clear the part of the screen image that are not covered by
9593 the image from the GIF file. Full animated GIF support
9594 requires more than can be done here (see the gif89 spec,
9595 disposal methods). Let's simply assume that the part
9596 not covered by a sub-image is in the frame's background color. */
9597 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9598 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9599 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9600 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9602 for (y
= 0; y
< image_top
; ++y
)
9603 for (x
= 0; x
< width
; ++x
)
9604 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9606 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9607 for (x
= 0; x
< width
; ++x
)
9608 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9610 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9612 for (x
= 0; x
< image_left
; ++x
)
9613 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9614 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9615 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9618 /* Read the GIF image into the X image. We use a local variable
9619 `raster' here because RasterBits below is a char *, and invites
9620 problems with bytes >= 0x80. */
9621 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9623 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9625 static int interlace_start
[] = {0, 4, 2, 1};
9626 static int interlace_increment
[] = {8, 8, 4, 2};
9628 int row
= interlace_start
[0];
9632 for (y
= 0; y
< image_height
; y
++)
9634 if (row
>= image_height
)
9636 row
= interlace_start
[++pass
];
9637 while (row
>= image_height
)
9638 row
= interlace_start
[++pass
];
9641 for (x
= 0; x
< image_width
; x
++)
9643 int i
= raster
[(y
* image_width
) + x
];
9644 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9648 row
+= interlace_increment
[pass
];
9653 for (y
= 0; y
< image_height
; ++y
)
9654 for (x
= 0; x
< image_width
; ++x
)
9656 int i
= raster
[y
* image_width
+ x
];
9657 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9661 DGifCloseFile (gif
);
9663 /* Put the image into the pixmap, then free the X image and its buffer. */
9664 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9665 x_destroy_x_image (ximg
);
9672 #endif /* HAVE_GIF != 0 */
9676 /***********************************************************************
9678 ***********************************************************************/
9680 static int gs_image_p
P_ ((Lisp_Object object
));
9681 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9682 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9684 /* The symbol `postscript' identifying images of this type. */
9686 Lisp_Object Qpostscript
;
9688 /* Keyword symbols. */
9690 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9692 /* Indices of image specification fields in gs_format, below. */
9694 enum gs_keyword_index
9710 /* Vector of image_keyword structures describing the format
9711 of valid user-defined image specifications. */
9713 static struct image_keyword gs_format
[GS_LAST
] =
9715 {":type", IMAGE_SYMBOL_VALUE
, 1},
9716 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9717 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9718 {":file", IMAGE_STRING_VALUE
, 1},
9719 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9720 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9721 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9722 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9723 {":relief", IMAGE_INTEGER_VALUE
, 0},
9724 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9725 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9728 /* Structure describing the image type `ghostscript'. */
9730 static struct image_type gs_type
=
9740 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9743 gs_clear_image (f
, img
)
9747 /* IMG->data.ptr_val may contain a recorded colormap. */
9748 xfree (img
->data
.ptr_val
);
9749 x_clear_image (f
, img
);
9753 /* Return non-zero if OBJECT is a valid Ghostscript image
9760 struct image_keyword fmt
[GS_LAST
];
9764 bcopy (gs_format
, fmt
, sizeof fmt
);
9766 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
)
9767 || (fmt
[GS_ASCENT
].count
9768 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
9771 /* Bounding box must be a list or vector containing 4 integers. */
9772 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9775 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9776 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9781 else if (VECTORP (tem
))
9783 if (XVECTOR (tem
)->size
!= 4)
9785 for (i
= 0; i
< 4; ++i
)
9786 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9796 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9805 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9806 struct gcpro gcpro1
, gcpro2
;
9808 double in_width
, in_height
;
9809 Lisp_Object pixel_colors
= Qnil
;
9811 /* Compute pixel size of pixmap needed from the given size in the
9812 image specification. Sizes in the specification are in pt. 1 pt
9813 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9815 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9816 in_width
= XFASTINT (pt_width
) / 72.0;
9817 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9818 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9819 in_height
= XFASTINT (pt_height
) / 72.0;
9820 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9822 /* Create the pixmap. */
9824 xassert (img
->pixmap
== 0);
9825 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9826 img
->width
, img
->height
,
9827 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9832 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9836 /* Call the loader to fill the pixmap. It returns a process object
9837 if successful. We do not record_unwind_protect here because
9838 other places in redisplay like calling window scroll functions
9839 don't either. Let the Lisp loader use `unwind-protect' instead. */
9840 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9842 sprintf (buffer
, "%lu %lu",
9843 (unsigned long) FRAME_X_WINDOW (f
),
9844 (unsigned long) img
->pixmap
);
9845 window_and_pixmap_id
= build_string (buffer
);
9847 sprintf (buffer
, "%lu %lu",
9848 FRAME_FOREGROUND_PIXEL (f
),
9849 FRAME_BACKGROUND_PIXEL (f
));
9850 pixel_colors
= build_string (buffer
);
9852 XSETFRAME (frame
, f
);
9853 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9855 loader
= intern ("gs-load-image");
9857 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9858 make_number (img
->width
),
9859 make_number (img
->height
),
9860 window_and_pixmap_id
,
9863 return PROCESSP (img
->data
.lisp_val
);
9867 /* Kill the Ghostscript process that was started to fill PIXMAP on
9868 frame F. Called from XTread_socket when receiving an event
9869 telling Emacs that Ghostscript has finished drawing. */
9872 x_kill_gs_process (pixmap
, f
)
9876 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9880 /* Find the image containing PIXMAP. */
9881 for (i
= 0; i
< c
->used
; ++i
)
9882 if (c
->images
[i
]->pixmap
== pixmap
)
9885 /* Kill the GS process. We should have found PIXMAP in the image
9886 cache and its image should contain a process object. */
9887 xassert (i
< c
->used
);
9889 xassert (PROCESSP (img
->data
.lisp_val
));
9890 Fkill_process (img
->data
.lisp_val
, Qnil
);
9891 img
->data
.lisp_val
= Qnil
;
9893 /* On displays with a mutable colormap, figure out the colors
9894 allocated for the image by looking at the pixels of an XImage for
9896 class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
9897 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9903 /* Try to get an XImage for img->pixmep. */
9904 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9905 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9910 /* Initialize the color table. */
9911 init_color_table ();
9913 /* For each pixel of the image, look its color up in the
9914 color table. After having done so, the color table will
9915 contain an entry for each color used by the image. */
9916 for (y
= 0; y
< img
->height
; ++y
)
9917 for (x
= 0; x
< img
->width
; ++x
)
9919 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9920 lookup_pixel_color (f
, pixel
);
9923 /* Record colors in the image. Free color table and XImage. */
9924 img
->colors
= colors_in_color_table (&img
->ncolors
);
9925 free_color_table ();
9926 XDestroyImage (ximg
);
9928 #if 0 /* This doesn't seem to be the case. If we free the colors
9929 here, we get a BadAccess later in x_clear_image when
9930 freeing the colors. */
9931 /* We have allocated colors once, but Ghostscript has also
9932 allocated colors on behalf of us. So, to get the
9933 reference counts right, free them once. */
9936 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
9937 XFreeColors (FRAME_X_DISPLAY (f
), cmap
,
9938 img
->colors
, img
->ncolors
, 0);
9943 image_error ("Cannot get X image of `%s'; colors will not be freed",
9952 /***********************************************************************
9954 ***********************************************************************/
9956 DEFUN ("x-change-window-property", Fx_change_window_property
,
9957 Sx_change_window_property
, 2, 3, 0,
9958 "Change window property PROP to VALUE on the X window of FRAME.\n\
9959 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9960 selected frame. Value is VALUE.")
9961 (prop
, value
, frame
)
9962 Lisp_Object frame
, prop
, value
;
9964 struct frame
*f
= check_x_frame (frame
);
9967 CHECK_STRING (prop
, 1);
9968 CHECK_STRING (value
, 2);
9971 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9972 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9973 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9974 XSTRING (value
)->data
, XSTRING (value
)->size
);
9976 /* Make sure the property is set when we return. */
9977 XFlush (FRAME_X_DISPLAY (f
));
9984 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9985 Sx_delete_window_property
, 1, 2, 0,
9986 "Remove window property PROP from X window of FRAME.\n\
9987 FRAME nil or omitted means use the selected frame. Value is PROP.")
9989 Lisp_Object prop
, frame
;
9991 struct frame
*f
= check_x_frame (frame
);
9994 CHECK_STRING (prop
, 1);
9996 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9997 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9999 /* Make sure the property is removed when we return. */
10000 XFlush (FRAME_X_DISPLAY (f
));
10007 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10009 "Value is the value of window property PROP on FRAME.\n\
10010 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10011 if FRAME hasn't a property with name PROP or if PROP has no string\n\
10014 Lisp_Object prop
, frame
;
10016 struct frame
*f
= check_x_frame (frame
);
10019 Lisp_Object prop_value
= Qnil
;
10020 char *tmp_data
= NULL
;
10023 unsigned long actual_size
, bytes_remaining
;
10025 CHECK_STRING (prop
, 1);
10027 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10028 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10029 prop_atom
, 0, 0, False
, XA_STRING
,
10030 &actual_type
, &actual_format
, &actual_size
,
10031 &bytes_remaining
, (unsigned char **) &tmp_data
);
10034 int size
= bytes_remaining
;
10039 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10040 prop_atom
, 0, bytes_remaining
,
10042 &actual_type
, &actual_format
,
10043 &actual_size
, &bytes_remaining
,
10044 (unsigned char **) &tmp_data
);
10046 prop_value
= make_string (tmp_data
, size
);
10057 /***********************************************************************
10059 ***********************************************************************/
10061 /* If non-null, an asynchronous timer that, when it expires, displays
10062 a busy cursor on all frames. */
10064 static struct atimer
*busy_cursor_atimer
;
10066 /* Non-zero means a busy cursor is currently shown. */
10068 static int busy_cursor_shown_p
;
10070 /* Number of seconds to wait before displaying a busy cursor. */
10072 static Lisp_Object Vbusy_cursor_delay
;
10074 /* Default number of seconds to wait before displaying a busy
10077 #define DEFAULT_BUSY_CURSOR_DELAY 1
10079 /* Function prototypes. */
10081 static void show_busy_cursor
P_ ((struct atimer
*));
10082 static void hide_busy_cursor
P_ ((void));
10085 /* Cancel a currently active busy-cursor timer, and start a new one. */
10088 start_busy_cursor ()
10091 int secs
, usecs
= 0;
10093 cancel_busy_cursor ();
10095 if (INTEGERP (Vbusy_cursor_delay
)
10096 && XINT (Vbusy_cursor_delay
) > 0)
10097 secs
= XFASTINT (Vbusy_cursor_delay
);
10098 else if (FLOATP (Vbusy_cursor_delay
)
10099 && XFLOAT_DATA (Vbusy_cursor_delay
) > 0)
10102 tem
= Ftruncate (Vbusy_cursor_delay
, Qnil
);
10103 secs
= XFASTINT (tem
);
10104 usecs
= (XFLOAT_DATA (Vbusy_cursor_delay
) - secs
) * 1000000;
10107 secs
= DEFAULT_BUSY_CURSOR_DELAY
;
10109 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10110 busy_cursor_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10111 show_busy_cursor
, NULL
);
10115 /* Cancel the busy cursor timer if active, hide a busy cursor if
10119 cancel_busy_cursor ()
10121 if (busy_cursor_atimer
)
10123 cancel_atimer (busy_cursor_atimer
);
10124 busy_cursor_atimer
= NULL
;
10127 if (busy_cursor_shown_p
)
10128 hide_busy_cursor ();
10132 /* Timer function of busy_cursor_atimer. TIMER is equal to
10133 busy_cursor_atimer.
10135 Display a busy cursor on all frames by mapping the frames'
10136 busy_window. Set the busy_p flag in the frames' output_data.x
10137 structure to indicate that a busy cursor is shown on the
10141 show_busy_cursor (timer
)
10142 struct atimer
*timer
;
10144 /* The timer implementation will cancel this timer automatically
10145 after this function has run. Set busy_cursor_atimer to null
10146 so that we know the timer doesn't have to be canceled. */
10147 busy_cursor_atimer
= NULL
;
10149 if (!busy_cursor_shown_p
)
10151 Lisp_Object rest
, frame
;
10155 FOR_EACH_FRAME (rest
, frame
)
10156 if (FRAME_X_P (XFRAME (frame
)))
10158 struct frame
*f
= XFRAME (frame
);
10160 f
->output_data
.x
->busy_p
= 1;
10162 if (!f
->output_data
.x
->busy_window
)
10164 unsigned long mask
= CWCursor
;
10165 XSetWindowAttributes attrs
;
10167 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
10169 f
->output_data
.x
->busy_window
10170 = XCreateWindow (FRAME_X_DISPLAY (f
),
10171 FRAME_OUTER_WINDOW (f
),
10172 0, 0, 32000, 32000, 0, 0,
10178 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10179 XFlush (FRAME_X_DISPLAY (f
));
10182 busy_cursor_shown_p
= 1;
10188 /* Hide the busy cursor on all frames, if it is currently shown. */
10191 hide_busy_cursor ()
10193 if (busy_cursor_shown_p
)
10195 Lisp_Object rest
, frame
;
10198 FOR_EACH_FRAME (rest
, frame
)
10200 struct frame
*f
= XFRAME (frame
);
10203 /* Watch out for newly created frames. */
10204 && f
->output_data
.x
->busy_window
)
10206 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10207 /* Sync here because XTread_socket looks at the busy_p flag
10208 that is reset to zero below. */
10209 XSync (FRAME_X_DISPLAY (f
), False
);
10210 f
->output_data
.x
->busy_p
= 0;
10214 busy_cursor_shown_p
= 0;
10221 /***********************************************************************
10223 ***********************************************************************/
10225 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10228 /* The frame of a currently visible tooltip, or null. */
10230 struct frame
*tip_frame
;
10232 /* If non-nil, a timer started that hides the last tooltip when it
10235 Lisp_Object tip_timer
;
10238 /* Create a frame for a tooltip on the display described by DPYINFO.
10239 PARMS is a list of frame parameters. Value is the frame. */
10242 x_create_tip_frame (dpyinfo
, parms
)
10243 struct x_display_info
*dpyinfo
;
10247 Lisp_Object frame
, tem
;
10249 long window_prompting
= 0;
10251 int count
= specpdl_ptr
- specpdl
;
10252 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10257 /* Use this general default value to start with until we know if
10258 this frame has a specified name. */
10259 Vx_resource_name
= Vinvocation_name
;
10261 #ifdef MULTI_KBOARD
10262 kb
= dpyinfo
->kboard
;
10264 kb
= &the_only_kboard
;
10267 /* Get the name of the frame to use for resource lookup. */
10268 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10269 if (!STRINGP (name
)
10270 && !EQ (name
, Qunbound
)
10272 error ("Invalid frame name--not a string or nil");
10273 Vx_resource_name
= name
;
10276 GCPRO3 (parms
, name
, frame
);
10277 tip_frame
= f
= make_frame (1);
10278 XSETFRAME (frame
, f
);
10279 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10281 f
->output_method
= output_x_window
;
10282 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10283 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10284 f
->output_data
.x
->icon_bitmap
= -1;
10285 f
->output_data
.x
->fontset
= -1;
10286 f
->icon_name
= Qnil
;
10287 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10288 #ifdef MULTI_KBOARD
10289 FRAME_KBOARD (f
) = kb
;
10291 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10292 f
->output_data
.x
->explicit_parent
= 0;
10294 /* Set the name; the functions to which we pass f expect the name to
10296 if (EQ (name
, Qunbound
) || NILP (name
))
10298 f
->name
= build_string (dpyinfo
->x_id_name
);
10299 f
->explicit_name
= 0;
10304 f
->explicit_name
= 1;
10305 /* use the frame's title when getting resources for this frame. */
10306 specbind (Qx_resource_name
, name
);
10309 /* Create fontsets from `global_fontset_alist' before handling fonts. */
10310 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
10311 fs_register_fontset (f
, XCAR (tem
));
10313 /* Extract the window parameters from the supplied values
10314 that are needed to determine window geometry. */
10318 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10321 /* First, try whatever font the caller has specified. */
10322 if (STRINGP (font
))
10324 tem
= Fquery_fontset (font
, Qnil
);
10326 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10328 font
= x_new_font (f
, XSTRING (font
)->data
);
10331 /* Try out a font which we hope has bold and italic variations. */
10332 if (!STRINGP (font
))
10333 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10334 if (!STRINGP (font
))
10335 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10336 if (! STRINGP (font
))
10337 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10338 if (! STRINGP (font
))
10339 /* This was formerly the first thing tried, but it finds too many fonts
10340 and takes too long. */
10341 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10342 /* If those didn't work, look for something which will at least work. */
10343 if (! STRINGP (font
))
10344 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10346 if (! STRINGP (font
))
10347 font
= build_string ("fixed");
10349 x_default_parameter (f
, parms
, Qfont
, font
,
10350 "font", "Font", RES_TYPE_STRING
);
10353 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10354 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10356 /* This defaults to 2 in order to match xterm. We recognize either
10357 internalBorderWidth or internalBorder (which is what xterm calls
10359 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10363 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10364 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10365 if (! EQ (value
, Qunbound
))
10366 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10370 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10371 "internalBorderWidth", "internalBorderWidth",
10374 /* Also do the stuff which must be set before the window exists. */
10375 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10376 "foreground", "Foreground", RES_TYPE_STRING
);
10377 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10378 "background", "Background", RES_TYPE_STRING
);
10379 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10380 "pointerColor", "Foreground", RES_TYPE_STRING
);
10381 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10382 "cursorColor", "Foreground", RES_TYPE_STRING
);
10383 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10384 "borderColor", "BorderColor", RES_TYPE_STRING
);
10386 /* Init faces before x_default_parameter is called for scroll-bar
10387 parameters because that function calls x_set_scroll_bar_width,
10388 which calls change_frame_size, which calls Fset_window_buffer,
10389 which runs hooks, which call Fvertical_motion. At the end, we
10390 end up in init_iterator with a null face cache, which should not
10392 init_frame_faces (f
);
10394 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10395 window_prompting
= x_figure_window_size (f
, parms
);
10397 if (window_prompting
& XNegative
)
10399 if (window_prompting
& YNegative
)
10400 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10402 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10406 if (window_prompting
& YNegative
)
10407 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10409 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10412 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10414 XSetWindowAttributes attrs
;
10415 unsigned long mask
;
10418 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
10419 /* Window managers looks at the override-redirect flag to
10420 determine whether or net to give windows a decoration (Xlib
10422 attrs
.override_redirect
= True
;
10423 attrs
.save_under
= True
;
10424 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10425 /* Arrange for getting MapNotify and UnmapNotify events. */
10426 attrs
.event_mask
= StructureNotifyMask
;
10428 = FRAME_X_WINDOW (f
)
10429 = XCreateWindow (FRAME_X_DISPLAY (f
),
10430 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10431 /* x, y, width, height */
10435 CopyFromParent
, InputOutput
, CopyFromParent
,
10442 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10443 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10444 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10445 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10446 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10447 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10449 /* Dimensions, especially f->height, must be done via change_frame_size.
10450 Change will not be effected unless different from the current
10453 height
= f
->height
;
10455 SET_FRAME_WIDTH (f
, 0);
10456 change_frame_size (f
, height
, width
, 1, 0, 0);
10462 /* It is now ok to make the frame official even if we get an error
10463 below. And the frame needs to be on Vframe_list or making it
10464 visible won't work. */
10465 Vframe_list
= Fcons (frame
, Vframe_list
);
10467 /* Now that the frame is official, it counts as a reference to
10469 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10471 return unbind_to (count
, frame
);
10475 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 4, 0,
10476 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10477 A tooltip window is a small X window displaying STRING at\n\
10478 the current mouse position.\n\
10479 FRAME nil or omitted means use the selected frame.\n\
10480 PARMS is an optional list of frame parameters which can be\n\
10481 used to change the tooltip's appearance.\n\
10482 Automatically hide the tooltip after TIMEOUT seconds.\n\
10483 TIMEOUT nil means use the default timeout of 5 seconds.")
10484 (string
, frame
, parms
, timeout
)
10485 Lisp_Object string
, frame
, parms
, timeout
;
10489 Window root
, child
;
10490 Lisp_Object buffer
;
10491 struct buffer
*old_buffer
;
10492 struct text_pos pos
;
10493 int i
, width
, height
;
10494 int root_x
, root_y
, win_x
, win_y
;
10496 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10497 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10498 int count
= specpdl_ptr
- specpdl
;
10500 specbind (Qinhibit_redisplay
, Qt
);
10502 GCPRO4 (string
, parms
, frame
, timeout
);
10504 CHECK_STRING (string
, 0);
10505 f
= check_x_frame (frame
);
10506 if (NILP (timeout
))
10507 timeout
= make_number (5);
10509 CHECK_NATNUM (timeout
, 2);
10511 /* Hide a previous tip, if any. */
10514 /* Add default values to frame parameters. */
10515 if (NILP (Fassq (Qname
, parms
)))
10516 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10517 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10518 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10519 if (NILP (Fassq (Qborder_width
, parms
)))
10520 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10521 if (NILP (Fassq (Qborder_color
, parms
)))
10522 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10523 if (NILP (Fassq (Qbackground_color
, parms
)))
10524 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10527 /* Create a frame for the tooltip, and record it in the global
10528 variable tip_frame. */
10529 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
10530 tip_frame
= f
= XFRAME (frame
);
10532 /* Set up the frame's root window. Currently we use a size of 80
10533 columns x 40 lines. If someone wants to show a larger tip, he
10534 will loose. I don't think this is a realistic case. */
10535 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10536 w
->left
= w
->top
= make_number (0);
10540 w
->pseudo_window_p
= 1;
10542 /* Display the tooltip text in a temporary buffer. */
10543 buffer
= Fget_buffer_create (build_string (" *tip*"));
10544 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10545 old_buffer
= current_buffer
;
10546 set_buffer_internal_1 (XBUFFER (buffer
));
10548 Finsert (make_number (1), &string
);
10549 clear_glyph_matrix (w
->desired_matrix
);
10550 clear_glyph_matrix (w
->current_matrix
);
10551 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10552 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10554 /* Compute width and height of the tooltip. */
10555 width
= height
= 0;
10556 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10558 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10559 struct glyph
*last
;
10562 /* Stop at the first empty row at the end. */
10563 if (!row
->enabled_p
|| !row
->displays_text_p
)
10566 /* Let the row go over the full width of the frame. */
10567 row
->full_width_p
= 1;
10569 /* There's a glyph at the end of rows that is use to place
10570 the cursor there. Don't include the width of this glyph. */
10571 if (row
->used
[TEXT_AREA
])
10573 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10574 row_width
= row
->pixel_width
- last
->pixel_width
;
10577 row_width
= row
->pixel_width
;
10579 height
+= row
->height
;
10580 width
= max (width
, row_width
);
10583 /* Add the frame's internal border to the width and height the X
10584 window should have. */
10585 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10586 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10588 /* Move the tooltip window where the mouse pointer is. Resize and
10591 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10592 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
10593 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10594 root_x
+ 5, root_y
- height
- 5, width
, height
);
10595 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10598 /* Draw into the window. */
10599 w
->must_be_updated_p
= 1;
10600 update_single_window (w
, 1);
10602 /* Restore original current buffer. */
10603 set_buffer_internal_1 (old_buffer
);
10604 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
10606 /* Let the tip disappear after timeout seconds. */
10607 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
10608 intern ("x-hide-tip"));
10611 return unbind_to (count
, Qnil
);
10615 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
10616 "Hide the current tooltip window, if there is any.\n\
10617 Value is t is tooltip was open, nil otherwise.")
10620 int count
= specpdl_ptr
- specpdl
;
10623 specbind (Qinhibit_redisplay
, Qt
);
10625 if (!NILP (tip_timer
))
10627 call1 (intern ("cancel-timer"), tip_timer
);
10635 XSETFRAME (frame
, tip_frame
);
10636 Fdelete_frame (frame
, Qt
);
10641 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
10646 /***********************************************************************
10647 File selection dialog
10648 ***********************************************************************/
10652 /* Callback for "OK" and "Cancel" on file selection dialog. */
10655 file_dialog_cb (widget
, client_data
, call_data
)
10657 XtPointer call_data
, client_data
;
10659 int *result
= (int *) client_data
;
10660 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
10661 *result
= cb
->reason
;
10665 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
10666 "Read file name, prompting with PROMPT in directory DIR.\n\
10667 Use a file selection dialog.\n\
10668 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10669 specified. Don't let the user enter a file name in the file\n\
10670 selection dialog's entry field, if MUSTMATCH is non-nil.")
10671 (prompt
, dir
, default_filename
, mustmatch
)
10672 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
10675 struct frame
*f
= SELECTED_FRAME ();
10676 Lisp_Object file
= Qnil
;
10677 Widget dialog
, text
, list
, help
;
10680 extern XtAppContext Xt_app_con
;
10682 XmString dir_xmstring
, pattern_xmstring
;
10683 int popup_activated_flag
;
10684 int count
= specpdl_ptr
- specpdl
;
10685 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
10687 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
10688 CHECK_STRING (prompt
, 0);
10689 CHECK_STRING (dir
, 1);
10691 /* Prevent redisplay. */
10692 specbind (Qinhibit_redisplay
, Qt
);
10696 /* Create the dialog with PROMPT as title, using DIR as initial
10697 directory and using "*" as pattern. */
10698 dir
= Fexpand_file_name (dir
, Qnil
);
10699 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
10700 pattern_xmstring
= XmStringCreateLocalized ("*");
10702 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
10703 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
10704 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
10705 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
10706 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
10707 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
10709 XmStringFree (dir_xmstring
);
10710 XmStringFree (pattern_xmstring
);
10712 /* Add callbacks for OK and Cancel. */
10713 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
10714 (XtPointer
) &result
);
10715 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
10716 (XtPointer
) &result
);
10718 /* Disable the help button since we can't display help. */
10719 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
10720 XtSetSensitive (help
, False
);
10722 /* Mark OK button as default. */
10723 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
10724 XmNshowAsDefault
, True
, NULL
);
10726 /* If MUSTMATCH is non-nil, disable the file entry field of the
10727 dialog, so that the user must select a file from the files list
10728 box. We can't remove it because we wouldn't have a way to get at
10729 the result file name, then. */
10730 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
10731 if (!NILP (mustmatch
))
10734 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
10735 XtSetSensitive (text
, False
);
10736 XtSetSensitive (label
, False
);
10739 /* Manage the dialog, so that list boxes get filled. */
10740 XtManageChild (dialog
);
10742 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10743 must include the path for this to work. */
10744 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
10745 if (STRINGP (default_filename
))
10747 XmString default_xmstring
;
10751 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
10753 if (!XmListItemExists (list
, default_xmstring
))
10755 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10756 XmListAddItem (list
, default_xmstring
, 0);
10760 item_pos
= XmListItemPos (list
, default_xmstring
);
10761 XmStringFree (default_xmstring
);
10763 /* Select the item and scroll it into view. */
10764 XmListSelectPos (list
, item_pos
, True
);
10765 XmListSetPos (list
, item_pos
);
10768 /* Process all events until the user presses Cancel or OK. */
10769 for (result
= 0; result
== 0;)
10772 Widget widget
, parent
;
10774 XtAppNextEvent (Xt_app_con
, &event
);
10776 /* See if the receiver of the event is one of the widgets of
10777 the file selection dialog. If so, dispatch it. If not,
10779 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
10781 while (parent
&& parent
!= dialog
)
10782 parent
= XtParent (parent
);
10784 if (parent
== dialog
10785 || (event
.type
== Expose
10786 && !process_expose_from_menu (event
)))
10787 XtDispatchEvent (&event
);
10790 /* Get the result. */
10791 if (result
== XmCR_OK
)
10796 XtVaGetValues (dialog
, XmNtextString
, &text
, 0);
10797 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
10798 XmStringFree (text
);
10799 file
= build_string (data
);
10806 XtUnmanageChild (dialog
);
10807 XtDestroyWidget (dialog
);
10811 /* Make "Cancel" equivalent to C-g. */
10813 Fsignal (Qquit
, Qnil
);
10815 return unbind_to (count
, file
);
10818 #endif /* USE_MOTIF */
10821 /***********************************************************************
10823 ***********************************************************************/
10827 DEFUN ("imagep", Fimagep
, Simagep
, 1, 1, 0,
10828 "Value is non-nil if SPEC is a valid image specification.")
10832 return valid_image_p (spec
) ? Qt
: Qnil
;
10836 DEFUN ("lookup-image", Flookup_image
, Slookup_image
, 1, 1, 0, "")
10842 if (valid_image_p (spec
))
10843 id
= lookup_image (SELECTED_FRAME (), spec
);
10845 debug_print (spec
);
10846 return make_number (id
);
10849 #endif /* GLYPH_DEBUG != 0 */
10853 /***********************************************************************
10855 ***********************************************************************/
10860 /* This is zero if not using X windows. */
10863 /* The section below is built by the lisp expression at the top of the file,
10864 just above where these variables are declared. */
10865 /*&&& init symbols here &&&*/
10866 Qauto_raise
= intern ("auto-raise");
10867 staticpro (&Qauto_raise
);
10868 Qauto_lower
= intern ("auto-lower");
10869 staticpro (&Qauto_lower
);
10870 Qbar
= intern ("bar");
10872 Qborder_color
= intern ("border-color");
10873 staticpro (&Qborder_color
);
10874 Qborder_width
= intern ("border-width");
10875 staticpro (&Qborder_width
);
10876 Qbox
= intern ("box");
10878 Qcursor_color
= intern ("cursor-color");
10879 staticpro (&Qcursor_color
);
10880 Qcursor_type
= intern ("cursor-type");
10881 staticpro (&Qcursor_type
);
10882 Qgeometry
= intern ("geometry");
10883 staticpro (&Qgeometry
);
10884 Qicon_left
= intern ("icon-left");
10885 staticpro (&Qicon_left
);
10886 Qicon_top
= intern ("icon-top");
10887 staticpro (&Qicon_top
);
10888 Qicon_type
= intern ("icon-type");
10889 staticpro (&Qicon_type
);
10890 Qicon_name
= intern ("icon-name");
10891 staticpro (&Qicon_name
);
10892 Qinternal_border_width
= intern ("internal-border-width");
10893 staticpro (&Qinternal_border_width
);
10894 Qleft
= intern ("left");
10895 staticpro (&Qleft
);
10896 Qright
= intern ("right");
10897 staticpro (&Qright
);
10898 Qmouse_color
= intern ("mouse-color");
10899 staticpro (&Qmouse_color
);
10900 Qnone
= intern ("none");
10901 staticpro (&Qnone
);
10902 Qparent_id
= intern ("parent-id");
10903 staticpro (&Qparent_id
);
10904 Qscroll_bar_width
= intern ("scroll-bar-width");
10905 staticpro (&Qscroll_bar_width
);
10906 Qsuppress_icon
= intern ("suppress-icon");
10907 staticpro (&Qsuppress_icon
);
10908 Qundefined_color
= intern ("undefined-color");
10909 staticpro (&Qundefined_color
);
10910 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10911 staticpro (&Qvertical_scroll_bars
);
10912 Qvisibility
= intern ("visibility");
10913 staticpro (&Qvisibility
);
10914 Qwindow_id
= intern ("window-id");
10915 staticpro (&Qwindow_id
);
10916 Qouter_window_id
= intern ("outer-window-id");
10917 staticpro (&Qouter_window_id
);
10918 Qx_frame_parameter
= intern ("x-frame-parameter");
10919 staticpro (&Qx_frame_parameter
);
10920 Qx_resource_name
= intern ("x-resource-name");
10921 staticpro (&Qx_resource_name
);
10922 Quser_position
= intern ("user-position");
10923 staticpro (&Quser_position
);
10924 Quser_size
= intern ("user-size");
10925 staticpro (&Quser_size
);
10926 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10927 staticpro (&Qscroll_bar_foreground
);
10928 Qscroll_bar_background
= intern ("scroll-bar-background");
10929 staticpro (&Qscroll_bar_background
);
10930 Qscreen_gamma
= intern ("screen-gamma");
10931 staticpro (&Qscreen_gamma
);
10932 /* This is the end of symbol initialization. */
10934 /* Text property `display' should be nonsticky by default. */
10935 Vtext_property_default_nonsticky
10936 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
10939 Qlaplace
= intern ("laplace");
10940 staticpro (&Qlaplace
);
10942 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10943 staticpro (&Qface_set_after_frame_default
);
10945 Fput (Qundefined_color
, Qerror_conditions
,
10946 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10947 Fput (Qundefined_color
, Qerror_message
,
10948 build_string ("Undefined color"));
10950 init_x_parm_symbols ();
10952 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
10953 "List of directories to search for bitmap files for X.");
10954 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
10956 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
10957 "The shape of the pointer when over text.\n\
10958 Changing the value does not affect existing frames\n\
10959 unless you set the mouse color.");
10960 Vx_pointer_shape
= Qnil
;
10962 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
10963 "The name Emacs uses to look up X resources.\n\
10964 `x-get-resource' uses this as the first component of the instance name\n\
10965 when requesting resource values.\n\
10966 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10967 was invoked, or to the value specified with the `-name' or `-rn'\n\
10968 switches, if present.\n\
10970 It may be useful to bind this variable locally around a call\n\
10971 to `x-get-resource'. See also the variable `x-resource-class'.");
10972 Vx_resource_name
= Qnil
;
10974 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
10975 "The class Emacs uses to look up X resources.\n\
10976 `x-get-resource' uses this as the first component of the instance class\n\
10977 when requesting resource values.\n\
10978 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10980 Setting this variable permanently is not a reasonable thing to do,\n\
10981 but binding this variable locally around a call to `x-get-resource'\n\
10982 is a reasonable practice. See also the variable `x-resource-name'.");
10983 Vx_resource_class
= build_string (EMACS_CLASS
);
10985 #if 0 /* This doesn't really do anything. */
10986 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
10987 "The shape of the pointer when not over text.\n\
10988 This variable takes effect when you create a new frame\n\
10989 or when you set the mouse color.");
10991 Vx_nontext_pointer_shape
= Qnil
;
10993 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
10994 "The shape of the pointer when Emacs is busy.\n\
10995 This variable takes effect when you create a new frame\n\
10996 or when you set the mouse color.");
10997 Vx_busy_pointer_shape
= Qnil
;
10999 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
11000 "Non-zero means Emacs displays a busy cursor on window systems.");
11001 display_busy_cursor_p
= 1;
11003 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay
,
11004 "*Seconds to wait before displaying a busy-cursor.\n\
11005 Value must be an integer or float.");
11006 Vbusy_cursor_delay
= make_number (DEFAULT_BUSY_CURSOR_DELAY
);
11008 #if 0 /* This doesn't really do anything. */
11009 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11010 "The shape of the pointer when over the mode line.\n\
11011 This variable takes effect when you create a new frame\n\
11012 or when you set the mouse color.");
11014 Vx_mode_pointer_shape
= Qnil
;
11016 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11017 &Vx_sensitive_text_pointer_shape
,
11018 "The shape of the pointer when over mouse-sensitive text.\n\
11019 This variable takes effect when you create a new frame\n\
11020 or when you set the mouse color.");
11021 Vx_sensitive_text_pointer_shape
= Qnil
;
11023 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11024 "A string indicating the foreground color of the cursor box.");
11025 Vx_cursor_fore_pixel
= Qnil
;
11027 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11028 "Non-nil if no X window manager is in use.\n\
11029 Emacs doesn't try to figure this out; this is always nil\n\
11030 unless you set it to something else.");
11031 /* We don't have any way to find this out, so set it to nil
11032 and maybe the user would like to set it to t. */
11033 Vx_no_window_manager
= Qnil
;
11035 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11036 &Vx_pixel_size_width_font_regexp
,
11037 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11039 Since Emacs gets width of a font matching with this regexp from\n\
11040 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11041 such a font. This is especially effective for such large fonts as\n\
11042 Chinese, Japanese, and Korean.");
11043 Vx_pixel_size_width_font_regexp
= Qnil
;
11045 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11046 "Time after which cached images are removed from the cache.\n\
11047 When an image has not been displayed this many seconds, remove it\n\
11048 from the image cache. Value must be an integer or nil with nil\n\
11049 meaning don't clear the cache.");
11050 Vimage_cache_eviction_delay
= make_number (30 * 60);
11052 DEFVAR_LISP ("image-types", &Vimage_types
,
11053 "List of supported image types.\n\
11054 Each element of the list is a symbol for a supported image type.");
11055 Vimage_types
= Qnil
;
11057 #ifdef USE_X_TOOLKIT
11058 Fprovide (intern ("x-toolkit"));
11061 Fprovide (intern ("motif"));
11064 defsubr (&Sx_get_resource
);
11066 /* X window properties. */
11067 defsubr (&Sx_change_window_property
);
11068 defsubr (&Sx_delete_window_property
);
11069 defsubr (&Sx_window_property
);
11072 defsubr (&Sx_draw_rectangle
);
11073 defsubr (&Sx_erase_rectangle
);
11074 defsubr (&Sx_contour_region
);
11075 defsubr (&Sx_uncontour_region
);
11077 defsubr (&Sxw_display_color_p
);
11078 defsubr (&Sx_display_grayscale_p
);
11079 defsubr (&Sxw_color_defined_p
);
11080 defsubr (&Sxw_color_values
);
11081 defsubr (&Sx_server_max_request_size
);
11082 defsubr (&Sx_server_vendor
);
11083 defsubr (&Sx_server_version
);
11084 defsubr (&Sx_display_pixel_width
);
11085 defsubr (&Sx_display_pixel_height
);
11086 defsubr (&Sx_display_mm_width
);
11087 defsubr (&Sx_display_mm_height
);
11088 defsubr (&Sx_display_screens
);
11089 defsubr (&Sx_display_planes
);
11090 defsubr (&Sx_display_color_cells
);
11091 defsubr (&Sx_display_visual_class
);
11092 defsubr (&Sx_display_backing_store
);
11093 defsubr (&Sx_display_save_under
);
11095 defsubr (&Sx_rebind_key
);
11096 defsubr (&Sx_rebind_keys
);
11097 defsubr (&Sx_track_pointer
);
11098 defsubr (&Sx_grab_pointer
);
11099 defsubr (&Sx_ungrab_pointer
);
11101 defsubr (&Sx_parse_geometry
);
11102 defsubr (&Sx_create_frame
);
11104 defsubr (&Sx_horizontal_line
);
11106 defsubr (&Sx_open_connection
);
11107 defsubr (&Sx_close_connection
);
11108 defsubr (&Sx_display_list
);
11109 defsubr (&Sx_synchronize
);
11111 /* Setting callback functions for fontset handler. */
11112 get_font_info_func
= x_get_font_info
;
11114 #if 0 /* This function pointer doesn't seem to be used anywhere.
11115 And the pointer assigned has the wrong type, anyway. */
11116 list_fonts_func
= x_list_fonts
;
11119 load_font_func
= x_load_font
;
11120 find_ccl_program_func
= x_find_ccl_program
;
11121 query_font_func
= x_query_font
;
11122 set_frame_fontset_func
= x_set_font
;
11123 check_window_system_func
= check_x
;
11126 Qxbm
= intern ("xbm");
11128 QCtype
= intern (":type");
11129 staticpro (&QCtype
);
11130 QCalgorithm
= intern (":algorithm");
11131 staticpro (&QCalgorithm
);
11132 QCheuristic_mask
= intern (":heuristic-mask");
11133 staticpro (&QCheuristic_mask
);
11134 QCcolor_symbols
= intern (":color-symbols");
11135 staticpro (&QCcolor_symbols
);
11136 QCdata
= intern (":data");
11137 staticpro (&QCdata
);
11138 QCascent
= intern (":ascent");
11139 staticpro (&QCascent
);
11140 QCmargin
= intern (":margin");
11141 staticpro (&QCmargin
);
11142 QCrelief
= intern (":relief");
11143 staticpro (&QCrelief
);
11144 Qpostscript
= intern ("postscript");
11145 staticpro (&Qpostscript
);
11146 QCloader
= intern (":loader");
11147 staticpro (&QCloader
);
11148 QCbounding_box
= intern (":bounding-box");
11149 staticpro (&QCbounding_box
);
11150 QCpt_width
= intern (":pt-width");
11151 staticpro (&QCpt_width
);
11152 QCpt_height
= intern (":pt-height");
11153 staticpro (&QCpt_height
);
11154 QCindex
= intern (":index");
11155 staticpro (&QCindex
);
11156 Qpbm
= intern ("pbm");
11160 Qxpm
= intern ("xpm");
11165 Qjpeg
= intern ("jpeg");
11166 staticpro (&Qjpeg
);
11170 Qtiff
= intern ("tiff");
11171 staticpro (&Qtiff
);
11175 Qgif
= intern ("gif");
11180 Qpng
= intern ("png");
11184 defsubr (&Sclear_image_cache
);
11187 defsubr (&Simagep
);
11188 defsubr (&Slookup_image
);
11191 busy_cursor_atimer
= NULL
;
11192 busy_cursor_shown_p
= 0;
11194 defsubr (&Sx_show_tip
);
11195 defsubr (&Sx_hide_tip
);
11196 staticpro (&tip_timer
);
11200 defsubr (&Sx_file_dialog
);
11208 image_types
= NULL
;
11209 Vimage_types
= Qnil
;
11211 define_image_type (&xbm_type
);
11212 define_image_type (&gs_type
);
11213 define_image_type (&pbm_type
);
11216 define_image_type (&xpm_type
);
11220 define_image_type (&jpeg_type
);
11224 define_image_type (&tiff_type
);
11228 define_image_type (&gif_type
);
11232 define_image_type (&png_type
);
11236 #endif /* HAVE_X_WINDOWS */