1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999, 2000
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>
54 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
55 #include "bitmaps/gray.xbm"
57 #include <X11/bitmaps/gray>
60 #include "[.bitmaps]gray.xbm"
64 #include <X11/Shell.h>
67 #include <X11/Xaw/Paned.h>
68 #include <X11/Xaw/Label.h>
69 #endif /* USE_MOTIF */
72 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
81 #include "../lwlib/lwlib.h"
85 #include <Xm/DialogS.h>
86 #include <Xm/FileSB.h>
89 /* Do the EDITRES protocol if running X11R5
90 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
92 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
94 extern void _XEditResCheckMessages ();
95 #endif /* R5 + Athena */
97 /* Unique id counter for widgets created by the Lucid Widget Library. */
99 extern LWLIB_ID widget_id_tick
;
102 /* This is part of a kludge--see lwlib/xlwmenu.c. */
103 extern XFontStruct
*xlwmenu_default_font
;
106 extern void free_frame_menubar ();
107 extern double atof ();
109 #endif /* USE_X_TOOLKIT */
111 #define min(a,b) ((a) < (b) ? (a) : (b))
112 #define max(a,b) ((a) > (b) ? (a) : (b))
115 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
117 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
120 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
121 it, and including `bitmaps/gray' more than once is a problem when
122 config.h defines `static' as an empty replacement string. */
124 int gray_bitmap_width
= gray_width
;
125 int gray_bitmap_height
= gray_height
;
126 unsigned char *gray_bitmap_bits
= gray_bits
;
128 /* The name we're using in resource queries. Most often "emacs". */
130 Lisp_Object Vx_resource_name
;
132 /* The application class we're using in resource queries.
135 Lisp_Object Vx_resource_class
;
137 /* Non-zero means we're allowed to display a busy cursor. */
139 int display_busy_cursor_p
;
141 /* The background and shape of the mouse pointer, and shape when not
142 over text or in the modeline. */
144 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
145 Lisp_Object Vx_busy_pointer_shape
;
147 /* The shape when over mouse-sensitive text. */
149 Lisp_Object Vx_sensitive_text_pointer_shape
;
151 /* Color of chars displayed in cursor box. */
153 Lisp_Object Vx_cursor_fore_pixel
;
155 /* Nonzero if using X. */
159 /* Non nil if no window manager is in use. */
161 Lisp_Object Vx_no_window_manager
;
163 /* Search path for bitmap files. */
165 Lisp_Object Vx_bitmap_file_path
;
167 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
169 Lisp_Object Vx_pixel_size_width_font_regexp
;
171 /* Evaluate this expression to rebuild the section of syms_of_xfns
172 that initializes and staticpros the symbols declared below. Note
173 that Emacs 18 has a bug that keeps C-x C-e from being able to
174 evaluate this expression.
177 ;; Accumulate a list of the symbols we want to initialize from the
178 ;; declarations at the top of the file.
179 (goto-char (point-min))
180 (search-forward "/\*&&& symbols declared here &&&*\/\n")
182 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
184 (cons (buffer-substring (match-beginning 1) (match-end 1))
187 (setq symbol-list (nreverse symbol-list))
188 ;; Delete the section of syms_of_... where we initialize the symbols.
189 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
190 (let ((start (point)))
191 (while (looking-at "^ Q")
193 (kill-region start (point)))
194 ;; Write a new symbol initialization section.
196 (insert (format " %s = intern (\"" (car symbol-list)))
197 (let ((start (point)))
198 (insert (substring (car symbol-list) 1))
199 (subst-char-in-region start (point) ?_ ?-))
200 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
201 (setq symbol-list (cdr symbol-list)))))
205 /*&&& symbols declared here &&&*/
206 Lisp_Object Qauto_raise
;
207 Lisp_Object Qauto_lower
;
209 Lisp_Object Qborder_color
;
210 Lisp_Object Qborder_width
;
212 Lisp_Object Qcursor_color
;
213 Lisp_Object Qcursor_type
;
214 Lisp_Object Qgeometry
;
215 Lisp_Object Qicon_left
;
216 Lisp_Object Qicon_top
;
217 Lisp_Object Qicon_type
;
218 Lisp_Object Qicon_name
;
219 Lisp_Object Qinternal_border_width
;
222 Lisp_Object Qmouse_color
;
224 Lisp_Object Qouter_window_id
;
225 Lisp_Object Qparent_id
;
226 Lisp_Object Qscroll_bar_width
;
227 Lisp_Object Qsuppress_icon
;
228 extern Lisp_Object Qtop
;
229 Lisp_Object Qundefined_color
;
230 Lisp_Object Qvertical_scroll_bars
;
231 Lisp_Object Qvisibility
;
232 Lisp_Object Qwindow_id
;
233 Lisp_Object Qx_frame_parameter
;
234 Lisp_Object Qx_resource_name
;
235 Lisp_Object Quser_position
;
236 Lisp_Object Quser_size
;
237 extern Lisp_Object Qdisplay
;
238 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
239 Lisp_Object Qscreen_gamma
, Qline_spacing
, Qcenter
;
241 /* The below are defined in frame.c. */
243 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
244 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
245 extern Lisp_Object Qtool_bar_lines
;
247 extern Lisp_Object Vwindow_system_version
;
249 Lisp_Object Qface_set_after_frame_default
;
252 /* Error if we are not connected to X. */
258 error ("X windows are not in use or not initialized");
261 /* Nonzero if we can use mouse menus.
262 You should not call this unless HAVE_MENUS is defined. */
270 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
271 and checking validity for X. */
274 check_x_frame (frame
)
280 frame
= selected_frame
;
281 CHECK_LIVE_FRAME (frame
, 0);
284 error ("Non-X frame used");
288 /* Let the user specify an X display with a frame.
289 nil stands for the selected frame--or, if that is not an X frame,
290 the first X display on the list. */
292 static struct x_display_info
*
293 check_x_display_info (frame
)
298 struct frame
*sf
= XFRAME (selected_frame
);
300 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
301 return FRAME_X_DISPLAY_INFO (sf
);
302 else if (x_display_list
!= 0)
303 return x_display_list
;
305 error ("X windows are not in use or not initialized");
307 else if (STRINGP (frame
))
308 return x_display_info_for_name (frame
);
313 CHECK_LIVE_FRAME (frame
, 0);
316 error ("Non-X frame used");
317 return FRAME_X_DISPLAY_INFO (f
);
322 /* Return the Emacs frame-object corresponding to an X window.
323 It could be the frame's main window or an icon window. */
325 /* This function can be called during GC, so use GC_xxx type test macros. */
328 x_window_to_frame (dpyinfo
, wdesc
)
329 struct x_display_info
*dpyinfo
;
332 Lisp_Object tail
, frame
;
335 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
338 if (!GC_FRAMEP (frame
))
341 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
343 if (f
->output_data
.x
->busy_window
== wdesc
)
346 if ((f
->output_data
.x
->edit_widget
347 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
348 /* A tooltip frame? */
349 || (!f
->output_data
.x
->edit_widget
350 && FRAME_X_WINDOW (f
) == wdesc
)
351 || f
->output_data
.x
->icon_desc
== wdesc
)
353 #else /* not USE_X_TOOLKIT */
354 if (FRAME_X_WINDOW (f
) == wdesc
355 || f
->output_data
.x
->icon_desc
== wdesc
)
357 #endif /* not USE_X_TOOLKIT */
363 /* Like x_window_to_frame but also compares the window with the widget's
367 x_any_window_to_frame (dpyinfo
, wdesc
)
368 struct x_display_info
*dpyinfo
;
371 Lisp_Object tail
, frame
;
372 struct frame
*f
, *found
;
376 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
379 if (!GC_FRAMEP (frame
))
383 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
385 /* This frame matches if the window is any of its widgets. */
386 x
= f
->output_data
.x
;
387 if (x
->busy_window
== wdesc
)
391 if (wdesc
== XtWindow (x
->widget
)
392 || wdesc
== XtWindow (x
->column_widget
)
393 || wdesc
== XtWindow (x
->edit_widget
))
395 /* Match if the window is this frame's menubar. */
396 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
399 else if (FRAME_X_WINDOW (f
) == wdesc
)
400 /* A tooltip frame. */
408 /* Likewise, but exclude the menu bar widget. */
411 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
412 struct x_display_info
*dpyinfo
;
415 Lisp_Object tail
, frame
;
419 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
422 if (!GC_FRAMEP (frame
))
425 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
427 x
= f
->output_data
.x
;
428 /* This frame matches if the window is any of its widgets. */
429 if (x
->busy_window
== wdesc
)
433 if (wdesc
== XtWindow (x
->widget
)
434 || wdesc
== XtWindow (x
->column_widget
)
435 || wdesc
== XtWindow (x
->edit_widget
))
438 else if (FRAME_X_WINDOW (f
) == wdesc
)
439 /* A tooltip frame. */
445 /* Likewise, but consider only the menu bar widget. */
448 x_menubar_window_to_frame (dpyinfo
, wdesc
)
449 struct x_display_info
*dpyinfo
;
452 Lisp_Object tail
, frame
;
456 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
459 if (!GC_FRAMEP (frame
))
462 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
464 x
= f
->output_data
.x
;
465 /* Match if the window is this frame's menubar. */
466 if (x
->menubar_widget
467 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
473 /* Return the frame whose principal (outermost) window is WDESC.
474 If WDESC is some other (smaller) window, we return 0. */
477 x_top_window_to_frame (dpyinfo
, wdesc
)
478 struct x_display_info
*dpyinfo
;
481 Lisp_Object tail
, frame
;
485 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
488 if (!GC_FRAMEP (frame
))
491 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
493 x
= f
->output_data
.x
;
497 /* This frame matches if the window is its topmost widget. */
498 if (wdesc
== XtWindow (x
->widget
))
500 #if 0 /* I don't know why it did this,
501 but it seems logically wrong,
502 and it causes trouble for MapNotify events. */
503 /* Match if the window is this frame's menubar. */
504 if (x
->menubar_widget
505 && wdesc
== XtWindow (x
->menubar_widget
))
509 else if (FRAME_X_WINDOW (f
) == wdesc
)
515 #endif /* USE_X_TOOLKIT */
519 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
520 id, which is just an int that this section returns. Bitmaps are
521 reference counted so they can be shared among frames.
523 Bitmap indices are guaranteed to be > 0, so a negative number can
524 be used to indicate no bitmap.
526 If you use x_create_bitmap_from_data, then you must keep track of
527 the bitmaps yourself. That is, creating a bitmap from the same
528 data more than once will not be caught. */
531 /* Functions to access the contents of a bitmap, given an id. */
534 x_bitmap_height (f
, id
)
538 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
542 x_bitmap_width (f
, id
)
546 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
550 x_bitmap_pixmap (f
, id
)
554 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
558 /* Allocate a new bitmap record. Returns index of new record. */
561 x_allocate_bitmap_record (f
)
564 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
567 if (dpyinfo
->bitmaps
== NULL
)
569 dpyinfo
->bitmaps_size
= 10;
571 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
572 dpyinfo
->bitmaps_last
= 1;
576 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
577 return ++dpyinfo
->bitmaps_last
;
579 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
580 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
583 dpyinfo
->bitmaps_size
*= 2;
585 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
586 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
587 return ++dpyinfo
->bitmaps_last
;
590 /* Add one reference to the reference count of the bitmap with id ID. */
593 x_reference_bitmap (f
, id
)
597 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
600 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
603 x_create_bitmap_from_data (f
, bits
, width
, height
)
606 unsigned int width
, height
;
608 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
612 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
613 bits
, width
, height
);
618 id
= x_allocate_bitmap_record (f
);
619 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
620 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
621 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
622 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
623 dpyinfo
->bitmaps
[id
- 1].height
= height
;
624 dpyinfo
->bitmaps
[id
- 1].width
= width
;
629 /* Create bitmap from file FILE for frame F. */
632 x_create_bitmap_from_file (f
, file
)
636 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
637 unsigned int width
, height
;
639 int xhot
, yhot
, result
, id
;
644 /* Look for an existing bitmap with the same name. */
645 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
647 if (dpyinfo
->bitmaps
[id
].refcount
648 && dpyinfo
->bitmaps
[id
].file
649 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
651 ++dpyinfo
->bitmaps
[id
].refcount
;
656 /* Search bitmap-file-path for the file, if appropriate. */
657 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
660 /* XReadBitmapFile won't handle magic file names. */
665 filename
= (char *) XSTRING (found
)->data
;
667 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
668 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
669 if (result
!= BitmapSuccess
)
672 id
= x_allocate_bitmap_record (f
);
673 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
674 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
675 dpyinfo
->bitmaps
[id
- 1].file
676 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
677 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
678 dpyinfo
->bitmaps
[id
- 1].height
= height
;
679 dpyinfo
->bitmaps
[id
- 1].width
= width
;
680 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
685 /* Remove reference to bitmap with id number ID. */
688 x_destroy_bitmap (f
, id
)
692 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
696 --dpyinfo
->bitmaps
[id
- 1].refcount
;
697 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
700 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
701 if (dpyinfo
->bitmaps
[id
- 1].file
)
703 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
704 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
711 /* Free all the bitmaps for the display specified by DPYINFO. */
714 x_destroy_all_bitmaps (dpyinfo
)
715 struct x_display_info
*dpyinfo
;
718 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
719 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
721 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
722 if (dpyinfo
->bitmaps
[i
].file
)
723 xfree (dpyinfo
->bitmaps
[i
].file
);
725 dpyinfo
->bitmaps_last
= 0;
728 /* Connect the frame-parameter names for X frames
729 to the ways of passing the parameter values to the window system.
731 The name of a parameter, as a Lisp symbol,
732 has an `x-frame-parameter' property which is an integer in Lisp
733 that is an index in this table. */
735 struct x_frame_parm_table
738 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
741 static void x_create_im
P_ ((struct frame
*));
742 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
743 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
744 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
745 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
746 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
750 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
755 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
760 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
761 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
762 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
763 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
764 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
765 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
766 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
768 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
770 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
775 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
777 static struct x_frame_parm_table x_frame_parms
[] =
779 "auto-raise", x_set_autoraise
,
780 "auto-lower", x_set_autolower
,
781 "background-color", x_set_background_color
,
782 "border-color", x_set_border_color
,
783 "border-width", x_set_border_width
,
784 "cursor-color", x_set_cursor_color
,
785 "cursor-type", x_set_cursor_type
,
787 "foreground-color", x_set_foreground_color
,
788 "icon-name", x_set_icon_name
,
789 "icon-type", x_set_icon_type
,
790 "internal-border-width", x_set_internal_border_width
,
791 "menu-bar-lines", x_set_menu_bar_lines
,
792 "mouse-color", x_set_mouse_color
,
793 "name", x_explicitly_set_name
,
794 "scroll-bar-width", x_set_scroll_bar_width
,
795 "title", x_set_title
,
796 "unsplittable", x_set_unsplittable
,
797 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
798 "visibility", x_set_visibility
,
799 "tool-bar-lines", x_set_tool_bar_lines
,
800 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
801 "scroll-bar-background", x_set_scroll_bar_background
,
802 "screen-gamma", x_set_screen_gamma
,
803 "line-spacing", x_set_line_spacing
806 /* Attach the `x-frame-parameter' properties to
807 the Lisp symbol names of parameters relevant to X. */
810 init_x_parm_symbols ()
814 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
815 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
819 /* Change the parameters of frame F as specified by ALIST.
820 If a parameter is not specially recognized, do nothing special;
821 otherwise call the `x_set_...' function for that parameter.
822 Except for certain geometry properties, always call store_frame_param
823 to store the new value in the parameter alist. */
826 x_set_frame_parameters (f
, alist
)
832 /* If both of these parameters are present, it's more efficient to
833 set them both at once. So we wait until we've looked at the
834 entire list before we set them. */
838 Lisp_Object left
, top
;
840 /* Same with these. */
841 Lisp_Object icon_left
, icon_top
;
843 /* Record in these vectors all the parms specified. */
847 int left_no_change
= 0, top_no_change
= 0;
848 int icon_left_no_change
= 0, icon_top_no_change
= 0;
850 struct gcpro gcpro1
, gcpro2
;
853 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
856 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
857 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
859 /* Extract parm names and values into those vectors. */
862 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
867 parms
[i
] = Fcar (elt
);
868 values
[i
] = Fcdr (elt
);
871 /* TAIL and ALIST are not used again below here. */
874 GCPRO2 (*parms
, *values
);
878 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
879 because their values appear in VALUES and strings are not valid. */
880 top
= left
= Qunbound
;
881 icon_left
= icon_top
= Qunbound
;
883 /* Provide default values for HEIGHT and WIDTH. */
884 if (FRAME_NEW_WIDTH (f
))
885 width
= FRAME_NEW_WIDTH (f
);
887 width
= FRAME_WIDTH (f
);
889 if (FRAME_NEW_HEIGHT (f
))
890 height
= FRAME_NEW_HEIGHT (f
);
892 height
= FRAME_HEIGHT (f
);
894 /* Process foreground_color and background_color before anything else.
895 They are independent of other properties, but other properties (e.g.,
896 cursor_color) are dependent upon them. */
897 for (p
= 0; p
< i
; p
++)
899 Lisp_Object prop
, val
;
903 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
905 register Lisp_Object param_index
, old_value
;
907 param_index
= Fget (prop
, Qx_frame_parameter
);
908 old_value
= get_frame_param (f
, prop
);
909 store_frame_param (f
, prop
, val
);
910 if (NATNUMP (param_index
)
911 && (XFASTINT (param_index
)
912 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
913 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
917 /* Now process them in reverse of specified order. */
918 for (i
--; i
>= 0; i
--)
920 Lisp_Object prop
, val
;
925 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
926 width
= XFASTINT (val
);
927 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
928 height
= XFASTINT (val
);
929 else if (EQ (prop
, Qtop
))
931 else if (EQ (prop
, Qleft
))
933 else if (EQ (prop
, Qicon_top
))
935 else if (EQ (prop
, Qicon_left
))
937 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
938 /* Processed above. */
942 register Lisp_Object param_index
, old_value
;
944 param_index
= Fget (prop
, Qx_frame_parameter
);
945 old_value
= get_frame_param (f
, prop
);
946 store_frame_param (f
, prop
, val
);
947 if (NATNUMP (param_index
)
948 && (XFASTINT (param_index
)
949 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
950 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
954 /* Don't die if just one of these was set. */
955 if (EQ (left
, Qunbound
))
958 if (f
->output_data
.x
->left_pos
< 0)
959 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
961 XSETINT (left
, f
->output_data
.x
->left_pos
);
963 if (EQ (top
, Qunbound
))
966 if (f
->output_data
.x
->top_pos
< 0)
967 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
969 XSETINT (top
, f
->output_data
.x
->top_pos
);
972 /* If one of the icon positions was not set, preserve or default it. */
973 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
975 icon_left_no_change
= 1;
976 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
977 if (NILP (icon_left
))
978 XSETINT (icon_left
, 0);
980 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
982 icon_top_no_change
= 1;
983 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
985 XSETINT (icon_top
, 0);
988 /* Don't set these parameters unless they've been explicitly
989 specified. The window might be mapped or resized while we're in
990 this function, and we don't want to override that unless the lisp
991 code has asked for it.
993 Don't set these parameters unless they actually differ from the
994 window's current parameters; the window may not actually exist
999 check_frame_size (f
, &height
, &width
);
1001 XSETFRAME (frame
, f
);
1003 if (width
!= FRAME_WIDTH (f
)
1004 || height
!= FRAME_HEIGHT (f
)
1005 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1006 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1008 if ((!NILP (left
) || !NILP (top
))
1009 && ! (left_no_change
&& top_no_change
)
1010 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1011 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1016 /* Record the signs. */
1017 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1018 if (EQ (left
, Qminus
))
1019 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1020 else if (INTEGERP (left
))
1022 leftpos
= XINT (left
);
1024 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1026 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1027 && CONSP (XCDR (left
))
1028 && INTEGERP (XCAR (XCDR (left
))))
1030 leftpos
= - XINT (XCAR (XCDR (left
)));
1031 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1033 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1034 && CONSP (XCDR (left
))
1035 && INTEGERP (XCAR (XCDR (left
))))
1037 leftpos
= XINT (XCAR (XCDR (left
)));
1040 if (EQ (top
, Qminus
))
1041 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1042 else if (INTEGERP (top
))
1044 toppos
= XINT (top
);
1046 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1048 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1049 && CONSP (XCDR (top
))
1050 && INTEGERP (XCAR (XCDR (top
))))
1052 toppos
= - XINT (XCAR (XCDR (top
)));
1053 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1055 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1056 && CONSP (XCDR (top
))
1057 && INTEGERP (XCAR (XCDR (top
))))
1059 toppos
= XINT (XCAR (XCDR (top
)));
1063 /* Store the numeric value of the position. */
1064 f
->output_data
.x
->top_pos
= toppos
;
1065 f
->output_data
.x
->left_pos
= leftpos
;
1067 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1069 /* Actually set that position, and convert to absolute. */
1070 x_set_offset (f
, leftpos
, toppos
, -1);
1073 if ((!NILP (icon_left
) || !NILP (icon_top
))
1074 && ! (icon_left_no_change
&& icon_top_no_change
))
1075 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1081 /* Store the screen positions of frame F into XPTR and YPTR.
1082 These are the positions of the containing window manager window,
1083 not Emacs's own window. */
1086 x_real_positions (f
, xptr
, yptr
)
1093 /* This is pretty gross, but seems to be the easiest way out of
1094 the problem that arises when restarting window-managers. */
1096 #ifdef USE_X_TOOLKIT
1097 Window outer
= (f
->output_data
.x
->widget
1098 ? XtWindow (f
->output_data
.x
->widget
)
1099 : FRAME_X_WINDOW (f
));
1101 Window outer
= f
->output_data
.x
->window_desc
;
1103 Window tmp_root_window
;
1104 Window
*tmp_children
;
1105 unsigned int tmp_nchildren
;
1109 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1110 Window outer_window
;
1112 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1113 &f
->output_data
.x
->parent_desc
,
1114 &tmp_children
, &tmp_nchildren
);
1115 XFree ((char *) tmp_children
);
1119 /* Find the position of the outside upper-left corner of
1120 the inner window, with respect to the outer window. */
1121 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1122 outer_window
= f
->output_data
.x
->parent_desc
;
1124 outer_window
= outer
;
1126 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1128 /* From-window, to-window. */
1130 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1132 /* From-position, to-position. */
1133 0, 0, &win_x
, &win_y
,
1138 /* It is possible for the window returned by the XQueryNotify
1139 to become invalid by the time we call XTranslateCoordinates.
1140 That can happen when you restart some window managers.
1141 If so, we get an error in XTranslateCoordinates.
1142 Detect that and try the whole thing over. */
1143 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1145 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1149 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1156 /* Insert a description of internally-recorded parameters of frame X
1157 into the parameter alist *ALISTPTR that is to be given to the user.
1158 Only parameters that are specific to the X window system
1159 and whose values are not correctly recorded in the frame's
1160 param_alist need to be considered here. */
1163 x_report_frame_params (f
, alistptr
)
1165 Lisp_Object
*alistptr
;
1170 /* Represent negative positions (off the top or left screen edge)
1171 in a way that Fmodify_frame_parameters will understand correctly. */
1172 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1173 if (f
->output_data
.x
->left_pos
>= 0)
1174 store_in_alist (alistptr
, Qleft
, tem
);
1176 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1178 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1179 if (f
->output_data
.x
->top_pos
>= 0)
1180 store_in_alist (alistptr
, Qtop
, tem
);
1182 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1184 store_in_alist (alistptr
, Qborder_width
,
1185 make_number (f
->output_data
.x
->border_width
));
1186 store_in_alist (alistptr
, Qinternal_border_width
,
1187 make_number (f
->output_data
.x
->internal_border_width
));
1188 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1189 store_in_alist (alistptr
, Qwindow_id
,
1190 build_string (buf
));
1191 #ifdef USE_X_TOOLKIT
1192 /* Tooltip frame may not have this widget. */
1193 if (f
->output_data
.x
->widget
)
1195 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1196 store_in_alist (alistptr
, Qouter_window_id
,
1197 build_string (buf
));
1198 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1199 FRAME_SAMPLE_VISIBILITY (f
);
1200 store_in_alist (alistptr
, Qvisibility
,
1201 (FRAME_VISIBLE_P (f
) ? Qt
1202 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1203 store_in_alist (alistptr
, Qdisplay
,
1204 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1206 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1209 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1210 store_in_alist (alistptr
, Qparent_id
, tem
);
1215 /* Gamma-correct COLOR on frame F. */
1218 gamma_correct (f
, color
)
1224 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1225 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1226 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1231 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1232 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1233 allocate the color. Value is zero if COLOR_NAME is invalid, or
1234 no color could be allocated. */
1237 x_defined_color (f
, color_name
, color
, alloc_p
)
1244 Display
*dpy
= FRAME_X_DISPLAY (f
);
1245 Colormap cmap
= FRAME_X_COLORMAP (f
);
1248 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1249 if (success_p
&& alloc_p
)
1250 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1257 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1258 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1259 Signal an error if color can't be allocated. */
1262 x_decode_color (f
, color_name
, mono_color
)
1264 Lisp_Object color_name
;
1269 CHECK_STRING (color_name
, 0);
1271 #if 0 /* Don't do this. It's wrong when we're not using the default
1272 colormap, it makes freeing difficult, and it's probably not
1273 an important optimization. */
1274 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1275 return BLACK_PIX_DEFAULT (f
);
1276 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1277 return WHITE_PIX_DEFAULT (f
);
1280 /* Return MONO_COLOR for monochrome frames. */
1281 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1284 /* x_defined_color is responsible for coping with failures
1285 by looking for a near-miss. */
1286 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1289 Fsignal (Qerror
, Fcons (build_string ("undefined color"),
1290 Fcons (color_name
, Qnil
)));
1295 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1296 the previous value of that parameter, NEW_VALUE is the new value. */
1299 x_set_line_spacing (f
, new_value
, old_value
)
1301 Lisp_Object new_value
, old_value
;
1303 if (NILP (new_value
))
1304 f
->extra_line_spacing
= 0;
1305 else if (NATNUMP (new_value
))
1306 f
->extra_line_spacing
= XFASTINT (new_value
);
1308 Fsignal (Qerror
, Fcons (build_string ("Illegal line-spacing"),
1309 Fcons (new_value
, Qnil
)));
1310 if (FRAME_VISIBLE_P (f
))
1315 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1316 the previous value of that parameter, NEW_VALUE is the new value. */
1319 x_set_screen_gamma (f
, new_value
, old_value
)
1321 Lisp_Object new_value
, old_value
;
1323 if (NILP (new_value
))
1325 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1326 /* The value 0.4545 is the normal viewing gamma. */
1327 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1329 Fsignal (Qerror
, Fcons (build_string ("Illegal screen-gamma"),
1330 Fcons (new_value
, Qnil
)));
1332 clear_face_cache (0);
1336 /* Functions called only from `x_set_frame_param'
1337 to set individual parameters.
1339 If FRAME_X_WINDOW (f) is 0,
1340 the frame is being created and its X-window does not exist yet.
1341 In that case, just record the parameter's new value
1342 in the standard place; do not attempt to change the window. */
1345 x_set_foreground_color (f
, arg
, oldval
)
1347 Lisp_Object arg
, oldval
;
1350 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1352 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1353 f
->output_data
.x
->foreground_pixel
= pixel
;
1355 if (FRAME_X_WINDOW (f
) != 0)
1358 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1359 f
->output_data
.x
->foreground_pixel
);
1360 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1361 f
->output_data
.x
->foreground_pixel
);
1363 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1364 if (FRAME_VISIBLE_P (f
))
1370 x_set_background_color (f
, arg
, oldval
)
1372 Lisp_Object arg
, oldval
;
1375 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1377 unload_color (f
, f
->output_data
.x
->background_pixel
);
1378 f
->output_data
.x
->background_pixel
= pixel
;
1380 if (FRAME_X_WINDOW (f
) != 0)
1383 /* The main frame area. */
1384 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1385 f
->output_data
.x
->background_pixel
);
1386 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1387 f
->output_data
.x
->background_pixel
);
1388 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1389 f
->output_data
.x
->background_pixel
);
1390 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1391 f
->output_data
.x
->background_pixel
);
1394 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1395 bar
= XSCROLL_BAR (bar
)->next
)
1396 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1397 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1398 f
->output_data
.x
->background_pixel
);
1402 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1404 if (FRAME_VISIBLE_P (f
))
1410 x_set_mouse_color (f
, arg
, oldval
)
1412 Lisp_Object arg
, oldval
;
1414 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1417 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1418 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1420 /* Don't let pointers be invisible. */
1421 if (mask_color
== pixel
1422 && mask_color
== f
->output_data
.x
->background_pixel
)
1423 pixel
= f
->output_data
.x
->foreground_pixel
;
1425 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1426 f
->output_data
.x
->mouse_pixel
= pixel
;
1430 /* It's not okay to crash if the user selects a screwy cursor. */
1431 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1433 if (!EQ (Qnil
, Vx_pointer_shape
))
1435 CHECK_NUMBER (Vx_pointer_shape
, 0);
1436 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1439 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1440 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1442 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1444 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1445 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1446 XINT (Vx_nontext_pointer_shape
));
1449 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1450 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1452 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1454 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1455 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1456 XINT (Vx_busy_pointer_shape
));
1459 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1460 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1462 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1463 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1465 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1466 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1467 XINT (Vx_mode_pointer_shape
));
1470 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1471 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1473 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1475 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1477 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1478 XINT (Vx_sensitive_text_pointer_shape
));
1481 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1483 /* Check and report errors with the above calls. */
1484 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1485 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1488 XColor fore_color
, back_color
;
1490 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1491 back_color
.pixel
= mask_color
;
1492 XQueryColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
1494 XQueryColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
1496 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1497 &fore_color
, &back_color
);
1498 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1499 &fore_color
, &back_color
);
1500 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1501 &fore_color
, &back_color
);
1502 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1503 &fore_color
, &back_color
);
1504 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1505 &fore_color
, &back_color
);
1508 if (FRAME_X_WINDOW (f
) != 0)
1509 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1511 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1512 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1513 f
->output_data
.x
->text_cursor
= cursor
;
1515 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1516 && f
->output_data
.x
->nontext_cursor
!= 0)
1517 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1518 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1520 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1521 && f
->output_data
.x
->busy_cursor
!= 0)
1522 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1523 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1525 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1526 && f
->output_data
.x
->modeline_cursor
!= 0)
1527 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1528 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1530 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1531 && f
->output_data
.x
->cross_cursor
!= 0)
1532 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1533 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1535 XFlush (FRAME_X_DISPLAY (f
));
1538 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1542 x_set_cursor_color (f
, arg
, oldval
)
1544 Lisp_Object arg
, oldval
;
1546 unsigned long fore_pixel
, pixel
;
1547 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1549 if (!NILP (Vx_cursor_fore_pixel
))
1551 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1552 WHITE_PIX_DEFAULT (f
));
1553 fore_pixel_allocated_p
= 1;
1556 fore_pixel
= f
->output_data
.x
->background_pixel
;
1558 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1559 pixel_allocated_p
= 1;
1561 /* Make sure that the cursor color differs from the background color. */
1562 if (pixel
== f
->output_data
.x
->background_pixel
)
1564 if (pixel_allocated_p
)
1566 x_free_colors (f
, &pixel
, 1);
1567 pixel_allocated_p
= 0;
1570 pixel
= f
->output_data
.x
->mouse_pixel
;
1571 if (pixel
== fore_pixel
)
1573 if (fore_pixel_allocated_p
)
1575 x_free_colors (f
, &fore_pixel
, 1);
1576 fore_pixel_allocated_p
= 0;
1578 fore_pixel
= f
->output_data
.x
->background_pixel
;
1582 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1583 if (!fore_pixel_allocated_p
)
1584 fore_pixel
= x_copy_color (f
, fore_pixel
);
1585 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1587 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1588 if (!pixel_allocated_p
)
1589 pixel
= x_copy_color (f
, pixel
);
1590 f
->output_data
.x
->cursor_pixel
= pixel
;
1592 if (FRAME_X_WINDOW (f
) != 0)
1595 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1596 f
->output_data
.x
->cursor_pixel
);
1597 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1601 if (FRAME_VISIBLE_P (f
))
1603 x_update_cursor (f
, 0);
1604 x_update_cursor (f
, 1);
1608 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1611 /* Set the border-color of frame F to value described by ARG.
1612 ARG can be a string naming a color.
1613 The border-color is used for the border that is drawn by the X server.
1614 Note that this does not fully take effect if done before
1615 F has an x-window; it must be redone when the window is created.
1617 Note: this is done in two routines because of the way X10 works.
1619 Note: under X11, this is normally the province of the window manager,
1620 and so emacs' border colors may be overridden. */
1623 x_set_border_color (f
, arg
, oldval
)
1625 Lisp_Object arg
, oldval
;
1629 CHECK_STRING (arg
, 0);
1630 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1631 x_set_border_pixel (f
, pix
);
1632 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1635 /* Set the border-color of frame F to pixel value PIX.
1636 Note that this does not fully take effect if done before
1637 F has an x-window. */
1640 x_set_border_pixel (f
, pix
)
1644 unload_color (f
, f
->output_data
.x
->border_pixel
);
1645 f
->output_data
.x
->border_pixel
= pix
;
1647 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1650 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1651 (unsigned long)pix
);
1654 if (FRAME_VISIBLE_P (f
))
1660 /* Value is the internal representation of the specified cursor type
1661 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1662 of the bar cursor. */
1664 enum text_cursor_kinds
1665 x_specified_cursor_type (arg
, width
)
1669 enum text_cursor_kinds type
;
1676 else if (CONSP (arg
)
1677 && EQ (XCAR (arg
), Qbar
)
1678 && INTEGERP (XCDR (arg
))
1679 && XINT (XCDR (arg
)) >= 0)
1682 *width
= XINT (XCDR (arg
));
1684 else if (NILP (arg
))
1687 /* Treat anything unknown as "box cursor".
1688 It was bad to signal an error; people have trouble fixing
1689 .Xdefaults with Emacs, when it has something bad in it. */
1690 type
= FILLED_BOX_CURSOR
;
1696 x_set_cursor_type (f
, arg
, oldval
)
1698 Lisp_Object arg
, oldval
;
1702 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1703 f
->output_data
.x
->cursor_width
= width
;
1705 /* Make sure the cursor gets redrawn. This is overkill, but how
1706 often do people change cursor types? */
1707 update_mode_lines
++;
1711 x_set_icon_type (f
, arg
, oldval
)
1713 Lisp_Object arg
, oldval
;
1719 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1722 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1727 result
= x_text_icon (f
,
1728 (char *) XSTRING ((!NILP (f
->icon_name
)
1732 result
= x_bitmap_icon (f
, arg
);
1737 error ("No icon window available");
1740 XFlush (FRAME_X_DISPLAY (f
));
1744 /* Return non-nil if frame F wants a bitmap icon. */
1752 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1760 x_set_icon_name (f
, arg
, oldval
)
1762 Lisp_Object arg
, oldval
;
1768 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1771 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1776 if (f
->output_data
.x
->icon_bitmap
!= 0)
1781 result
= x_text_icon (f
,
1782 (char *) XSTRING ((!NILP (f
->icon_name
)
1791 error ("No icon window available");
1794 XFlush (FRAME_X_DISPLAY (f
));
1799 x_set_font (f
, arg
, oldval
)
1801 Lisp_Object arg
, oldval
;
1804 Lisp_Object fontset_name
;
1807 CHECK_STRING (arg
, 1);
1809 fontset_name
= Fquery_fontset (arg
, Qnil
);
1812 result
= (STRINGP (fontset_name
)
1813 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1814 : x_new_font (f
, XSTRING (arg
)->data
));
1817 if (EQ (result
, Qnil
))
1818 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1819 else if (EQ (result
, Qt
))
1820 error ("The characters of the given font have varying widths");
1821 else if (STRINGP (result
))
1823 store_frame_param (f
, Qfont
, result
);
1824 recompute_basic_faces (f
);
1829 do_pending_window_change (0);
1831 /* Don't call `face-set-after-frame-default' when faces haven't been
1832 initialized yet. This is the case when called from
1833 Fx_create_frame. In that case, the X widget or window doesn't
1834 exist either, and we can end up in x_report_frame_params with a
1835 null widget which gives a segfault. */
1836 if (FRAME_FACE_CACHE (f
))
1838 XSETFRAME (frame
, f
);
1839 call1 (Qface_set_after_frame_default
, frame
);
1844 x_set_border_width (f
, arg
, oldval
)
1846 Lisp_Object arg
, oldval
;
1848 CHECK_NUMBER (arg
, 0);
1850 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1853 if (FRAME_X_WINDOW (f
) != 0)
1854 error ("Cannot change the border width of a window");
1856 f
->output_data
.x
->border_width
= XINT (arg
);
1860 x_set_internal_border_width (f
, arg
, oldval
)
1862 Lisp_Object arg
, oldval
;
1864 int old
= f
->output_data
.x
->internal_border_width
;
1866 CHECK_NUMBER (arg
, 0);
1867 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1868 if (f
->output_data
.x
->internal_border_width
< 0)
1869 f
->output_data
.x
->internal_border_width
= 0;
1871 #ifdef USE_X_TOOLKIT
1872 if (f
->output_data
.x
->edit_widget
)
1873 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1876 if (f
->output_data
.x
->internal_border_width
== old
)
1879 if (FRAME_X_WINDOW (f
) != 0)
1881 x_set_window_size (f
, 0, f
->width
, f
->height
);
1882 SET_FRAME_GARBAGED (f
);
1883 do_pending_window_change (0);
1888 x_set_visibility (f
, value
, oldval
)
1890 Lisp_Object value
, oldval
;
1893 XSETFRAME (frame
, f
);
1896 Fmake_frame_invisible (frame
, Qt
);
1897 else if (EQ (value
, Qicon
))
1898 Ficonify_frame (frame
);
1900 Fmake_frame_visible (frame
);
1904 x_set_menu_bar_lines_1 (window
, n
)
1908 struct window
*w
= XWINDOW (window
);
1910 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1911 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1913 if (INTEGERP (w
->orig_top
))
1914 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1915 if (INTEGERP (w
->orig_height
))
1916 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1918 /* Handle just the top child in a vertical split. */
1919 if (!NILP (w
->vchild
))
1920 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1922 /* Adjust all children in a horizontal split. */
1923 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1925 w
= XWINDOW (window
);
1926 x_set_menu_bar_lines_1 (window
, n
);
1931 x_set_menu_bar_lines (f
, value
, oldval
)
1933 Lisp_Object value
, oldval
;
1936 #ifndef USE_X_TOOLKIT
1937 int olines
= FRAME_MENU_BAR_LINES (f
);
1940 /* Right now, menu bars don't work properly in minibuf-only frames;
1941 most of the commands try to apply themselves to the minibuffer
1942 frame itself, and get an error because you can't switch buffers
1943 in or split the minibuffer window. */
1944 if (FRAME_MINIBUF_ONLY_P (f
))
1947 if (INTEGERP (value
))
1948 nlines
= XINT (value
);
1952 /* Make sure we redisplay all windows in this frame. */
1953 windows_or_buffers_changed
++;
1955 #ifdef USE_X_TOOLKIT
1956 FRAME_MENU_BAR_LINES (f
) = 0;
1959 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1960 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1961 /* Make sure next redisplay shows the menu bar. */
1962 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1966 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1967 free_frame_menubar (f
);
1968 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1970 f
->output_data
.x
->menubar_widget
= 0;
1972 #else /* not USE_X_TOOLKIT */
1973 FRAME_MENU_BAR_LINES (f
) = nlines
;
1974 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1975 #endif /* not USE_X_TOOLKIT */
1980 /* Set the number of lines used for the tool bar of frame F to VALUE.
1981 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1982 is the old number of tool bar lines. This function changes the
1983 height of all windows on frame F to match the new tool bar height.
1984 The frame's height doesn't change. */
1987 x_set_tool_bar_lines (f
, value
, oldval
)
1989 Lisp_Object value
, oldval
;
1993 /* Use VALUE only if an integer >= 0. */
1994 if (INTEGERP (value
) && XINT (value
) >= 0)
1995 nlines
= XFASTINT (value
);
1999 /* Make sure we redisplay all windows in this frame. */
2000 ++windows_or_buffers_changed
;
2002 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2003 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2004 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f
), delta
);
2009 /* Set the foreground color for scroll bars on frame F to VALUE.
2010 VALUE should be a string, a color name. If it isn't a string or
2011 isn't a valid color name, do nothing. OLDVAL is the old value of
2012 the frame parameter. */
2015 x_set_scroll_bar_foreground (f
, value
, oldval
)
2017 Lisp_Object value
, oldval
;
2019 unsigned long pixel
;
2021 if (STRINGP (value
))
2022 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2026 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2027 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2029 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2030 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2032 /* Remove all scroll bars because they have wrong colors. */
2033 if (condemn_scroll_bars_hook
)
2034 (*condemn_scroll_bars_hook
) (f
);
2035 if (judge_scroll_bars_hook
)
2036 (*judge_scroll_bars_hook
) (f
);
2038 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2044 /* Set the background color for scroll bars on frame F to VALUE VALUE
2045 should be a string, a color name. If it isn't a string or isn't a
2046 valid color name, do nothing. OLDVAL is the old value of the frame
2050 x_set_scroll_bar_background (f
, value
, oldval
)
2052 Lisp_Object value
, oldval
;
2054 unsigned long pixel
;
2056 if (STRINGP (value
))
2057 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2061 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2062 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2064 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2065 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2067 /* Remove all scroll bars because they have wrong colors. */
2068 if (condemn_scroll_bars_hook
)
2069 (*condemn_scroll_bars_hook
) (f
);
2070 if (judge_scroll_bars_hook
)
2071 (*judge_scroll_bars_hook
) (f
);
2073 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2079 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2082 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2083 name; if NAME is a string, set F's name to NAME and set
2084 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2086 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2087 suggesting a new name, which lisp code should override; if
2088 F->explicit_name is set, ignore the new name; otherwise, set it. */
2091 x_set_name (f
, name
, explicit)
2096 /* Make sure that requests from lisp code override requests from
2097 Emacs redisplay code. */
2100 /* If we're switching from explicit to implicit, we had better
2101 update the mode lines and thereby update the title. */
2102 if (f
->explicit_name
&& NILP (name
))
2103 update_mode_lines
= 1;
2105 f
->explicit_name
= ! NILP (name
);
2107 else if (f
->explicit_name
)
2110 /* If NAME is nil, set the name to the x_id_name. */
2113 /* Check for no change needed in this very common case
2114 before we do any consing. */
2115 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2116 XSTRING (f
->name
)->data
))
2118 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2121 CHECK_STRING (name
, 0);
2123 /* Don't change the name if it's already NAME. */
2124 if (! NILP (Fstring_equal (name
, f
->name
)))
2129 /* For setting the frame title, the title parameter should override
2130 the name parameter. */
2131 if (! NILP (f
->title
))
2134 if (FRAME_X_WINDOW (f
))
2139 XTextProperty text
, icon
;
2140 Lisp_Object icon_name
;
2142 text
.value
= XSTRING (name
)->data
;
2143 text
.encoding
= XA_STRING
;
2145 text
.nitems
= STRING_BYTES (XSTRING (name
));
2147 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2149 icon
.value
= XSTRING (icon_name
)->data
;
2150 icon
.encoding
= XA_STRING
;
2152 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2153 #ifdef USE_X_TOOLKIT
2154 XSetWMName (FRAME_X_DISPLAY (f
),
2155 XtWindow (f
->output_data
.x
->widget
), &text
);
2156 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2158 #else /* not USE_X_TOOLKIT */
2159 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2160 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2161 #endif /* not USE_X_TOOLKIT */
2163 #else /* not HAVE_X11R4 */
2164 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2165 XSTRING (name
)->data
);
2166 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2167 XSTRING (name
)->data
);
2168 #endif /* not HAVE_X11R4 */
2173 /* This function should be called when the user's lisp code has
2174 specified a name for the frame; the name will override any set by the
2177 x_explicitly_set_name (f
, arg
, oldval
)
2179 Lisp_Object arg
, oldval
;
2181 x_set_name (f
, arg
, 1);
2184 /* This function should be called by Emacs redisplay code to set the
2185 name; names set this way will never override names set by the user's
2188 x_implicitly_set_name (f
, arg
, oldval
)
2190 Lisp_Object arg
, oldval
;
2192 x_set_name (f
, arg
, 0);
2195 /* Change the title of frame F to NAME.
2196 If NAME is nil, use the frame name as the title.
2198 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2199 name; if NAME is a string, set F's name to NAME and set
2200 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2202 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2203 suggesting a new name, which lisp code should override; if
2204 F->explicit_name is set, ignore the new name; otherwise, set it. */
2207 x_set_title (f
, name
, old_name
)
2209 Lisp_Object name
, old_name
;
2211 /* Don't change the title if it's already NAME. */
2212 if (EQ (name
, f
->title
))
2215 update_mode_lines
= 1;
2222 CHECK_STRING (name
, 0);
2224 if (FRAME_X_WINDOW (f
))
2229 XTextProperty text
, icon
;
2230 Lisp_Object icon_name
;
2232 text
.value
= XSTRING (name
)->data
;
2233 text
.encoding
= XA_STRING
;
2235 text
.nitems
= STRING_BYTES (XSTRING (name
));
2237 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2239 icon
.value
= XSTRING (icon_name
)->data
;
2240 icon
.encoding
= XA_STRING
;
2242 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2243 #ifdef USE_X_TOOLKIT
2244 XSetWMName (FRAME_X_DISPLAY (f
),
2245 XtWindow (f
->output_data
.x
->widget
), &text
);
2246 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2248 #else /* not USE_X_TOOLKIT */
2249 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2250 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2251 #endif /* not USE_X_TOOLKIT */
2253 #else /* not HAVE_X11R4 */
2254 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2255 XSTRING (name
)->data
);
2256 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2257 XSTRING (name
)->data
);
2258 #endif /* not HAVE_X11R4 */
2264 x_set_autoraise (f
, arg
, oldval
)
2266 Lisp_Object arg
, oldval
;
2268 f
->auto_raise
= !EQ (Qnil
, arg
);
2272 x_set_autolower (f
, arg
, oldval
)
2274 Lisp_Object arg
, oldval
;
2276 f
->auto_lower
= !EQ (Qnil
, arg
);
2280 x_set_unsplittable (f
, arg
, oldval
)
2282 Lisp_Object arg
, oldval
;
2284 f
->no_split
= !NILP (arg
);
2288 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2290 Lisp_Object arg
, oldval
;
2292 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2293 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2294 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2295 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2297 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2299 ? vertical_scroll_bar_none
2301 ? vertical_scroll_bar_right
2302 : vertical_scroll_bar_left
);
2304 /* We set this parameter before creating the X window for the
2305 frame, so we can get the geometry right from the start.
2306 However, if the window hasn't been created yet, we shouldn't
2307 call x_set_window_size. */
2308 if (FRAME_X_WINDOW (f
))
2309 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2310 do_pending_window_change (0);
2315 x_set_scroll_bar_width (f
, arg
, oldval
)
2317 Lisp_Object arg
, oldval
;
2319 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2323 #ifdef USE_TOOLKIT_SCROLL_BARS
2324 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2325 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2326 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2327 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2329 /* Make the actual width at least 14 pixels and a multiple of a
2331 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2333 /* Use all of that space (aside from required margins) for the
2335 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2338 if (FRAME_X_WINDOW (f
))
2339 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2340 do_pending_window_change (0);
2342 else if (INTEGERP (arg
) && XINT (arg
) > 0
2343 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2345 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2346 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2348 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2349 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2350 if (FRAME_X_WINDOW (f
))
2351 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2354 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2355 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2356 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2361 /* Subroutines of creating an X frame. */
2363 /* Make sure that Vx_resource_name is set to a reasonable value.
2364 Fix it up, or set it to `emacs' if it is too hopeless. */
2367 validate_x_resource_name ()
2370 /* Number of valid characters in the resource name. */
2372 /* Number of invalid characters in the resource name. */
2377 if (!STRINGP (Vx_resource_class
))
2378 Vx_resource_class
= build_string (EMACS_CLASS
);
2380 if (STRINGP (Vx_resource_name
))
2382 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2385 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2387 /* Only letters, digits, - and _ are valid in resource names.
2388 Count the valid characters and count the invalid ones. */
2389 for (i
= 0; i
< len
; i
++)
2392 if (! ((c
>= 'a' && c
<= 'z')
2393 || (c
>= 'A' && c
<= 'Z')
2394 || (c
>= '0' && c
<= '9')
2395 || c
== '-' || c
== '_'))
2402 /* Not a string => completely invalid. */
2403 bad_count
= 5, good_count
= 0;
2405 /* If name is valid already, return. */
2409 /* If name is entirely invalid, or nearly so, use `emacs'. */
2411 || (good_count
== 1 && bad_count
> 0))
2413 Vx_resource_name
= build_string ("emacs");
2417 /* Name is partly valid. Copy it and replace the invalid characters
2418 with underscores. */
2420 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2422 for (i
= 0; i
< len
; i
++)
2424 int c
= XSTRING (new)->data
[i
];
2425 if (! ((c
>= 'a' && c
<= 'z')
2426 || (c
>= 'A' && c
<= 'Z')
2427 || (c
>= '0' && c
<= '9')
2428 || c
== '-' || c
== '_'))
2429 XSTRING (new)->data
[i
] = '_';
2434 extern char *x_get_string_resource ();
2436 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2437 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2438 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2439 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2440 the name specified by the `-name' or `-rn' command-line arguments.\n\
2442 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2443 class, respectively. You must specify both of them or neither.\n\
2444 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2445 and the class is `Emacs.CLASS.SUBCLASS'.")
2446 (attribute
, class, component
, subclass
)
2447 Lisp_Object attribute
, class, component
, subclass
;
2449 register char *value
;
2455 CHECK_STRING (attribute
, 0);
2456 CHECK_STRING (class, 0);
2458 if (!NILP (component
))
2459 CHECK_STRING (component
, 1);
2460 if (!NILP (subclass
))
2461 CHECK_STRING (subclass
, 2);
2462 if (NILP (component
) != NILP (subclass
))
2463 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2465 validate_x_resource_name ();
2467 /* Allocate space for the components, the dots which separate them,
2468 and the final '\0'. Make them big enough for the worst case. */
2469 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2470 + (STRINGP (component
)
2471 ? STRING_BYTES (XSTRING (component
)) : 0)
2472 + STRING_BYTES (XSTRING (attribute
))
2475 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2476 + STRING_BYTES (XSTRING (class))
2477 + (STRINGP (subclass
)
2478 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2481 /* Start with emacs.FRAMENAME for the name (the specific one)
2482 and with `Emacs' for the class key (the general one). */
2483 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2484 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2486 strcat (class_key
, ".");
2487 strcat (class_key
, XSTRING (class)->data
);
2489 if (!NILP (component
))
2491 strcat (class_key
, ".");
2492 strcat (class_key
, XSTRING (subclass
)->data
);
2494 strcat (name_key
, ".");
2495 strcat (name_key
, XSTRING (component
)->data
);
2498 strcat (name_key
, ".");
2499 strcat (name_key
, XSTRING (attribute
)->data
);
2501 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2502 name_key
, class_key
);
2504 if (value
!= (char *) 0)
2505 return build_string (value
);
2510 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2513 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2514 struct x_display_info
*dpyinfo
;
2515 Lisp_Object attribute
, class, component
, subclass
;
2517 register char *value
;
2521 CHECK_STRING (attribute
, 0);
2522 CHECK_STRING (class, 0);
2524 if (!NILP (component
))
2525 CHECK_STRING (component
, 1);
2526 if (!NILP (subclass
))
2527 CHECK_STRING (subclass
, 2);
2528 if (NILP (component
) != NILP (subclass
))
2529 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2531 validate_x_resource_name ();
2533 /* Allocate space for the components, the dots which separate them,
2534 and the final '\0'. Make them big enough for the worst case. */
2535 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2536 + (STRINGP (component
)
2537 ? STRING_BYTES (XSTRING (component
)) : 0)
2538 + STRING_BYTES (XSTRING (attribute
))
2541 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2542 + STRING_BYTES (XSTRING (class))
2543 + (STRINGP (subclass
)
2544 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2547 /* Start with emacs.FRAMENAME for the name (the specific one)
2548 and with `Emacs' for the class key (the general one). */
2549 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2550 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2552 strcat (class_key
, ".");
2553 strcat (class_key
, XSTRING (class)->data
);
2555 if (!NILP (component
))
2557 strcat (class_key
, ".");
2558 strcat (class_key
, XSTRING (subclass
)->data
);
2560 strcat (name_key
, ".");
2561 strcat (name_key
, XSTRING (component
)->data
);
2564 strcat (name_key
, ".");
2565 strcat (name_key
, XSTRING (attribute
)->data
);
2567 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2569 if (value
!= (char *) 0)
2570 return build_string (value
);
2575 /* Used when C code wants a resource value. */
2578 x_get_resource_string (attribute
, class)
2579 char *attribute
, *class;
2583 struct frame
*sf
= SELECTED_FRAME ();
2585 /* Allocate space for the components, the dots which separate them,
2586 and the final '\0'. */
2587 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2588 + strlen (attribute
) + 2);
2589 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2590 + strlen (class) + 2);
2592 sprintf (name_key
, "%s.%s",
2593 XSTRING (Vinvocation_name
)->data
,
2595 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2597 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2598 name_key
, class_key
);
2601 /* Types we might convert a resource string into. */
2611 /* Return the value of parameter PARAM.
2613 First search ALIST, then Vdefault_frame_alist, then the X defaults
2614 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2616 Convert the resource to the type specified by desired_type.
2618 If no default is specified, return Qunbound. If you call
2619 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2620 and don't let it get stored in any Lisp-visible variables! */
2623 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2624 struct x_display_info
*dpyinfo
;
2625 Lisp_Object alist
, param
;
2628 enum resource_types type
;
2630 register Lisp_Object tem
;
2632 tem
= Fassq (param
, alist
);
2634 tem
= Fassq (param
, Vdefault_frame_alist
);
2640 tem
= display_x_get_resource (dpyinfo
,
2641 build_string (attribute
),
2642 build_string (class),
2650 case RES_TYPE_NUMBER
:
2651 return make_number (atoi (XSTRING (tem
)->data
));
2653 case RES_TYPE_FLOAT
:
2654 return make_float (atof (XSTRING (tem
)->data
));
2656 case RES_TYPE_BOOLEAN
:
2657 tem
= Fdowncase (tem
);
2658 if (!strcmp (XSTRING (tem
)->data
, "on")
2659 || !strcmp (XSTRING (tem
)->data
, "true"))
2664 case RES_TYPE_STRING
:
2667 case RES_TYPE_SYMBOL
:
2668 /* As a special case, we map the values `true' and `on'
2669 to Qt, and `false' and `off' to Qnil. */
2672 lower
= Fdowncase (tem
);
2673 if (!strcmp (XSTRING (lower
)->data
, "on")
2674 || !strcmp (XSTRING (lower
)->data
, "true"))
2676 else if (!strcmp (XSTRING (lower
)->data
, "off")
2677 || !strcmp (XSTRING (lower
)->data
, "false"))
2680 return Fintern (tem
, Qnil
);
2693 /* Like x_get_arg, but also record the value in f->param_alist. */
2696 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2698 Lisp_Object alist
, param
;
2701 enum resource_types type
;
2705 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2706 attribute
, class, type
);
2708 store_frame_param (f
, param
, value
);
2713 /* Record in frame F the specified or default value according to ALIST
2714 of the parameter named PROP (a Lisp symbol).
2715 If no value is specified for PROP, look for an X default for XPROP
2716 on the frame named NAME.
2717 If that is not found either, use the value DEFLT. */
2720 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2727 enum resource_types type
;
2731 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2732 if (EQ (tem
, Qunbound
))
2734 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2739 /* Record in frame F the specified or default value according to ALIST
2740 of the parameter named PROP (a Lisp symbol). If no value is
2741 specified for PROP, look for an X default for XPROP on the frame
2742 named NAME. If that is not found either, use the value DEFLT. */
2745 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2754 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2757 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2758 if (EQ (tem
, Qunbound
))
2760 #ifdef USE_TOOLKIT_SCROLL_BARS
2762 /* See if an X resource for the scroll bar color has been
2764 tem
= display_x_get_resource (dpyinfo
,
2765 build_string (foreground_p
2769 build_string ("verticalScrollBar"),
2773 /* If nothing has been specified, scroll bars will use a
2774 toolkit-dependent default. Because these defaults are
2775 difficult to get at without actually creating a scroll
2776 bar, use nil to indicate that no color has been
2781 #else /* not USE_TOOLKIT_SCROLL_BARS */
2785 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2788 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2794 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2795 "Parse an X-style geometry string STRING.\n\
2796 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2797 The properties returned may include `top', `left', `height', and `width'.\n\
2798 The value of `left' or `top' may be an integer,\n\
2799 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2800 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2805 unsigned int width
, height
;
2808 CHECK_STRING (string
, 0);
2810 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2811 &x
, &y
, &width
, &height
);
2814 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2815 error ("Must specify both x and y position, or neither");
2819 if (geometry
& XValue
)
2821 Lisp_Object element
;
2823 if (x
>= 0 && (geometry
& XNegative
))
2824 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2825 else if (x
< 0 && ! (geometry
& XNegative
))
2826 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2828 element
= Fcons (Qleft
, make_number (x
));
2829 result
= Fcons (element
, result
);
2832 if (geometry
& YValue
)
2834 Lisp_Object element
;
2836 if (y
>= 0 && (geometry
& YNegative
))
2837 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2838 else if (y
< 0 && ! (geometry
& YNegative
))
2839 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2841 element
= Fcons (Qtop
, make_number (y
));
2842 result
= Fcons (element
, result
);
2845 if (geometry
& WidthValue
)
2846 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2847 if (geometry
& HeightValue
)
2848 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2853 /* Calculate the desired size and position of this window,
2854 and return the flags saying which aspects were specified.
2856 This function does not make the coordinates positive. */
2858 #define DEFAULT_ROWS 40
2859 #define DEFAULT_COLS 80
2862 x_figure_window_size (f
, parms
)
2866 register Lisp_Object tem0
, tem1
, tem2
;
2867 long window_prompting
= 0;
2868 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2870 /* Default values if we fall through.
2871 Actually, if that happens we should get
2872 window manager prompting. */
2873 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2874 f
->height
= DEFAULT_ROWS
;
2875 /* Window managers expect that if program-specified
2876 positions are not (0,0), they're intentional, not defaults. */
2877 f
->output_data
.x
->top_pos
= 0;
2878 f
->output_data
.x
->left_pos
= 0;
2880 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
2881 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
2882 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
2883 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2885 if (!EQ (tem0
, Qunbound
))
2887 CHECK_NUMBER (tem0
, 0);
2888 f
->height
= XINT (tem0
);
2890 if (!EQ (tem1
, Qunbound
))
2892 CHECK_NUMBER (tem1
, 0);
2893 SET_FRAME_WIDTH (f
, XINT (tem1
));
2895 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2896 window_prompting
|= USSize
;
2898 window_prompting
|= PSize
;
2901 f
->output_data
.x
->vertical_scroll_bar_extra
2902 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2904 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2905 f
->output_data
.x
->flags_areas_extra
2906 = FRAME_FLAGS_AREA_WIDTH (f
);
2907 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2908 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2910 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
2911 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
2912 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
2913 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2915 if (EQ (tem0
, Qminus
))
2917 f
->output_data
.x
->top_pos
= 0;
2918 window_prompting
|= YNegative
;
2920 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
2921 && CONSP (XCDR (tem0
))
2922 && INTEGERP (XCAR (XCDR (tem0
))))
2924 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
2925 window_prompting
|= YNegative
;
2927 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
2928 && CONSP (XCDR (tem0
))
2929 && INTEGERP (XCAR (XCDR (tem0
))))
2931 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
2933 else if (EQ (tem0
, Qunbound
))
2934 f
->output_data
.x
->top_pos
= 0;
2937 CHECK_NUMBER (tem0
, 0);
2938 f
->output_data
.x
->top_pos
= XINT (tem0
);
2939 if (f
->output_data
.x
->top_pos
< 0)
2940 window_prompting
|= YNegative
;
2943 if (EQ (tem1
, Qminus
))
2945 f
->output_data
.x
->left_pos
= 0;
2946 window_prompting
|= XNegative
;
2948 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
2949 && CONSP (XCDR (tem1
))
2950 && INTEGERP (XCAR (XCDR (tem1
))))
2952 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
2953 window_prompting
|= XNegative
;
2955 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
2956 && CONSP (XCDR (tem1
))
2957 && INTEGERP (XCAR (XCDR (tem1
))))
2959 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
2961 else if (EQ (tem1
, Qunbound
))
2962 f
->output_data
.x
->left_pos
= 0;
2965 CHECK_NUMBER (tem1
, 0);
2966 f
->output_data
.x
->left_pos
= XINT (tem1
);
2967 if (f
->output_data
.x
->left_pos
< 0)
2968 window_prompting
|= XNegative
;
2971 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2972 window_prompting
|= USPosition
;
2974 window_prompting
|= PPosition
;
2977 return window_prompting
;
2980 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2983 XSetWMProtocols (dpy
, w
, protocols
, count
)
2990 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
2991 if (prop
== None
) return False
;
2992 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
2993 (unsigned char *) protocols
, count
);
2996 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2998 #ifdef USE_X_TOOLKIT
3000 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3001 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3002 already be present because of the toolkit (Motif adds some of them,
3003 for example, but Xt doesn't). */
3006 hack_wm_protocols (f
, widget
)
3010 Display
*dpy
= XtDisplay (widget
);
3011 Window w
= XtWindow (widget
);
3012 int need_delete
= 1;
3018 Atom type
, *atoms
= 0;
3020 unsigned long nitems
= 0;
3021 unsigned long bytes_after
;
3023 if ((XGetWindowProperty (dpy
, w
,
3024 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3025 (long)0, (long)100, False
, XA_ATOM
,
3026 &type
, &format
, &nitems
, &bytes_after
,
3027 (unsigned char **) &atoms
)
3029 && format
== 32 && type
== XA_ATOM
)
3033 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3035 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3037 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3040 if (atoms
) XFree ((char *) atoms
);
3046 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3048 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3050 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3052 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3053 XA_ATOM
, 32, PropModeAppend
,
3054 (unsigned char *) props
, count
);
3062 /* Support routines for XIC (X Input Context). */
3066 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3067 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3070 /* Supported XIM styles, ordered by preferenc. */
3072 static XIMStyle supported_xim_styles
[] =
3074 XIMPreeditPosition
| XIMStatusArea
,
3075 XIMPreeditPosition
| XIMStatusNothing
,
3076 XIMPreeditPosition
| XIMStatusNone
,
3077 XIMPreeditNothing
| XIMStatusArea
,
3078 XIMPreeditNothing
| XIMStatusNothing
,
3079 XIMPreeditNothing
| XIMStatusNone
,
3080 XIMPreeditNone
| XIMStatusArea
,
3081 XIMPreeditNone
| XIMStatusNothing
,
3082 XIMPreeditNone
| XIMStatusNone
,
3087 /* Create an X fontset on frame F with base font name
3091 xic_create_xfontset (f
, base_fontname
)
3093 char *base_fontname
;
3096 char **missing_list
;
3100 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3101 base_fontname
, &missing_list
,
3102 &missing_count
, &def_string
);
3104 XFreeStringList (missing_list
);
3106 /* No need to free def_string. */
3111 /* Value is the best input style, given user preferences USER (already
3112 checked to be supported by Emacs), and styles supported by the
3113 input method XIM. */
3116 best_xim_style (user
, xim
)
3122 for (i
= 0; i
< user
->count_styles
; ++i
)
3123 for (j
= 0; j
< xim
->count_styles
; ++j
)
3124 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3125 return user
->supported_styles
[i
];
3127 /* Return the default style. */
3128 return XIMPreeditNothing
| XIMStatusNothing
;
3131 /* Create XIC for frame F. */
3134 create_frame_xic (f
)
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 /* Determine the base fontname from the ASCII font name of
3165 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3166 char *p
= ascii_font
;
3169 for (i
= 0; *p
; p
++)
3172 /* As the font name doesn't conform to XLFD, we can't
3173 modify it to get a suitable base fontname for the
3175 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3178 int len
= strlen (ascii_font
) + 1;
3181 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3190 base_fontname
= (char *) alloca (len
);
3191 bzero (base_fontname
, len
);
3192 strcpy (base_fontname
, "-*-*-");
3193 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3194 strcat (base_fontname
, "*-*-*-*-*-*-*");
3197 xfs
= xic_create_xfontset (f
, base_fontname
);
3199 /* Determine XIC style. */
3202 XIMStyles supported_list
;
3203 supported_list
.count_styles
= (sizeof supported_xim_styles
3204 / sizeof supported_xim_styles
[0]);
3205 supported_list
.supported_styles
= supported_xim_styles
;
3206 xic_style
= best_xim_style (&supported_list
,
3207 FRAME_X_XIM_STYLES (f
));
3210 preedit_attr
= XVaCreateNestedList (0,
3213 FRAME_FOREGROUND_PIXEL (f
),
3215 FRAME_BACKGROUND_PIXEL (f
),
3216 (xic_style
& XIMPreeditPosition
3221 status_attr
= XVaCreateNestedList (0,
3227 FRAME_FOREGROUND_PIXEL (f
),
3229 FRAME_BACKGROUND_PIXEL (f
),
3232 xic
= XCreateIC (xim
,
3233 XNInputStyle
, xic_style
,
3234 XNClientWindow
, FRAME_X_WINDOW(f
),
3235 XNFocusWindow
, FRAME_X_WINDOW(f
),
3236 XNStatusAttributes
, status_attr
,
3237 XNPreeditAttributes
, preedit_attr
,
3239 XFree (preedit_attr
);
3240 XFree (status_attr
);
3243 FRAME_XIC (f
) = xic
;
3244 FRAME_XIC_STYLE (f
) = xic_style
;
3245 FRAME_XIC_FONTSET (f
) = xfs
;
3249 /* Destroy XIC and free XIC fontset of frame F, if any. */
3255 if (FRAME_XIC (f
) == NULL
)
3258 XDestroyIC (FRAME_XIC (f
));
3259 if (FRAME_XIC_FONTSET (f
))
3260 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3262 FRAME_XIC (f
) = NULL
;
3263 FRAME_XIC_FONTSET (f
) = NULL
;
3267 /* Place preedit area for XIC of window W's frame to specified
3268 pixel position X/Y. X and Y are relative to window W. */
3271 xic_set_preeditarea (w
, x
, y
)
3275 struct frame
*f
= XFRAME (w
->frame
);
3279 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3280 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3281 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3282 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3287 /* Place status area for XIC in bottom right corner of frame F.. */
3290 xic_set_statusarea (f
)
3293 XIC xic
= FRAME_XIC (f
);
3298 /* Negotiate geometry of status area. If input method has existing
3299 status area, use its current size. */
3300 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3301 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3302 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3305 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3306 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3309 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3311 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3312 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3316 area
.width
= needed
->width
;
3317 area
.height
= needed
->height
;
3318 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3319 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3320 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3323 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3324 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3329 /* Set X fontset for XIC of frame F, using base font name
3330 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3333 xic_set_xfontset (f
, base_fontname
)
3335 char *base_fontname
;
3340 xfs
= xic_create_xfontset (f
, base_fontname
);
3342 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3343 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3344 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3345 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3346 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3349 if (FRAME_XIC_FONTSET (f
))
3350 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3351 FRAME_XIC_FONTSET (f
) = xfs
;
3354 #endif /* HAVE_X_I18N */
3358 #ifdef USE_X_TOOLKIT
3360 /* Create and set up the X widget for frame F. */
3363 x_window (f
, window_prompting
, minibuffer_only
)
3365 long window_prompting
;
3366 int minibuffer_only
;
3368 XClassHint class_hints
;
3369 XSetWindowAttributes attributes
;
3370 unsigned long attribute_mask
;
3371 Widget shell_widget
;
3373 Widget frame_widget
;
3379 /* Use the resource name as the top-level widget name
3380 for looking up resources. Make a non-Lisp copy
3381 for the window manager, so GC relocation won't bother it.
3383 Elsewhere we specify the window name for the window manager. */
3386 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3387 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3388 strcpy (f
->namebuf
, str
);
3392 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3393 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3394 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3395 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3396 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3397 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3398 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3399 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3400 applicationShellWidgetClass
,
3401 FRAME_X_DISPLAY (f
), al
, ac
);
3403 f
->output_data
.x
->widget
= shell_widget
;
3404 /* maybe_set_screen_title_format (shell_widget); */
3406 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3407 (widget_value
*) NULL
,
3408 shell_widget
, False
,
3412 (lw_callback
) NULL
);
3415 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3416 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3417 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3418 XtSetValues (pane_widget
, al
, ac
);
3419 f
->output_data
.x
->column_widget
= pane_widget
;
3421 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3422 the emacs screen when changing menubar. This reduces flickering. */
3425 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3426 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3427 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3428 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3429 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3430 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3431 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3432 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3433 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3436 f
->output_data
.x
->edit_widget
= frame_widget
;
3438 XtManageChild (frame_widget
);
3440 /* Do some needed geometry management. */
3443 char *tem
, shell_position
[32];
3446 int extra_borders
= 0;
3448 = (f
->output_data
.x
->menubar_widget
3449 ? (f
->output_data
.x
->menubar_widget
->core
.height
3450 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3453 #if 0 /* Experimentally, we now get the right results
3454 for -geometry -0-0 without this. 24 Aug 96, rms. */
3455 if (FRAME_EXTERNAL_MENU_BAR (f
))
3458 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3459 menubar_size
+= ibw
;
3463 f
->output_data
.x
->menubar_height
= menubar_size
;
3466 /* Motif seems to need this amount added to the sizes
3467 specified for the shell widget. The Athena/Lucid widgets don't.
3468 Both conclusions reached experimentally. -- rms. */
3469 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3470 &extra_borders
, NULL
);
3474 /* Convert our geometry parameters into a geometry string
3476 Note that we do not specify here whether the position
3477 is a user-specified or program-specified one.
3478 We pass that information later, in x_wm_set_size_hints. */
3480 int left
= f
->output_data
.x
->left_pos
;
3481 int xneg
= window_prompting
& XNegative
;
3482 int top
= f
->output_data
.x
->top_pos
;
3483 int yneg
= window_prompting
& YNegative
;
3489 if (window_prompting
& USPosition
)
3490 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3491 PIXEL_WIDTH (f
) + extra_borders
,
3492 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3493 (xneg
? '-' : '+'), left
,
3494 (yneg
? '-' : '+'), top
);
3496 sprintf (shell_position
, "=%dx%d",
3497 PIXEL_WIDTH (f
) + extra_borders
,
3498 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3501 len
= strlen (shell_position
) + 1;
3502 /* We don't free this because we don't know whether
3503 it is safe to free it while the frame exists.
3504 It isn't worth the trouble of arranging to free it
3505 when the frame is deleted. */
3506 tem
= (char *) xmalloc (len
);
3507 strncpy (tem
, shell_position
, len
);
3508 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3509 XtSetValues (shell_widget
, al
, ac
);
3512 XtManageChild (pane_widget
);
3513 XtRealizeWidget (shell_widget
);
3515 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3517 validate_x_resource_name ();
3519 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3520 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3521 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3524 FRAME_XIC (f
) = NULL
;
3526 create_frame_xic (f
);
3530 f
->output_data
.x
->wm_hints
.input
= True
;
3531 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3532 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3533 &f
->output_data
.x
->wm_hints
);
3535 hack_wm_protocols (f
, shell_widget
);
3538 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3541 /* Do a stupid property change to force the server to generate a
3542 PropertyNotify event so that the event_stream server timestamp will
3543 be initialized to something relevant to the time we created the window.
3545 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3546 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3547 XA_ATOM
, 32, PropModeAppend
,
3548 (unsigned char*) NULL
, 0);
3550 /* Make all the standard events reach the Emacs frame. */
3551 attributes
.event_mask
= STANDARD_EVENT_SET
;
3556 /* XIM server might require some X events. */
3557 unsigned long fevent
= NoEventMask
;
3558 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3559 attributes
.event_mask
|= fevent
;
3561 #endif /* HAVE_X_I18N */
3563 attribute_mask
= CWEventMask
;
3564 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3565 attribute_mask
, &attributes
);
3567 XtMapWidget (frame_widget
);
3569 /* x_set_name normally ignores requests to set the name if the
3570 requested name is the same as the current name. This is the one
3571 place where that assumption isn't correct; f->name is set, but
3572 the X server hasn't been told. */
3575 int explicit = f
->explicit_name
;
3577 f
->explicit_name
= 0;
3580 x_set_name (f
, name
, explicit);
3583 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3584 f
->output_data
.x
->text_cursor
);
3588 /* This is a no-op, except under Motif. Make sure main areas are
3589 set to something reasonable, in case we get an error later. */
3590 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3593 #else /* not USE_X_TOOLKIT */
3595 /* Create and set up the X window for frame F. */
3602 XClassHint class_hints
;
3603 XSetWindowAttributes attributes
;
3604 unsigned long attribute_mask
;
3606 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3607 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3608 attributes
.bit_gravity
= StaticGravity
;
3609 attributes
.backing_store
= NotUseful
;
3610 attributes
.save_under
= True
;
3611 attributes
.event_mask
= STANDARD_EVENT_SET
;
3612 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3613 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3618 = XCreateWindow (FRAME_X_DISPLAY (f
),
3619 f
->output_data
.x
->parent_desc
,
3620 f
->output_data
.x
->left_pos
,
3621 f
->output_data
.x
->top_pos
,
3622 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3623 f
->output_data
.x
->border_width
,
3624 CopyFromParent
, /* depth */
3625 InputOutput
, /* class */
3627 attribute_mask
, &attributes
);
3631 create_frame_xic (f
);
3634 /* XIM server might require some X events. */
3635 unsigned long fevent
= NoEventMask
;
3636 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3637 attributes
.event_mask
|= fevent
;
3638 attribute_mask
= CWEventMask
;
3639 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3640 attribute_mask
, &attributes
);
3643 #endif /* HAVE_X_I18N */
3645 validate_x_resource_name ();
3647 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3648 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3649 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3651 /* The menubar is part of the ordinary display;
3652 it does not count in addition to the height of the window. */
3653 f
->output_data
.x
->menubar_height
= 0;
3655 /* This indicates that we use the "Passive Input" input model.
3656 Unless we do this, we don't get the Focus{In,Out} events that we
3657 need to draw the cursor correctly. Accursed bureaucrats.
3658 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3660 f
->output_data
.x
->wm_hints
.input
= True
;
3661 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3662 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3663 &f
->output_data
.x
->wm_hints
);
3664 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3666 /* Request "save yourself" and "delete window" commands from wm. */
3669 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3670 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3671 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3674 /* x_set_name normally ignores requests to set the name if the
3675 requested name is the same as the current name. This is the one
3676 place where that assumption isn't correct; f->name is set, but
3677 the X server hasn't been told. */
3680 int explicit = f
->explicit_name
;
3682 f
->explicit_name
= 0;
3685 x_set_name (f
, name
, explicit);
3688 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3689 f
->output_data
.x
->text_cursor
);
3693 if (FRAME_X_WINDOW (f
) == 0)
3694 error ("Unable to create window");
3697 #endif /* not USE_X_TOOLKIT */
3699 /* Handle the icon stuff for this window. Perhaps later we might
3700 want an x_set_icon_position which can be called interactively as
3708 Lisp_Object icon_x
, icon_y
;
3709 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3711 /* Set the position of the icon. Note that twm groups all
3712 icons in an icon window. */
3713 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3714 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3715 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3717 CHECK_NUMBER (icon_x
, 0);
3718 CHECK_NUMBER (icon_y
, 0);
3720 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3721 error ("Both left and top icon corners of icon must be specified");
3725 if (! EQ (icon_x
, Qunbound
))
3726 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3728 /* Start up iconic or window? */
3729 x_wm_set_window_state
3730 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3735 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3742 /* Make the GC's needed for this window, setting the
3743 background, border and mouse colors; also create the
3744 mouse cursor and the gray border tile. */
3746 static char cursor_bits
[] =
3748 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3749 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3750 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3751 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3758 XGCValues gc_values
;
3762 /* Create the GC's of this frame.
3763 Note that many default values are used. */
3766 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3767 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3768 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3769 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3770 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3772 GCLineWidth
| GCFont
3773 | GCForeground
| GCBackground
,
3776 /* Reverse video style. */
3777 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3778 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3779 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3781 GCFont
| GCForeground
| GCBackground
3785 /* Cursor has cursor-color background, background-color foreground. */
3786 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3787 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3788 gc_values
.fill_style
= FillOpaqueStippled
;
3790 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3791 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3792 cursor_bits
, 16, 16);
3793 f
->output_data
.x
->cursor_gc
3794 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3795 (GCFont
| GCForeground
| GCBackground
3796 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3800 f
->output_data
.x
->white_relief
.gc
= 0;
3801 f
->output_data
.x
->black_relief
.gc
= 0;
3803 /* Create the gray border tile used when the pointer is not in
3804 the frame. Since this depends on the frame's pixel values,
3805 this must be done on a per-frame basis. */
3806 f
->output_data
.x
->border_tile
3807 = (XCreatePixmapFromBitmapData
3808 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3809 gray_bits
, gray_width
, gray_height
,
3810 f
->output_data
.x
->foreground_pixel
,
3811 f
->output_data
.x
->background_pixel
,
3812 DefaultDepth (FRAME_X_DISPLAY (f
),
3813 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3818 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3820 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3821 Returns an Emacs frame object.\n\
3822 ALIST is an alist of frame parameters.\n\
3823 If the parameters specify that the frame should not have a minibuffer,\n\
3824 and do not specify a specific minibuffer window to use,\n\
3825 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3826 be shared by the new frame.\n\
3828 This function is an internal primitive--use `make-frame' instead.")
3833 Lisp_Object frame
, tem
;
3835 int minibuffer_only
= 0;
3836 long window_prompting
= 0;
3838 int count
= specpdl_ptr
- specpdl
;
3839 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3840 Lisp_Object display
;
3841 struct x_display_info
*dpyinfo
= NULL
;
3847 /* Use this general default value to start with
3848 until we know if this frame has a specified name. */
3849 Vx_resource_name
= Vinvocation_name
;
3851 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3852 if (EQ (display
, Qunbound
))
3854 dpyinfo
= check_x_display_info (display
);
3856 kb
= dpyinfo
->kboard
;
3858 kb
= &the_only_kboard
;
3861 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3863 && ! EQ (name
, Qunbound
)
3865 error ("Invalid frame name--not a string or nil");
3868 Vx_resource_name
= name
;
3870 /* See if parent window is specified. */
3871 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
3872 if (EQ (parent
, Qunbound
))
3874 if (! NILP (parent
))
3875 CHECK_NUMBER (parent
, 0);
3877 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3878 /* No need to protect DISPLAY because that's not used after passing
3879 it to make_frame_without_minibuffer. */
3881 GCPRO4 (parms
, parent
, name
, frame
);
3882 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
3884 if (EQ (tem
, Qnone
) || NILP (tem
))
3885 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3886 else if (EQ (tem
, Qonly
))
3888 f
= make_minibuffer_frame ();
3889 minibuffer_only
= 1;
3891 else if (WINDOWP (tem
))
3892 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3896 XSETFRAME (frame
, f
);
3898 /* Note that X Windows does support scroll bars. */
3899 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3901 f
->output_method
= output_x_window
;
3902 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
3903 bzero (f
->output_data
.x
, sizeof (struct x_output
));
3904 f
->output_data
.x
->icon_bitmap
= -1;
3905 f
->output_data
.x
->fontset
= -1;
3906 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
3907 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
3910 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
3912 if (! STRINGP (f
->icon_name
))
3913 f
->icon_name
= Qnil
;
3915 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
3917 FRAME_KBOARD (f
) = kb
;
3920 /* These colors will be set anyway later, but it's important
3921 to get the color reference counts right, so initialize them! */
3924 struct gcpro gcpro1
;
3926 black
= build_string ("black");
3928 f
->output_data
.x
->foreground_pixel
3929 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3930 f
->output_data
.x
->background_pixel
3931 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3932 f
->output_data
.x
->cursor_pixel
3933 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3934 f
->output_data
.x
->cursor_foreground_pixel
3935 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3936 f
->output_data
.x
->border_pixel
3937 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3938 f
->output_data
.x
->mouse_pixel
3939 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3943 /* Specify the parent under which to make this X window. */
3947 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
3948 f
->output_data
.x
->explicit_parent
= 1;
3952 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3953 f
->output_data
.x
->explicit_parent
= 0;
3956 /* Set the name; the functions to which we pass f expect the name to
3958 if (EQ (name
, Qunbound
) || NILP (name
))
3960 f
->name
= build_string (dpyinfo
->x_id_name
);
3961 f
->explicit_name
= 0;
3966 f
->explicit_name
= 1;
3967 /* use the frame's title when getting resources for this frame. */
3968 specbind (Qx_resource_name
, name
);
3971 /* Extract the window parameters from the supplied values
3972 that are needed to determine window geometry. */
3976 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
3979 /* First, try whatever font the caller has specified. */
3982 tem
= Fquery_fontset (font
, Qnil
);
3984 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
3986 font
= x_new_font (f
, XSTRING (font
)->data
);
3989 /* Try out a font which we hope has bold and italic variations. */
3990 if (!STRINGP (font
))
3991 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3992 if (!STRINGP (font
))
3993 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3994 if (! STRINGP (font
))
3995 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3996 if (! STRINGP (font
))
3997 /* This was formerly the first thing tried, but it finds too many fonts
3998 and takes too long. */
3999 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4000 /* If those didn't work, look for something which will at least work. */
4001 if (! STRINGP (font
))
4002 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4004 if (! STRINGP (font
))
4005 font
= build_string ("fixed");
4007 x_default_parameter (f
, parms
, Qfont
, font
,
4008 "font", "Font", RES_TYPE_STRING
);
4012 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4013 whereby it fails to get any font. */
4014 xlwmenu_default_font
= f
->output_data
.x
->font
;
4017 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4018 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4020 /* This defaults to 2 in order to match xterm. We recognize either
4021 internalBorderWidth or internalBorder (which is what xterm calls
4023 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4027 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4028 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4029 if (! EQ (value
, Qunbound
))
4030 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4033 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4034 "internalBorderWidth", "internalBorderWidth",
4036 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4037 "verticalScrollBars", "ScrollBars",
4040 /* Also do the stuff which must be set before the window exists. */
4041 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4042 "foreground", "Foreground", RES_TYPE_STRING
);
4043 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4044 "background", "Background", RES_TYPE_STRING
);
4045 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4046 "pointerColor", "Foreground", RES_TYPE_STRING
);
4047 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4048 "cursorColor", "Foreground", RES_TYPE_STRING
);
4049 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4050 "borderColor", "BorderColor", RES_TYPE_STRING
);
4051 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4052 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4053 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4054 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4056 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4057 "scrollBarForeground",
4058 "ScrollBarForeground", 1);
4059 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4060 "scrollBarBackground",
4061 "ScrollBarBackground", 0);
4063 /* Init faces before x_default_parameter is called for scroll-bar
4064 parameters because that function calls x_set_scroll_bar_width,
4065 which calls change_frame_size, which calls Fset_window_buffer,
4066 which runs hooks, which call Fvertical_motion. At the end, we
4067 end up in init_iterator with a null face cache, which should not
4069 init_frame_faces (f
);
4071 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4072 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4073 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
4074 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4075 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4076 "bufferPredicate", "BufferPredicate",
4078 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4079 "title", "Title", RES_TYPE_STRING
);
4081 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4082 window_prompting
= x_figure_window_size (f
, parms
);
4084 if (window_prompting
& XNegative
)
4086 if (window_prompting
& YNegative
)
4087 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4089 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4093 if (window_prompting
& YNegative
)
4094 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4096 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4099 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4101 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4102 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4104 /* Create the X widget or window. Add the tool-bar height to the
4105 initial frame height so that the user gets a text display area of
4106 the size he specified with -g or via .Xdefaults. Later changes
4107 of the tool-bar height don't change the frame size. This is done
4108 so that users can create tall Emacs frames without having to
4109 guess how tall the tool-bar will get. */
4110 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
4112 #ifdef USE_X_TOOLKIT
4113 x_window (f
, window_prompting
, minibuffer_only
);
4121 /* Now consider the frame official. */
4122 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4123 Vframe_list
= Fcons (frame
, Vframe_list
);
4125 /* We need to do this after creating the X window, so that the
4126 icon-creation functions can say whose icon they're describing. */
4127 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4128 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4130 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4131 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4132 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4133 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4134 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4135 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4136 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4137 "scrollBarWidth", "ScrollBarWidth",
4140 /* Dimensions, especially f->height, must be done via change_frame_size.
4141 Change will not be effected unless different from the current
4146 SET_FRAME_WIDTH (f
, 0);
4147 change_frame_size (f
, height
, width
, 1, 0, 0);
4149 /* Set up faces after all frame parameters are known. */
4150 call1 (Qface_set_after_frame_default
, frame
);
4152 #ifdef USE_X_TOOLKIT
4153 /* Create the menu bar. */
4154 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4156 /* If this signals an error, we haven't set size hints for the
4157 frame and we didn't make it visible. */
4158 initialize_frame_menubar (f
);
4160 /* This is a no-op, except under Motif where it arranges the
4161 main window for the widgets on it. */
4162 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4163 f
->output_data
.x
->menubar_widget
,
4164 f
->output_data
.x
->edit_widget
);
4166 #endif /* USE_X_TOOLKIT */
4168 /* Tell the server what size and position, etc, we want, and how
4169 badly we want them. This should be done after we have the menu
4170 bar so that its size can be taken into account. */
4172 x_wm_set_size_hint (f
, window_prompting
, 0);
4175 /* Make the window appear on the frame and enable display, unless
4176 the caller says not to. However, with explicit parent, Emacs
4177 cannot control visibility, so don't try. */
4178 if (! f
->output_data
.x
->explicit_parent
)
4180 Lisp_Object visibility
;
4182 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4184 if (EQ (visibility
, Qunbound
))
4187 if (EQ (visibility
, Qicon
))
4188 x_iconify_frame (f
);
4189 else if (! NILP (visibility
))
4190 x_make_frame_visible (f
);
4192 /* Must have been Qnil. */
4197 return unbind_to (count
, frame
);
4200 /* FRAME is used only to get a handle on the X display. We don't pass the
4201 display info directly because we're called from frame.c, which doesn't
4202 know about that structure. */
4205 x_get_focus_frame (frame
)
4206 struct frame
*frame
;
4208 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4210 if (! dpyinfo
->x_focus_frame
)
4213 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4218 /* In certain situations, when the window manager follows a
4219 click-to-focus policy, there seems to be no way around calling
4220 XSetInputFocus to give another frame the input focus .
4222 In an ideal world, XSetInputFocus should generally be avoided so
4223 that applications don't interfere with the window manager's focus
4224 policy. But I think it's okay to use when it's clearly done
4225 following a user-command. */
4227 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4228 "Set the input focus to FRAME.\n\
4229 FRAME nil means use the selected frame.")
4233 struct frame
*f
= check_x_frame (frame
);
4234 Display
*dpy
= FRAME_X_DISPLAY (f
);
4238 count
= x_catch_errors (dpy
);
4239 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4240 RevertToParent
, CurrentTime
);
4241 x_uncatch_errors (dpy
, count
);
4248 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4249 "Internal function called by `color-defined-p', which see.")
4251 Lisp_Object color
, frame
;
4254 FRAME_PTR f
= check_x_frame (frame
);
4256 CHECK_STRING (color
, 1);
4258 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4264 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4265 "Internal function called by `color-values', which see.")
4267 Lisp_Object color
, frame
;
4270 FRAME_PTR f
= check_x_frame (frame
);
4272 CHECK_STRING (color
, 1);
4274 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4278 rgb
[0] = make_number (foo
.red
);
4279 rgb
[1] = make_number (foo
.green
);
4280 rgb
[2] = make_number (foo
.blue
);
4281 return Flist (3, rgb
);
4287 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4288 "Internal function called by `display-color-p', which see.")
4290 Lisp_Object display
;
4292 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4294 if (dpyinfo
->n_planes
<= 2)
4297 switch (dpyinfo
->visual
->class)
4310 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4312 "Return t if the X display supports shades of gray.\n\
4313 Note that color displays do support shades of gray.\n\
4314 The optional argument DISPLAY specifies which display to ask about.\n\
4315 DISPLAY should be either a frame or a display name (a string).\n\
4316 If omitted or nil, that stands for the selected frame's display.")
4318 Lisp_Object display
;
4320 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4322 if (dpyinfo
->n_planes
<= 1)
4325 switch (dpyinfo
->visual
->class)
4340 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4342 "Returns the width in pixels of the X display DISPLAY.\n\
4343 The optional argument DISPLAY specifies which display to ask about.\n\
4344 DISPLAY should be either a frame or a display name (a string).\n\
4345 If omitted or nil, that stands for the selected frame's display.")
4347 Lisp_Object display
;
4349 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4351 return make_number (dpyinfo
->width
);
4354 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4355 Sx_display_pixel_height
, 0, 1, 0,
4356 "Returns the height in pixels of the X display DISPLAY.\n\
4357 The optional argument DISPLAY specifies which display to ask about.\n\
4358 DISPLAY should be either a frame or a display name (a string).\n\
4359 If omitted or nil, that stands for the selected frame's display.")
4361 Lisp_Object display
;
4363 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4365 return make_number (dpyinfo
->height
);
4368 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4370 "Returns the number of bitplanes of the X display DISPLAY.\n\
4371 The optional argument DISPLAY specifies which display to ask about.\n\
4372 DISPLAY should be either a frame or a display name (a string).\n\
4373 If omitted or nil, that stands for the selected frame's display.")
4375 Lisp_Object display
;
4377 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4379 return make_number (dpyinfo
->n_planes
);
4382 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4384 "Returns the number of color cells of the X display DISPLAY.\n\
4385 The optional argument DISPLAY specifies which display to ask about.\n\
4386 DISPLAY should be either a frame or a display name (a string).\n\
4387 If omitted or nil, that stands for the selected frame's display.")
4389 Lisp_Object display
;
4391 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4393 return make_number (DisplayCells (dpyinfo
->display
,
4394 XScreenNumberOfScreen (dpyinfo
->screen
)));
4397 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4398 Sx_server_max_request_size
,
4400 "Returns the maximum request size of the X server of display DISPLAY.\n\
4401 The optional argument DISPLAY specifies which display to ask about.\n\
4402 DISPLAY should be either a frame or a display name (a string).\n\
4403 If omitted or nil, that stands for the selected frame's display.")
4405 Lisp_Object display
;
4407 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4409 return make_number (MAXREQUEST (dpyinfo
->display
));
4412 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4413 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4414 The optional argument DISPLAY specifies which display to ask about.\n\
4415 DISPLAY should be either a frame or a display name (a string).\n\
4416 If omitted or nil, that stands for the selected frame's display.")
4418 Lisp_Object display
;
4420 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4421 char *vendor
= ServerVendor (dpyinfo
->display
);
4423 if (! vendor
) vendor
= "";
4424 return build_string (vendor
);
4427 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4428 "Returns the version numbers of the X server of display DISPLAY.\n\
4429 The value is a list of three integers: the major and minor\n\
4430 version numbers of the X Protocol in use, and the vendor-specific release\n\
4431 number. See also the function `x-server-vendor'.\n\n\
4432 The optional argument DISPLAY specifies which display to ask about.\n\
4433 DISPLAY should be either a frame or a display name (a string).\n\
4434 If omitted or nil, that stands for the selected frame's display.")
4436 Lisp_Object display
;
4438 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4439 Display
*dpy
= dpyinfo
->display
;
4441 return Fcons (make_number (ProtocolVersion (dpy
)),
4442 Fcons (make_number (ProtocolRevision (dpy
)),
4443 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4446 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4447 "Returns the number of screens on the X server of display DISPLAY.\n\
4448 The optional argument DISPLAY specifies which display to ask about.\n\
4449 DISPLAY should be either a frame or a display name (a string).\n\
4450 If omitted or nil, that stands for the selected frame's display.")
4452 Lisp_Object display
;
4454 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4456 return make_number (ScreenCount (dpyinfo
->display
));
4459 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4460 "Returns the height in millimeters of the X display DISPLAY.\n\
4461 The optional argument DISPLAY specifies which display to ask about.\n\
4462 DISPLAY should be either a frame or a display name (a string).\n\
4463 If omitted or nil, that stands for the selected frame's display.")
4465 Lisp_Object display
;
4467 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4469 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4472 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4473 "Returns the width in millimeters of the X display DISPLAY.\n\
4474 The optional argument DISPLAY specifies which display to ask about.\n\
4475 DISPLAY should be either a frame or a display name (a string).\n\
4476 If omitted or nil, that stands for the selected frame's display.")
4478 Lisp_Object display
;
4480 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4482 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4485 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4486 Sx_display_backing_store
, 0, 1, 0,
4487 "Returns an indication of whether X display DISPLAY does backing store.\n\
4488 The value may be `always', `when-mapped', or `not-useful'.\n\
4489 The optional argument DISPLAY specifies which display to ask about.\n\
4490 DISPLAY should be either a frame or a display name (a string).\n\
4491 If omitted or nil, that stands for the selected frame's display.")
4493 Lisp_Object display
;
4495 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4497 switch (DoesBackingStore (dpyinfo
->screen
))
4500 return intern ("always");
4503 return intern ("when-mapped");
4506 return intern ("not-useful");
4509 error ("Strange value for BackingStore parameter of screen");
4513 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4514 Sx_display_visual_class
, 0, 1, 0,
4515 "Returns the visual class of the X display DISPLAY.\n\
4516 The value is one of the symbols `static-gray', `gray-scale',\n\
4517 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4518 The optional argument DISPLAY specifies which display to ask about.\n\
4519 DISPLAY should be either a frame or a display name (a string).\n\
4520 If omitted or nil, that stands for the selected frame's display.")
4522 Lisp_Object display
;
4524 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4526 switch (dpyinfo
->visual
->class)
4528 case StaticGray
: return (intern ("static-gray"));
4529 case GrayScale
: return (intern ("gray-scale"));
4530 case StaticColor
: return (intern ("static-color"));
4531 case PseudoColor
: return (intern ("pseudo-color"));
4532 case TrueColor
: return (intern ("true-color"));
4533 case DirectColor
: return (intern ("direct-color"));
4535 error ("Display has an unknown visual class");
4539 DEFUN ("x-display-save-under", Fx_display_save_under
,
4540 Sx_display_save_under
, 0, 1, 0,
4541 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4542 The optional argument DISPLAY specifies which display to ask about.\n\
4543 DISPLAY should be either a frame or a display name (a string).\n\
4544 If omitted or nil, that stands for the selected frame's display.")
4546 Lisp_Object display
;
4548 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4550 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4558 register struct frame
*f
;
4560 return PIXEL_WIDTH (f
);
4565 register struct frame
*f
;
4567 return PIXEL_HEIGHT (f
);
4572 register struct frame
*f
;
4574 return FONT_WIDTH (f
->output_data
.x
->font
);
4579 register struct frame
*f
;
4581 return f
->output_data
.x
->line_height
;
4586 register struct frame
*f
;
4588 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4593 /************************************************************************
4595 ************************************************************************/
4598 /* Mapping visual names to visuals. */
4600 static struct visual_class
4607 {"StaticGray", StaticGray
},
4608 {"GrayScale", GrayScale
},
4609 {"StaticColor", StaticColor
},
4610 {"PseudoColor", PseudoColor
},
4611 {"TrueColor", TrueColor
},
4612 {"DirectColor", DirectColor
},
4617 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4619 /* Value is the screen number of screen SCR. This is a substitute for
4620 the X function with the same name when that doesn't exist. */
4623 XScreenNumberOfScreen (scr
)
4624 register Screen
*scr
;
4626 Display
*dpy
= scr
->display
;
4629 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4630 if (scr
== dpy
->screens
[i
])
4636 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4639 /* Select the visual that should be used on display DPYINFO. Set
4640 members of DPYINFO appropriately. Called from x_term_init. */
4643 select_visual (dpyinfo
)
4644 struct x_display_info
*dpyinfo
;
4646 Display
*dpy
= dpyinfo
->display
;
4647 Screen
*screen
= dpyinfo
->screen
;
4650 /* See if a visual is specified. */
4651 value
= display_x_get_resource (dpyinfo
,
4652 build_string ("visualClass"),
4653 build_string ("VisualClass"),
4655 if (STRINGP (value
))
4657 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4658 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4659 depth, a decimal number. NAME is compared with case ignored. */
4660 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4665 strcpy (s
, XSTRING (value
)->data
);
4666 dash
= index (s
, '-');
4669 dpyinfo
->n_planes
= atoi (dash
+ 1);
4673 /* We won't find a matching visual with depth 0, so that
4674 an error will be printed below. */
4675 dpyinfo
->n_planes
= 0;
4677 /* Determine the visual class. */
4678 for (i
= 0; visual_classes
[i
].name
; ++i
)
4679 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4681 class = visual_classes
[i
].class;
4685 /* Look up a matching visual for the specified class. */
4687 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4688 dpyinfo
->n_planes
, class, &vinfo
))
4689 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4691 dpyinfo
->visual
= vinfo
.visual
;
4696 XVisualInfo
*vinfo
, vinfo_template
;
4698 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
4701 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
4703 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
4705 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4706 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
4707 &vinfo_template
, &n_visuals
);
4709 fatal ("Can't get proper X visual info");
4711 dpyinfo
->n_planes
= vinfo
->depth
;
4712 XFree ((char *) vinfo
);
4717 /* Return the X display structure for the display named NAME.
4718 Open a new connection if necessary. */
4720 struct x_display_info
*
4721 x_display_info_for_name (name
)
4725 struct x_display_info
*dpyinfo
;
4727 CHECK_STRING (name
, 0);
4729 if (! EQ (Vwindow_system
, intern ("x")))
4730 error ("Not using X Windows");
4732 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
4734 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
4737 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
4742 /* Use this general default value to start with. */
4743 Vx_resource_name
= Vinvocation_name
;
4745 validate_x_resource_name ();
4747 dpyinfo
= x_term_init (name
, (unsigned char *)0,
4748 (char *) XSTRING (Vx_resource_name
)->data
);
4751 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
4754 XSETFASTINT (Vwindow_system_version
, 11);
4760 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4761 1, 3, 0, "Open a connection to an X server.\n\
4762 DISPLAY is the name of the display to connect to.\n\
4763 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4764 If the optional third arg MUST-SUCCEED is non-nil,\n\
4765 terminate Emacs if we can't open the connection.")
4766 (display
, xrm_string
, must_succeed
)
4767 Lisp_Object display
, xrm_string
, must_succeed
;
4769 unsigned char *xrm_option
;
4770 struct x_display_info
*dpyinfo
;
4772 CHECK_STRING (display
, 0);
4773 if (! NILP (xrm_string
))
4774 CHECK_STRING (xrm_string
, 1);
4776 if (! EQ (Vwindow_system
, intern ("x")))
4777 error ("Not using X Windows");
4779 if (! NILP (xrm_string
))
4780 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4782 xrm_option
= (unsigned char *) 0;
4784 validate_x_resource_name ();
4786 /* This is what opens the connection and sets x_current_display.
4787 This also initializes many symbols, such as those used for input. */
4788 dpyinfo
= x_term_init (display
, xrm_option
,
4789 (char *) XSTRING (Vx_resource_name
)->data
);
4793 if (!NILP (must_succeed
))
4794 fatal ("Cannot connect to X server %s.\n\
4795 Check the DISPLAY environment variable or use `-d'.\n\
4796 Also use the `xhost' program to verify that it is set to permit\n\
4797 connections from your machine.\n",
4798 XSTRING (display
)->data
);
4800 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
4805 XSETFASTINT (Vwindow_system_version
, 11);
4809 DEFUN ("x-close-connection", Fx_close_connection
,
4810 Sx_close_connection
, 1, 1, 0,
4811 "Close the connection to DISPLAY's X server.\n\
4812 For DISPLAY, specify either a frame or a display name (a string).\n\
4813 If DISPLAY is nil, that stands for the selected frame's display.")
4815 Lisp_Object display
;
4817 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4820 if (dpyinfo
->reference_count
> 0)
4821 error ("Display still has frames on it");
4824 /* Free the fonts in the font table. */
4825 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4826 if (dpyinfo
->font_table
[i
].name
)
4828 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
4829 xfree (dpyinfo
->font_table
[i
].full_name
);
4830 xfree (dpyinfo
->font_table
[i
].name
);
4831 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
4834 x_destroy_all_bitmaps (dpyinfo
);
4835 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
4837 #ifdef USE_X_TOOLKIT
4838 XtCloseDisplay (dpyinfo
->display
);
4840 XCloseDisplay (dpyinfo
->display
);
4843 x_delete_display (dpyinfo
);
4849 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
4850 "Return the list of display names that Emacs has connections to.")
4853 Lisp_Object tail
, result
;
4856 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
4857 result
= Fcons (XCAR (XCAR (tail
)), result
);
4862 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
4863 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4864 If ON is nil, allow buffering of requests.\n\
4865 Turning on synchronization prohibits the Xlib routines from buffering\n\
4866 requests and seriously degrades performance, but makes debugging much\n\
4868 The optional second argument DISPLAY specifies which display to act on.\n\
4869 DISPLAY should be either a frame or a display name (a string).\n\
4870 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4872 Lisp_Object display
, on
;
4874 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4876 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
4881 /* Wait for responses to all X commands issued so far for frame F. */
4888 XSync (FRAME_X_DISPLAY (f
), False
);
4893 /***********************************************************************
4895 ***********************************************************************/
4897 /* Value is the number of elements of vector VECTOR. */
4899 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
4901 /* List of supported image types. Use define_image_type to add new
4902 types. Use lookup_image_type to find a type for a given symbol. */
4904 static struct image_type
*image_types
;
4906 /* The symbol `image' which is the car of the lists used to represent
4909 extern Lisp_Object Qimage
;
4911 /* The symbol `xbm' which is used as the type symbol for XBM images. */
4917 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
4918 extern Lisp_Object QCdata
;
4919 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
4920 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
4921 Lisp_Object QCindex
;
4923 /* Other symbols. */
4925 Lisp_Object Qlaplace
;
4927 /* Time in seconds after which images should be removed from the cache
4928 if not displayed. */
4930 Lisp_Object Vimage_cache_eviction_delay
;
4932 /* Function prototypes. */
4934 static void define_image_type
P_ ((struct image_type
*type
));
4935 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
4936 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
4937 static void x_laplace
P_ ((struct frame
*, struct image
*));
4938 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
4942 /* Define a new image type from TYPE. This adds a copy of TYPE to
4943 image_types and adds the symbol *TYPE->type to Vimage_types. */
4946 define_image_type (type
)
4947 struct image_type
*type
;
4949 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
4950 The initialized data segment is read-only. */
4951 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
4952 bcopy (type
, p
, sizeof *p
);
4953 p
->next
= image_types
;
4955 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
4959 /* Look up image type SYMBOL, and return a pointer to its image_type
4960 structure. Value is null if SYMBOL is not a known image type. */
4962 static INLINE
struct image_type
*
4963 lookup_image_type (symbol
)
4966 struct image_type
*type
;
4968 for (type
= image_types
; type
; type
= type
->next
)
4969 if (EQ (symbol
, *type
->type
))
4976 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
4977 valid image specification is a list whose car is the symbol
4978 `image', and whose rest is a property list. The property list must
4979 contain a value for key `:type'. That value must be the name of a
4980 supported image type. The rest of the property list depends on the
4984 valid_image_p (object
)
4989 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
4991 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
4992 struct image_type
*type
= lookup_image_type (symbol
);
4995 valid_p
= type
->valid_p (object
);
5002 /* Log error message with format string FORMAT and argument ARG.
5003 Signaling an error, e.g. when an image cannot be loaded, is not a
5004 good idea because this would interrupt redisplay, and the error
5005 message display would lead to another redisplay. This function
5006 therefore simply displays a message. */
5009 image_error (format
, arg1
, arg2
)
5011 Lisp_Object arg1
, arg2
;
5013 add_to_log (format
, arg1
, arg2
);
5018 /***********************************************************************
5019 Image specifications
5020 ***********************************************************************/
5022 enum image_value_type
5024 IMAGE_DONT_CHECK_VALUE_TYPE
,
5027 IMAGE_POSITIVE_INTEGER_VALUE
,
5028 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5030 IMAGE_INTEGER_VALUE
,
5031 IMAGE_FUNCTION_VALUE
,
5036 /* Structure used when parsing image specifications. */
5038 struct image_keyword
5040 /* Name of keyword. */
5043 /* The type of value allowed. */
5044 enum image_value_type type
;
5046 /* Non-zero means key must be present. */
5049 /* Used to recognize duplicate keywords in a property list. */
5052 /* The value that was found. */
5057 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5059 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5062 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5063 has the format (image KEYWORD VALUE ...). One of the keyword/
5064 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5065 image_keywords structures of size NKEYWORDS describing other
5066 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5069 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5071 struct image_keyword
*keywords
;
5078 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5081 plist
= XCDR (spec
);
5082 while (CONSP (plist
))
5084 Lisp_Object key
, value
;
5086 /* First element of a pair must be a symbol. */
5088 plist
= XCDR (plist
);
5092 /* There must follow a value. */
5095 value
= XCAR (plist
);
5096 plist
= XCDR (plist
);
5098 /* Find key in KEYWORDS. Error if not found. */
5099 for (i
= 0; i
< nkeywords
; ++i
)
5100 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5106 /* Record that we recognized the keyword. If a keywords
5107 was found more than once, it's an error. */
5108 keywords
[i
].value
= value
;
5109 ++keywords
[i
].count
;
5111 if (keywords
[i
].count
> 1)
5114 /* Check type of value against allowed type. */
5115 switch (keywords
[i
].type
)
5117 case IMAGE_STRING_VALUE
:
5118 if (!STRINGP (value
))
5122 case IMAGE_SYMBOL_VALUE
:
5123 if (!SYMBOLP (value
))
5127 case IMAGE_POSITIVE_INTEGER_VALUE
:
5128 if (!INTEGERP (value
) || XINT (value
) <= 0)
5132 case IMAGE_ASCENT_VALUE
:
5133 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5135 else if (INTEGERP (value
)
5136 && XINT (value
) >= 0
5137 && XINT (value
) <= 100)
5141 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5142 if (!INTEGERP (value
) || XINT (value
) < 0)
5146 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5149 case IMAGE_FUNCTION_VALUE
:
5150 value
= indirect_function (value
);
5152 || COMPILEDP (value
)
5153 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5157 case IMAGE_NUMBER_VALUE
:
5158 if (!INTEGERP (value
) && !FLOATP (value
))
5162 case IMAGE_INTEGER_VALUE
:
5163 if (!INTEGERP (value
))
5167 case IMAGE_BOOL_VALUE
:
5168 if (!NILP (value
) && !EQ (value
, Qt
))
5177 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5181 /* Check that all mandatory fields are present. */
5182 for (i
= 0; i
< nkeywords
; ++i
)
5183 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5186 return NILP (plist
);
5190 /* Return the value of KEY in image specification SPEC. Value is nil
5191 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5192 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5195 image_spec_value (spec
, key
, found
)
5196 Lisp_Object spec
, key
;
5201 xassert (valid_image_p (spec
));
5203 for (tail
= XCDR (spec
);
5204 CONSP (tail
) && CONSP (XCDR (tail
));
5205 tail
= XCDR (XCDR (tail
)))
5207 if (EQ (XCAR (tail
), key
))
5211 return XCAR (XCDR (tail
));
5221 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5222 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5223 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5224 size in canonical character units.\n\
5225 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5226 or omitted means use the selected frame.")
5227 (spec
, pixels
, frame
)
5228 Lisp_Object spec
, pixels
, frame
;
5233 if (valid_image_p (spec
))
5235 struct frame
*f
= check_x_frame (frame
);
5236 int id
= lookup_image (f
, spec
);
5237 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5238 int width
= img
->width
+ 2 * img
->margin
;
5239 int height
= img
->height
+ 2 * img
->margin
;
5242 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5243 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5245 size
= Fcons (make_number (width
), make_number (height
));
5248 error ("Invalid image specification");
5255 /***********************************************************************
5256 Image type independent image structures
5257 ***********************************************************************/
5259 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5260 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5263 /* Allocate and return a new image structure for image specification
5264 SPEC. SPEC has a hash value of HASH. */
5266 static struct image
*
5267 make_image (spec
, hash
)
5271 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5273 xassert (valid_image_p (spec
));
5274 bzero (img
, sizeof *img
);
5275 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5276 xassert (img
->type
!= NULL
);
5278 img
->data
.lisp_val
= Qnil
;
5279 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5285 /* Free image IMG which was used on frame F, including its resources. */
5294 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5296 /* Remove IMG from the hash table of its cache. */
5298 img
->prev
->next
= img
->next
;
5300 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5303 img
->next
->prev
= img
->prev
;
5305 c
->images
[img
->id
] = NULL
;
5307 /* Free resources, then free IMG. */
5308 img
->type
->free (f
, img
);
5314 /* Prepare image IMG for display on frame F. Must be called before
5315 drawing an image. */
5318 prepare_image_for_display (f
, img
)
5324 /* We're about to display IMG, so set its timestamp to `now'. */
5326 img
->timestamp
= EMACS_SECS (t
);
5328 /* If IMG doesn't have a pixmap yet, load it now, using the image
5329 type dependent loader function. */
5330 if (img
->pixmap
== 0 && !img
->load_failed_p
)
5331 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5335 /* Value is the number of pixels for the ascent of image IMG when
5336 drawn in face FACE. */
5339 image_ascent (img
, face
)
5343 int height
= img
->height
+ img
->margin
;
5346 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5349 ascent
= height
/ 2 - (face
->font
->descent
- face
->font
->ascent
) / 2;
5351 ascent
= height
/ 2;
5354 ascent
= height
* img
->ascent
/ 100.0;
5361 /***********************************************************************
5362 Helper functions for X image types
5363 ***********************************************************************/
5365 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5366 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5368 Lisp_Object color_name
,
5369 unsigned long dflt
));
5371 /* Free X resources of image IMG which is used on frame F. */
5374 x_clear_image (f
, img
)
5381 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5389 x_free_colors (f
, img
->colors
, img
->ncolors
);
5392 xfree (img
->colors
);
5399 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5400 cannot be allocated, use DFLT. Add a newly allocated color to
5401 IMG->colors, so that it can be freed again. Value is the pixel
5404 static unsigned long
5405 x_alloc_image_color (f
, img
, color_name
, dflt
)
5408 Lisp_Object color_name
;
5412 unsigned long result
;
5414 xassert (STRINGP (color_name
));
5416 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5418 /* This isn't called frequently so we get away with simply
5419 reallocating the color vector to the needed size, here. */
5422 (unsigned long *) xrealloc (img
->colors
,
5423 img
->ncolors
* sizeof *img
->colors
);
5424 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5425 result
= color
.pixel
;
5435 /***********************************************************************
5437 ***********************************************************************/
5439 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5442 /* Return a new, initialized image cache that is allocated from the
5443 heap. Call free_image_cache to free an image cache. */
5445 struct image_cache
*
5448 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5451 bzero (c
, sizeof *c
);
5453 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5454 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5455 c
->buckets
= (struct image
**) xmalloc (size
);
5456 bzero (c
->buckets
, size
);
5461 /* Free image cache of frame F. Be aware that X frames share images
5465 free_image_cache (f
)
5468 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5473 /* Cache should not be referenced by any frame when freed. */
5474 xassert (c
->refcount
== 0);
5476 for (i
= 0; i
< c
->used
; ++i
)
5477 free_image (f
, c
->images
[i
]);
5481 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5486 /* Clear image cache of frame F. FORCE_P non-zero means free all
5487 images. FORCE_P zero means clear only images that haven't been
5488 displayed for some time. Should be called from time to time to
5489 reduce the number of loaded images. If image-eviction-seconds is
5490 non-nil, this frees images in the cache which weren't displayed for
5491 at least that many seconds. */
5494 clear_image_cache (f
, force_p
)
5498 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5500 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5504 int i
, any_freed_p
= 0;
5507 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5509 for (i
= 0; i
< c
->used
; ++i
)
5511 struct image
*img
= c
->images
[i
];
5514 || (img
->timestamp
> old
)))
5516 free_image (f
, img
);
5521 /* We may be clearing the image cache because, for example,
5522 Emacs was iconified for a longer period of time. In that
5523 case, current matrices may still contain references to
5524 images freed above. So, clear these matrices. */
5527 clear_current_matrices (f
);
5528 ++windows_or_buffers_changed
;
5534 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5536 "Clear the image cache of FRAME.\n\
5537 FRAME nil or omitted means use the selected frame.\n\
5538 FRAME t means clear the image caches of all frames.")
5546 FOR_EACH_FRAME (tail
, frame
)
5547 if (FRAME_X_P (XFRAME (frame
)))
5548 clear_image_cache (XFRAME (frame
), 1);
5551 clear_image_cache (check_x_frame (frame
), 1);
5557 /* Return the id of image with Lisp specification SPEC on frame F.
5558 SPEC must be a valid Lisp image specification (see valid_image_p). */
5561 lookup_image (f
, spec
)
5565 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5569 struct gcpro gcpro1
;
5572 /* F must be a window-system frame, and SPEC must be a valid image
5574 xassert (FRAME_WINDOW_P (f
));
5575 xassert (valid_image_p (spec
));
5579 /* Look up SPEC in the hash table of the image cache. */
5580 hash
= sxhash (spec
, 0);
5581 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5583 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
5584 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
5587 /* If not found, create a new image and cache it. */
5590 img
= make_image (spec
, hash
);
5591 cache_image (f
, img
);
5592 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5593 xassert (!interrupt_input_blocked
);
5595 /* If we can't load the image, and we don't have a width and
5596 height, use some arbitrary width and height so that we can
5597 draw a rectangle for it. */
5598 if (img
->load_failed_p
)
5602 value
= image_spec_value (spec
, QCwidth
, NULL
);
5603 img
->width
= (INTEGERP (value
)
5604 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
5605 value
= image_spec_value (spec
, QCheight
, NULL
);
5606 img
->height
= (INTEGERP (value
)
5607 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
5611 /* Handle image type independent image attributes
5612 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
5613 Lisp_Object ascent
, margin
, relief
, algorithm
, heuristic_mask
;
5616 ascent
= image_spec_value (spec
, QCascent
, NULL
);
5617 if (INTEGERP (ascent
))
5618 img
->ascent
= XFASTINT (ascent
);
5619 else if (EQ (ascent
, Qcenter
))
5620 img
->ascent
= CENTERED_IMAGE_ASCENT
;
5622 margin
= image_spec_value (spec
, QCmargin
, NULL
);
5623 if (INTEGERP (margin
) && XINT (margin
) >= 0)
5624 img
->margin
= XFASTINT (margin
);
5626 relief
= image_spec_value (spec
, QCrelief
, NULL
);
5627 if (INTEGERP (relief
))
5629 img
->relief
= XINT (relief
);
5630 img
->margin
+= abs (img
->relief
);
5633 /* Should we apply a Laplace edge-detection algorithm? */
5634 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
5635 if (img
->pixmap
&& EQ (algorithm
, Qlaplace
))
5638 /* Should we built a mask heuristically? */
5639 heuristic_mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
5640 if (img
->pixmap
&& !img
->mask
&& !NILP (heuristic_mask
))
5641 x_build_heuristic_mask (f
, img
, heuristic_mask
);
5645 /* We're using IMG, so set its timestamp to `now'. */
5646 EMACS_GET_TIME (now
);
5647 img
->timestamp
= EMACS_SECS (now
);
5651 /* Value is the image id. */
5656 /* Cache image IMG in the image cache of frame F. */
5659 cache_image (f
, img
)
5663 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5666 /* Find a free slot in c->images. */
5667 for (i
= 0; i
< c
->used
; ++i
)
5668 if (c
->images
[i
] == NULL
)
5671 /* If no free slot found, maybe enlarge c->images. */
5672 if (i
== c
->used
&& c
->used
== c
->size
)
5675 c
->images
= (struct image
**) xrealloc (c
->images
,
5676 c
->size
* sizeof *c
->images
);
5679 /* Add IMG to c->images, and assign IMG an id. */
5685 /* Add IMG to the cache's hash table. */
5686 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5687 img
->next
= c
->buckets
[i
];
5689 img
->next
->prev
= img
;
5691 c
->buckets
[i
] = img
;
5695 /* Call FN on every image in the image cache of frame F. Used to mark
5696 Lisp Objects in the image cache. */
5699 forall_images_in_image_cache (f
, fn
)
5701 void (*fn
) P_ ((struct image
*img
));
5703 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
5705 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5709 for (i
= 0; i
< c
->used
; ++i
)
5718 /***********************************************************************
5720 ***********************************************************************/
5722 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
5723 XImage
**, Pixmap
*));
5724 static void x_destroy_x_image
P_ ((XImage
*));
5725 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
5728 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
5729 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
5730 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
5731 via xmalloc. Print error messages via image_error if an error
5732 occurs. Value is non-zero if successful. */
5735 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
5737 int width
, height
, depth
;
5741 Display
*display
= FRAME_X_DISPLAY (f
);
5742 Screen
*screen
= FRAME_X_SCREEN (f
);
5743 Window window
= FRAME_X_WINDOW (f
);
5745 xassert (interrupt_input_blocked
);
5748 depth
= DefaultDepthOfScreen (screen
);
5749 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
5750 depth
, ZPixmap
, 0, NULL
, width
, height
,
5751 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
5754 image_error ("Unable to allocate X image", Qnil
, Qnil
);
5758 /* Allocate image raster. */
5759 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
5761 /* Allocate a pixmap of the same size. */
5762 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
5765 x_destroy_x_image (*ximg
);
5767 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
5775 /* Destroy XImage XIMG. Free XIMG->data. */
5778 x_destroy_x_image (ximg
)
5781 xassert (interrupt_input_blocked
);
5786 XDestroyImage (ximg
);
5791 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
5792 are width and height of both the image and pixmap. */
5795 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
5802 xassert (interrupt_input_blocked
);
5803 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
5804 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
5805 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
5810 /***********************************************************************
5812 ***********************************************************************/
5814 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
5815 static char *slurp_file
P_ ((char *, int *));
5818 /* Find image file FILE. Look in data-directory, then
5819 x-bitmap-file-path. Value is the full name of the file found, or
5820 nil if not found. */
5823 x_find_image_file (file
)
5826 Lisp_Object file_found
, search_path
;
5827 struct gcpro gcpro1
, gcpro2
;
5831 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
5832 GCPRO2 (file_found
, search_path
);
5834 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
5835 fd
= openp (search_path
, file
, "", &file_found
, 0);
5847 /* Read FILE into memory. Value is a pointer to a buffer allocated
5848 with xmalloc holding FILE's contents. Value is null if an error
5849 occured. *SIZE is set to the size of the file. */
5852 slurp_file (file
, size
)
5860 if (stat (file
, &st
) == 0
5861 && (fp
= fopen (file
, "r")) != NULL
5862 && (buf
= (char *) xmalloc (st
.st_size
),
5863 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
5884 /***********************************************************************
5886 ***********************************************************************/
5888 static int xbm_scan
P_ ((char **, char *, char *, int *));
5889 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
5890 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
5892 static int xbm_image_p
P_ ((Lisp_Object object
));
5893 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
5895 static int xbm_file_p
P_ ((Lisp_Object
));
5898 /* Indices of image specification fields in xbm_format, below. */
5900 enum xbm_keyword_index
5917 /* Vector of image_keyword structures describing the format
5918 of valid XBM image specifications. */
5920 static struct image_keyword xbm_format
[XBM_LAST
] =
5922 {":type", IMAGE_SYMBOL_VALUE
, 1},
5923 {":file", IMAGE_STRING_VALUE
, 0},
5924 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
5925 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
5926 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
5927 {":foreground", IMAGE_STRING_VALUE
, 0},
5928 {":background", IMAGE_STRING_VALUE
, 0},
5929 {":ascent", IMAGE_ASCENT_VALUE
, 0},
5930 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
5931 {":relief", IMAGE_INTEGER_VALUE
, 0},
5932 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
5933 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
5936 /* Structure describing the image type XBM. */
5938 static struct image_type xbm_type
=
5947 /* Tokens returned from xbm_scan. */
5956 /* Return non-zero if OBJECT is a valid XBM-type image specification.
5957 A valid specification is a list starting with the symbol `image'
5958 The rest of the list is a property list which must contain an
5961 If the specification specifies a file to load, it must contain
5962 an entry `:file FILENAME' where FILENAME is a string.
5964 If the specification is for a bitmap loaded from memory it must
5965 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
5966 WIDTH and HEIGHT are integers > 0. DATA may be:
5968 1. a string large enough to hold the bitmap data, i.e. it must
5969 have a size >= (WIDTH + 7) / 8 * HEIGHT
5971 2. a bool-vector of size >= WIDTH * HEIGHT
5973 3. a vector of strings or bool-vectors, one for each line of the
5976 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
5977 may not be specified in this case because they are defined in the
5980 Both the file and data forms may contain the additional entries
5981 `:background COLOR' and `:foreground COLOR'. If not present,
5982 foreground and background of the frame on which the image is
5983 displayed is used. */
5986 xbm_image_p (object
)
5989 struct image_keyword kw
[XBM_LAST
];
5991 bcopy (xbm_format
, kw
, sizeof kw
);
5992 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
5995 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
5997 if (kw
[XBM_FILE
].count
)
5999 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6002 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6004 /* In-memory XBM file. */
6005 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6013 /* Entries for `:width', `:height' and `:data' must be present. */
6014 if (!kw
[XBM_WIDTH
].count
6015 || !kw
[XBM_HEIGHT
].count
6016 || !kw
[XBM_DATA
].count
)
6019 data
= kw
[XBM_DATA
].value
;
6020 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6021 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6023 /* Check type of data, and width and height against contents of
6029 /* Number of elements of the vector must be >= height. */
6030 if (XVECTOR (data
)->size
< height
)
6033 /* Each string or bool-vector in data must be large enough
6034 for one line of the image. */
6035 for (i
= 0; i
< height
; ++i
)
6037 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6041 if (XSTRING (elt
)->size
6042 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6045 else if (BOOL_VECTOR_P (elt
))
6047 if (XBOOL_VECTOR (elt
)->size
< width
)
6054 else if (STRINGP (data
))
6056 if (XSTRING (data
)->size
6057 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6060 else if (BOOL_VECTOR_P (data
))
6062 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6073 /* Scan a bitmap file. FP is the stream to read from. Value is
6074 either an enumerator from enum xbm_token, or a character for a
6075 single-character token, or 0 at end of file. If scanning an
6076 identifier, store the lexeme of the identifier in SVAL. If
6077 scanning a number, store its value in *IVAL. */
6080 xbm_scan (s
, end
, sval
, ival
)
6087 /* Skip white space. */
6088 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6093 else if (isdigit (c
))
6095 int value
= 0, digit
;
6097 if (c
== '0' && *s
< end
)
6100 if (c
== 'x' || c
== 'X')
6107 else if (c
>= 'a' && c
<= 'f')
6108 digit
= c
- 'a' + 10;
6109 else if (c
>= 'A' && c
<= 'F')
6110 digit
= c
- 'A' + 10;
6113 value
= 16 * value
+ digit
;
6116 else if (isdigit (c
))
6120 && (c
= *(*s
)++, isdigit (c
)))
6121 value
= 8 * value
+ c
- '0';
6128 && (c
= *(*s
)++, isdigit (c
)))
6129 value
= 10 * value
+ c
- '0';
6137 else if (isalpha (c
) || c
== '_')
6141 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6153 /* Replacement for XReadBitmapFileData which isn't available under old
6154 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6155 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6156 the image. Return in *DATA the bitmap data allocated with xmalloc.
6157 Value is non-zero if successful. DATA null means just test if
6158 CONTENTS looks like an im-memory XBM file. */
6161 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6162 char *contents
, *end
;
6163 int *width
, *height
;
6164 unsigned char **data
;
6167 char buffer
[BUFSIZ
];
6170 int bytes_per_line
, i
, nbytes
;
6176 LA1 = xbm_scan (&s, end, buffer, &value)
6178 #define expect(TOKEN) \
6179 if (LA1 != (TOKEN)) \
6184 #define expect_ident(IDENT) \
6185 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6190 *width
= *height
= -1;
6193 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6195 /* Parse defines for width, height and hot-spots. */
6199 expect_ident ("define");
6200 expect (XBM_TK_IDENT
);
6202 if (LA1
== XBM_TK_NUMBER
);
6204 char *p
= strrchr (buffer
, '_');
6205 p
= p
? p
+ 1 : buffer
;
6206 if (strcmp (p
, "width") == 0)
6208 else if (strcmp (p
, "height") == 0)
6211 expect (XBM_TK_NUMBER
);
6214 if (*width
< 0 || *height
< 0)
6216 else if (data
== NULL
)
6219 /* Parse bits. Must start with `static'. */
6220 expect_ident ("static");
6221 if (LA1
== XBM_TK_IDENT
)
6223 if (strcmp (buffer
, "unsigned") == 0)
6226 expect_ident ("char");
6228 else if (strcmp (buffer
, "short") == 0)
6232 if (*width
% 16 && *width
% 16 < 9)
6235 else if (strcmp (buffer
, "char") == 0)
6243 expect (XBM_TK_IDENT
);
6249 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6250 nbytes
= bytes_per_line
* *height
;
6251 p
= *data
= (char *) xmalloc (nbytes
);
6255 for (i
= 0; i
< nbytes
; i
+= 2)
6258 expect (XBM_TK_NUMBER
);
6261 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6264 if (LA1
== ',' || LA1
== '}')
6272 for (i
= 0; i
< nbytes
; ++i
)
6275 expect (XBM_TK_NUMBER
);
6279 if (LA1
== ',' || LA1
== '}')
6304 /* Load XBM image IMG which will be displayed on frame F from buffer
6305 CONTENTS. END is the end of the buffer. Value is non-zero if
6309 xbm_load_image (f
, img
, contents
, end
)
6312 char *contents
, *end
;
6315 unsigned char *data
;
6318 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6321 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6322 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6323 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6326 xassert (img
->width
> 0 && img
->height
> 0);
6328 /* Get foreground and background colors, maybe allocate colors. */
6329 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6331 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6333 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6335 background
= x_alloc_image_color (f
, img
, value
, background
);
6339 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6342 img
->width
, img
->height
,
6343 foreground
, background
,
6347 if (img
->pixmap
== 0)
6349 x_clear_image (f
, img
);
6350 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6358 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6364 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6371 return (STRINGP (data
)
6372 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6373 (XSTRING (data
)->data
6374 + STRING_BYTES (XSTRING (data
))),
6379 /* Fill image IMG which is used on frame F with pixmap data. Value is
6380 non-zero if successful. */
6388 Lisp_Object file_name
;
6390 xassert (xbm_image_p (img
->spec
));
6392 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6393 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6394 if (STRINGP (file_name
))
6399 struct gcpro gcpro1
;
6401 file
= x_find_image_file (file_name
);
6403 if (!STRINGP (file
))
6405 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6410 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6411 if (contents
== NULL
)
6413 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6418 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6423 struct image_keyword fmt
[XBM_LAST
];
6425 unsigned char *bitmap_data
;
6427 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6428 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6430 int parsed_p
, height
, width
;
6431 int in_memory_file_p
= 0;
6433 /* See if data looks like an in-memory XBM file. */
6434 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6435 in_memory_file_p
= xbm_file_p (data
);
6437 /* Parse the image specification. */
6438 bcopy (xbm_format
, fmt
, sizeof fmt
);
6439 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6442 /* Get specified width, and height. */
6443 if (!in_memory_file_p
)
6445 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6446 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6447 xassert (img
->width
> 0 && img
->height
> 0);
6452 /* Get foreground and background colors, maybe allocate colors. */
6453 if (fmt
[XBM_FOREGROUND
].count
)
6454 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6456 if (fmt
[XBM_BACKGROUND
].count
)
6457 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6460 if (in_memory_file_p
)
6461 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6462 (XSTRING (data
)->data
6463 + STRING_BYTES (XSTRING (data
))));
6470 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6472 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6473 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6475 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6477 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6479 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6482 else if (STRINGP (data
))
6483 bits
= XSTRING (data
)->data
;
6485 bits
= XBOOL_VECTOR (data
)->data
;
6487 /* Create the pixmap. */
6488 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6490 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6493 img
->width
, img
->height
,
6494 foreground
, background
,
6500 image_error ("Unable to create pixmap for XBM image `%s'",
6502 x_clear_image (f
, img
);
6514 /***********************************************************************
6516 ***********************************************************************/
6520 static int xpm_image_p
P_ ((Lisp_Object object
));
6521 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6522 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6524 #include "X11/xpm.h"
6526 /* The symbol `xpm' identifying XPM-format images. */
6530 /* Indices of image specification fields in xpm_format, below. */
6532 enum xpm_keyword_index
6546 /* Vector of image_keyword structures describing the format
6547 of valid XPM image specifications. */
6549 static struct image_keyword xpm_format
[XPM_LAST
] =
6551 {":type", IMAGE_SYMBOL_VALUE
, 1},
6552 {":file", IMAGE_STRING_VALUE
, 0},
6553 {":data", IMAGE_STRING_VALUE
, 0},
6554 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6555 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6556 {":relief", IMAGE_INTEGER_VALUE
, 0},
6557 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6558 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6559 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6562 /* Structure describing the image type XBM. */
6564 static struct image_type xpm_type
=
6574 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6575 for XPM images. Such a list must consist of conses whose car and
6579 xpm_valid_color_symbols_p (color_symbols
)
6580 Lisp_Object color_symbols
;
6582 while (CONSP (color_symbols
))
6584 Lisp_Object sym
= XCAR (color_symbols
);
6586 || !STRINGP (XCAR (sym
))
6587 || !STRINGP (XCDR (sym
)))
6589 color_symbols
= XCDR (color_symbols
);
6592 return NILP (color_symbols
);
6596 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6599 xpm_image_p (object
)
6602 struct image_keyword fmt
[XPM_LAST
];
6603 bcopy (xpm_format
, fmt
, sizeof fmt
);
6604 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
6605 /* Either `:file' or `:data' must be present. */
6606 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
6607 /* Either no `:color-symbols' or it's a list of conses
6608 whose car and cdr are strings. */
6609 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
6610 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
6614 /* Load image IMG which will be displayed on frame F. Value is
6615 non-zero if successful. */
6623 XpmAttributes attrs
;
6624 Lisp_Object specified_file
, color_symbols
;
6626 /* Configure the XPM lib. Use the visual of frame F. Allocate
6627 close colors. Return colors allocated. */
6628 bzero (&attrs
, sizeof attrs
);
6629 attrs
.visual
= FRAME_X_VISUAL (f
);
6630 attrs
.colormap
= FRAME_X_COLORMAP (f
);
6631 attrs
.valuemask
|= XpmVisual
;
6632 attrs
.valuemask
|= XpmColormap
;
6633 attrs
.valuemask
|= XpmReturnAllocPixels
;
6634 #ifdef XpmAllocCloseColors
6635 attrs
.alloc_close_colors
= 1;
6636 attrs
.valuemask
|= XpmAllocCloseColors
;
6638 attrs
.closeness
= 600;
6639 attrs
.valuemask
|= XpmCloseness
;
6642 /* If image specification contains symbolic color definitions, add
6643 these to `attrs'. */
6644 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
6645 if (CONSP (color_symbols
))
6648 XpmColorSymbol
*xpm_syms
;
6651 attrs
.valuemask
|= XpmColorSymbols
;
6653 /* Count number of symbols. */
6654 attrs
.numsymbols
= 0;
6655 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
6658 /* Allocate an XpmColorSymbol array. */
6659 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
6660 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
6661 bzero (xpm_syms
, size
);
6662 attrs
.colorsymbols
= xpm_syms
;
6664 /* Fill the color symbol array. */
6665 for (tail
= color_symbols
, i
= 0;
6667 ++i
, tail
= XCDR (tail
))
6669 Lisp_Object name
= XCAR (XCAR (tail
));
6670 Lisp_Object color
= XCDR (XCAR (tail
));
6671 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
6672 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
6673 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
6674 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
6678 /* Create a pixmap for the image, either from a file, or from a
6679 string buffer containing data in the same format as an XPM file. */
6681 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
6682 if (STRINGP (specified_file
))
6684 Lisp_Object file
= x_find_image_file (specified_file
);
6685 if (!STRINGP (file
))
6687 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
6692 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
6693 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
6698 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
6699 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
6700 XSTRING (buffer
)->data
,
6701 &img
->pixmap
, &img
->mask
,
6706 if (rc
== XpmSuccess
)
6708 /* Remember allocated colors. */
6709 img
->ncolors
= attrs
.nalloc_pixels
;
6710 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
6711 * sizeof *img
->colors
);
6712 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
6714 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
6715 #ifdef DEBUG_X_COLORS
6716 register_color (img
->colors
[i
]);
6720 img
->width
= attrs
.width
;
6721 img
->height
= attrs
.height
;
6722 xassert (img
->width
> 0 && img
->height
> 0);
6724 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
6726 XpmFreeAttributes (&attrs
);
6734 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
6737 case XpmFileInvalid
:
6738 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
6742 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
6745 case XpmColorFailed
:
6746 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
6750 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
6755 return rc
== XpmSuccess
;
6758 #endif /* HAVE_XPM != 0 */
6761 /***********************************************************************
6763 ***********************************************************************/
6765 /* An entry in the color table mapping an RGB color to a pixel color. */
6770 unsigned long pixel
;
6772 /* Next in color table collision list. */
6773 struct ct_color
*next
;
6776 /* The bucket vector size to use. Must be prime. */
6780 /* Value is a hash of the RGB color given by R, G, and B. */
6782 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
6784 /* The color hash table. */
6786 struct ct_color
**ct_table
;
6788 /* Number of entries in the color table. */
6790 int ct_colors_allocated
;
6792 /* Function prototypes. */
6794 static void init_color_table
P_ ((void));
6795 static void free_color_table
P_ ((void));
6796 static unsigned long *colors_in_color_table
P_ ((int *n
));
6797 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
6798 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
6801 /* Initialize the color table. */
6806 int size
= CT_SIZE
* sizeof (*ct_table
);
6807 ct_table
= (struct ct_color
**) xmalloc (size
);
6808 bzero (ct_table
, size
);
6809 ct_colors_allocated
= 0;
6813 /* Free memory associated with the color table. */
6819 struct ct_color
*p
, *next
;
6821 for (i
= 0; i
< CT_SIZE
; ++i
)
6822 for (p
= ct_table
[i
]; p
; p
= next
)
6833 /* Value is a pixel color for RGB color R, G, B on frame F. If an
6834 entry for that color already is in the color table, return the
6835 pixel color of that entry. Otherwise, allocate a new color for R,
6836 G, B, and make an entry in the color table. */
6838 static unsigned long
6839 lookup_rgb_color (f
, r
, g
, b
)
6843 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
6844 int i
= hash
% CT_SIZE
;
6847 for (p
= ct_table
[i
]; p
; p
= p
->next
)
6848 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
6862 cmap
= FRAME_X_COLORMAP (f
);
6863 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
6868 ++ct_colors_allocated
;
6870 p
= (struct ct_color
*) xmalloc (sizeof *p
);
6874 p
->pixel
= color
.pixel
;
6875 p
->next
= ct_table
[i
];
6879 return FRAME_FOREGROUND_PIXEL (f
);
6886 /* Look up pixel color PIXEL which is used on frame F in the color
6887 table. If not already present, allocate it. Value is PIXEL. */
6889 static unsigned long
6890 lookup_pixel_color (f
, pixel
)
6892 unsigned long pixel
;
6894 int i
= pixel
% CT_SIZE
;
6897 for (p
= ct_table
[i
]; p
; p
= p
->next
)
6898 if (p
->pixel
== pixel
)
6909 cmap
= FRAME_X_COLORMAP (f
);
6910 color
.pixel
= pixel
;
6911 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
6912 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
6917 ++ct_colors_allocated
;
6919 p
= (struct ct_color
*) xmalloc (sizeof *p
);
6924 p
->next
= ct_table
[i
];
6928 return FRAME_FOREGROUND_PIXEL (f
);
6935 /* Value is a vector of all pixel colors contained in the color table,
6936 allocated via xmalloc. Set *N to the number of colors. */
6938 static unsigned long *
6939 colors_in_color_table (n
)
6944 unsigned long *colors
;
6946 if (ct_colors_allocated
== 0)
6953 colors
= (unsigned long *) xmalloc (ct_colors_allocated
6955 *n
= ct_colors_allocated
;
6957 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
6958 for (p
= ct_table
[i
]; p
; p
= p
->next
)
6959 colors
[j
++] = p
->pixel
;
6967 /***********************************************************************
6969 ***********************************************************************/
6971 static void x_laplace_write_row
P_ ((struct frame
*, long *,
6972 int, XImage
*, int));
6973 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
6974 XColor
*, int, XImage
*, int));
6977 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
6978 frame we operate on, CMAP is the color-map in effect, and WIDTH is
6979 the width of one row in the image. */
6982 x_laplace_read_row (f
, cmap
, colors
, width
, ximg
, y
)
6992 for (x
= 0; x
< width
; ++x
)
6993 colors
[x
].pixel
= XGetPixel (ximg
, x
, y
);
6995 XQueryColors (FRAME_X_DISPLAY (f
), cmap
, colors
, width
);
6999 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
7000 containing the pixel colors to write. F is the frame we are
7004 x_laplace_write_row (f
, pixels
, width
, ximg
, y
)
7013 for (x
= 0; x
< width
; ++x
)
7014 XPutPixel (ximg
, x
, y
, pixels
[x
]);
7018 /* Transform image IMG which is used on frame F with a Laplace
7019 edge-detection algorithm. The result is an image that can be used
7020 to draw disabled buttons, for example. */
7027 Colormap cmap
= FRAME_X_COLORMAP (f
);
7028 XImage
*ximg
, *oimg
;
7034 int in_y
, out_y
, rc
;
7039 /* Get the X image IMG->pixmap. */
7040 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7041 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7043 /* Allocate 3 input rows, and one output row of colors. */
7044 for (i
= 0; i
< 3; ++i
)
7045 in
[i
] = (XColor
*) alloca (img
->width
* sizeof (XColor
));
7046 out
= (long *) alloca (img
->width
* sizeof (long));
7048 /* Create an X image for output. */
7049 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7052 /* Fill first two rows. */
7053 x_laplace_read_row (f
, cmap
, in
[0], img
->width
, ximg
, 0);
7054 x_laplace_read_row (f
, cmap
, in
[1], img
->width
, ximg
, 1);
7057 /* Write first row, all zeros. */
7058 init_color_table ();
7059 pixel
= lookup_rgb_color (f
, 0, 0, 0);
7060 for (x
= 0; x
< img
->width
; ++x
)
7062 x_laplace_write_row (f
, out
, img
->width
, oimg
, 0);
7065 for (y
= 2; y
< img
->height
; ++y
)
7068 int rowb
= (y
+ 2) % 3;
7070 x_laplace_read_row (f
, cmap
, in
[rowa
], img
->width
, ximg
, in_y
++);
7072 for (x
= 0; x
< img
->width
- 2; ++x
)
7074 int r
= in
[rowa
][x
].red
+ mv2
- in
[rowb
][x
+ 2].red
;
7075 int g
= in
[rowa
][x
].green
+ mv2
- in
[rowb
][x
+ 2].green
;
7076 int b
= in
[rowa
][x
].blue
+ mv2
- in
[rowb
][x
+ 2].blue
;
7078 out
[x
+ 1] = lookup_rgb_color (f
, r
& 0xffff, g
& 0xffff,
7082 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
++);
7085 /* Write last line, all zeros. */
7086 for (x
= 0; x
< img
->width
; ++x
)
7088 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
);
7090 /* Free the input image, and free resources of IMG. */
7091 XDestroyImage (ximg
);
7092 x_clear_image (f
, img
);
7094 /* Put the output image into pixmap, and destroy it. */
7095 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7096 x_destroy_x_image (oimg
);
7098 /* Remember new pixmap and colors in IMG. */
7099 img
->pixmap
= pixmap
;
7100 img
->colors
= colors_in_color_table (&img
->ncolors
);
7101 free_color_table ();
7107 /* Build a mask for image IMG which is used on frame F. FILE is the
7108 name of an image file, for error messages. HOW determines how to
7109 determine the background color of IMG. If it is a list '(R G B)',
7110 with R, G, and B being integers >= 0, take that as the color of the
7111 background. Otherwise, determine the background color of IMG
7112 heuristically. Value is non-zero if successful. */
7115 x_build_heuristic_mask (f
, img
, how
)
7120 Display
*dpy
= FRAME_X_DISPLAY (f
);
7121 XImage
*ximg
, *mask_img
;
7122 int x
, y
, rc
, look_at_corners_p
;
7127 /* Create an image and pixmap serving as mask. */
7128 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7129 &mask_img
, &img
->mask
);
7136 /* Get the X image of IMG->pixmap. */
7137 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7140 /* Determine the background color of ximg. If HOW is `(R G B)'
7141 take that as color. Otherwise, try to determine the color
7143 look_at_corners_p
= 1;
7151 && NATNUMP (XCAR (how
)))
7153 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7157 if (i
== 3 && NILP (how
))
7159 char color_name
[30];
7160 XColor exact
, color
;
7163 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7165 cmap
= FRAME_X_COLORMAP (f
);
7166 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7169 look_at_corners_p
= 0;
7174 if (look_at_corners_p
)
7176 unsigned long corners
[4];
7179 /* Get the colors at the corners of ximg. */
7180 corners
[0] = XGetPixel (ximg
, 0, 0);
7181 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7182 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7183 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7185 /* Choose the most frequently found color as background. */
7186 for (i
= best_count
= 0; i
< 4; ++i
)
7190 for (j
= n
= 0; j
< 4; ++j
)
7191 if (corners
[i
] == corners
[j
])
7195 bg
= corners
[i
], best_count
= n
;
7199 /* Set all bits in mask_img to 1 whose color in ximg is different
7200 from the background color bg. */
7201 for (y
= 0; y
< img
->height
; ++y
)
7202 for (x
= 0; x
< img
->width
; ++x
)
7203 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7205 /* Put mask_img into img->mask. */
7206 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7207 x_destroy_x_image (mask_img
);
7208 XDestroyImage (ximg
);
7216 /***********************************************************************
7217 PBM (mono, gray, color)
7218 ***********************************************************************/
7220 static int pbm_image_p
P_ ((Lisp_Object object
));
7221 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7222 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
7224 /* The symbol `pbm' identifying images of this type. */
7228 /* Indices of image specification fields in gs_format, below. */
7230 enum pbm_keyword_index
7243 /* Vector of image_keyword structures describing the format
7244 of valid user-defined image specifications. */
7246 static struct image_keyword pbm_format
[PBM_LAST
] =
7248 {":type", IMAGE_SYMBOL_VALUE
, 1},
7249 {":file", IMAGE_STRING_VALUE
, 0},
7250 {":data", IMAGE_STRING_VALUE
, 0},
7251 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7252 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7253 {":relief", IMAGE_INTEGER_VALUE
, 0},
7254 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7255 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7258 /* Structure describing the image type `pbm'. */
7260 static struct image_type pbm_type
=
7270 /* Return non-zero if OBJECT is a valid PBM image specification. */
7273 pbm_image_p (object
)
7276 struct image_keyword fmt
[PBM_LAST
];
7278 bcopy (pbm_format
, fmt
, sizeof fmt
);
7280 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
7283 /* Must specify either :data or :file. */
7284 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
7288 /* Scan a decimal number from *S and return it. Advance *S while
7289 reading the number. END is the end of the string. Value is -1 at
7293 pbm_scan_number (s
, end
)
7294 unsigned char **s
, *end
;
7300 /* Skip white-space. */
7301 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
7306 /* Skip comment to end of line. */
7307 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
7310 else if (isdigit (c
))
7312 /* Read decimal number. */
7314 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
7315 val
= 10 * val
+ c
- '0';
7326 /* Load PBM image IMG for use on frame F. */
7334 int width
, height
, max_color_idx
= 0;
7336 Lisp_Object file
, specified_file
;
7337 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
7338 struct gcpro gcpro1
;
7339 unsigned char *contents
= NULL
;
7340 unsigned char *end
, *p
;
7343 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7347 if (STRINGP (specified_file
))
7349 file
= x_find_image_file (specified_file
);
7350 if (!STRINGP (file
))
7352 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7357 contents
= slurp_file (XSTRING (file
)->data
, &size
);
7358 if (contents
== NULL
)
7360 image_error ("Error reading `%s'", file
, Qnil
);
7366 end
= contents
+ size
;
7371 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7372 p
= XSTRING (data
)->data
;
7373 end
= p
+ STRING_BYTES (XSTRING (data
));
7376 /* Check magic number. */
7377 if (end
- p
< 2 || *p
++ != 'P')
7379 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
7389 raw_p
= 0, type
= PBM_MONO
;
7393 raw_p
= 0, type
= PBM_GRAY
;
7397 raw_p
= 0, type
= PBM_COLOR
;
7401 raw_p
= 1, type
= PBM_MONO
;
7405 raw_p
= 1, type
= PBM_GRAY
;
7409 raw_p
= 1, type
= PBM_COLOR
;
7413 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
7417 /* Read width, height, maximum color-component. Characters
7418 starting with `#' up to the end of a line are ignored. */
7419 width
= pbm_scan_number (&p
, end
);
7420 height
= pbm_scan_number (&p
, end
);
7422 if (type
!= PBM_MONO
)
7424 max_color_idx
= pbm_scan_number (&p
, end
);
7425 if (raw_p
&& max_color_idx
> 255)
7426 max_color_idx
= 255;
7431 || (type
!= PBM_MONO
&& max_color_idx
< 0))
7435 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
7436 &ximg
, &img
->pixmap
))
7442 /* Initialize the color hash table. */
7443 init_color_table ();
7445 if (type
== PBM_MONO
)
7449 for (y
= 0; y
< height
; ++y
)
7450 for (x
= 0; x
< width
; ++x
)
7460 g
= pbm_scan_number (&p
, end
);
7462 XPutPixel (ximg
, x
, y
, (g
7463 ? FRAME_FOREGROUND_PIXEL (f
)
7464 : FRAME_BACKGROUND_PIXEL (f
)));
7469 for (y
= 0; y
< height
; ++y
)
7470 for (x
= 0; x
< width
; ++x
)
7474 if (type
== PBM_GRAY
)
7475 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
7484 r
= pbm_scan_number (&p
, end
);
7485 g
= pbm_scan_number (&p
, end
);
7486 b
= pbm_scan_number (&p
, end
);
7489 if (r
< 0 || g
< 0 || b
< 0)
7493 XDestroyImage (ximg
);
7495 image_error ("Invalid pixel value in image `%s'",
7500 /* RGB values are now in the range 0..max_color_idx.
7501 Scale this to the range 0..0xffff supported by X. */
7502 r
= (double) r
* 65535 / max_color_idx
;
7503 g
= (double) g
* 65535 / max_color_idx
;
7504 b
= (double) b
* 65535 / max_color_idx
;
7505 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7509 /* Store in IMG->colors the colors allocated for the image, and
7510 free the color table. */
7511 img
->colors
= colors_in_color_table (&img
->ncolors
);
7512 free_color_table ();
7514 /* Put the image into a pixmap. */
7515 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7516 x_destroy_x_image (ximg
);
7520 img
->height
= height
;
7529 /***********************************************************************
7531 ***********************************************************************/
7537 /* Function prototypes. */
7539 static int png_image_p
P_ ((Lisp_Object object
));
7540 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
7542 /* The symbol `png' identifying images of this type. */
7546 /* Indices of image specification fields in png_format, below. */
7548 enum png_keyword_index
7561 /* Vector of image_keyword structures describing the format
7562 of valid user-defined image specifications. */
7564 static struct image_keyword png_format
[PNG_LAST
] =
7566 {":type", IMAGE_SYMBOL_VALUE
, 1},
7567 {":data", IMAGE_STRING_VALUE
, 0},
7568 {":file", IMAGE_STRING_VALUE
, 0},
7569 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7570 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7571 {":relief", IMAGE_INTEGER_VALUE
, 0},
7572 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7573 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7576 /* Structure describing the image type `png'. */
7578 static struct image_type png_type
=
7588 /* Return non-zero if OBJECT is a valid PNG image specification. */
7591 png_image_p (object
)
7594 struct image_keyword fmt
[PNG_LAST
];
7595 bcopy (png_format
, fmt
, sizeof fmt
);
7597 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
7600 /* Must specify either the :data or :file keyword. */
7601 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
7605 /* Error and warning handlers installed when the PNG library
7609 my_png_error (png_ptr
, msg
)
7610 png_struct
*png_ptr
;
7613 xassert (png_ptr
!= NULL
);
7614 image_error ("PNG error: %s", build_string (msg
), Qnil
);
7615 longjmp (png_ptr
->jmpbuf
, 1);
7620 my_png_warning (png_ptr
, msg
)
7621 png_struct
*png_ptr
;
7624 xassert (png_ptr
!= NULL
);
7625 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
7628 /* Memory source for PNG decoding. */
7630 struct png_memory_storage
7632 unsigned char *bytes
; /* The data */
7633 size_t len
; /* How big is it? */
7634 int index
; /* Where are we? */
7638 /* Function set as reader function when reading PNG image from memory.
7639 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
7640 bytes from the input to DATA. */
7643 png_read_from_memory (png_ptr
, data
, length
)
7644 png_structp png_ptr
;
7648 struct png_memory_storage
*tbr
7649 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
7651 if (length
> tbr
->len
- tbr
->index
)
7652 png_error (png_ptr
, "Read error");
7654 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
7655 tbr
->index
= tbr
->index
+ length
;
7658 /* Load PNG image IMG for use on frame F. Value is non-zero if
7666 Lisp_Object file
, specified_file
;
7667 Lisp_Object specified_data
;
7669 XImage
*ximg
, *mask_img
= NULL
;
7670 struct gcpro gcpro1
;
7671 png_struct
*png_ptr
= NULL
;
7672 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
7675 png_byte
*pixels
= NULL
;
7676 png_byte
**rows
= NULL
;
7677 png_uint_32 width
, height
;
7678 int bit_depth
, color_type
, interlace_type
;
7680 png_uint_32 row_bytes
;
7683 double screen_gamma
, image_gamma
;
7685 struct png_memory_storage tbr
; /* Data to be read */
7687 /* Find out what file to load. */
7688 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7689 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7693 if (NILP (specified_data
))
7695 file
= x_find_image_file (specified_file
);
7696 if (!STRINGP (file
))
7698 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7703 /* Open the image file. */
7704 fp
= fopen (XSTRING (file
)->data
, "rb");
7707 image_error ("Cannot open image file `%s'", file
, Qnil
);
7713 /* Check PNG signature. */
7714 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
7715 || !png_check_sig (sig
, sizeof sig
))
7717 image_error ("Not a PNG file: `%s'", file
, Qnil
);
7725 /* Read from memory. */
7726 tbr
.bytes
= XSTRING (specified_data
)->data
;
7727 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
7730 /* Check PNG signature. */
7731 if (tbr
.len
< sizeof sig
7732 || !png_check_sig (tbr
.bytes
, sizeof sig
))
7734 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
7739 /* Need to skip past the signature. */
7740 tbr
.bytes
+= sizeof (sig
);
7743 /* Initialize read and info structs for PNG lib. */
7744 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
7745 my_png_error
, my_png_warning
);
7748 if (fp
) fclose (fp
);
7753 info_ptr
= png_create_info_struct (png_ptr
);
7756 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
7757 if (fp
) fclose (fp
);
7762 end_info
= png_create_info_struct (png_ptr
);
7765 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
7766 if (fp
) fclose (fp
);
7771 /* Set error jump-back. We come back here when the PNG library
7772 detects an error. */
7773 if (setjmp (png_ptr
->jmpbuf
))
7777 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
7780 if (fp
) fclose (fp
);
7785 /* Read image info. */
7786 if (!NILP (specified_data
))
7787 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
7789 png_init_io (png_ptr
, fp
);
7791 png_set_sig_bytes (png_ptr
, sizeof sig
);
7792 png_read_info (png_ptr
, info_ptr
);
7793 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
7794 &interlace_type
, NULL
, NULL
);
7796 /* If image contains simply transparency data, we prefer to
7797 construct a clipping mask. */
7798 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
7803 /* This function is easier to write if we only have to handle
7804 one data format: RGB or RGBA with 8 bits per channel. Let's
7805 transform other formats into that format. */
7807 /* Strip more than 8 bits per channel. */
7808 if (bit_depth
== 16)
7809 png_set_strip_16 (png_ptr
);
7811 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
7813 png_set_expand (png_ptr
);
7815 /* Convert grayscale images to RGB. */
7816 if (color_type
== PNG_COLOR_TYPE_GRAY
7817 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
7818 png_set_gray_to_rgb (png_ptr
);
7820 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
7821 gamma_str
= getenv ("SCREEN_GAMMA");
7822 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
7824 /* Tell the PNG lib to handle gamma correction for us. */
7826 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
7827 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
7828 /* There is a special chunk in the image specifying the gamma. */
7829 png_set_sRGB (png_ptr
, info_ptr
, intent
);
7832 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
7833 /* Image contains gamma information. */
7834 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
7836 /* Use a default of 0.5 for the image gamma. */
7837 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
7839 /* Handle alpha channel by combining the image with a background
7840 color. Do this only if a real alpha channel is supplied. For
7841 simple transparency, we prefer a clipping mask. */
7844 png_color_16
*image_background
;
7846 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
7847 /* Image contains a background color with which to
7848 combine the image. */
7849 png_set_background (png_ptr
, image_background
,
7850 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
7853 /* Image does not contain a background color with which
7854 to combine the image data via an alpha channel. Use
7855 the frame's background instead. */
7858 png_color_16 frame_background
;
7861 cmap
= FRAME_X_COLORMAP (f
);
7862 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
7863 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
7866 bzero (&frame_background
, sizeof frame_background
);
7867 frame_background
.red
= color
.red
;
7868 frame_background
.green
= color
.green
;
7869 frame_background
.blue
= color
.blue
;
7871 png_set_background (png_ptr
, &frame_background
,
7872 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
7876 /* Update info structure. */
7877 png_read_update_info (png_ptr
, info_ptr
);
7879 /* Get number of channels. Valid values are 1 for grayscale images
7880 and images with a palette, 2 for grayscale images with transparency
7881 information (alpha channel), 3 for RGB images, and 4 for RGB
7882 images with alpha channel, i.e. RGBA. If conversions above were
7883 sufficient we should only have 3 or 4 channels here. */
7884 channels
= png_get_channels (png_ptr
, info_ptr
);
7885 xassert (channels
== 3 || channels
== 4);
7887 /* Number of bytes needed for one row of the image. */
7888 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
7890 /* Allocate memory for the image. */
7891 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
7892 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
7893 for (i
= 0; i
< height
; ++i
)
7894 rows
[i
] = pixels
+ i
* row_bytes
;
7896 /* Read the entire image. */
7897 png_read_image (png_ptr
, rows
);
7898 png_read_end (png_ptr
, info_ptr
);
7907 /* Create the X image and pixmap. */
7908 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
7915 /* Create an image and pixmap serving as mask if the PNG image
7916 contains an alpha channel. */
7919 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
7920 &mask_img
, &img
->mask
))
7922 x_destroy_x_image (ximg
);
7923 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
7929 /* Fill the X image and mask from PNG data. */
7930 init_color_table ();
7932 for (y
= 0; y
< height
; ++y
)
7934 png_byte
*p
= rows
[y
];
7936 for (x
= 0; x
< width
; ++x
)
7943 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7945 /* An alpha channel, aka mask channel, associates variable
7946 transparency with an image. Where other image formats
7947 support binary transparency---fully transparent or fully
7948 opaque---PNG allows up to 254 levels of partial transparency.
7949 The PNG library implements partial transparency by combining
7950 the image with a specified background color.
7952 I'm not sure how to handle this here nicely: because the
7953 background on which the image is displayed may change, for
7954 real alpha channel support, it would be necessary to create
7955 a new image for each possible background.
7957 What I'm doing now is that a mask is created if we have
7958 boolean transparency information. Otherwise I'm using
7959 the frame's background color to combine the image with. */
7964 XPutPixel (mask_img
, x
, y
, *p
> 0);
7970 /* Remember colors allocated for this image. */
7971 img
->colors
= colors_in_color_table (&img
->ncolors
);
7972 free_color_table ();
7975 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
7980 img
->height
= height
;
7982 /* Put the image into the pixmap, then free the X image and its buffer. */
7983 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7984 x_destroy_x_image (ximg
);
7986 /* Same for the mask. */
7989 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7990 x_destroy_x_image (mask_img
);
7998 #endif /* HAVE_PNG != 0 */
8002 /***********************************************************************
8004 ***********************************************************************/
8008 /* Work around a warning about HAVE_STDLIB_H being redefined in
8010 #ifdef HAVE_STDLIB_H
8011 #define HAVE_STDLIB_H_1
8012 #undef HAVE_STDLIB_H
8013 #endif /* HAVE_STLIB_H */
8015 #include <jpeglib.h>
8019 #ifdef HAVE_STLIB_H_1
8020 #define HAVE_STDLIB_H 1
8023 static int jpeg_image_p
P_ ((Lisp_Object object
));
8024 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8026 /* The symbol `jpeg' identifying images of this type. */
8030 /* Indices of image specification fields in gs_format, below. */
8032 enum jpeg_keyword_index
8041 JPEG_HEURISTIC_MASK
,
8045 /* Vector of image_keyword structures describing the format
8046 of valid user-defined image specifications. */
8048 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8050 {":type", IMAGE_SYMBOL_VALUE
, 1},
8051 {":data", IMAGE_STRING_VALUE
, 0},
8052 {":file", IMAGE_STRING_VALUE
, 0},
8053 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8054 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8055 {":relief", IMAGE_INTEGER_VALUE
, 0},
8056 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8057 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8060 /* Structure describing the image type `jpeg'. */
8062 static struct image_type jpeg_type
=
8072 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8075 jpeg_image_p (object
)
8078 struct image_keyword fmt
[JPEG_LAST
];
8080 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8082 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8085 /* Must specify either the :data or :file keyword. */
8086 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8090 struct my_jpeg_error_mgr
8092 struct jpeg_error_mgr pub
;
8093 jmp_buf setjmp_buffer
;
8098 my_error_exit (cinfo
)
8101 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8102 longjmp (mgr
->setjmp_buffer
, 1);
8106 /* Init source method for JPEG data source manager. Called by
8107 jpeg_read_header() before any data is actually read. See
8108 libjpeg.doc from the JPEG lib distribution. */
8111 our_init_source (cinfo
)
8112 j_decompress_ptr cinfo
;
8117 /* Fill input buffer method for JPEG data source manager. Called
8118 whenever more data is needed. We read the whole image in one step,
8119 so this only adds a fake end of input marker at the end. */
8122 our_fill_input_buffer (cinfo
)
8123 j_decompress_ptr cinfo
;
8125 /* Insert a fake EOI marker. */
8126 struct jpeg_source_mgr
*src
= cinfo
->src
;
8127 static JOCTET buffer
[2];
8129 buffer
[0] = (JOCTET
) 0xFF;
8130 buffer
[1] = (JOCTET
) JPEG_EOI
;
8132 src
->next_input_byte
= buffer
;
8133 src
->bytes_in_buffer
= 2;
8138 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8139 is the JPEG data source manager. */
8142 our_skip_input_data (cinfo
, num_bytes
)
8143 j_decompress_ptr cinfo
;
8146 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8150 if (num_bytes
> src
->bytes_in_buffer
)
8151 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8153 src
->bytes_in_buffer
-= num_bytes
;
8154 src
->next_input_byte
+= num_bytes
;
8159 /* Method to terminate data source. Called by
8160 jpeg_finish_decompress() after all data has been processed. */
8163 our_term_source (cinfo
)
8164 j_decompress_ptr cinfo
;
8169 /* Set up the JPEG lib for reading an image from DATA which contains
8170 LEN bytes. CINFO is the decompression info structure created for
8171 reading the image. */
8174 jpeg_memory_src (cinfo
, data
, len
)
8175 j_decompress_ptr cinfo
;
8179 struct jpeg_source_mgr
*src
;
8181 if (cinfo
->src
== NULL
)
8183 /* First time for this JPEG object? */
8184 cinfo
->src
= (struct jpeg_source_mgr
*)
8185 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8186 sizeof (struct jpeg_source_mgr
));
8187 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8188 src
->next_input_byte
= data
;
8191 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8192 src
->init_source
= our_init_source
;
8193 src
->fill_input_buffer
= our_fill_input_buffer
;
8194 src
->skip_input_data
= our_skip_input_data
;
8195 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
8196 src
->term_source
= our_term_source
;
8197 src
->bytes_in_buffer
= len
;
8198 src
->next_input_byte
= data
;
8202 /* Load image IMG for use on frame F. Patterned after example.c
8203 from the JPEG lib. */
8210 struct jpeg_decompress_struct cinfo
;
8211 struct my_jpeg_error_mgr mgr
;
8212 Lisp_Object file
, specified_file
;
8213 Lisp_Object specified_data
;
8216 int row_stride
, x
, y
;
8217 XImage
*ximg
= NULL
;
8219 unsigned long *colors
;
8221 struct gcpro gcpro1
;
8223 /* Open the JPEG file. */
8224 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8225 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8229 if (NILP (specified_data
))
8231 file
= x_find_image_file (specified_file
);
8232 if (!STRINGP (file
))
8234 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8239 fp
= fopen (XSTRING (file
)->data
, "r");
8242 image_error ("Cannot open `%s'", file
, Qnil
);
8248 /* Customize libjpeg's error handling to call my_error_exit when an
8249 error is detected. This function will perform a longjmp. */
8250 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8251 mgr
.pub
.error_exit
= my_error_exit
;
8253 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8257 /* Called from my_error_exit. Display a JPEG error. */
8258 char buffer
[JMSG_LENGTH_MAX
];
8259 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8260 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
8261 build_string (buffer
));
8264 /* Close the input file and destroy the JPEG object. */
8267 jpeg_destroy_decompress (&cinfo
);
8271 /* If we already have an XImage, free that. */
8272 x_destroy_x_image (ximg
);
8274 /* Free pixmap and colors. */
8275 x_clear_image (f
, img
);
8282 /* Create the JPEG decompression object. Let it read from fp.
8283 Read the JPEG image header. */
8284 jpeg_create_decompress (&cinfo
);
8286 if (NILP (specified_data
))
8287 jpeg_stdio_src (&cinfo
, fp
);
8289 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
8290 STRING_BYTES (XSTRING (specified_data
)));
8292 jpeg_read_header (&cinfo
, TRUE
);
8294 /* Customize decompression so that color quantization will be used.
8295 Start decompression. */
8296 cinfo
.quantize_colors
= TRUE
;
8297 jpeg_start_decompress (&cinfo
);
8298 width
= img
->width
= cinfo
.output_width
;
8299 height
= img
->height
= cinfo
.output_height
;
8303 /* Create X image and pixmap. */
8304 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8307 longjmp (mgr
.setjmp_buffer
, 2);
8310 /* Allocate colors. When color quantization is used,
8311 cinfo.actual_number_of_colors has been set with the number of
8312 colors generated, and cinfo.colormap is a two-dimensional array
8313 of color indices in the range 0..cinfo.actual_number_of_colors.
8314 No more than 255 colors will be generated. */
8318 if (cinfo
.out_color_components
> 2)
8319 ir
= 0, ig
= 1, ib
= 2;
8320 else if (cinfo
.out_color_components
> 1)
8321 ir
= 0, ig
= 1, ib
= 0;
8323 ir
= 0, ig
= 0, ib
= 0;
8325 /* Use the color table mechanism because it handles colors that
8326 cannot be allocated nicely. Such colors will be replaced with
8327 a default color, and we don't have to care about which colors
8328 can be freed safely, and which can't. */
8329 init_color_table ();
8330 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
8333 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
8335 /* Multiply RGB values with 255 because X expects RGB values
8336 in the range 0..0xffff. */
8337 int r
= cinfo
.colormap
[ir
][i
] << 8;
8338 int g
= cinfo
.colormap
[ig
][i
] << 8;
8339 int b
= cinfo
.colormap
[ib
][i
] << 8;
8340 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8343 /* Remember those colors actually allocated. */
8344 img
->colors
= colors_in_color_table (&img
->ncolors
);
8345 free_color_table ();
8349 row_stride
= width
* cinfo
.output_components
;
8350 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
8352 for (y
= 0; y
< height
; ++y
)
8354 jpeg_read_scanlines (&cinfo
, buffer
, 1);
8355 for (x
= 0; x
< cinfo
.output_width
; ++x
)
8356 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
8360 jpeg_finish_decompress (&cinfo
);
8361 jpeg_destroy_decompress (&cinfo
);
8365 /* Put the image into the pixmap. */
8366 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8367 x_destroy_x_image (ximg
);
8373 #endif /* HAVE_JPEG */
8377 /***********************************************************************
8379 ***********************************************************************/
8385 static int tiff_image_p
P_ ((Lisp_Object object
));
8386 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
8388 /* The symbol `tiff' identifying images of this type. */
8392 /* Indices of image specification fields in tiff_format, below. */
8394 enum tiff_keyword_index
8403 TIFF_HEURISTIC_MASK
,
8407 /* Vector of image_keyword structures describing the format
8408 of valid user-defined image specifications. */
8410 static struct image_keyword tiff_format
[TIFF_LAST
] =
8412 {":type", IMAGE_SYMBOL_VALUE
, 1},
8413 {":data", IMAGE_STRING_VALUE
, 0},
8414 {":file", IMAGE_STRING_VALUE
, 0},
8415 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8416 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8417 {":relief", IMAGE_INTEGER_VALUE
, 0},
8418 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8419 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8422 /* Structure describing the image type `tiff'. */
8424 static struct image_type tiff_type
=
8434 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8437 tiff_image_p (object
)
8440 struct image_keyword fmt
[TIFF_LAST
];
8441 bcopy (tiff_format
, fmt
, sizeof fmt
);
8443 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
8446 /* Must specify either the :data or :file keyword. */
8447 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
8451 /* Reading from a memory buffer for TIFF images Based on the PNG
8452 memory source, but we have to provide a lot of extra functions.
8455 We really only need to implement read and seek, but I am not
8456 convinced that the TIFF library is smart enough not to destroy
8457 itself if we only hand it the function pointers we need to
8462 unsigned char *bytes
;
8470 tiff_read_from_memory (data
, buf
, size
)
8475 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
8477 if (size
> src
->len
- src
->index
)
8479 bcopy (src
->bytes
+ src
->index
, buf
, size
);
8486 tiff_write_from_memory (data
, buf
, size
)
8496 tiff_seek_in_memory (data
, off
, whence
)
8501 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
8506 case SEEK_SET
: /* Go from beginning of source. */
8510 case SEEK_END
: /* Go from end of source. */
8511 idx
= src
->len
+ off
;
8514 case SEEK_CUR
: /* Go from current position. */
8515 idx
= src
->index
+ off
;
8518 default: /* Invalid `whence'. */
8522 if (idx
> src
->len
|| idx
< 0)
8531 tiff_close_memory (data
)
8540 tiff_mmap_memory (data
, pbase
, psize
)
8545 /* It is already _IN_ memory. */
8551 tiff_unmap_memory (data
, base
, size
)
8556 /* We don't need to do this. */
8561 tiff_size_of_memory (data
)
8564 return ((tiff_memory_source
*) data
)->len
;
8568 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8576 Lisp_Object file
, specified_file
;
8577 Lisp_Object specified_data
;
8579 int width
, height
, x
, y
;
8583 struct gcpro gcpro1
;
8584 tiff_memory_source memsrc
;
8586 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8587 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8591 if (NILP (specified_data
))
8593 /* Read from a file */
8594 file
= x_find_image_file (specified_file
);
8595 if (!STRINGP (file
))
8597 image_error ("Cannot find image file `%s'", file
, Qnil
);
8602 /* Try to open the image file. */
8603 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
8606 image_error ("Cannot open `%s'", file
, Qnil
);
8613 /* Memory source! */
8614 memsrc
.bytes
= XSTRING (specified_data
)->data
;
8615 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
8618 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
8619 (TIFFReadWriteProc
) tiff_read_from_memory
,
8620 (TIFFReadWriteProc
) tiff_write_from_memory
,
8621 tiff_seek_in_memory
,
8623 tiff_size_of_memory
,
8629 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
8635 /* Get width and height of the image, and allocate a raster buffer
8636 of width x height 32-bit values. */
8637 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
8638 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
8639 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
8641 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
8645 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
8653 /* Create the X image and pixmap. */
8654 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8662 /* Initialize the color table. */
8663 init_color_table ();
8665 /* Process the pixel raster. Origin is in the lower-left corner. */
8666 for (y
= 0; y
< height
; ++y
)
8668 uint32
*row
= buf
+ y
* width
;
8670 for (x
= 0; x
< width
; ++x
)
8672 uint32 abgr
= row
[x
];
8673 int r
= TIFFGetR (abgr
) << 8;
8674 int g
= TIFFGetG (abgr
) << 8;
8675 int b
= TIFFGetB (abgr
) << 8;
8676 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
8680 /* Remember the colors allocated for the image. Free the color table. */
8681 img
->colors
= colors_in_color_table (&img
->ncolors
);
8682 free_color_table ();
8684 /* Put the image into the pixmap, then free the X image and its buffer. */
8685 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8686 x_destroy_x_image (ximg
);
8691 img
->height
= height
;
8697 #endif /* HAVE_TIFF != 0 */
8701 /***********************************************************************
8703 ***********************************************************************/
8707 #include <gif_lib.h>
8709 static int gif_image_p
P_ ((Lisp_Object object
));
8710 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
8712 /* The symbol `gif' identifying images of this type. */
8716 /* Indices of image specification fields in gif_format, below. */
8718 enum gif_keyword_index
8732 /* Vector of image_keyword structures describing the format
8733 of valid user-defined image specifications. */
8735 static struct image_keyword gif_format
[GIF_LAST
] =
8737 {":type", IMAGE_SYMBOL_VALUE
, 1},
8738 {":data", IMAGE_STRING_VALUE
, 0},
8739 {":file", IMAGE_STRING_VALUE
, 0},
8740 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8741 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8742 {":relief", IMAGE_INTEGER_VALUE
, 0},
8743 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8744 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8745 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
8748 /* Structure describing the image type `gif'. */
8750 static struct image_type gif_type
=
8760 /* Return non-zero if OBJECT is a valid GIF image specification. */
8763 gif_image_p (object
)
8766 struct image_keyword fmt
[GIF_LAST
];
8767 bcopy (gif_format
, fmt
, sizeof fmt
);
8769 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
8772 /* Must specify either the :data or :file keyword. */
8773 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
8777 /* Reading a GIF image from memory
8778 Based on the PNG memory stuff to a certain extent. */
8782 unsigned char *bytes
;
8789 /* Make the current memory source available to gif_read_from_memory.
8790 It's done this way because not all versions of libungif support
8791 a UserData field in the GifFileType structure. */
8792 static gif_memory_source
*current_gif_memory_src
;
8795 gif_read_from_memory (file
, buf
, len
)
8800 gif_memory_source
*src
= current_gif_memory_src
;
8802 if (len
> src
->len
- src
->index
)
8805 bcopy (src
->bytes
+ src
->index
, buf
, len
);
8811 /* Load GIF image IMG for use on frame F. Value is non-zero if
8819 Lisp_Object file
, specified_file
;
8820 Lisp_Object specified_data
;
8821 int rc
, width
, height
, x
, y
, i
;
8823 ColorMapObject
*gif_color_map
;
8824 unsigned long pixel_colors
[256];
8826 struct gcpro gcpro1
;
8828 int ino
, image_left
, image_top
, image_width
, image_height
;
8829 gif_memory_source memsrc
;
8830 unsigned char *raster
;
8832 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8833 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8837 if (NILP (specified_data
))
8839 file
= x_find_image_file (specified_file
);
8840 if (!STRINGP (file
))
8842 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8847 /* Open the GIF file. */
8848 gif
= DGifOpenFileName (XSTRING (file
)->data
);
8851 image_error ("Cannot open `%s'", file
, Qnil
);
8858 /* Read from memory! */
8859 current_gif_memory_src
= &memsrc
;
8860 memsrc
.bytes
= XSTRING (specified_data
)->data
;
8861 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
8864 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
8867 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
8873 /* Read entire contents. */
8874 rc
= DGifSlurp (gif
);
8875 if (rc
== GIF_ERROR
)
8877 image_error ("Error reading `%s'", img
->spec
, Qnil
);
8878 DGifCloseFile (gif
);
8883 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
8884 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
8885 if (ino
>= gif
->ImageCount
)
8887 image_error ("Invalid image number `%s' in image `%s'",
8889 DGifCloseFile (gif
);
8894 width
= img
->width
= gif
->SWidth
;
8895 height
= img
->height
= gif
->SHeight
;
8899 /* Create the X image and pixmap. */
8900 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8903 DGifCloseFile (gif
);
8908 /* Allocate colors. */
8909 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
8911 gif_color_map
= gif
->SColorMap
;
8912 init_color_table ();
8913 bzero (pixel_colors
, sizeof pixel_colors
);
8915 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
8917 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
8918 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
8919 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
8920 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8923 img
->colors
= colors_in_color_table (&img
->ncolors
);
8924 free_color_table ();
8926 /* Clear the part of the screen image that are not covered by
8927 the image from the GIF file. Full animated GIF support
8928 requires more than can be done here (see the gif89 spec,
8929 disposal methods). Let's simply assume that the part
8930 not covered by a sub-image is in the frame's background color. */
8931 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
8932 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
8933 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
8934 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
8936 for (y
= 0; y
< image_top
; ++y
)
8937 for (x
= 0; x
< width
; ++x
)
8938 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8940 for (y
= image_top
+ image_height
; y
< height
; ++y
)
8941 for (x
= 0; x
< width
; ++x
)
8942 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8944 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
8946 for (x
= 0; x
< image_left
; ++x
)
8947 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8948 for (x
= image_left
+ image_width
; x
< width
; ++x
)
8949 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8952 /* Read the GIF image into the X image. We use a local variable
8953 `raster' here because RasterBits below is a char *, and invites
8954 problems with bytes >= 0x80. */
8955 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
8957 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
8959 static int interlace_start
[] = {0, 4, 2, 1};
8960 static int interlace_increment
[] = {8, 8, 4, 2};
8962 int row
= interlace_start
[0];
8966 for (y
= 0; y
< image_height
; y
++)
8968 if (row
>= image_height
)
8970 row
= interlace_start
[++pass
];
8971 while (row
>= image_height
)
8972 row
= interlace_start
[++pass
];
8975 for (x
= 0; x
< image_width
; x
++)
8977 int i
= raster
[(y
* image_width
) + x
];
8978 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
8982 row
+= interlace_increment
[pass
];
8987 for (y
= 0; y
< image_height
; ++y
)
8988 for (x
= 0; x
< image_width
; ++x
)
8990 int i
= raster
[y
* image_width
+ x
];
8991 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
8995 DGifCloseFile (gif
);
8997 /* Put the image into the pixmap, then free the X image and its buffer. */
8998 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8999 x_destroy_x_image (ximg
);
9006 #endif /* HAVE_GIF != 0 */
9010 /***********************************************************************
9012 ***********************************************************************/
9014 static int gs_image_p
P_ ((Lisp_Object object
));
9015 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9016 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9018 /* The symbol `postscript' identifying images of this type. */
9020 Lisp_Object Qpostscript
;
9022 /* Keyword symbols. */
9024 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9026 /* Indices of image specification fields in gs_format, below. */
9028 enum gs_keyword_index
9044 /* Vector of image_keyword structures describing the format
9045 of valid user-defined image specifications. */
9047 static struct image_keyword gs_format
[GS_LAST
] =
9049 {":type", IMAGE_SYMBOL_VALUE
, 1},
9050 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9051 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9052 {":file", IMAGE_STRING_VALUE
, 1},
9053 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9054 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9055 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9056 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9057 {":relief", IMAGE_INTEGER_VALUE
, 0},
9058 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9059 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9062 /* Structure describing the image type `ghostscript'. */
9064 static struct image_type gs_type
=
9074 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9077 gs_clear_image (f
, img
)
9081 /* IMG->data.ptr_val may contain a recorded colormap. */
9082 xfree (img
->data
.ptr_val
);
9083 x_clear_image (f
, img
);
9087 /* Return non-zero if OBJECT is a valid Ghostscript image
9094 struct image_keyword fmt
[GS_LAST
];
9098 bcopy (gs_format
, fmt
, sizeof fmt
);
9100 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
9103 /* Bounding box must be a list or vector containing 4 integers. */
9104 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9107 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9108 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9113 else if (VECTORP (tem
))
9115 if (XVECTOR (tem
)->size
!= 4)
9117 for (i
= 0; i
< 4; ++i
)
9118 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9128 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9137 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9138 struct gcpro gcpro1
, gcpro2
;
9140 double in_width
, in_height
;
9141 Lisp_Object pixel_colors
= Qnil
;
9143 /* Compute pixel size of pixmap needed from the given size in the
9144 image specification. Sizes in the specification are in pt. 1 pt
9145 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9147 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9148 in_width
= XFASTINT (pt_width
) / 72.0;
9149 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9150 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9151 in_height
= XFASTINT (pt_height
) / 72.0;
9152 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9154 /* Create the pixmap. */
9156 xassert (img
->pixmap
== 0);
9157 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9158 img
->width
, img
->height
,
9159 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9164 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9168 /* Call the loader to fill the pixmap. It returns a process object
9169 if successful. We do not record_unwind_protect here because
9170 other places in redisplay like calling window scroll functions
9171 don't either. Let the Lisp loader use `unwind-protect' instead. */
9172 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9174 sprintf (buffer
, "%lu %lu",
9175 (unsigned long) FRAME_X_WINDOW (f
),
9176 (unsigned long) img
->pixmap
);
9177 window_and_pixmap_id
= build_string (buffer
);
9179 sprintf (buffer
, "%lu %lu",
9180 FRAME_FOREGROUND_PIXEL (f
),
9181 FRAME_BACKGROUND_PIXEL (f
));
9182 pixel_colors
= build_string (buffer
);
9184 XSETFRAME (frame
, f
);
9185 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9187 loader
= intern ("gs-load-image");
9189 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9190 make_number (img
->width
),
9191 make_number (img
->height
),
9192 window_and_pixmap_id
,
9195 return PROCESSP (img
->data
.lisp_val
);
9199 /* Kill the Ghostscript process that was started to fill PIXMAP on
9200 frame F. Called from XTread_socket when receiving an event
9201 telling Emacs that Ghostscript has finished drawing. */
9204 x_kill_gs_process (pixmap
, f
)
9208 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9212 /* Find the image containing PIXMAP. */
9213 for (i
= 0; i
< c
->used
; ++i
)
9214 if (c
->images
[i
]->pixmap
== pixmap
)
9217 /* Kill the GS process. We should have found PIXMAP in the image
9218 cache and its image should contain a process object. */
9219 xassert (i
< c
->used
);
9221 xassert (PROCESSP (img
->data
.lisp_val
));
9222 Fkill_process (img
->data
.lisp_val
, Qnil
);
9223 img
->data
.lisp_val
= Qnil
;
9225 /* On displays with a mutable colormap, figure out the colors
9226 allocated for the image by looking at the pixels of an XImage for
9228 class = FRAME_X_VISUAL (f
)->class;
9229 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9235 /* Try to get an XImage for img->pixmep. */
9236 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9237 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9242 /* Initialize the color table. */
9243 init_color_table ();
9245 /* For each pixel of the image, look its color up in the
9246 color table. After having done so, the color table will
9247 contain an entry for each color used by the image. */
9248 for (y
= 0; y
< img
->height
; ++y
)
9249 for (x
= 0; x
< img
->width
; ++x
)
9251 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9252 lookup_pixel_color (f
, pixel
);
9255 /* Record colors in the image. Free color table and XImage. */
9256 img
->colors
= colors_in_color_table (&img
->ncolors
);
9257 free_color_table ();
9258 XDestroyImage (ximg
);
9260 #if 0 /* This doesn't seem to be the case. If we free the colors
9261 here, we get a BadAccess later in x_clear_image when
9262 freeing the colors. */
9263 /* We have allocated colors once, but Ghostscript has also
9264 allocated colors on behalf of us. So, to get the
9265 reference counts right, free them once. */
9267 x_free_colors (f
, img
->colors
, img
->ncolors
);
9271 image_error ("Cannot get X image of `%s'; colors will not be freed",
9280 /***********************************************************************
9282 ***********************************************************************/
9284 DEFUN ("x-change-window-property", Fx_change_window_property
,
9285 Sx_change_window_property
, 2, 3, 0,
9286 "Change window property PROP to VALUE on the X window of FRAME.\n\
9287 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9288 selected frame. Value is VALUE.")
9289 (prop
, value
, frame
)
9290 Lisp_Object frame
, prop
, value
;
9292 struct frame
*f
= check_x_frame (frame
);
9295 CHECK_STRING (prop
, 1);
9296 CHECK_STRING (value
, 2);
9299 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9300 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9301 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9302 XSTRING (value
)->data
, XSTRING (value
)->size
);
9304 /* Make sure the property is set when we return. */
9305 XFlush (FRAME_X_DISPLAY (f
));
9312 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9313 Sx_delete_window_property
, 1, 2, 0,
9314 "Remove window property PROP from X window of FRAME.\n\
9315 FRAME nil or omitted means use the selected frame. Value is PROP.")
9317 Lisp_Object prop
, frame
;
9319 struct frame
*f
= check_x_frame (frame
);
9322 CHECK_STRING (prop
, 1);
9324 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9325 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9327 /* Make sure the property is removed when we return. */
9328 XFlush (FRAME_X_DISPLAY (f
));
9335 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
9337 "Value is the value of window property PROP on FRAME.\n\
9338 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9339 if FRAME hasn't a property with name PROP or if PROP has no string\n\
9342 Lisp_Object prop
, frame
;
9344 struct frame
*f
= check_x_frame (frame
);
9347 Lisp_Object prop_value
= Qnil
;
9348 char *tmp_data
= NULL
;
9351 unsigned long actual_size
, bytes_remaining
;
9353 CHECK_STRING (prop
, 1);
9355 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9356 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9357 prop_atom
, 0, 0, False
, XA_STRING
,
9358 &actual_type
, &actual_format
, &actual_size
,
9359 &bytes_remaining
, (unsigned char **) &tmp_data
);
9362 int size
= bytes_remaining
;
9367 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9368 prop_atom
, 0, bytes_remaining
,
9370 &actual_type
, &actual_format
,
9371 &actual_size
, &bytes_remaining
,
9372 (unsigned char **) &tmp_data
);
9374 prop_value
= make_string (tmp_data
, size
);
9385 /***********************************************************************
9387 ***********************************************************************/
9389 /* If non-null, an asynchronous timer that, when it expires, displays
9390 a busy cursor on all frames. */
9392 static struct atimer
*busy_cursor_atimer
;
9394 /* Non-zero means a busy cursor is currently shown. */
9396 static int busy_cursor_shown_p
;
9398 /* Number of seconds to wait before displaying a busy cursor. */
9400 static Lisp_Object Vbusy_cursor_delay
;
9402 /* Default number of seconds to wait before displaying a busy
9405 #define DEFAULT_BUSY_CURSOR_DELAY 1
9407 /* Function prototypes. */
9409 static void show_busy_cursor
P_ ((struct atimer
*));
9410 static void hide_busy_cursor
P_ ((void));
9413 /* Cancel a currently active busy-cursor timer, and start a new one. */
9416 start_busy_cursor ()
9419 int secs
, usecs
= 0;
9421 cancel_busy_cursor ();
9423 if (INTEGERP (Vbusy_cursor_delay
)
9424 && XINT (Vbusy_cursor_delay
) > 0)
9425 secs
= XFASTINT (Vbusy_cursor_delay
);
9426 else if (FLOATP (Vbusy_cursor_delay
)
9427 && XFLOAT_DATA (Vbusy_cursor_delay
) > 0)
9430 tem
= Ftruncate (Vbusy_cursor_delay
, Qnil
);
9431 secs
= XFASTINT (tem
);
9432 usecs
= (XFLOAT_DATA (Vbusy_cursor_delay
) - secs
) * 1000000;
9435 secs
= DEFAULT_BUSY_CURSOR_DELAY
;
9437 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
9438 busy_cursor_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
9439 show_busy_cursor
, NULL
);
9443 /* Cancel the busy cursor timer if active, hide a busy cursor if
9447 cancel_busy_cursor ()
9449 if (busy_cursor_atimer
)
9451 cancel_atimer (busy_cursor_atimer
);
9452 busy_cursor_atimer
= NULL
;
9455 if (busy_cursor_shown_p
)
9456 hide_busy_cursor ();
9460 /* Timer function of busy_cursor_atimer. TIMER is equal to
9463 Display a busy cursor on all frames by mapping the frames'
9464 busy_window. Set the busy_p flag in the frames' output_data.x
9465 structure to indicate that a busy cursor is shown on the
9469 show_busy_cursor (timer
)
9470 struct atimer
*timer
;
9472 /* The timer implementation will cancel this timer automatically
9473 after this function has run. Set busy_cursor_atimer to null
9474 so that we know the timer doesn't have to be canceled. */
9475 busy_cursor_atimer
= NULL
;
9477 if (!busy_cursor_shown_p
)
9479 Lisp_Object rest
, frame
;
9483 FOR_EACH_FRAME (rest
, frame
)
9484 if (FRAME_X_P (XFRAME (frame
)))
9486 struct frame
*f
= XFRAME (frame
);
9488 f
->output_data
.x
->busy_p
= 1;
9490 if (!f
->output_data
.x
->busy_window
)
9492 unsigned long mask
= CWCursor
;
9493 XSetWindowAttributes attrs
;
9495 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
9497 f
->output_data
.x
->busy_window
9498 = XCreateWindow (FRAME_X_DISPLAY (f
),
9499 FRAME_OUTER_WINDOW (f
),
9500 0, 0, 32000, 32000, 0, 0,
9506 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9507 XFlush (FRAME_X_DISPLAY (f
));
9510 busy_cursor_shown_p
= 1;
9516 /* Hide the busy cursor on all frames, if it is currently shown. */
9521 if (busy_cursor_shown_p
)
9523 Lisp_Object rest
, frame
;
9526 FOR_EACH_FRAME (rest
, frame
)
9528 struct frame
*f
= XFRAME (frame
);
9531 /* Watch out for newly created frames. */
9532 && f
->output_data
.x
->busy_window
)
9534 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9535 /* Sync here because XTread_socket looks at the busy_p flag
9536 that is reset to zero below. */
9537 XSync (FRAME_X_DISPLAY (f
), False
);
9538 f
->output_data
.x
->busy_p
= 0;
9542 busy_cursor_shown_p
= 0;
9549 /***********************************************************************
9551 ***********************************************************************/
9553 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
9556 /* The frame of a currently visible tooltip, or null. */
9558 struct frame
*tip_frame
;
9560 /* If non-nil, a timer started that hides the last tooltip when it
9563 Lisp_Object tip_timer
;
9566 /* Create a frame for a tooltip on the display described by DPYINFO.
9567 PARMS is a list of frame parameters. Value is the frame. */
9570 x_create_tip_frame (dpyinfo
, parms
)
9571 struct x_display_info
*dpyinfo
;
9575 Lisp_Object frame
, tem
;
9577 long window_prompting
= 0;
9579 int count
= specpdl_ptr
- specpdl
;
9580 struct gcpro gcpro1
, gcpro2
, gcpro3
;
9585 /* Use this general default value to start with until we know if
9586 this frame has a specified name. */
9587 Vx_resource_name
= Vinvocation_name
;
9590 kb
= dpyinfo
->kboard
;
9592 kb
= &the_only_kboard
;
9595 /* Get the name of the frame to use for resource lookup. */
9596 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
9598 && !EQ (name
, Qunbound
)
9600 error ("Invalid frame name--not a string or nil");
9601 Vx_resource_name
= name
;
9604 GCPRO3 (parms
, name
, frame
);
9605 tip_frame
= f
= make_frame (1);
9606 XSETFRAME (frame
, f
);
9607 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
9609 f
->output_method
= output_x_window
;
9610 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
9611 bzero (f
->output_data
.x
, sizeof (struct x_output
));
9612 f
->output_data
.x
->icon_bitmap
= -1;
9613 f
->output_data
.x
->fontset
= -1;
9614 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
9615 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
9616 f
->icon_name
= Qnil
;
9617 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
9619 FRAME_KBOARD (f
) = kb
;
9621 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9622 f
->output_data
.x
->explicit_parent
= 0;
9624 /* These colors will be set anyway later, but it's important
9625 to get the color reference counts right, so initialize them! */
9628 struct gcpro gcpro1
;
9630 black
= build_string ("black");
9632 f
->output_data
.x
->foreground_pixel
9633 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
9634 f
->output_data
.x
->background_pixel
9635 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
9636 f
->output_data
.x
->cursor_pixel
9637 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
9638 f
->output_data
.x
->cursor_foreground_pixel
9639 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
9640 f
->output_data
.x
->border_pixel
9641 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
9642 f
->output_data
.x
->mouse_pixel
9643 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
9647 /* Set the name; the functions to which we pass f expect the name to
9649 if (EQ (name
, Qunbound
) || NILP (name
))
9651 f
->name
= build_string (dpyinfo
->x_id_name
);
9652 f
->explicit_name
= 0;
9657 f
->explicit_name
= 1;
9658 /* use the frame's title when getting resources for this frame. */
9659 specbind (Qx_resource_name
, name
);
9662 /* Extract the window parameters from the supplied values
9663 that are needed to determine window geometry. */
9667 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
9670 /* First, try whatever font the caller has specified. */
9673 tem
= Fquery_fontset (font
, Qnil
);
9675 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
9677 font
= x_new_font (f
, XSTRING (font
)->data
);
9680 /* Try out a font which we hope has bold and italic variations. */
9681 if (!STRINGP (font
))
9682 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
9683 if (!STRINGP (font
))
9684 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9685 if (! STRINGP (font
))
9686 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9687 if (! STRINGP (font
))
9688 /* This was formerly the first thing tried, but it finds too many fonts
9689 and takes too long. */
9690 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
9691 /* If those didn't work, look for something which will at least work. */
9692 if (! STRINGP (font
))
9693 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
9695 if (! STRINGP (font
))
9696 font
= build_string ("fixed");
9698 x_default_parameter (f
, parms
, Qfont
, font
,
9699 "font", "Font", RES_TYPE_STRING
);
9702 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
9703 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
9705 /* This defaults to 2 in order to match xterm. We recognize either
9706 internalBorderWidth or internalBorder (which is what xterm calls
9708 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9712 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
9713 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
9714 if (! EQ (value
, Qunbound
))
9715 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
9719 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
9720 "internalBorderWidth", "internalBorderWidth",
9723 /* Also do the stuff which must be set before the window exists. */
9724 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
9725 "foreground", "Foreground", RES_TYPE_STRING
);
9726 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
9727 "background", "Background", RES_TYPE_STRING
);
9728 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
9729 "pointerColor", "Foreground", RES_TYPE_STRING
);
9730 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
9731 "cursorColor", "Foreground", RES_TYPE_STRING
);
9732 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
9733 "borderColor", "BorderColor", RES_TYPE_STRING
);
9735 /* Init faces before x_default_parameter is called for scroll-bar
9736 parameters because that function calls x_set_scroll_bar_width,
9737 which calls change_frame_size, which calls Fset_window_buffer,
9738 which runs hooks, which call Fvertical_motion. At the end, we
9739 end up in init_iterator with a null face cache, which should not
9741 init_frame_faces (f
);
9743 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9744 window_prompting
= x_figure_window_size (f
, parms
);
9746 if (window_prompting
& XNegative
)
9748 if (window_prompting
& YNegative
)
9749 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
9751 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
9755 if (window_prompting
& YNegative
)
9756 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
9758 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
9761 f
->output_data
.x
->size_hint_flags
= window_prompting
;
9763 XSetWindowAttributes attrs
;
9767 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
9768 /* Window managers look at the override-redirect flag to determine
9769 whether or net to give windows a decoration (Xlib spec, chapter
9771 attrs
.override_redirect
= True
;
9772 attrs
.save_under
= True
;
9773 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
9774 /* Arrange for getting MapNotify and UnmapNotify events. */
9775 attrs
.event_mask
= StructureNotifyMask
;
9777 = FRAME_X_WINDOW (f
)
9778 = XCreateWindow (FRAME_X_DISPLAY (f
),
9779 FRAME_X_DISPLAY_INFO (f
)->root_window
,
9780 /* x, y, width, height */
9784 CopyFromParent
, InputOutput
, CopyFromParent
,
9791 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
9792 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9793 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
9794 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9795 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
9796 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
9798 /* Dimensions, especially f->height, must be done via change_frame_size.
9799 Change will not be effected unless different from the current
9804 SET_FRAME_WIDTH (f
, 0);
9805 change_frame_size (f
, height
, width
, 1, 0, 0);
9811 /* It is now ok to make the frame official even if we get an error
9812 below. And the frame needs to be on Vframe_list or making it
9813 visible won't work. */
9814 Vframe_list
= Fcons (frame
, Vframe_list
);
9816 /* Now that the frame is official, it counts as a reference to
9818 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
9820 return unbind_to (count
, frame
);
9824 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 4, 0,
9825 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
9826 A tooltip window is a small X window displaying STRING at\n\
9827 the current mouse position.\n\
9828 FRAME nil or omitted means use the selected frame.\n\
9829 PARMS is an optional list of frame parameters which can be\n\
9830 used to change the tooltip's appearance.\n\
9831 Automatically hide the tooltip after TIMEOUT seconds.\n\
9832 TIMEOUT nil means use the default timeout of 5 seconds.")
9833 (string
, frame
, parms
, timeout
)
9834 Lisp_Object string
, frame
, parms
, timeout
;
9840 struct buffer
*old_buffer
;
9841 struct text_pos pos
;
9842 int i
, width
, height
;
9843 int root_x
, root_y
, win_x
, win_y
;
9845 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
9846 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
9847 int count
= specpdl_ptr
- specpdl
;
9849 specbind (Qinhibit_redisplay
, Qt
);
9851 GCPRO4 (string
, parms
, frame
, timeout
);
9853 CHECK_STRING (string
, 0);
9854 f
= check_x_frame (frame
);
9856 timeout
= make_number (5);
9858 CHECK_NATNUM (timeout
, 2);
9860 /* Hide a previous tip, if any. */
9863 /* Add default values to frame parameters. */
9864 if (NILP (Fassq (Qname
, parms
)))
9865 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
9866 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9867 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
9868 if (NILP (Fassq (Qborder_width
, parms
)))
9869 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
9870 if (NILP (Fassq (Qborder_color
, parms
)))
9871 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
9872 if (NILP (Fassq (Qbackground_color
, parms
)))
9873 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
9876 /* Create a frame for the tooltip, and record it in the global
9877 variable tip_frame. */
9878 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
9879 tip_frame
= f
= XFRAME (frame
);
9881 /* Set up the frame's root window. Currently we use a size of 80
9882 columns x 40 lines. If someone wants to show a larger tip, he
9883 will loose. I don't think this is a realistic case. */
9884 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
9885 w
->left
= w
->top
= make_number (0);
9886 w
->width
= make_number (80);
9887 w
->height
= make_number (40);
9889 w
->pseudo_window_p
= 1;
9891 /* Display the tooltip text in a temporary buffer. */
9892 buffer
= Fget_buffer_create (build_string (" *tip*"));
9893 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
9894 old_buffer
= current_buffer
;
9895 set_buffer_internal_1 (XBUFFER (buffer
));
9897 Finsert (1, &string
);
9898 clear_glyph_matrix (w
->desired_matrix
);
9899 clear_glyph_matrix (w
->current_matrix
);
9900 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
9901 try_window (FRAME_ROOT_WINDOW (f
), pos
);
9903 /* Compute width and height of the tooltip. */
9905 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
9907 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
9911 /* Stop at the first empty row at the end. */
9912 if (!row
->enabled_p
|| !row
->displays_text_p
)
9915 /* Let the row go over the full width of the frame. */
9916 row
->full_width_p
= 1;
9918 /* There's a glyph at the end of rows that is used to place
9919 the cursor there. Don't include the width of this glyph. */
9920 if (row
->used
[TEXT_AREA
])
9922 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
9923 row_width
= row
->pixel_width
- last
->pixel_width
;
9926 row_width
= row
->pixel_width
;
9928 height
+= row
->height
;
9929 width
= max (width
, row_width
);
9932 /* Add the frame's internal border to the width and height the X
9933 window should have. */
9934 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9935 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9937 /* Move the tooltip window where the mouse pointer is. Resize and
9940 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
9941 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
9942 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9943 root_x
+ 5, root_y
- height
- 5, width
, height
);
9944 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
9947 /* Draw into the window. */
9948 w
->must_be_updated_p
= 1;
9949 update_single_window (w
, 1);
9951 /* Restore original current buffer. */
9952 set_buffer_internal_1 (old_buffer
);
9953 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
9955 /* Let the tip disappear after timeout seconds. */
9956 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
9957 intern ("x-hide-tip"));
9960 return unbind_to (count
, Qnil
);
9964 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
9965 "Hide the current tooltip window, if there is any.\n\
9966 Value is t is tooltip was open, nil otherwise.")
9969 int count
= specpdl_ptr
- specpdl
;
9972 specbind (Qinhibit_redisplay
, Qt
);
9974 if (!NILP (tip_timer
))
9976 call1 (intern ("cancel-timer"), tip_timer
);
9984 XSETFRAME (frame
, tip_frame
);
9985 Fdelete_frame (frame
, Qt
);
9990 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
9995 /***********************************************************************
9996 File selection dialog
9997 ***********************************************************************/
10001 /* Callback for "OK" and "Cancel" on file selection dialog. */
10004 file_dialog_cb (widget
, client_data
, call_data
)
10006 XtPointer call_data
, client_data
;
10008 int *result
= (int *) client_data
;
10009 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
10010 *result
= cb
->reason
;
10014 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
10015 "Read file name, prompting with PROMPT in directory DIR.\n\
10016 Use a file selection dialog.\n\
10017 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10018 specified. Don't let the user enter a file name in the file\n\
10019 selection dialog's entry field, if MUSTMATCH is non-nil.")
10020 (prompt
, dir
, default_filename
, mustmatch
)
10021 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
10024 struct frame
*f
= SELECTED_FRAME ();
10025 Lisp_Object file
= Qnil
;
10026 Widget dialog
, text
, list
, help
;
10029 extern XtAppContext Xt_app_con
;
10031 XmString dir_xmstring
, pattern_xmstring
;
10032 int popup_activated_flag
;
10033 int count
= specpdl_ptr
- specpdl
;
10034 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
10036 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
10037 CHECK_STRING (prompt
, 0);
10038 CHECK_STRING (dir
, 1);
10040 /* Prevent redisplay. */
10041 specbind (Qinhibit_redisplay
, Qt
);
10045 /* Create the dialog with PROMPT as title, using DIR as initial
10046 directory and using "*" as pattern. */
10047 dir
= Fexpand_file_name (dir
, Qnil
);
10048 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
10049 pattern_xmstring
= XmStringCreateLocalized ("*");
10051 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
10052 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
10053 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
10054 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
10055 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
10056 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
10058 XmStringFree (dir_xmstring
);
10059 XmStringFree (pattern_xmstring
);
10061 /* Add callbacks for OK and Cancel. */
10062 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
10063 (XtPointer
) &result
);
10064 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
10065 (XtPointer
) &result
);
10067 /* Disable the help button since we can't display help. */
10068 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
10069 XtSetSensitive (help
, False
);
10071 /* Mark OK button as default. */
10072 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
10073 XmNshowAsDefault
, True
, NULL
);
10075 /* If MUSTMATCH is non-nil, disable the file entry field of the
10076 dialog, so that the user must select a file from the files list
10077 box. We can't remove it because we wouldn't have a way to get at
10078 the result file name, then. */
10079 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
10080 if (!NILP (mustmatch
))
10083 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
10084 XtSetSensitive (text
, False
);
10085 XtSetSensitive (label
, False
);
10088 /* Manage the dialog, so that list boxes get filled. */
10089 XtManageChild (dialog
);
10091 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10092 must include the path for this to work. */
10093 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
10094 if (STRINGP (default_filename
))
10096 XmString default_xmstring
;
10100 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
10102 if (!XmListItemExists (list
, default_xmstring
))
10104 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10105 XmListAddItem (list
, default_xmstring
, 0);
10109 item_pos
= XmListItemPos (list
, default_xmstring
);
10110 XmStringFree (default_xmstring
);
10112 /* Select the item and scroll it into view. */
10113 XmListSelectPos (list
, item_pos
, True
);
10114 XmListSetPos (list
, item_pos
);
10117 #ifdef HAVE_MOTIF_2_1
10119 /* Process events until the user presses Cancel or OK. */
10121 while (result
== 0 || XtAppPending (Xt_app_con
))
10122 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
10124 #else /* not HAVE_MOTIF_2_1 */
10126 /* Process all events until the user presses Cancel or OK. */
10127 for (result
= 0; result
== 0;)
10130 Widget widget
, parent
;
10132 XtAppNextEvent (Xt_app_con
, &event
);
10134 /* See if the receiver of the event is one of the widgets of
10135 the file selection dialog. If so, dispatch it. If not,
10137 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
10139 while (parent
&& parent
!= dialog
)
10140 parent
= XtParent (parent
);
10142 if (parent
== dialog
10143 || (event
.type
== Expose
10144 && !process_expose_from_menu (event
)))
10145 XtDispatchEvent (&event
);
10148 #endif /* not HAVE_MOTIF_2_1 */
10150 /* Get the result. */
10151 if (result
== XmCR_OK
)
10156 XtVaGetValues (dialog
, XmNtextString
, &text
, 0);
10157 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
10158 XmStringFree (text
);
10159 file
= build_string (data
);
10166 XtUnmanageChild (dialog
);
10167 XtDestroyWidget (dialog
);
10171 /* Make "Cancel" equivalent to C-g. */
10173 Fsignal (Qquit
, Qnil
);
10175 return unbind_to (count
, file
);
10178 #endif /* USE_MOTIF */
10182 /***********************************************************************
10184 ***********************************************************************/
10189 /* This is zero if not using X windows. */
10192 /* The section below is built by the lisp expression at the top of the file,
10193 just above where these variables are declared. */
10194 /*&&& init symbols here &&&*/
10195 Qauto_raise
= intern ("auto-raise");
10196 staticpro (&Qauto_raise
);
10197 Qauto_lower
= intern ("auto-lower");
10198 staticpro (&Qauto_lower
);
10199 Qbar
= intern ("bar");
10201 Qborder_color
= intern ("border-color");
10202 staticpro (&Qborder_color
);
10203 Qborder_width
= intern ("border-width");
10204 staticpro (&Qborder_width
);
10205 Qbox
= intern ("box");
10207 Qcursor_color
= intern ("cursor-color");
10208 staticpro (&Qcursor_color
);
10209 Qcursor_type
= intern ("cursor-type");
10210 staticpro (&Qcursor_type
);
10211 Qgeometry
= intern ("geometry");
10212 staticpro (&Qgeometry
);
10213 Qicon_left
= intern ("icon-left");
10214 staticpro (&Qicon_left
);
10215 Qicon_top
= intern ("icon-top");
10216 staticpro (&Qicon_top
);
10217 Qicon_type
= intern ("icon-type");
10218 staticpro (&Qicon_type
);
10219 Qicon_name
= intern ("icon-name");
10220 staticpro (&Qicon_name
);
10221 Qinternal_border_width
= intern ("internal-border-width");
10222 staticpro (&Qinternal_border_width
);
10223 Qleft
= intern ("left");
10224 staticpro (&Qleft
);
10225 Qright
= intern ("right");
10226 staticpro (&Qright
);
10227 Qmouse_color
= intern ("mouse-color");
10228 staticpro (&Qmouse_color
);
10229 Qnone
= intern ("none");
10230 staticpro (&Qnone
);
10231 Qparent_id
= intern ("parent-id");
10232 staticpro (&Qparent_id
);
10233 Qscroll_bar_width
= intern ("scroll-bar-width");
10234 staticpro (&Qscroll_bar_width
);
10235 Qsuppress_icon
= intern ("suppress-icon");
10236 staticpro (&Qsuppress_icon
);
10237 Qundefined_color
= intern ("undefined-color");
10238 staticpro (&Qundefined_color
);
10239 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10240 staticpro (&Qvertical_scroll_bars
);
10241 Qvisibility
= intern ("visibility");
10242 staticpro (&Qvisibility
);
10243 Qwindow_id
= intern ("window-id");
10244 staticpro (&Qwindow_id
);
10245 Qouter_window_id
= intern ("outer-window-id");
10246 staticpro (&Qouter_window_id
);
10247 Qx_frame_parameter
= intern ("x-frame-parameter");
10248 staticpro (&Qx_frame_parameter
);
10249 Qx_resource_name
= intern ("x-resource-name");
10250 staticpro (&Qx_resource_name
);
10251 Quser_position
= intern ("user-position");
10252 staticpro (&Quser_position
);
10253 Quser_size
= intern ("user-size");
10254 staticpro (&Quser_size
);
10255 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10256 staticpro (&Qscroll_bar_foreground
);
10257 Qscroll_bar_background
= intern ("scroll-bar-background");
10258 staticpro (&Qscroll_bar_background
);
10259 Qscreen_gamma
= intern ("screen-gamma");
10260 staticpro (&Qscreen_gamma
);
10261 Qline_spacing
= intern ("line-spacing");
10262 staticpro (&Qline_spacing
);
10263 Qcenter
= intern ("center");
10264 staticpro (&Qcenter
);
10265 /* This is the end of symbol initialization. */
10267 /* Text property `display' should be nonsticky by default. */
10268 Vtext_property_default_nonsticky
10269 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
10272 Qlaplace
= intern ("laplace");
10273 staticpro (&Qlaplace
);
10275 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10276 staticpro (&Qface_set_after_frame_default
);
10278 Fput (Qundefined_color
, Qerror_conditions
,
10279 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10280 Fput (Qundefined_color
, Qerror_message
,
10281 build_string ("Undefined color"));
10283 init_x_parm_symbols ();
10285 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
10286 "List of directories to search for bitmap files for X.");
10287 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
10289 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
10290 "The shape of the pointer when over text.\n\
10291 Changing the value does not affect existing frames\n\
10292 unless you set the mouse color.");
10293 Vx_pointer_shape
= Qnil
;
10295 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
10296 "The name Emacs uses to look up X resources.\n\
10297 `x-get-resource' uses this as the first component of the instance name\n\
10298 when requesting resource values.\n\
10299 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10300 was invoked, or to the value specified with the `-name' or `-rn'\n\
10301 switches, if present.\n\
10303 It may be useful to bind this variable locally around a call\n\
10304 to `x-get-resource'. See also the variable `x-resource-class'.");
10305 Vx_resource_name
= Qnil
;
10307 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
10308 "The class Emacs uses to look up X resources.\n\
10309 `x-get-resource' uses this as the first component of the instance class\n\
10310 when requesting resource values.\n\
10311 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10313 Setting this variable permanently is not a reasonable thing to do,\n\
10314 but binding this variable locally around a call to `x-get-resource'\n\
10315 is a reasonable practice. See also the variable `x-resource-name'.");
10316 Vx_resource_class
= build_string (EMACS_CLASS
);
10318 #if 0 /* This doesn't really do anything. */
10319 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
10320 "The shape of the pointer when not over text.\n\
10321 This variable takes effect when you create a new frame\n\
10322 or when you set the mouse color.");
10324 Vx_nontext_pointer_shape
= Qnil
;
10326 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
10327 "The shape of the pointer when Emacs is busy.\n\
10328 This variable takes effect when you create a new frame\n\
10329 or when you set the mouse color.");
10330 Vx_busy_pointer_shape
= Qnil
;
10332 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
10333 "Non-zero means Emacs displays a busy cursor on window systems.");
10334 display_busy_cursor_p
= 1;
10336 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay
,
10337 "*Seconds to wait before displaying a busy-cursor.\n\
10338 Value must be an integer or float.");
10339 Vbusy_cursor_delay
= make_number (DEFAULT_BUSY_CURSOR_DELAY
);
10341 #if 0 /* This doesn't really do anything. */
10342 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
10343 "The shape of the pointer when over the mode line.\n\
10344 This variable takes effect when you create a new frame\n\
10345 or when you set the mouse color.");
10347 Vx_mode_pointer_shape
= Qnil
;
10349 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10350 &Vx_sensitive_text_pointer_shape
,
10351 "The shape of the pointer when over mouse-sensitive text.\n\
10352 This variable takes effect when you create a new frame\n\
10353 or when you set the mouse color.");
10354 Vx_sensitive_text_pointer_shape
= Qnil
;
10356 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
10357 "A string indicating the foreground color of the cursor box.");
10358 Vx_cursor_fore_pixel
= Qnil
;
10360 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
10361 "Non-nil if no X window manager is in use.\n\
10362 Emacs doesn't try to figure this out; this is always nil\n\
10363 unless you set it to something else.");
10364 /* We don't have any way to find this out, so set it to nil
10365 and maybe the user would like to set it to t. */
10366 Vx_no_window_manager
= Qnil
;
10368 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
10369 &Vx_pixel_size_width_font_regexp
,
10370 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
10372 Since Emacs gets width of a font matching with this regexp from\n\
10373 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
10374 such a font. This is especially effective for such large fonts as\n\
10375 Chinese, Japanese, and Korean.");
10376 Vx_pixel_size_width_font_regexp
= Qnil
;
10378 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
10379 "Time after which cached images are removed from the cache.\n\
10380 When an image has not been displayed this many seconds, remove it\n\
10381 from the image cache. Value must be an integer or nil with nil\n\
10382 meaning don't clear the cache.");
10383 Vimage_cache_eviction_delay
= make_number (30 * 60);
10385 #ifdef USE_X_TOOLKIT
10386 Fprovide (intern ("x-toolkit"));
10389 Fprovide (intern ("motif"));
10392 defsubr (&Sx_get_resource
);
10394 /* X window properties. */
10395 defsubr (&Sx_change_window_property
);
10396 defsubr (&Sx_delete_window_property
);
10397 defsubr (&Sx_window_property
);
10399 defsubr (&Sxw_display_color_p
);
10400 defsubr (&Sx_display_grayscale_p
);
10401 defsubr (&Sxw_color_defined_p
);
10402 defsubr (&Sxw_color_values
);
10403 defsubr (&Sx_server_max_request_size
);
10404 defsubr (&Sx_server_vendor
);
10405 defsubr (&Sx_server_version
);
10406 defsubr (&Sx_display_pixel_width
);
10407 defsubr (&Sx_display_pixel_height
);
10408 defsubr (&Sx_display_mm_width
);
10409 defsubr (&Sx_display_mm_height
);
10410 defsubr (&Sx_display_screens
);
10411 defsubr (&Sx_display_planes
);
10412 defsubr (&Sx_display_color_cells
);
10413 defsubr (&Sx_display_visual_class
);
10414 defsubr (&Sx_display_backing_store
);
10415 defsubr (&Sx_display_save_under
);
10416 defsubr (&Sx_parse_geometry
);
10417 defsubr (&Sx_create_frame
);
10418 defsubr (&Sx_open_connection
);
10419 defsubr (&Sx_close_connection
);
10420 defsubr (&Sx_display_list
);
10421 defsubr (&Sx_synchronize
);
10422 defsubr (&Sx_focus_frame
);
10424 /* Setting callback functions for fontset handler. */
10425 get_font_info_func
= x_get_font_info
;
10427 #if 0 /* This function pointer doesn't seem to be used anywhere.
10428 And the pointer assigned has the wrong type, anyway. */
10429 list_fonts_func
= x_list_fonts
;
10432 load_font_func
= x_load_font
;
10433 find_ccl_program_func
= x_find_ccl_program
;
10434 query_font_func
= x_query_font
;
10435 set_frame_fontset_func
= x_set_font
;
10436 check_window_system_func
= check_x
;
10439 Qxbm
= intern ("xbm");
10441 QCtype
= intern (":type");
10442 staticpro (&QCtype
);
10443 QCalgorithm
= intern (":algorithm");
10444 staticpro (&QCalgorithm
);
10445 QCheuristic_mask
= intern (":heuristic-mask");
10446 staticpro (&QCheuristic_mask
);
10447 QCcolor_symbols
= intern (":color-symbols");
10448 staticpro (&QCcolor_symbols
);
10449 QCascent
= intern (":ascent");
10450 staticpro (&QCascent
);
10451 QCmargin
= intern (":margin");
10452 staticpro (&QCmargin
);
10453 QCrelief
= intern (":relief");
10454 staticpro (&QCrelief
);
10455 Qpostscript
= intern ("postscript");
10456 staticpro (&Qpostscript
);
10457 QCloader
= intern (":loader");
10458 staticpro (&QCloader
);
10459 QCbounding_box
= intern (":bounding-box");
10460 staticpro (&QCbounding_box
);
10461 QCpt_width
= intern (":pt-width");
10462 staticpro (&QCpt_width
);
10463 QCpt_height
= intern (":pt-height");
10464 staticpro (&QCpt_height
);
10465 QCindex
= intern (":index");
10466 staticpro (&QCindex
);
10467 Qpbm
= intern ("pbm");
10471 Qxpm
= intern ("xpm");
10476 Qjpeg
= intern ("jpeg");
10477 staticpro (&Qjpeg
);
10481 Qtiff
= intern ("tiff");
10482 staticpro (&Qtiff
);
10486 Qgif
= intern ("gif");
10491 Qpng
= intern ("png");
10495 defsubr (&Sclear_image_cache
);
10496 defsubr (&Simage_size
);
10498 busy_cursor_atimer
= NULL
;
10499 busy_cursor_shown_p
= 0;
10501 defsubr (&Sx_show_tip
);
10502 defsubr (&Sx_hide_tip
);
10503 staticpro (&tip_timer
);
10507 defsubr (&Sx_file_dialog
);
10515 image_types
= NULL
;
10516 Vimage_types
= Qnil
;
10518 define_image_type (&xbm_type
);
10519 define_image_type (&gs_type
);
10520 define_image_type (&pbm_type
);
10523 define_image_type (&xpm_type
);
10527 define_image_type (&jpeg_type
);
10531 define_image_type (&tiff_type
);
10535 define_image_type (&gif_type
);
10539 define_image_type (&png_type
);
10543 #endif /* HAVE_X_WINDOWS */