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"
45 #include "termhooks.h"
51 #include <sys/types.h>
55 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
56 #include "bitmaps/gray.xbm"
58 #include <X11/bitmaps/gray>
61 #include "[.bitmaps]gray.xbm"
65 #include <X11/Shell.h>
68 #include <X11/Xaw/Paned.h>
69 #include <X11/Xaw/Label.h>
70 #endif /* USE_MOTIF */
73 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
82 #include "../lwlib/lwlib.h"
86 #include <Xm/DialogS.h>
87 #include <Xm/FileSB.h>
90 /* Do the EDITRES protocol if running X11R5
91 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
93 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
95 extern void _XEditResCheckMessages ();
96 #endif /* R5 + Athena */
98 /* Unique id counter for widgets created by the Lucid Widget Library. */
100 extern LWLIB_ID widget_id_tick
;
103 /* This is part of a kludge--see lwlib/xlwmenu.c. */
104 extern XFontStruct
*xlwmenu_default_font
;
107 extern void free_frame_menubar ();
108 extern double atof ();
110 #endif /* USE_X_TOOLKIT */
112 #define min(a,b) ((a) < (b) ? (a) : (b))
113 #define max(a,b) ((a) > (b) ? (a) : (b))
116 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
118 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
121 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
122 it, and including `bitmaps/gray' more than once is a problem when
123 config.h defines `static' as an empty replacement string. */
125 int gray_bitmap_width
= gray_width
;
126 int gray_bitmap_height
= gray_height
;
127 unsigned char *gray_bitmap_bits
= gray_bits
;
129 /* The name we're using in resource queries. Most often "emacs". */
131 Lisp_Object Vx_resource_name
;
133 /* The application class we're using in resource queries.
136 Lisp_Object Vx_resource_class
;
138 /* Non-zero means we're allowed to display a busy cursor. */
140 int display_busy_cursor_p
;
142 /* The background and shape of the mouse pointer, and shape when not
143 over text or in the modeline. */
145 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
146 Lisp_Object Vx_busy_pointer_shape
;
148 /* The shape when over mouse-sensitive text. */
150 Lisp_Object Vx_sensitive_text_pointer_shape
;
152 /* Color of chars displayed in cursor box. */
154 Lisp_Object Vx_cursor_fore_pixel
;
156 /* Nonzero if using X. */
160 /* Non nil if no window manager is in use. */
162 Lisp_Object Vx_no_window_manager
;
164 /* Search path for bitmap files. */
166 Lisp_Object Vx_bitmap_file_path
;
168 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
170 Lisp_Object Vx_pixel_size_width_font_regexp
;
172 /* Evaluate this expression to rebuild the section of syms_of_xfns
173 that initializes and staticpros the symbols declared below. Note
174 that Emacs 18 has a bug that keeps C-x C-e from being able to
175 evaluate this expression.
178 ;; Accumulate a list of the symbols we want to initialize from the
179 ;; declarations at the top of the file.
180 (goto-char (point-min))
181 (search-forward "/\*&&& symbols declared here &&&*\/\n")
183 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
185 (cons (buffer-substring (match-beginning 1) (match-end 1))
188 (setq symbol-list (nreverse symbol-list))
189 ;; Delete the section of syms_of_... where we initialize the symbols.
190 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
191 (let ((start (point)))
192 (while (looking-at "^ Q")
194 (kill-region start (point)))
195 ;; Write a new symbol initialization section.
197 (insert (format " %s = intern (\"" (car symbol-list)))
198 (let ((start (point)))
199 (insert (substring (car symbol-list) 1))
200 (subst-char-in-region start (point) ?_ ?-))
201 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
202 (setq symbol-list (cdr symbol-list)))))
206 /*&&& symbols declared here &&&*/
207 Lisp_Object Qauto_raise
;
208 Lisp_Object Qauto_lower
;
210 Lisp_Object Qborder_color
;
211 Lisp_Object Qborder_width
;
213 Lisp_Object Qcursor_color
;
214 Lisp_Object Qcursor_type
;
215 Lisp_Object Qgeometry
;
216 Lisp_Object Qicon_left
;
217 Lisp_Object Qicon_top
;
218 Lisp_Object Qicon_type
;
219 Lisp_Object Qicon_name
;
220 Lisp_Object Qinternal_border_width
;
223 Lisp_Object Qmouse_color
;
225 Lisp_Object Qouter_window_id
;
226 Lisp_Object Qparent_id
;
227 Lisp_Object Qscroll_bar_width
;
228 Lisp_Object Qsuppress_icon
;
229 extern Lisp_Object Qtop
;
230 Lisp_Object Qundefined_color
;
231 Lisp_Object Qvertical_scroll_bars
;
232 Lisp_Object Qvisibility
;
233 Lisp_Object Qwindow_id
;
234 Lisp_Object Qx_frame_parameter
;
235 Lisp_Object Qx_resource_name
;
236 Lisp_Object Quser_position
;
237 Lisp_Object Quser_size
;
238 extern Lisp_Object Qdisplay
;
239 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
240 Lisp_Object Qscreen_gamma
, Qline_spacing
, Qcenter
;
241 Lisp_Object Qcompound_text
;
243 /* The below are defined in frame.c. */
245 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
246 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
247 extern Lisp_Object Qtool_bar_lines
;
249 extern Lisp_Object Vwindow_system_version
;
251 Lisp_Object Qface_set_after_frame_default
;
254 /* Error if we are not connected to X. */
260 error ("X windows are not in use or not initialized");
263 /* Nonzero if we can use mouse menus.
264 You should not call this unless HAVE_MENUS is defined. */
272 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
273 and checking validity for X. */
276 check_x_frame (frame
)
282 frame
= selected_frame
;
283 CHECK_LIVE_FRAME (frame
, 0);
286 error ("Non-X frame used");
290 /* Let the user specify an X display with a frame.
291 nil stands for the selected frame--or, if that is not an X frame,
292 the first X display on the list. */
294 static struct x_display_info
*
295 check_x_display_info (frame
)
298 struct x_display_info
*dpyinfo
= NULL
;
302 struct frame
*sf
= XFRAME (selected_frame
);
304 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
305 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
306 else if (x_display_list
!= 0)
307 dpyinfo
= x_display_list
;
309 error ("X windows are not in use or not initialized");
311 else if (STRINGP (frame
))
312 dpyinfo
= x_display_info_for_name (frame
);
317 CHECK_LIVE_FRAME (frame
, 0);
320 error ("Non-X frame used");
321 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
328 /* Return the Emacs frame-object corresponding to an X window.
329 It could be the frame's main window or an icon window. */
331 /* This function can be called during GC, so use GC_xxx type test macros. */
334 x_window_to_frame (dpyinfo
, wdesc
)
335 struct x_display_info
*dpyinfo
;
338 Lisp_Object tail
, frame
;
341 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
344 if (!GC_FRAMEP (frame
))
347 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
349 if (f
->output_data
.x
->busy_window
== wdesc
)
352 if ((f
->output_data
.x
->edit_widget
353 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
354 /* A tooltip frame? */
355 || (!f
->output_data
.x
->edit_widget
356 && FRAME_X_WINDOW (f
) == wdesc
)
357 || f
->output_data
.x
->icon_desc
== wdesc
)
359 #else /* not USE_X_TOOLKIT */
360 if (FRAME_X_WINDOW (f
) == wdesc
361 || f
->output_data
.x
->icon_desc
== wdesc
)
363 #endif /* not USE_X_TOOLKIT */
369 /* Like x_window_to_frame but also compares the window with the widget's
373 x_any_window_to_frame (dpyinfo
, wdesc
)
374 struct x_display_info
*dpyinfo
;
377 Lisp_Object tail
, frame
;
378 struct frame
*f
, *found
;
382 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
385 if (!GC_FRAMEP (frame
))
389 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
391 /* This frame matches if the window is any of its widgets. */
392 x
= f
->output_data
.x
;
393 if (x
->busy_window
== wdesc
)
397 if (wdesc
== XtWindow (x
->widget
)
398 || wdesc
== XtWindow (x
->column_widget
)
399 || wdesc
== XtWindow (x
->edit_widget
))
401 /* Match if the window is this frame's menubar. */
402 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
405 else if (FRAME_X_WINDOW (f
) == wdesc
)
406 /* A tooltip frame. */
414 /* Likewise, but exclude the menu bar widget. */
417 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
418 struct x_display_info
*dpyinfo
;
421 Lisp_Object tail
, frame
;
425 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
428 if (!GC_FRAMEP (frame
))
431 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
433 x
= f
->output_data
.x
;
434 /* This frame matches if the window is any of its widgets. */
435 if (x
->busy_window
== wdesc
)
439 if (wdesc
== XtWindow (x
->widget
)
440 || wdesc
== XtWindow (x
->column_widget
)
441 || wdesc
== XtWindow (x
->edit_widget
))
444 else if (FRAME_X_WINDOW (f
) == wdesc
)
445 /* A tooltip frame. */
451 /* Likewise, but consider only the menu bar widget. */
454 x_menubar_window_to_frame (dpyinfo
, wdesc
)
455 struct x_display_info
*dpyinfo
;
458 Lisp_Object tail
, frame
;
462 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
465 if (!GC_FRAMEP (frame
))
468 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
470 x
= f
->output_data
.x
;
471 /* Match if the window is this frame's menubar. */
472 if (x
->menubar_widget
473 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
479 /* Return the frame whose principal (outermost) window is WDESC.
480 If WDESC is some other (smaller) window, we return 0. */
483 x_top_window_to_frame (dpyinfo
, wdesc
)
484 struct x_display_info
*dpyinfo
;
487 Lisp_Object tail
, frame
;
491 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
494 if (!GC_FRAMEP (frame
))
497 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
499 x
= f
->output_data
.x
;
503 /* This frame matches if the window is its topmost widget. */
504 if (wdesc
== XtWindow (x
->widget
))
506 #if 0 /* I don't know why it did this,
507 but it seems logically wrong,
508 and it causes trouble for MapNotify events. */
509 /* Match if the window is this frame's menubar. */
510 if (x
->menubar_widget
511 && wdesc
== XtWindow (x
->menubar_widget
))
515 else if (FRAME_X_WINDOW (f
) == wdesc
)
521 #endif /* USE_X_TOOLKIT */
525 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
526 id, which is just an int that this section returns. Bitmaps are
527 reference counted so they can be shared among frames.
529 Bitmap indices are guaranteed to be > 0, so a negative number can
530 be used to indicate no bitmap.
532 If you use x_create_bitmap_from_data, then you must keep track of
533 the bitmaps yourself. That is, creating a bitmap from the same
534 data more than once will not be caught. */
537 /* Functions to access the contents of a bitmap, given an id. */
540 x_bitmap_height (f
, id
)
544 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
548 x_bitmap_width (f
, id
)
552 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
556 x_bitmap_pixmap (f
, id
)
560 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
564 /* Allocate a new bitmap record. Returns index of new record. */
567 x_allocate_bitmap_record (f
)
570 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
573 if (dpyinfo
->bitmaps
== NULL
)
575 dpyinfo
->bitmaps_size
= 10;
577 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
578 dpyinfo
->bitmaps_last
= 1;
582 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
583 return ++dpyinfo
->bitmaps_last
;
585 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
586 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
589 dpyinfo
->bitmaps_size
*= 2;
591 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
592 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
593 return ++dpyinfo
->bitmaps_last
;
596 /* Add one reference to the reference count of the bitmap with id ID. */
599 x_reference_bitmap (f
, id
)
603 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
606 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
609 x_create_bitmap_from_data (f
, bits
, width
, height
)
612 unsigned int width
, height
;
614 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
618 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
619 bits
, width
, height
);
624 id
= x_allocate_bitmap_record (f
);
625 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
626 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
627 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
628 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
629 dpyinfo
->bitmaps
[id
- 1].height
= height
;
630 dpyinfo
->bitmaps
[id
- 1].width
= width
;
635 /* Create bitmap from file FILE for frame F. */
638 x_create_bitmap_from_file (f
, file
)
642 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
643 unsigned int width
, height
;
645 int xhot
, yhot
, result
, id
;
650 /* Look for an existing bitmap with the same name. */
651 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
653 if (dpyinfo
->bitmaps
[id
].refcount
654 && dpyinfo
->bitmaps
[id
].file
655 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
657 ++dpyinfo
->bitmaps
[id
].refcount
;
662 /* Search bitmap-file-path for the file, if appropriate. */
663 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
666 /* XReadBitmapFile won't handle magic file names. */
671 filename
= (char *) XSTRING (found
)->data
;
673 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
674 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
675 if (result
!= BitmapSuccess
)
678 id
= x_allocate_bitmap_record (f
);
679 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
680 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
681 dpyinfo
->bitmaps
[id
- 1].file
682 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
683 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
684 dpyinfo
->bitmaps
[id
- 1].height
= height
;
685 dpyinfo
->bitmaps
[id
- 1].width
= width
;
686 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
691 /* Remove reference to bitmap with id number ID. */
694 x_destroy_bitmap (f
, id
)
698 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
702 --dpyinfo
->bitmaps
[id
- 1].refcount
;
703 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
706 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
707 if (dpyinfo
->bitmaps
[id
- 1].file
)
709 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
710 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
717 /* Free all the bitmaps for the display specified by DPYINFO. */
720 x_destroy_all_bitmaps (dpyinfo
)
721 struct x_display_info
*dpyinfo
;
724 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
725 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
727 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
728 if (dpyinfo
->bitmaps
[i
].file
)
729 xfree (dpyinfo
->bitmaps
[i
].file
);
731 dpyinfo
->bitmaps_last
= 0;
734 /* Connect the frame-parameter names for X frames
735 to the ways of passing the parameter values to the window system.
737 The name of a parameter, as a Lisp symbol,
738 has an `x-frame-parameter' property which is an integer in Lisp
739 that is an index in this table. */
741 struct x_frame_parm_table
744 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 static void x_change_window_heights
P_ ((Lisp_Object
, int));
748 static void x_disable_image
P_ ((struct frame
*, struct image
*));
749 static void x_create_im
P_ ((struct frame
*));
750 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
755 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
759 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
760 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
761 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
763 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
764 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
765 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
766 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
768 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
769 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
770 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
771 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
772 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
773 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
774 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
776 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
778 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
783 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
784 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
786 static void init_color_table
P_ ((void));
787 static void free_color_table
P_ ((void));
788 static unsigned long *colors_in_color_table
P_ ((int *n
));
789 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
790 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
794 static struct x_frame_parm_table x_frame_parms
[] =
796 "auto-raise", x_set_autoraise
,
797 "auto-lower", x_set_autolower
,
798 "background-color", x_set_background_color
,
799 "border-color", x_set_border_color
,
800 "border-width", x_set_border_width
,
801 "cursor-color", x_set_cursor_color
,
802 "cursor-type", x_set_cursor_type
,
804 "foreground-color", x_set_foreground_color
,
805 "icon-name", x_set_icon_name
,
806 "icon-type", x_set_icon_type
,
807 "internal-border-width", x_set_internal_border_width
,
808 "menu-bar-lines", x_set_menu_bar_lines
,
809 "mouse-color", x_set_mouse_color
,
810 "name", x_explicitly_set_name
,
811 "scroll-bar-width", x_set_scroll_bar_width
,
812 "title", x_set_title
,
813 "unsplittable", x_set_unsplittable
,
814 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
815 "visibility", x_set_visibility
,
816 "tool-bar-lines", x_set_tool_bar_lines
,
817 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
818 "scroll-bar-background", x_set_scroll_bar_background
,
819 "screen-gamma", x_set_screen_gamma
,
820 "line-spacing", x_set_line_spacing
823 /* Attach the `x-frame-parameter' properties to
824 the Lisp symbol names of parameters relevant to X. */
827 init_x_parm_symbols ()
831 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
832 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
836 /* Change the parameters of frame F as specified by ALIST.
837 If a parameter is not specially recognized, do nothing special;
838 otherwise call the `x_set_...' function for that parameter.
839 Except for certain geometry properties, always call store_frame_param
840 to store the new value in the parameter alist. */
843 x_set_frame_parameters (f
, alist
)
849 /* If both of these parameters are present, it's more efficient to
850 set them both at once. So we wait until we've looked at the
851 entire list before we set them. */
855 Lisp_Object left
, top
;
857 /* Same with these. */
858 Lisp_Object icon_left
, icon_top
;
860 /* Record in these vectors all the parms specified. */
864 int left_no_change
= 0, top_no_change
= 0;
865 int icon_left_no_change
= 0, icon_top_no_change
= 0;
867 struct gcpro gcpro1
, gcpro2
;
870 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
873 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
874 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
876 /* Extract parm names and values into those vectors. */
879 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
884 parms
[i
] = Fcar (elt
);
885 values
[i
] = Fcdr (elt
);
888 /* TAIL and ALIST are not used again below here. */
891 GCPRO2 (*parms
, *values
);
895 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
896 because their values appear in VALUES and strings are not valid. */
897 top
= left
= Qunbound
;
898 icon_left
= icon_top
= Qunbound
;
900 /* Provide default values for HEIGHT and WIDTH. */
901 if (FRAME_NEW_WIDTH (f
))
902 width
= FRAME_NEW_WIDTH (f
);
904 width
= FRAME_WIDTH (f
);
906 if (FRAME_NEW_HEIGHT (f
))
907 height
= FRAME_NEW_HEIGHT (f
);
909 height
= FRAME_HEIGHT (f
);
911 /* Process foreground_color and background_color before anything else.
912 They are independent of other properties, but other properties (e.g.,
913 cursor_color) are dependent upon them. */
914 for (p
= 0; p
< i
; p
++)
916 Lisp_Object prop
, val
;
920 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
922 register Lisp_Object param_index
, old_value
;
924 param_index
= Fget (prop
, Qx_frame_parameter
);
925 old_value
= get_frame_param (f
, prop
);
926 store_frame_param (f
, prop
, val
);
927 if (NATNUMP (param_index
)
928 && (XFASTINT (param_index
)
929 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
930 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
934 /* Now process them in reverse of specified order. */
935 for (i
--; i
>= 0; i
--)
937 Lisp_Object prop
, val
;
942 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
943 width
= XFASTINT (val
);
944 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
945 height
= XFASTINT (val
);
946 else if (EQ (prop
, Qtop
))
948 else if (EQ (prop
, Qleft
))
950 else if (EQ (prop
, Qicon_top
))
952 else if (EQ (prop
, Qicon_left
))
954 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
955 /* Processed above. */
959 register Lisp_Object param_index
, old_value
;
961 param_index
= Fget (prop
, Qx_frame_parameter
);
962 old_value
= get_frame_param (f
, prop
);
963 store_frame_param (f
, prop
, val
);
964 if (NATNUMP (param_index
)
965 && (XFASTINT (param_index
)
966 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
967 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
971 /* Don't die if just one of these was set. */
972 if (EQ (left
, Qunbound
))
975 if (f
->output_data
.x
->left_pos
< 0)
976 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
978 XSETINT (left
, f
->output_data
.x
->left_pos
);
980 if (EQ (top
, Qunbound
))
983 if (f
->output_data
.x
->top_pos
< 0)
984 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
986 XSETINT (top
, f
->output_data
.x
->top_pos
);
989 /* If one of the icon positions was not set, preserve or default it. */
990 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
992 icon_left_no_change
= 1;
993 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
994 if (NILP (icon_left
))
995 XSETINT (icon_left
, 0);
997 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
999 icon_top_no_change
= 1;
1000 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
1001 if (NILP (icon_top
))
1002 XSETINT (icon_top
, 0);
1005 /* Don't set these parameters unless they've been explicitly
1006 specified. The window might be mapped or resized while we're in
1007 this function, and we don't want to override that unless the lisp
1008 code has asked for it.
1010 Don't set these parameters unless they actually differ from the
1011 window's current parameters; the window may not actually exist
1016 check_frame_size (f
, &height
, &width
);
1018 XSETFRAME (frame
, f
);
1020 if (width
!= FRAME_WIDTH (f
)
1021 || height
!= FRAME_HEIGHT (f
)
1022 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1023 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1025 if ((!NILP (left
) || !NILP (top
))
1026 && ! (left_no_change
&& top_no_change
)
1027 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1028 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1033 /* Record the signs. */
1034 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1035 if (EQ (left
, Qminus
))
1036 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1037 else if (INTEGERP (left
))
1039 leftpos
= XINT (left
);
1041 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1043 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1044 && CONSP (XCDR (left
))
1045 && INTEGERP (XCAR (XCDR (left
))))
1047 leftpos
= - XINT (XCAR (XCDR (left
)));
1048 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1050 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1051 && CONSP (XCDR (left
))
1052 && INTEGERP (XCAR (XCDR (left
))))
1054 leftpos
= XINT (XCAR (XCDR (left
)));
1057 if (EQ (top
, Qminus
))
1058 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1059 else if (INTEGERP (top
))
1061 toppos
= XINT (top
);
1063 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1065 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1066 && CONSP (XCDR (top
))
1067 && INTEGERP (XCAR (XCDR (top
))))
1069 toppos
= - XINT (XCAR (XCDR (top
)));
1070 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1072 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1073 && CONSP (XCDR (top
))
1074 && INTEGERP (XCAR (XCDR (top
))))
1076 toppos
= XINT (XCAR (XCDR (top
)));
1080 /* Store the numeric value of the position. */
1081 f
->output_data
.x
->top_pos
= toppos
;
1082 f
->output_data
.x
->left_pos
= leftpos
;
1084 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1086 /* Actually set that position, and convert to absolute. */
1087 x_set_offset (f
, leftpos
, toppos
, -1);
1090 if ((!NILP (icon_left
) || !NILP (icon_top
))
1091 && ! (icon_left_no_change
&& icon_top_no_change
))
1092 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1098 /* Store the screen positions of frame F into XPTR and YPTR.
1099 These are the positions of the containing window manager window,
1100 not Emacs's own window. */
1103 x_real_positions (f
, xptr
, yptr
)
1110 /* This is pretty gross, but seems to be the easiest way out of
1111 the problem that arises when restarting window-managers. */
1113 #ifdef USE_X_TOOLKIT
1114 Window outer
= (f
->output_data
.x
->widget
1115 ? XtWindow (f
->output_data
.x
->widget
)
1116 : FRAME_X_WINDOW (f
));
1118 Window outer
= f
->output_data
.x
->window_desc
;
1120 Window tmp_root_window
;
1121 Window
*tmp_children
;
1122 unsigned int tmp_nchildren
;
1126 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1127 Window outer_window
;
1129 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1130 &f
->output_data
.x
->parent_desc
,
1131 &tmp_children
, &tmp_nchildren
);
1132 XFree ((char *) tmp_children
);
1136 /* Find the position of the outside upper-left corner of
1137 the inner window, with respect to the outer window. */
1138 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1139 outer_window
= f
->output_data
.x
->parent_desc
;
1141 outer_window
= outer
;
1143 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1145 /* From-window, to-window. */
1147 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1149 /* From-position, to-position. */
1150 0, 0, &win_x
, &win_y
,
1155 /* It is possible for the window returned by the XQueryNotify
1156 to become invalid by the time we call XTranslateCoordinates.
1157 That can happen when you restart some window managers.
1158 If so, we get an error in XTranslateCoordinates.
1159 Detect that and try the whole thing over. */
1160 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1162 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1166 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1173 /* Insert a description of internally-recorded parameters of frame X
1174 into the parameter alist *ALISTPTR that is to be given to the user.
1175 Only parameters that are specific to the X window system
1176 and whose values are not correctly recorded in the frame's
1177 param_alist need to be considered here. */
1180 x_report_frame_params (f
, alistptr
)
1182 Lisp_Object
*alistptr
;
1187 /* Represent negative positions (off the top or left screen edge)
1188 in a way that Fmodify_frame_parameters will understand correctly. */
1189 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1190 if (f
->output_data
.x
->left_pos
>= 0)
1191 store_in_alist (alistptr
, Qleft
, tem
);
1193 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1195 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1196 if (f
->output_data
.x
->top_pos
>= 0)
1197 store_in_alist (alistptr
, Qtop
, tem
);
1199 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1201 store_in_alist (alistptr
, Qborder_width
,
1202 make_number (f
->output_data
.x
->border_width
));
1203 store_in_alist (alistptr
, Qinternal_border_width
,
1204 make_number (f
->output_data
.x
->internal_border_width
));
1205 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1206 store_in_alist (alistptr
, Qwindow_id
,
1207 build_string (buf
));
1208 #ifdef USE_X_TOOLKIT
1209 /* Tooltip frame may not have this widget. */
1210 if (f
->output_data
.x
->widget
)
1212 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1213 store_in_alist (alistptr
, Qouter_window_id
,
1214 build_string (buf
));
1215 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1216 FRAME_SAMPLE_VISIBILITY (f
);
1217 store_in_alist (alistptr
, Qvisibility
,
1218 (FRAME_VISIBLE_P (f
) ? Qt
1219 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1220 store_in_alist (alistptr
, Qdisplay
,
1221 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1223 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1226 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1227 store_in_alist (alistptr
, Qparent_id
, tem
);
1232 /* Gamma-correct COLOR on frame F. */
1235 gamma_correct (f
, color
)
1241 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1242 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1243 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1248 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1249 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1250 allocate the color. Value is zero if COLOR_NAME is invalid, or
1251 no color could be allocated. */
1254 x_defined_color (f
, color_name
, color
, alloc_p
)
1261 Display
*dpy
= FRAME_X_DISPLAY (f
);
1262 Colormap cmap
= FRAME_X_COLORMAP (f
);
1265 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1266 if (success_p
&& alloc_p
)
1267 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1274 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1275 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1276 Signal an error if color can't be allocated. */
1279 x_decode_color (f
, color_name
, mono_color
)
1281 Lisp_Object color_name
;
1286 CHECK_STRING (color_name
, 0);
1288 #if 0 /* Don't do this. It's wrong when we're not using the default
1289 colormap, it makes freeing difficult, and it's probably not
1290 an important optimization. */
1291 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1292 return BLACK_PIX_DEFAULT (f
);
1293 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1294 return WHITE_PIX_DEFAULT (f
);
1297 /* Return MONO_COLOR for monochrome frames. */
1298 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1301 /* x_defined_color is responsible for coping with failures
1302 by looking for a near-miss. */
1303 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1306 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1307 Fcons (color_name
, Qnil
)));
1313 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1314 the previous value of that parameter, NEW_VALUE is the new value. */
1317 x_set_line_spacing (f
, new_value
, old_value
)
1319 Lisp_Object new_value
, old_value
;
1321 if (NILP (new_value
))
1322 f
->extra_line_spacing
= 0;
1323 else if (NATNUMP (new_value
))
1324 f
->extra_line_spacing
= XFASTINT (new_value
);
1326 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1327 Fcons (new_value
, Qnil
)));
1328 if (FRAME_VISIBLE_P (f
))
1333 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1334 the previous value of that parameter, NEW_VALUE is the new value. */
1337 x_set_screen_gamma (f
, new_value
, old_value
)
1339 Lisp_Object new_value
, old_value
;
1341 if (NILP (new_value
))
1343 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1344 /* The value 0.4545 is the normal viewing gamma. */
1345 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1347 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1348 Fcons (new_value
, Qnil
)));
1350 clear_face_cache (0);
1354 /* Functions called only from `x_set_frame_param'
1355 to set individual parameters.
1357 If FRAME_X_WINDOW (f) is 0,
1358 the frame is being created and its X-window does not exist yet.
1359 In that case, just record the parameter's new value
1360 in the standard place; do not attempt to change the window. */
1363 x_set_foreground_color (f
, arg
, oldval
)
1365 Lisp_Object arg
, oldval
;
1368 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1370 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1371 f
->output_data
.x
->foreground_pixel
= pixel
;
1373 if (FRAME_X_WINDOW (f
) != 0)
1376 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1377 f
->output_data
.x
->foreground_pixel
);
1378 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1379 f
->output_data
.x
->foreground_pixel
);
1381 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1382 if (FRAME_VISIBLE_P (f
))
1388 x_set_background_color (f
, arg
, oldval
)
1390 Lisp_Object arg
, oldval
;
1393 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1395 unload_color (f
, f
->output_data
.x
->background_pixel
);
1396 f
->output_data
.x
->background_pixel
= pixel
;
1398 if (FRAME_X_WINDOW (f
) != 0)
1401 /* The main frame area. */
1402 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1403 f
->output_data
.x
->background_pixel
);
1404 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1405 f
->output_data
.x
->background_pixel
);
1406 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1407 f
->output_data
.x
->background_pixel
);
1408 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1409 f
->output_data
.x
->background_pixel
);
1412 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1413 bar
= XSCROLL_BAR (bar
)->next
)
1414 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1415 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1416 f
->output_data
.x
->background_pixel
);
1420 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1422 if (FRAME_VISIBLE_P (f
))
1428 x_set_mouse_color (f
, arg
, oldval
)
1430 Lisp_Object arg
, oldval
;
1432 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1435 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1436 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1438 /* Don't let pointers be invisible. */
1439 if (mask_color
== pixel
1440 && mask_color
== f
->output_data
.x
->background_pixel
)
1441 pixel
= f
->output_data
.x
->foreground_pixel
;
1443 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1444 f
->output_data
.x
->mouse_pixel
= pixel
;
1448 /* It's not okay to crash if the user selects a screwy cursor. */
1449 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1451 if (!EQ (Qnil
, Vx_pointer_shape
))
1453 CHECK_NUMBER (Vx_pointer_shape
, 0);
1454 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1457 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1458 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1460 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1462 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1463 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1464 XINT (Vx_nontext_pointer_shape
));
1467 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1468 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1470 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1472 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1473 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1474 XINT (Vx_busy_pointer_shape
));
1477 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1478 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1480 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1481 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1483 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1484 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1485 XINT (Vx_mode_pointer_shape
));
1488 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1489 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1491 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1493 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1495 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1496 XINT (Vx_sensitive_text_pointer_shape
));
1499 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1501 /* Check and report errors with the above calls. */
1502 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1503 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1506 XColor fore_color
, back_color
;
1508 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1509 x_query_color (f
, &fore_color
);
1510 back_color
.pixel
= mask_color
;
1511 x_query_color (f
, &back_color
);
1513 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1514 &fore_color
, &back_color
);
1515 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1516 &fore_color
, &back_color
);
1517 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1518 &fore_color
, &back_color
);
1519 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1520 &fore_color
, &back_color
);
1521 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1522 &fore_color
, &back_color
);
1525 if (FRAME_X_WINDOW (f
) != 0)
1526 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1528 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1529 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1530 f
->output_data
.x
->text_cursor
= cursor
;
1532 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1533 && f
->output_data
.x
->nontext_cursor
!= 0)
1534 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1535 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1537 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1538 && f
->output_data
.x
->busy_cursor
!= 0)
1539 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1540 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1542 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1543 && f
->output_data
.x
->modeline_cursor
!= 0)
1544 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1545 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1547 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1548 && f
->output_data
.x
->cross_cursor
!= 0)
1549 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1550 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1552 XFlush (FRAME_X_DISPLAY (f
));
1555 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1559 x_set_cursor_color (f
, arg
, oldval
)
1561 Lisp_Object arg
, oldval
;
1563 unsigned long fore_pixel
, pixel
;
1564 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1566 if (!NILP (Vx_cursor_fore_pixel
))
1568 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1569 WHITE_PIX_DEFAULT (f
));
1570 fore_pixel_allocated_p
= 1;
1573 fore_pixel
= f
->output_data
.x
->background_pixel
;
1575 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1576 pixel_allocated_p
= 1;
1578 /* Make sure that the cursor color differs from the background color. */
1579 if (pixel
== f
->output_data
.x
->background_pixel
)
1581 if (pixel_allocated_p
)
1583 x_free_colors (f
, &pixel
, 1);
1584 pixel_allocated_p
= 0;
1587 pixel
= f
->output_data
.x
->mouse_pixel
;
1588 if (pixel
== fore_pixel
)
1590 if (fore_pixel_allocated_p
)
1592 x_free_colors (f
, &fore_pixel
, 1);
1593 fore_pixel_allocated_p
= 0;
1595 fore_pixel
= f
->output_data
.x
->background_pixel
;
1599 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1600 if (!fore_pixel_allocated_p
)
1601 fore_pixel
= x_copy_color (f
, fore_pixel
);
1602 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1604 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1605 if (!pixel_allocated_p
)
1606 pixel
= x_copy_color (f
, pixel
);
1607 f
->output_data
.x
->cursor_pixel
= pixel
;
1609 if (FRAME_X_WINDOW (f
) != 0)
1612 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1613 f
->output_data
.x
->cursor_pixel
);
1614 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1618 if (FRAME_VISIBLE_P (f
))
1620 x_update_cursor (f
, 0);
1621 x_update_cursor (f
, 1);
1625 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1628 /* Set the border-color of frame F to value described by ARG.
1629 ARG can be a string naming a color.
1630 The border-color is used for the border that is drawn by the X server.
1631 Note that this does not fully take effect if done before
1632 F has an x-window; it must be redone when the window is created.
1634 Note: this is done in two routines because of the way X10 works.
1636 Note: under X11, this is normally the province of the window manager,
1637 and so emacs' border colors may be overridden. */
1640 x_set_border_color (f
, arg
, oldval
)
1642 Lisp_Object arg
, oldval
;
1646 CHECK_STRING (arg
, 0);
1647 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1648 x_set_border_pixel (f
, pix
);
1649 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1652 /* Set the border-color of frame F to pixel value PIX.
1653 Note that this does not fully take effect if done before
1654 F has an x-window. */
1657 x_set_border_pixel (f
, pix
)
1661 unload_color (f
, f
->output_data
.x
->border_pixel
);
1662 f
->output_data
.x
->border_pixel
= pix
;
1664 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1667 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1668 (unsigned long)pix
);
1671 if (FRAME_VISIBLE_P (f
))
1677 /* Value is the internal representation of the specified cursor type
1678 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1679 of the bar cursor. */
1681 enum text_cursor_kinds
1682 x_specified_cursor_type (arg
, width
)
1686 enum text_cursor_kinds type
;
1693 else if (CONSP (arg
)
1694 && EQ (XCAR (arg
), Qbar
)
1695 && INTEGERP (XCDR (arg
))
1696 && XINT (XCDR (arg
)) >= 0)
1699 *width
= XINT (XCDR (arg
));
1701 else if (NILP (arg
))
1704 /* Treat anything unknown as "box cursor".
1705 It was bad to signal an error; people have trouble fixing
1706 .Xdefaults with Emacs, when it has something bad in it. */
1707 type
= FILLED_BOX_CURSOR
;
1713 x_set_cursor_type (f
, arg
, oldval
)
1715 Lisp_Object arg
, oldval
;
1719 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1720 f
->output_data
.x
->cursor_width
= width
;
1722 /* Make sure the cursor gets redrawn. This is overkill, but how
1723 often do people change cursor types? */
1724 update_mode_lines
++;
1728 x_set_icon_type (f
, arg
, oldval
)
1730 Lisp_Object arg
, oldval
;
1736 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1739 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1744 result
= x_text_icon (f
,
1745 (char *) XSTRING ((!NILP (f
->icon_name
)
1749 result
= x_bitmap_icon (f
, arg
);
1754 error ("No icon window available");
1757 XFlush (FRAME_X_DISPLAY (f
));
1761 /* Return non-nil if frame F wants a bitmap icon. */
1769 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1777 x_set_icon_name (f
, arg
, oldval
)
1779 Lisp_Object arg
, oldval
;
1785 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1788 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1793 if (f
->output_data
.x
->icon_bitmap
!= 0)
1798 result
= x_text_icon (f
,
1799 (char *) XSTRING ((!NILP (f
->icon_name
)
1808 error ("No icon window available");
1811 XFlush (FRAME_X_DISPLAY (f
));
1816 x_set_font (f
, arg
, oldval
)
1818 Lisp_Object arg
, oldval
;
1821 Lisp_Object fontset_name
;
1824 CHECK_STRING (arg
, 1);
1826 fontset_name
= Fquery_fontset (arg
, Qnil
);
1829 result
= (STRINGP (fontset_name
)
1830 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1831 : x_new_font (f
, XSTRING (arg
)->data
));
1834 if (EQ (result
, Qnil
))
1835 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1836 else if (EQ (result
, Qt
))
1837 error ("The characters of the given font have varying widths");
1838 else if (STRINGP (result
))
1840 store_frame_param (f
, Qfont
, result
);
1841 recompute_basic_faces (f
);
1846 do_pending_window_change (0);
1848 /* Don't call `face-set-after-frame-default' when faces haven't been
1849 initialized yet. This is the case when called from
1850 Fx_create_frame. In that case, the X widget or window doesn't
1851 exist either, and we can end up in x_report_frame_params with a
1852 null widget which gives a segfault. */
1853 if (FRAME_FACE_CACHE (f
))
1855 XSETFRAME (frame
, f
);
1856 call1 (Qface_set_after_frame_default
, frame
);
1861 x_set_border_width (f
, arg
, oldval
)
1863 Lisp_Object arg
, oldval
;
1865 CHECK_NUMBER (arg
, 0);
1867 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1870 if (FRAME_X_WINDOW (f
) != 0)
1871 error ("Cannot change the border width of a window");
1873 f
->output_data
.x
->border_width
= XINT (arg
);
1877 x_set_internal_border_width (f
, arg
, oldval
)
1879 Lisp_Object arg
, oldval
;
1881 int old
= f
->output_data
.x
->internal_border_width
;
1883 CHECK_NUMBER (arg
, 0);
1884 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1885 if (f
->output_data
.x
->internal_border_width
< 0)
1886 f
->output_data
.x
->internal_border_width
= 0;
1888 #ifdef USE_X_TOOLKIT
1889 if (f
->output_data
.x
->edit_widget
)
1890 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1893 if (f
->output_data
.x
->internal_border_width
== old
)
1896 if (FRAME_X_WINDOW (f
) != 0)
1898 x_set_window_size (f
, 0, f
->width
, f
->height
);
1899 SET_FRAME_GARBAGED (f
);
1900 do_pending_window_change (0);
1905 x_set_visibility (f
, value
, oldval
)
1907 Lisp_Object value
, oldval
;
1910 XSETFRAME (frame
, f
);
1913 Fmake_frame_invisible (frame
, Qt
);
1914 else if (EQ (value
, Qicon
))
1915 Ficonify_frame (frame
);
1917 Fmake_frame_visible (frame
);
1921 /* Change window heights in windows rooted in WINDOW by N lines. */
1924 x_change_window_heights (window
, n
)
1928 struct window
*w
= XWINDOW (window
);
1930 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1931 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1933 if (INTEGERP (w
->orig_top
))
1934 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1935 if (INTEGERP (w
->orig_height
))
1936 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1938 /* Handle just the top child in a vertical split. */
1939 if (!NILP (w
->vchild
))
1940 x_change_window_heights (w
->vchild
, n
);
1942 /* Adjust all children in a horizontal split. */
1943 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1945 w
= XWINDOW (window
);
1946 x_change_window_heights (window
, n
);
1951 x_set_menu_bar_lines (f
, value
, oldval
)
1953 Lisp_Object value
, oldval
;
1956 #ifndef USE_X_TOOLKIT
1957 int olines
= FRAME_MENU_BAR_LINES (f
);
1960 /* Right now, menu bars don't work properly in minibuf-only frames;
1961 most of the commands try to apply themselves to the minibuffer
1962 frame itself, and get an error because you can't switch buffers
1963 in or split the minibuffer window. */
1964 if (FRAME_MINIBUF_ONLY_P (f
))
1967 if (INTEGERP (value
))
1968 nlines
= XINT (value
);
1972 /* Make sure we redisplay all windows in this frame. */
1973 windows_or_buffers_changed
++;
1975 #ifdef USE_X_TOOLKIT
1976 FRAME_MENU_BAR_LINES (f
) = 0;
1979 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1980 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1981 /* Make sure next redisplay shows the menu bar. */
1982 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1986 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1987 free_frame_menubar (f
);
1988 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1990 f
->output_data
.x
->menubar_widget
= 0;
1992 #else /* not USE_X_TOOLKIT */
1993 FRAME_MENU_BAR_LINES (f
) = nlines
;
1994 x_change_window_heights (f
->root_window
, nlines
- olines
);
1995 #endif /* not USE_X_TOOLKIT */
2000 /* Set the number of lines used for the tool bar of frame F to VALUE.
2001 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2002 is the old number of tool bar lines. This function changes the
2003 height of all windows on frame F to match the new tool bar height.
2004 The frame's height doesn't change. */
2007 x_set_tool_bar_lines (f
, value
, oldval
)
2009 Lisp_Object value
, oldval
;
2011 int delta
, nlines
, root_height
;
2012 Lisp_Object root_window
;
2014 /* Use VALUE only if an integer >= 0. */
2015 if (INTEGERP (value
) && XINT (value
) >= 0)
2016 nlines
= XFASTINT (value
);
2020 /* Make sure we redisplay all windows in this frame. */
2021 ++windows_or_buffers_changed
;
2023 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2025 /* Don't resize the tool-bar to more than we have room for. */
2026 root_window
= FRAME_ROOT_WINDOW (f
);
2027 root_height
= XINT (XWINDOW (root_window
)->height
);
2028 if (root_height
- delta
< 1)
2030 delta
= root_height
- 1;
2031 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2034 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2035 x_change_window_heights (root_window
, delta
);
2038 /* We also have to make sure that the internal border at the top of
2039 the frame, below the menu bar or tool bar, is redrawn when the
2040 tool bar disappears. This is so because the internal border is
2041 below the tool bar if one is displayed, but is below the menu bar
2042 if there isn't a tool bar. The tool bar draws into the area
2043 below the menu bar. */
2044 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2048 updating_frame
= NULL
;
2053 /* Set the foreground color for scroll bars on frame F to VALUE.
2054 VALUE should be a string, a color name. If it isn't a string or
2055 isn't a valid color name, do nothing. OLDVAL is the old value of
2056 the frame parameter. */
2059 x_set_scroll_bar_foreground (f
, value
, oldval
)
2061 Lisp_Object value
, oldval
;
2063 unsigned long pixel
;
2065 if (STRINGP (value
))
2066 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2070 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2071 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2073 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2074 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2076 /* Remove all scroll bars because they have wrong colors. */
2077 if (condemn_scroll_bars_hook
)
2078 (*condemn_scroll_bars_hook
) (f
);
2079 if (judge_scroll_bars_hook
)
2080 (*judge_scroll_bars_hook
) (f
);
2082 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2088 /* Set the background color for scroll bars on frame F to VALUE VALUE
2089 should be a string, a color name. If it isn't a string or isn't a
2090 valid color name, do nothing. OLDVAL is the old value of the frame
2094 x_set_scroll_bar_background (f
, value
, oldval
)
2096 Lisp_Object value
, oldval
;
2098 unsigned long pixel
;
2100 if (STRINGP (value
))
2101 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2105 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2106 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2108 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2109 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2111 /* Remove all scroll bars because they have wrong colors. */
2112 if (condemn_scroll_bars_hook
)
2113 (*condemn_scroll_bars_hook
) (f
);
2114 if (judge_scroll_bars_hook
)
2115 (*judge_scroll_bars_hook
) (f
);
2117 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2123 /* Encode Lisp string STRING as a text in a format appropriate for
2124 XICCC (X Inter Client Communication Conventions).
2126 If STRING contains only ASCII characters, do no conversion and
2127 return the string data of STRING. Otherwise, encode the text by
2128 CODING_SYSTEM, and return a newly allocated memory area which
2129 should be freed by `xfree' by a caller.
2131 Store the byte length of resulting text in *TEXT_BYTES.
2133 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2134 which means that the `encoding' of the result can be `STRING'.
2135 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2136 the result should be `COMPOUND_TEXT'. */
2139 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2140 Lisp_Object string
, coding_system
;
2141 int *text_bytes
, *stringp
;
2143 unsigned char *str
= XSTRING (string
)->data
;
2144 int chars
= XSTRING (string
)->size
;
2145 int bytes
= STRING_BYTES (XSTRING (string
));
2149 struct coding_system coding
;
2151 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2152 if (charset_info
== 0)
2154 /* No multibyte character in OBJ. We need not encode it. */
2155 *text_bytes
= bytes
;
2160 setup_coding_system (coding_system
, &coding
);
2161 coding
.src_multibyte
= 1;
2162 coding
.dst_multibyte
= 0;
2163 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2164 if (coding
.type
== coding_type_iso2022
)
2165 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2166 /* We suppress producing escape sequences for composition. */
2167 coding
.composing
= COMPOSITION_DISABLED
;
2168 bufsize
= encoding_buffer_size (&coding
, bytes
);
2169 buf
= (unsigned char *) xmalloc (bufsize
);
2170 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2171 *text_bytes
= coding
.produced
;
2172 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2177 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2180 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2181 name; if NAME is a string, set F's name to NAME and set
2182 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2184 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2185 suggesting a new name, which lisp code should override; if
2186 F->explicit_name is set, ignore the new name; otherwise, set it. */
2189 x_set_name (f
, name
, explicit)
2194 /* Make sure that requests from lisp code override requests from
2195 Emacs redisplay code. */
2198 /* If we're switching from explicit to implicit, we had better
2199 update the mode lines and thereby update the title. */
2200 if (f
->explicit_name
&& NILP (name
))
2201 update_mode_lines
= 1;
2203 f
->explicit_name
= ! NILP (name
);
2205 else if (f
->explicit_name
)
2208 /* If NAME is nil, set the name to the x_id_name. */
2211 /* Check for no change needed in this very common case
2212 before we do any consing. */
2213 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2214 XSTRING (f
->name
)->data
))
2216 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2219 CHECK_STRING (name
, 0);
2221 /* Don't change the name if it's already NAME. */
2222 if (! NILP (Fstring_equal (name
, f
->name
)))
2227 /* For setting the frame title, the title parameter should override
2228 the name parameter. */
2229 if (! NILP (f
->title
))
2232 if (FRAME_X_WINDOW (f
))
2237 XTextProperty text
, icon
;
2239 Lisp_Object coding_system
;
2241 coding_system
= Vlocale_coding_system
;
2242 if (NILP (coding_system
))
2243 coding_system
= Qcompound_text
;
2244 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2245 text
.encoding
= (stringp
? XA_STRING
2246 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2248 text
.nitems
= bytes
;
2250 if (NILP (f
->icon_name
))
2256 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2258 icon
.encoding
= (stringp
? XA_STRING
2259 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2261 icon
.nitems
= bytes
;
2263 #ifdef USE_X_TOOLKIT
2264 XSetWMName (FRAME_X_DISPLAY (f
),
2265 XtWindow (f
->output_data
.x
->widget
), &text
);
2266 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2268 #else /* not USE_X_TOOLKIT */
2269 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2270 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2271 #endif /* not USE_X_TOOLKIT */
2272 if (!NILP (f
->icon_name
)
2273 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2275 if (text
.value
!= XSTRING (name
)->data
)
2278 #else /* not HAVE_X11R4 */
2279 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2280 XSTRING (name
)->data
);
2281 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2282 XSTRING (name
)->data
);
2283 #endif /* not HAVE_X11R4 */
2288 /* This function should be called when the user's lisp code has
2289 specified a name for the frame; the name will override any set by the
2292 x_explicitly_set_name (f
, arg
, oldval
)
2294 Lisp_Object arg
, oldval
;
2296 x_set_name (f
, arg
, 1);
2299 /* This function should be called by Emacs redisplay code to set the
2300 name; names set this way will never override names set by the user's
2303 x_implicitly_set_name (f
, arg
, oldval
)
2305 Lisp_Object arg
, oldval
;
2307 x_set_name (f
, arg
, 0);
2310 /* Change the title of frame F to NAME.
2311 If NAME is nil, use the frame name as the title.
2313 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2314 name; if NAME is a string, set F's name to NAME and set
2315 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2317 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2318 suggesting a new name, which lisp code should override; if
2319 F->explicit_name is set, ignore the new name; otherwise, set it. */
2322 x_set_title (f
, name
, old_name
)
2324 Lisp_Object name
, old_name
;
2326 /* Don't change the title if it's already NAME. */
2327 if (EQ (name
, f
->title
))
2330 update_mode_lines
= 1;
2337 CHECK_STRING (name
, 0);
2339 if (FRAME_X_WINDOW (f
))
2344 XTextProperty text
, icon
;
2346 Lisp_Object coding_system
;
2348 coding_system
= Vlocale_coding_system
;
2349 if (NILP (coding_system
))
2350 coding_system
= Qcompound_text
;
2351 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2352 text
.encoding
= (stringp
? XA_STRING
2353 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2355 text
.nitems
= bytes
;
2357 if (NILP (f
->icon_name
))
2363 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2365 icon
.encoding
= (stringp
? XA_STRING
2366 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2368 icon
.nitems
= bytes
;
2370 #ifdef USE_X_TOOLKIT
2371 XSetWMName (FRAME_X_DISPLAY (f
),
2372 XtWindow (f
->output_data
.x
->widget
), &text
);
2373 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2375 #else /* not USE_X_TOOLKIT */
2376 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2377 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2378 #endif /* not USE_X_TOOLKIT */
2379 if (!NILP (f
->icon_name
)
2380 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2382 if (text
.value
!= XSTRING (name
)->data
)
2385 #else /* not HAVE_X11R4 */
2386 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2387 XSTRING (name
)->data
);
2388 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2389 XSTRING (name
)->data
);
2390 #endif /* not HAVE_X11R4 */
2396 x_set_autoraise (f
, arg
, oldval
)
2398 Lisp_Object arg
, oldval
;
2400 f
->auto_raise
= !EQ (Qnil
, arg
);
2404 x_set_autolower (f
, arg
, oldval
)
2406 Lisp_Object arg
, oldval
;
2408 f
->auto_lower
= !EQ (Qnil
, arg
);
2412 x_set_unsplittable (f
, arg
, oldval
)
2414 Lisp_Object arg
, oldval
;
2416 f
->no_split
= !NILP (arg
);
2420 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2422 Lisp_Object arg
, oldval
;
2424 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2425 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2426 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2427 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2429 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2431 ? vertical_scroll_bar_none
2433 ? vertical_scroll_bar_right
2434 : vertical_scroll_bar_left
);
2436 /* We set this parameter before creating the X window for the
2437 frame, so we can get the geometry right from the start.
2438 However, if the window hasn't been created yet, we shouldn't
2439 call x_set_window_size. */
2440 if (FRAME_X_WINDOW (f
))
2441 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2442 do_pending_window_change (0);
2447 x_set_scroll_bar_width (f
, arg
, oldval
)
2449 Lisp_Object arg
, oldval
;
2451 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2455 #ifdef USE_TOOLKIT_SCROLL_BARS
2456 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2457 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2458 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2459 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2461 /* Make the actual width at least 14 pixels and a multiple of a
2463 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2465 /* Use all of that space (aside from required margins) for the
2467 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2470 if (FRAME_X_WINDOW (f
))
2471 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2472 do_pending_window_change (0);
2474 else if (INTEGERP (arg
) && XINT (arg
) > 0
2475 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2477 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2478 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2480 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2481 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2482 if (FRAME_X_WINDOW (f
))
2483 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2486 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2487 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2488 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2493 /* Subroutines of creating an X frame. */
2495 /* Make sure that Vx_resource_name is set to a reasonable value.
2496 Fix it up, or set it to `emacs' if it is too hopeless. */
2499 validate_x_resource_name ()
2502 /* Number of valid characters in the resource name. */
2504 /* Number of invalid characters in the resource name. */
2509 if (!STRINGP (Vx_resource_class
))
2510 Vx_resource_class
= build_string (EMACS_CLASS
);
2512 if (STRINGP (Vx_resource_name
))
2514 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2517 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2519 /* Only letters, digits, - and _ are valid in resource names.
2520 Count the valid characters and count the invalid ones. */
2521 for (i
= 0; i
< len
; i
++)
2524 if (! ((c
>= 'a' && c
<= 'z')
2525 || (c
>= 'A' && c
<= 'Z')
2526 || (c
>= '0' && c
<= '9')
2527 || c
== '-' || c
== '_'))
2534 /* Not a string => completely invalid. */
2535 bad_count
= 5, good_count
= 0;
2537 /* If name is valid already, return. */
2541 /* If name is entirely invalid, or nearly so, use `emacs'. */
2543 || (good_count
== 1 && bad_count
> 0))
2545 Vx_resource_name
= build_string ("emacs");
2549 /* Name is partly valid. Copy it and replace the invalid characters
2550 with underscores. */
2552 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2554 for (i
= 0; i
< len
; i
++)
2556 int c
= XSTRING (new)->data
[i
];
2557 if (! ((c
>= 'a' && c
<= 'z')
2558 || (c
>= 'A' && c
<= 'Z')
2559 || (c
>= '0' && c
<= '9')
2560 || c
== '-' || c
== '_'))
2561 XSTRING (new)->data
[i
] = '_';
2566 extern char *x_get_string_resource ();
2568 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2569 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2570 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2571 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2572 the name specified by the `-name' or `-rn' command-line arguments.\n\
2574 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2575 class, respectively. You must specify both of them or neither.\n\
2576 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2577 and the class is `Emacs.CLASS.SUBCLASS'.")
2578 (attribute
, class, component
, subclass
)
2579 Lisp_Object attribute
, class, component
, subclass
;
2581 register char *value
;
2587 CHECK_STRING (attribute
, 0);
2588 CHECK_STRING (class, 0);
2590 if (!NILP (component
))
2591 CHECK_STRING (component
, 1);
2592 if (!NILP (subclass
))
2593 CHECK_STRING (subclass
, 2);
2594 if (NILP (component
) != NILP (subclass
))
2595 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2597 validate_x_resource_name ();
2599 /* Allocate space for the components, the dots which separate them,
2600 and the final '\0'. Make them big enough for the worst case. */
2601 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2602 + (STRINGP (component
)
2603 ? STRING_BYTES (XSTRING (component
)) : 0)
2604 + STRING_BYTES (XSTRING (attribute
))
2607 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2608 + STRING_BYTES (XSTRING (class))
2609 + (STRINGP (subclass
)
2610 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2613 /* Start with emacs.FRAMENAME for the name (the specific one)
2614 and with `Emacs' for the class key (the general one). */
2615 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2616 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2618 strcat (class_key
, ".");
2619 strcat (class_key
, XSTRING (class)->data
);
2621 if (!NILP (component
))
2623 strcat (class_key
, ".");
2624 strcat (class_key
, XSTRING (subclass
)->data
);
2626 strcat (name_key
, ".");
2627 strcat (name_key
, XSTRING (component
)->data
);
2630 strcat (name_key
, ".");
2631 strcat (name_key
, XSTRING (attribute
)->data
);
2633 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2634 name_key
, class_key
);
2636 if (value
!= (char *) 0)
2637 return build_string (value
);
2642 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2645 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2646 struct x_display_info
*dpyinfo
;
2647 Lisp_Object attribute
, class, component
, subclass
;
2649 register char *value
;
2653 CHECK_STRING (attribute
, 0);
2654 CHECK_STRING (class, 0);
2656 if (!NILP (component
))
2657 CHECK_STRING (component
, 1);
2658 if (!NILP (subclass
))
2659 CHECK_STRING (subclass
, 2);
2660 if (NILP (component
) != NILP (subclass
))
2661 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2663 validate_x_resource_name ();
2665 /* Allocate space for the components, the dots which separate them,
2666 and the final '\0'. Make them big enough for the worst case. */
2667 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2668 + (STRINGP (component
)
2669 ? STRING_BYTES (XSTRING (component
)) : 0)
2670 + STRING_BYTES (XSTRING (attribute
))
2673 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2674 + STRING_BYTES (XSTRING (class))
2675 + (STRINGP (subclass
)
2676 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2679 /* Start with emacs.FRAMENAME for the name (the specific one)
2680 and with `Emacs' for the class key (the general one). */
2681 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2682 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2684 strcat (class_key
, ".");
2685 strcat (class_key
, XSTRING (class)->data
);
2687 if (!NILP (component
))
2689 strcat (class_key
, ".");
2690 strcat (class_key
, XSTRING (subclass
)->data
);
2692 strcat (name_key
, ".");
2693 strcat (name_key
, XSTRING (component
)->data
);
2696 strcat (name_key
, ".");
2697 strcat (name_key
, XSTRING (attribute
)->data
);
2699 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2701 if (value
!= (char *) 0)
2702 return build_string (value
);
2707 /* Used when C code wants a resource value. */
2710 x_get_resource_string (attribute
, class)
2711 char *attribute
, *class;
2715 struct frame
*sf
= SELECTED_FRAME ();
2717 /* Allocate space for the components, the dots which separate them,
2718 and the final '\0'. */
2719 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2720 + strlen (attribute
) + 2);
2721 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2722 + strlen (class) + 2);
2724 sprintf (name_key
, "%s.%s",
2725 XSTRING (Vinvocation_name
)->data
,
2727 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2729 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2730 name_key
, class_key
);
2733 /* Types we might convert a resource string into. */
2743 /* Return the value of parameter PARAM.
2745 First search ALIST, then Vdefault_frame_alist, then the X defaults
2746 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2748 Convert the resource to the type specified by desired_type.
2750 If no default is specified, return Qunbound. If you call
2751 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2752 and don't let it get stored in any Lisp-visible variables! */
2755 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2756 struct x_display_info
*dpyinfo
;
2757 Lisp_Object alist
, param
;
2760 enum resource_types type
;
2762 register Lisp_Object tem
;
2764 tem
= Fassq (param
, alist
);
2766 tem
= Fassq (param
, Vdefault_frame_alist
);
2772 tem
= display_x_get_resource (dpyinfo
,
2773 build_string (attribute
),
2774 build_string (class),
2782 case RES_TYPE_NUMBER
:
2783 return make_number (atoi (XSTRING (tem
)->data
));
2785 case RES_TYPE_FLOAT
:
2786 return make_float (atof (XSTRING (tem
)->data
));
2788 case RES_TYPE_BOOLEAN
:
2789 tem
= Fdowncase (tem
);
2790 if (!strcmp (XSTRING (tem
)->data
, "on")
2791 || !strcmp (XSTRING (tem
)->data
, "true"))
2796 case RES_TYPE_STRING
:
2799 case RES_TYPE_SYMBOL
:
2800 /* As a special case, we map the values `true' and `on'
2801 to Qt, and `false' and `off' to Qnil. */
2804 lower
= Fdowncase (tem
);
2805 if (!strcmp (XSTRING (lower
)->data
, "on")
2806 || !strcmp (XSTRING (lower
)->data
, "true"))
2808 else if (!strcmp (XSTRING (lower
)->data
, "off")
2809 || !strcmp (XSTRING (lower
)->data
, "false"))
2812 return Fintern (tem
, Qnil
);
2825 /* Like x_get_arg, but also record the value in f->param_alist. */
2828 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2830 Lisp_Object alist
, param
;
2833 enum resource_types type
;
2837 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2838 attribute
, class, type
);
2840 store_frame_param (f
, param
, value
);
2845 /* Record in frame F the specified or default value according to ALIST
2846 of the parameter named PROP (a Lisp symbol).
2847 If no value is specified for PROP, look for an X default for XPROP
2848 on the frame named NAME.
2849 If that is not found either, use the value DEFLT. */
2852 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2859 enum resource_types type
;
2863 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2864 if (EQ (tem
, Qunbound
))
2866 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2871 /* Record in frame F the specified or default value according to ALIST
2872 of the parameter named PROP (a Lisp symbol). If no value is
2873 specified for PROP, look for an X default for XPROP on the frame
2874 named NAME. If that is not found either, use the value DEFLT. */
2877 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2886 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2889 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2890 if (EQ (tem
, Qunbound
))
2892 #ifdef USE_TOOLKIT_SCROLL_BARS
2894 /* See if an X resource for the scroll bar color has been
2896 tem
= display_x_get_resource (dpyinfo
,
2897 build_string (foreground_p
2901 build_string ("verticalScrollBar"),
2905 /* If nothing has been specified, scroll bars will use a
2906 toolkit-dependent default. Because these defaults are
2907 difficult to get at without actually creating a scroll
2908 bar, use nil to indicate that no color has been
2913 #else /* not USE_TOOLKIT_SCROLL_BARS */
2917 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2920 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2926 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2927 "Parse an X-style geometry string STRING.\n\
2928 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2929 The properties returned may include `top', `left', `height', and `width'.\n\
2930 The value of `left' or `top' may be an integer,\n\
2931 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2932 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2937 unsigned int width
, height
;
2940 CHECK_STRING (string
, 0);
2942 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2943 &x
, &y
, &width
, &height
);
2946 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2947 error ("Must specify both x and y position, or neither");
2951 if (geometry
& XValue
)
2953 Lisp_Object element
;
2955 if (x
>= 0 && (geometry
& XNegative
))
2956 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2957 else if (x
< 0 && ! (geometry
& XNegative
))
2958 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2960 element
= Fcons (Qleft
, make_number (x
));
2961 result
= Fcons (element
, result
);
2964 if (geometry
& YValue
)
2966 Lisp_Object element
;
2968 if (y
>= 0 && (geometry
& YNegative
))
2969 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2970 else if (y
< 0 && ! (geometry
& YNegative
))
2971 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2973 element
= Fcons (Qtop
, make_number (y
));
2974 result
= Fcons (element
, result
);
2977 if (geometry
& WidthValue
)
2978 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2979 if (geometry
& HeightValue
)
2980 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2985 /* Calculate the desired size and position of this window,
2986 and return the flags saying which aspects were specified.
2988 This function does not make the coordinates positive. */
2990 #define DEFAULT_ROWS 40
2991 #define DEFAULT_COLS 80
2994 x_figure_window_size (f
, parms
)
2998 register Lisp_Object tem0
, tem1
, tem2
;
2999 long window_prompting
= 0;
3000 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3002 /* Default values if we fall through.
3003 Actually, if that happens we should get
3004 window manager prompting. */
3005 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3006 f
->height
= DEFAULT_ROWS
;
3007 /* Window managers expect that if program-specified
3008 positions are not (0,0), they're intentional, not defaults. */
3009 f
->output_data
.x
->top_pos
= 0;
3010 f
->output_data
.x
->left_pos
= 0;
3012 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3013 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3014 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3015 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3017 if (!EQ (tem0
, Qunbound
))
3019 CHECK_NUMBER (tem0
, 0);
3020 f
->height
= XINT (tem0
);
3022 if (!EQ (tem1
, Qunbound
))
3024 CHECK_NUMBER (tem1
, 0);
3025 SET_FRAME_WIDTH (f
, XINT (tem1
));
3027 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3028 window_prompting
|= USSize
;
3030 window_prompting
|= PSize
;
3033 f
->output_data
.x
->vertical_scroll_bar_extra
3034 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3036 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3037 f
->output_data
.x
->flags_areas_extra
3038 = FRAME_FLAGS_AREA_WIDTH (f
);
3039 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3040 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3042 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3043 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3044 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3045 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3047 if (EQ (tem0
, Qminus
))
3049 f
->output_data
.x
->top_pos
= 0;
3050 window_prompting
|= YNegative
;
3052 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3053 && CONSP (XCDR (tem0
))
3054 && INTEGERP (XCAR (XCDR (tem0
))))
3056 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3057 window_prompting
|= YNegative
;
3059 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3060 && CONSP (XCDR (tem0
))
3061 && INTEGERP (XCAR (XCDR (tem0
))))
3063 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3065 else if (EQ (tem0
, Qunbound
))
3066 f
->output_data
.x
->top_pos
= 0;
3069 CHECK_NUMBER (tem0
, 0);
3070 f
->output_data
.x
->top_pos
= XINT (tem0
);
3071 if (f
->output_data
.x
->top_pos
< 0)
3072 window_prompting
|= YNegative
;
3075 if (EQ (tem1
, Qminus
))
3077 f
->output_data
.x
->left_pos
= 0;
3078 window_prompting
|= XNegative
;
3080 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3081 && CONSP (XCDR (tem1
))
3082 && INTEGERP (XCAR (XCDR (tem1
))))
3084 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3085 window_prompting
|= XNegative
;
3087 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3088 && CONSP (XCDR (tem1
))
3089 && INTEGERP (XCAR (XCDR (tem1
))))
3091 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3093 else if (EQ (tem1
, Qunbound
))
3094 f
->output_data
.x
->left_pos
= 0;
3097 CHECK_NUMBER (tem1
, 0);
3098 f
->output_data
.x
->left_pos
= XINT (tem1
);
3099 if (f
->output_data
.x
->left_pos
< 0)
3100 window_prompting
|= XNegative
;
3103 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3104 window_prompting
|= USPosition
;
3106 window_prompting
|= PPosition
;
3109 return window_prompting
;
3112 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3115 XSetWMProtocols (dpy
, w
, protocols
, count
)
3122 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3123 if (prop
== None
) return False
;
3124 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3125 (unsigned char *) protocols
, count
);
3128 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3130 #ifdef USE_X_TOOLKIT
3132 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3133 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3134 already be present because of the toolkit (Motif adds some of them,
3135 for example, but Xt doesn't). */
3138 hack_wm_protocols (f
, widget
)
3142 Display
*dpy
= XtDisplay (widget
);
3143 Window w
= XtWindow (widget
);
3144 int need_delete
= 1;
3150 Atom type
, *atoms
= 0;
3152 unsigned long nitems
= 0;
3153 unsigned long bytes_after
;
3155 if ((XGetWindowProperty (dpy
, w
,
3156 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3157 (long)0, (long)100, False
, XA_ATOM
,
3158 &type
, &format
, &nitems
, &bytes_after
,
3159 (unsigned char **) &atoms
)
3161 && format
== 32 && type
== XA_ATOM
)
3165 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3167 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3169 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3172 if (atoms
) XFree ((char *) atoms
);
3178 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3180 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3182 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3184 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3185 XA_ATOM
, 32, PropModeAppend
,
3186 (unsigned char *) props
, count
);
3194 /* Support routines for XIC (X Input Context). */
3198 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3199 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3202 /* Supported XIM styles, ordered by preferenc. */
3204 static XIMStyle supported_xim_styles
[] =
3206 XIMPreeditPosition
| XIMStatusArea
,
3207 XIMPreeditPosition
| XIMStatusNothing
,
3208 XIMPreeditPosition
| XIMStatusNone
,
3209 XIMPreeditNothing
| XIMStatusArea
,
3210 XIMPreeditNothing
| XIMStatusNothing
,
3211 XIMPreeditNothing
| XIMStatusNone
,
3212 XIMPreeditNone
| XIMStatusArea
,
3213 XIMPreeditNone
| XIMStatusNothing
,
3214 XIMPreeditNone
| XIMStatusNone
,
3219 /* Create an X fontset on frame F with base font name
3223 xic_create_xfontset (f
, base_fontname
)
3225 char *base_fontname
;
3228 char **missing_list
;
3232 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3233 base_fontname
, &missing_list
,
3234 &missing_count
, &def_string
);
3236 XFreeStringList (missing_list
);
3238 /* No need to free def_string. */
3243 /* Value is the best input style, given user preferences USER (already
3244 checked to be supported by Emacs), and styles supported by the
3245 input method XIM. */
3248 best_xim_style (user
, xim
)
3254 for (i
= 0; i
< user
->count_styles
; ++i
)
3255 for (j
= 0; j
< xim
->count_styles
; ++j
)
3256 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3257 return user
->supported_styles
[i
];
3259 /* Return the default style. */
3260 return XIMPreeditNothing
| XIMStatusNothing
;
3263 /* Create XIC for frame F. */
3266 create_frame_xic (f
)
3271 XFontSet xfs
= NULL
;
3272 static XIMStyle xic_style
;
3277 xim
= FRAME_X_XIM (f
);
3282 XVaNestedList preedit_attr
;
3283 XVaNestedList status_attr
;
3284 char *base_fontname
;
3287 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3288 spot
.x
= 0; spot
.y
= 1;
3289 /* Create X fontset. */
3290 fontset
= FRAME_FONTSET (f
);
3292 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3295 /* Determine the base fontname from the ASCII font name of
3297 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3298 char *p
= ascii_font
;
3301 for (i
= 0; *p
; p
++)
3304 /* As the font name doesn't conform to XLFD, we can't
3305 modify it to get a suitable base fontname for the
3307 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3310 int len
= strlen (ascii_font
) + 1;
3313 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3322 base_fontname
= (char *) alloca (len
);
3323 bzero (base_fontname
, len
);
3324 strcpy (base_fontname
, "-*-*-");
3325 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3326 strcat (base_fontname
, "*-*-*-*-*-*-*");
3329 xfs
= xic_create_xfontset (f
, base_fontname
);
3331 /* Determine XIC style. */
3334 XIMStyles supported_list
;
3335 supported_list
.count_styles
= (sizeof supported_xim_styles
3336 / sizeof supported_xim_styles
[0]);
3337 supported_list
.supported_styles
= supported_xim_styles
;
3338 xic_style
= best_xim_style (&supported_list
,
3339 FRAME_X_XIM_STYLES (f
));
3342 preedit_attr
= XVaCreateNestedList (0,
3345 FRAME_FOREGROUND_PIXEL (f
),
3347 FRAME_BACKGROUND_PIXEL (f
),
3348 (xic_style
& XIMPreeditPosition
3353 status_attr
= XVaCreateNestedList (0,
3359 FRAME_FOREGROUND_PIXEL (f
),
3361 FRAME_BACKGROUND_PIXEL (f
),
3364 xic
= XCreateIC (xim
,
3365 XNInputStyle
, xic_style
,
3366 XNClientWindow
, FRAME_X_WINDOW(f
),
3367 XNFocusWindow
, FRAME_X_WINDOW(f
),
3368 XNStatusAttributes
, status_attr
,
3369 XNPreeditAttributes
, preedit_attr
,
3371 XFree (preedit_attr
);
3372 XFree (status_attr
);
3375 FRAME_XIC (f
) = xic
;
3376 FRAME_XIC_STYLE (f
) = xic_style
;
3377 FRAME_XIC_FONTSET (f
) = xfs
;
3381 /* Destroy XIC and free XIC fontset of frame F, if any. */
3387 if (FRAME_XIC (f
) == NULL
)
3390 XDestroyIC (FRAME_XIC (f
));
3391 if (FRAME_XIC_FONTSET (f
))
3392 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3394 FRAME_XIC (f
) = NULL
;
3395 FRAME_XIC_FONTSET (f
) = NULL
;
3399 /* Place preedit area for XIC of window W's frame to specified
3400 pixel position X/Y. X and Y are relative to window W. */
3403 xic_set_preeditarea (w
, x
, y
)
3407 struct frame
*f
= XFRAME (w
->frame
);
3411 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3412 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3413 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3414 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3419 /* Place status area for XIC in bottom right corner of frame F.. */
3422 xic_set_statusarea (f
)
3425 XIC xic
= FRAME_XIC (f
);
3430 /* Negotiate geometry of status area. If input method has existing
3431 status area, use its current size. */
3432 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3433 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3434 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3437 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3438 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3441 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3443 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3444 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3448 area
.width
= needed
->width
;
3449 area
.height
= needed
->height
;
3450 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3451 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3452 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3455 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3456 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3461 /* Set X fontset for XIC of frame F, using base font name
3462 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3465 xic_set_xfontset (f
, base_fontname
)
3467 char *base_fontname
;
3472 xfs
= xic_create_xfontset (f
, base_fontname
);
3474 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3475 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3476 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3477 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3478 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3481 if (FRAME_XIC_FONTSET (f
))
3482 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3483 FRAME_XIC_FONTSET (f
) = xfs
;
3486 #endif /* HAVE_X_I18N */
3490 #ifdef USE_X_TOOLKIT
3492 /* Create and set up the X widget for frame F. */
3495 x_window (f
, window_prompting
, minibuffer_only
)
3497 long window_prompting
;
3498 int minibuffer_only
;
3500 XClassHint class_hints
;
3501 XSetWindowAttributes attributes
;
3502 unsigned long attribute_mask
;
3503 Widget shell_widget
;
3505 Widget frame_widget
;
3511 /* Use the resource name as the top-level widget name
3512 for looking up resources. Make a non-Lisp copy
3513 for the window manager, so GC relocation won't bother it.
3515 Elsewhere we specify the window name for the window manager. */
3518 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3519 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3520 strcpy (f
->namebuf
, str
);
3524 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3525 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3526 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3527 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3528 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3529 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3530 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3531 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3532 applicationShellWidgetClass
,
3533 FRAME_X_DISPLAY (f
), al
, ac
);
3535 f
->output_data
.x
->widget
= shell_widget
;
3536 /* maybe_set_screen_title_format (shell_widget); */
3538 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3539 (widget_value
*) NULL
,
3540 shell_widget
, False
,
3544 (lw_callback
) NULL
);
3547 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3548 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3549 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3550 XtSetValues (pane_widget
, al
, ac
);
3551 f
->output_data
.x
->column_widget
= pane_widget
;
3553 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3554 the emacs screen when changing menubar. This reduces flickering. */
3557 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3558 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3559 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3560 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3561 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3562 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3563 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3564 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3565 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3568 f
->output_data
.x
->edit_widget
= frame_widget
;
3570 XtManageChild (frame_widget
);
3572 /* Do some needed geometry management. */
3575 char *tem
, shell_position
[32];
3578 int extra_borders
= 0;
3580 = (f
->output_data
.x
->menubar_widget
3581 ? (f
->output_data
.x
->menubar_widget
->core
.height
3582 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3585 #if 0 /* Experimentally, we now get the right results
3586 for -geometry -0-0 without this. 24 Aug 96, rms. */
3587 if (FRAME_EXTERNAL_MENU_BAR (f
))
3590 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3591 menubar_size
+= ibw
;
3595 f
->output_data
.x
->menubar_height
= menubar_size
;
3598 /* Motif seems to need this amount added to the sizes
3599 specified for the shell widget. The Athena/Lucid widgets don't.
3600 Both conclusions reached experimentally. -- rms. */
3601 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3602 &extra_borders
, NULL
);
3606 /* Convert our geometry parameters into a geometry string
3608 Note that we do not specify here whether the position
3609 is a user-specified or program-specified one.
3610 We pass that information later, in x_wm_set_size_hints. */
3612 int left
= f
->output_data
.x
->left_pos
;
3613 int xneg
= window_prompting
& XNegative
;
3614 int top
= f
->output_data
.x
->top_pos
;
3615 int yneg
= window_prompting
& YNegative
;
3621 if (window_prompting
& USPosition
)
3622 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3623 PIXEL_WIDTH (f
) + extra_borders
,
3624 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3625 (xneg
? '-' : '+'), left
,
3626 (yneg
? '-' : '+'), top
);
3628 sprintf (shell_position
, "=%dx%d",
3629 PIXEL_WIDTH (f
) + extra_borders
,
3630 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3633 len
= strlen (shell_position
) + 1;
3634 /* We don't free this because we don't know whether
3635 it is safe to free it while the frame exists.
3636 It isn't worth the trouble of arranging to free it
3637 when the frame is deleted. */
3638 tem
= (char *) xmalloc (len
);
3639 strncpy (tem
, shell_position
, len
);
3640 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3641 XtSetValues (shell_widget
, al
, ac
);
3644 XtManageChild (pane_widget
);
3645 XtRealizeWidget (shell_widget
);
3647 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3649 validate_x_resource_name ();
3651 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3652 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3653 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3656 FRAME_XIC (f
) = NULL
;
3658 create_frame_xic (f
);
3662 f
->output_data
.x
->wm_hints
.input
= True
;
3663 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3664 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3665 &f
->output_data
.x
->wm_hints
);
3667 hack_wm_protocols (f
, shell_widget
);
3670 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3673 /* Do a stupid property change to force the server to generate a
3674 PropertyNotify event so that the event_stream server timestamp will
3675 be initialized to something relevant to the time we created the window.
3677 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3678 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3679 XA_ATOM
, 32, PropModeAppend
,
3680 (unsigned char*) NULL
, 0);
3682 /* Make all the standard events reach the Emacs frame. */
3683 attributes
.event_mask
= STANDARD_EVENT_SET
;
3688 /* XIM server might require some X events. */
3689 unsigned long fevent
= NoEventMask
;
3690 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3691 attributes
.event_mask
|= fevent
;
3693 #endif /* HAVE_X_I18N */
3695 attribute_mask
= CWEventMask
;
3696 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3697 attribute_mask
, &attributes
);
3699 XtMapWidget (frame_widget
);
3701 /* x_set_name normally ignores requests to set the name if the
3702 requested name is the same as the current name. This is the one
3703 place where that assumption isn't correct; f->name is set, but
3704 the X server hasn't been told. */
3707 int explicit = f
->explicit_name
;
3709 f
->explicit_name
= 0;
3712 x_set_name (f
, name
, explicit);
3715 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3716 f
->output_data
.x
->text_cursor
);
3720 /* This is a no-op, except under Motif. Make sure main areas are
3721 set to something reasonable, in case we get an error later. */
3722 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3725 #else /* not USE_X_TOOLKIT */
3727 /* Create and set up the X window for frame F. */
3734 XClassHint class_hints
;
3735 XSetWindowAttributes attributes
;
3736 unsigned long attribute_mask
;
3738 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3739 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3740 attributes
.bit_gravity
= StaticGravity
;
3741 attributes
.backing_store
= NotUseful
;
3742 attributes
.save_under
= True
;
3743 attributes
.event_mask
= STANDARD_EVENT_SET
;
3744 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3745 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3750 = XCreateWindow (FRAME_X_DISPLAY (f
),
3751 f
->output_data
.x
->parent_desc
,
3752 f
->output_data
.x
->left_pos
,
3753 f
->output_data
.x
->top_pos
,
3754 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3755 f
->output_data
.x
->border_width
,
3756 CopyFromParent
, /* depth */
3757 InputOutput
, /* class */
3759 attribute_mask
, &attributes
);
3763 create_frame_xic (f
);
3766 /* XIM server might require some X events. */
3767 unsigned long fevent
= NoEventMask
;
3768 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3769 attributes
.event_mask
|= fevent
;
3770 attribute_mask
= CWEventMask
;
3771 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3772 attribute_mask
, &attributes
);
3775 #endif /* HAVE_X_I18N */
3777 validate_x_resource_name ();
3779 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3780 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3781 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3783 /* The menubar is part of the ordinary display;
3784 it does not count in addition to the height of the window. */
3785 f
->output_data
.x
->menubar_height
= 0;
3787 /* This indicates that we use the "Passive Input" input model.
3788 Unless we do this, we don't get the Focus{In,Out} events that we
3789 need to draw the cursor correctly. Accursed bureaucrats.
3790 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3792 f
->output_data
.x
->wm_hints
.input
= True
;
3793 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3794 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3795 &f
->output_data
.x
->wm_hints
);
3796 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3798 /* Request "save yourself" and "delete window" commands from wm. */
3801 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3802 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3803 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3806 /* x_set_name normally ignores requests to set the name if the
3807 requested name is the same as the current name. This is the one
3808 place where that assumption isn't correct; f->name is set, but
3809 the X server hasn't been told. */
3812 int explicit = f
->explicit_name
;
3814 f
->explicit_name
= 0;
3817 x_set_name (f
, name
, explicit);
3820 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3821 f
->output_data
.x
->text_cursor
);
3825 if (FRAME_X_WINDOW (f
) == 0)
3826 error ("Unable to create window");
3829 #endif /* not USE_X_TOOLKIT */
3831 /* Handle the icon stuff for this window. Perhaps later we might
3832 want an x_set_icon_position which can be called interactively as
3840 Lisp_Object icon_x
, icon_y
;
3841 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3843 /* Set the position of the icon. Note that twm groups all
3844 icons in an icon window. */
3845 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3846 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3847 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3849 CHECK_NUMBER (icon_x
, 0);
3850 CHECK_NUMBER (icon_y
, 0);
3852 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3853 error ("Both left and top icon corners of icon must be specified");
3857 if (! EQ (icon_x
, Qunbound
))
3858 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3860 /* Start up iconic or window? */
3861 x_wm_set_window_state
3862 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3867 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3874 /* Make the GCs needed for this window, setting the
3875 background, border and mouse colors; also create the
3876 mouse cursor and the gray border tile. */
3878 static char cursor_bits
[] =
3880 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3881 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3882 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3883 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3890 XGCValues gc_values
;
3894 /* Create the GCs of this frame.
3895 Note that many default values are used. */
3898 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3899 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3900 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3901 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3902 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3904 GCLineWidth
| GCFont
3905 | GCForeground
| GCBackground
,
3908 /* Reverse video style. */
3909 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3910 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3911 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3913 GCFont
| GCForeground
| GCBackground
3917 /* Cursor has cursor-color background, background-color foreground. */
3918 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3919 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3920 gc_values
.fill_style
= FillOpaqueStippled
;
3922 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3923 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3924 cursor_bits
, 16, 16);
3925 f
->output_data
.x
->cursor_gc
3926 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3927 (GCFont
| GCForeground
| GCBackground
3928 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3932 f
->output_data
.x
->white_relief
.gc
= 0;
3933 f
->output_data
.x
->black_relief
.gc
= 0;
3935 /* Create the gray border tile used when the pointer is not in
3936 the frame. Since this depends on the frame's pixel values,
3937 this must be done on a per-frame basis. */
3938 f
->output_data
.x
->border_tile
3939 = (XCreatePixmapFromBitmapData
3940 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3941 gray_bits
, gray_width
, gray_height
,
3942 f
->output_data
.x
->foreground_pixel
,
3943 f
->output_data
.x
->background_pixel
,
3944 DefaultDepth (FRAME_X_DISPLAY (f
),
3945 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3950 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3952 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3953 Returns an Emacs frame object.\n\
3954 ALIST is an alist of frame parameters.\n\
3955 If the parameters specify that the frame should not have a minibuffer,\n\
3956 and do not specify a specific minibuffer window to use,\n\
3957 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3958 be shared by the new frame.\n\
3960 This function is an internal primitive--use `make-frame' instead.")
3965 Lisp_Object frame
, tem
;
3967 int minibuffer_only
= 0;
3968 long window_prompting
= 0;
3970 int count
= specpdl_ptr
- specpdl
;
3971 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3972 Lisp_Object display
;
3973 struct x_display_info
*dpyinfo
= NULL
;
3979 /* Use this general default value to start with
3980 until we know if this frame has a specified name. */
3981 Vx_resource_name
= Vinvocation_name
;
3983 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3984 if (EQ (display
, Qunbound
))
3986 dpyinfo
= check_x_display_info (display
);
3988 kb
= dpyinfo
->kboard
;
3990 kb
= &the_only_kboard
;
3993 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3995 && ! EQ (name
, Qunbound
)
3997 error ("Invalid frame name--not a string or nil");
4000 Vx_resource_name
= name
;
4002 /* See if parent window is specified. */
4003 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4004 if (EQ (parent
, Qunbound
))
4006 if (! NILP (parent
))
4007 CHECK_NUMBER (parent
, 0);
4009 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4010 /* No need to protect DISPLAY because that's not used after passing
4011 it to make_frame_without_minibuffer. */
4013 GCPRO4 (parms
, parent
, name
, frame
);
4014 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4016 if (EQ (tem
, Qnone
) || NILP (tem
))
4017 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4018 else if (EQ (tem
, Qonly
))
4020 f
= make_minibuffer_frame ();
4021 minibuffer_only
= 1;
4023 else if (WINDOWP (tem
))
4024 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4028 XSETFRAME (frame
, f
);
4030 /* Note that X Windows does support scroll bars. */
4031 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4033 f
->output_method
= output_x_window
;
4034 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4035 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4036 f
->output_data
.x
->icon_bitmap
= -1;
4037 f
->output_data
.x
->fontset
= -1;
4038 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4039 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4042 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4044 if (! STRINGP (f
->icon_name
))
4045 f
->icon_name
= Qnil
;
4047 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4049 FRAME_KBOARD (f
) = kb
;
4052 /* These colors will be set anyway later, but it's important
4053 to get the color reference counts right, so initialize them! */
4056 struct gcpro gcpro1
;
4058 black
= build_string ("black");
4060 f
->output_data
.x
->foreground_pixel
4061 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4062 f
->output_data
.x
->background_pixel
4063 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4064 f
->output_data
.x
->cursor_pixel
4065 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4066 f
->output_data
.x
->cursor_foreground_pixel
4067 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4068 f
->output_data
.x
->border_pixel
4069 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4070 f
->output_data
.x
->mouse_pixel
4071 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4075 /* Specify the parent under which to make this X window. */
4079 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4080 f
->output_data
.x
->explicit_parent
= 1;
4084 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4085 f
->output_data
.x
->explicit_parent
= 0;
4088 /* Set the name; the functions to which we pass f expect the name to
4090 if (EQ (name
, Qunbound
) || NILP (name
))
4092 f
->name
= build_string (dpyinfo
->x_id_name
);
4093 f
->explicit_name
= 0;
4098 f
->explicit_name
= 1;
4099 /* use the frame's title when getting resources for this frame. */
4100 specbind (Qx_resource_name
, name
);
4103 /* Extract the window parameters from the supplied values
4104 that are needed to determine window geometry. */
4108 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4111 /* First, try whatever font the caller has specified. */
4114 tem
= Fquery_fontset (font
, Qnil
);
4116 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4118 font
= x_new_font (f
, XSTRING (font
)->data
);
4121 /* Try out a font which we hope has bold and italic variations. */
4122 if (!STRINGP (font
))
4123 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4124 if (!STRINGP (font
))
4125 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4126 if (! STRINGP (font
))
4127 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4128 if (! STRINGP (font
))
4129 /* This was formerly the first thing tried, but it finds too many fonts
4130 and takes too long. */
4131 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4132 /* If those didn't work, look for something which will at least work. */
4133 if (! STRINGP (font
))
4134 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4136 if (! STRINGP (font
))
4137 font
= build_string ("fixed");
4139 x_default_parameter (f
, parms
, Qfont
, font
,
4140 "font", "Font", RES_TYPE_STRING
);
4144 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4145 whereby it fails to get any font. */
4146 xlwmenu_default_font
= f
->output_data
.x
->font
;
4149 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4150 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4152 /* This defaults to 2 in order to match xterm. We recognize either
4153 internalBorderWidth or internalBorder (which is what xterm calls
4155 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4159 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4160 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4161 if (! EQ (value
, Qunbound
))
4162 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4165 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4166 "internalBorderWidth", "internalBorderWidth",
4168 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4169 "verticalScrollBars", "ScrollBars",
4172 /* Also do the stuff which must be set before the window exists. */
4173 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4174 "foreground", "Foreground", RES_TYPE_STRING
);
4175 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4176 "background", "Background", RES_TYPE_STRING
);
4177 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4178 "pointerColor", "Foreground", RES_TYPE_STRING
);
4179 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4180 "cursorColor", "Foreground", RES_TYPE_STRING
);
4181 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4182 "borderColor", "BorderColor", RES_TYPE_STRING
);
4183 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4184 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4185 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4186 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4188 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4189 "scrollBarForeground",
4190 "ScrollBarForeground", 1);
4191 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4192 "scrollBarBackground",
4193 "ScrollBarBackground", 0);
4195 /* Init faces before x_default_parameter is called for scroll-bar
4196 parameters because that function calls x_set_scroll_bar_width,
4197 which calls change_frame_size, which calls Fset_window_buffer,
4198 which runs hooks, which call Fvertical_motion. At the end, we
4199 end up in init_iterator with a null face cache, which should not
4201 init_frame_faces (f
);
4203 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4204 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4205 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4206 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4207 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4208 "bufferPredicate", "BufferPredicate",
4210 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4211 "title", "Title", RES_TYPE_STRING
);
4213 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4214 window_prompting
= x_figure_window_size (f
, parms
);
4216 if (window_prompting
& XNegative
)
4218 if (window_prompting
& YNegative
)
4219 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4221 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4225 if (window_prompting
& YNegative
)
4226 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4228 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4231 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4233 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4234 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4236 /* Create the X widget or window. Add the tool-bar height to the
4237 initial frame height so that the user gets a text display area of
4238 the size he specified with -g or via .Xdefaults. Later changes
4239 of the tool-bar height don't change the frame size. This is done
4240 so that users can create tall Emacs frames without having to
4241 guess how tall the tool-bar will get. */
4242 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
4244 #ifdef USE_X_TOOLKIT
4245 x_window (f
, window_prompting
, minibuffer_only
);
4253 /* Now consider the frame official. */
4254 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4255 Vframe_list
= Fcons (frame
, Vframe_list
);
4257 /* We need to do this after creating the X window, so that the
4258 icon-creation functions can say whose icon they're describing. */
4259 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4260 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4262 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4263 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4264 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4265 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4266 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4267 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4268 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4269 "scrollBarWidth", "ScrollBarWidth",
4272 /* Dimensions, especially f->height, must be done via change_frame_size.
4273 Change will not be effected unless different from the current
4278 SET_FRAME_WIDTH (f
, 0);
4279 change_frame_size (f
, height
, width
, 1, 0, 0);
4281 #ifdef USE_X_TOOLKIT
4282 /* Create the menu bar. */
4283 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4285 /* If this signals an error, we haven't set size hints for the
4286 frame and we didn't make it visible. */
4287 initialize_frame_menubar (f
);
4289 /* This is a no-op, except under Motif where it arranges the
4290 main window for the widgets on it. */
4291 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4292 f
->output_data
.x
->menubar_widget
,
4293 f
->output_data
.x
->edit_widget
);
4295 #endif /* USE_X_TOOLKIT */
4297 /* Tell the server what size and position, etc, we want, and how
4298 badly we want them. This should be done after we have the menu
4299 bar so that its size can be taken into account. */
4301 x_wm_set_size_hint (f
, window_prompting
, 0);
4304 /* Make the window appear on the frame and enable display, unless
4305 the caller says not to. However, with explicit parent, Emacs
4306 cannot control visibility, so don't try. */
4307 if (! f
->output_data
.x
->explicit_parent
)
4309 Lisp_Object visibility
;
4311 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4313 if (EQ (visibility
, Qunbound
))
4316 if (EQ (visibility
, Qicon
))
4317 x_iconify_frame (f
);
4318 else if (! NILP (visibility
))
4319 x_make_frame_visible (f
);
4321 /* Must have been Qnil. */
4326 return unbind_to (count
, frame
);
4329 /* FRAME is used only to get a handle on the X display. We don't pass the
4330 display info directly because we're called from frame.c, which doesn't
4331 know about that structure. */
4334 x_get_focus_frame (frame
)
4335 struct frame
*frame
;
4337 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4339 if (! dpyinfo
->x_focus_frame
)
4342 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4347 /* In certain situations, when the window manager follows a
4348 click-to-focus policy, there seems to be no way around calling
4349 XSetInputFocus to give another frame the input focus .
4351 In an ideal world, XSetInputFocus should generally be avoided so
4352 that applications don't interfere with the window manager's focus
4353 policy. But I think it's okay to use when it's clearly done
4354 following a user-command. */
4356 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4357 "Set the input focus to FRAME.\n\
4358 FRAME nil means use the selected frame.")
4362 struct frame
*f
= check_x_frame (frame
);
4363 Display
*dpy
= FRAME_X_DISPLAY (f
);
4367 count
= x_catch_errors (dpy
);
4368 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4369 RevertToParent
, CurrentTime
);
4370 x_uncatch_errors (dpy
, count
);
4377 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4378 "Internal function called by `color-defined-p', which see.")
4380 Lisp_Object color
, frame
;
4383 FRAME_PTR f
= check_x_frame (frame
);
4385 CHECK_STRING (color
, 1);
4387 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4393 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4394 "Internal function called by `color-values', which see.")
4396 Lisp_Object color
, frame
;
4399 FRAME_PTR f
= check_x_frame (frame
);
4401 CHECK_STRING (color
, 1);
4403 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4407 rgb
[0] = make_number (foo
.red
);
4408 rgb
[1] = make_number (foo
.green
);
4409 rgb
[2] = make_number (foo
.blue
);
4410 return Flist (3, rgb
);
4416 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4417 "Internal function called by `display-color-p', which see.")
4419 Lisp_Object display
;
4421 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4423 if (dpyinfo
->n_planes
<= 2)
4426 switch (dpyinfo
->visual
->class)
4439 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4441 "Return t if the X display supports shades of gray.\n\
4442 Note that color displays do support shades of gray.\n\
4443 The optional argument DISPLAY specifies which display to ask about.\n\
4444 DISPLAY should be either a frame or a display name (a string).\n\
4445 If omitted or nil, that stands for the selected frame's display.")
4447 Lisp_Object display
;
4449 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4451 if (dpyinfo
->n_planes
<= 1)
4454 switch (dpyinfo
->visual
->class)
4469 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4471 "Returns the width in pixels of the X display DISPLAY.\n\
4472 The optional argument DISPLAY specifies which display to ask about.\n\
4473 DISPLAY should be either a frame or a display name (a string).\n\
4474 If omitted or nil, that stands for the selected frame's display.")
4476 Lisp_Object display
;
4478 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4480 return make_number (dpyinfo
->width
);
4483 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4484 Sx_display_pixel_height
, 0, 1, 0,
4485 "Returns the height in pixels of the X display DISPLAY.\n\
4486 The optional argument DISPLAY specifies which display to ask about.\n\
4487 DISPLAY should be either a frame or a display name (a string).\n\
4488 If omitted or nil, that stands for the selected frame's display.")
4490 Lisp_Object display
;
4492 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4494 return make_number (dpyinfo
->height
);
4497 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4499 "Returns the number of bitplanes of the X display DISPLAY.\n\
4500 The optional argument DISPLAY specifies which display to ask about.\n\
4501 DISPLAY should be either a frame or a display name (a string).\n\
4502 If omitted or nil, that stands for the selected frame's display.")
4504 Lisp_Object display
;
4506 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4508 return make_number (dpyinfo
->n_planes
);
4511 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4513 "Returns the number of color cells of the X display DISPLAY.\n\
4514 The optional argument DISPLAY specifies which display to ask about.\n\
4515 DISPLAY should be either a frame or a display name (a string).\n\
4516 If omitted or nil, that stands for the selected frame's display.")
4518 Lisp_Object display
;
4520 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4522 return make_number (DisplayCells (dpyinfo
->display
,
4523 XScreenNumberOfScreen (dpyinfo
->screen
)));
4526 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4527 Sx_server_max_request_size
,
4529 "Returns the maximum request size of the X server of display DISPLAY.\n\
4530 The optional argument DISPLAY specifies which display to ask about.\n\
4531 DISPLAY should be either a frame or a display name (a string).\n\
4532 If omitted or nil, that stands for the selected frame's display.")
4534 Lisp_Object display
;
4536 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4538 return make_number (MAXREQUEST (dpyinfo
->display
));
4541 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4542 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4543 The optional argument DISPLAY specifies which display to ask about.\n\
4544 DISPLAY should be either a frame or a display name (a string).\n\
4545 If omitted or nil, that stands for the selected frame's display.")
4547 Lisp_Object display
;
4549 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4550 char *vendor
= ServerVendor (dpyinfo
->display
);
4552 if (! vendor
) vendor
= "";
4553 return build_string (vendor
);
4556 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4557 "Returns the version numbers of the X server of display DISPLAY.\n\
4558 The value is a list of three integers: the major and minor\n\
4559 version numbers of the X Protocol in use, and the vendor-specific release\n\
4560 number. See also the function `x-server-vendor'.\n\n\
4561 The optional argument DISPLAY specifies which display to ask about.\n\
4562 DISPLAY should be either a frame or a display name (a string).\n\
4563 If omitted or nil, that stands for the selected frame's display.")
4565 Lisp_Object display
;
4567 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4568 Display
*dpy
= dpyinfo
->display
;
4570 return Fcons (make_number (ProtocolVersion (dpy
)),
4571 Fcons (make_number (ProtocolRevision (dpy
)),
4572 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4575 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4576 "Returns the number of screens on the X server of display DISPLAY.\n\
4577 The optional argument DISPLAY specifies which display to ask about.\n\
4578 DISPLAY should be either a frame or a display name (a string).\n\
4579 If omitted or nil, that stands for the selected frame's display.")
4581 Lisp_Object display
;
4583 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4585 return make_number (ScreenCount (dpyinfo
->display
));
4588 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4589 "Returns the height in millimeters of the X display DISPLAY.\n\
4590 The optional argument DISPLAY specifies which display to ask about.\n\
4591 DISPLAY should be either a frame or a display name (a string).\n\
4592 If omitted or nil, that stands for the selected frame's display.")
4594 Lisp_Object display
;
4596 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4598 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4601 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4602 "Returns the width in millimeters of the X display DISPLAY.\n\
4603 The optional argument DISPLAY specifies which display to ask about.\n\
4604 DISPLAY should be either a frame or a display name (a string).\n\
4605 If omitted or nil, that stands for the selected frame's display.")
4607 Lisp_Object display
;
4609 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4611 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4614 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4615 Sx_display_backing_store
, 0, 1, 0,
4616 "Returns an indication of whether X display DISPLAY does backing store.\n\
4617 The value may be `always', `when-mapped', or `not-useful'.\n\
4618 The optional argument DISPLAY specifies which display to ask about.\n\
4619 DISPLAY should be either a frame or a display name (a string).\n\
4620 If omitted or nil, that stands for the selected frame's display.")
4622 Lisp_Object display
;
4624 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4627 switch (DoesBackingStore (dpyinfo
->screen
))
4630 result
= intern ("always");
4634 result
= intern ("when-mapped");
4638 result
= intern ("not-useful");
4642 error ("Strange value for BackingStore parameter of screen");
4649 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4650 Sx_display_visual_class
, 0, 1, 0,
4651 "Returns the visual class of the X display DISPLAY.\n\
4652 The value is one of the symbols `static-gray', `gray-scale',\n\
4653 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4654 The optional argument DISPLAY specifies which display to ask about.\n\
4655 DISPLAY should be either a frame or a display name (a string).\n\
4656 If omitted or nil, that stands for the selected frame's display.")
4658 Lisp_Object display
;
4660 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4663 switch (dpyinfo
->visual
->class)
4666 result
= intern ("static-gray");
4669 result
= intern ("gray-scale");
4672 result
= intern ("static-color");
4675 result
= intern ("pseudo-color");
4678 result
= intern ("true-color");
4681 result
= intern ("direct-color");
4684 error ("Display has an unknown visual class");
4691 DEFUN ("x-display-save-under", Fx_display_save_under
,
4692 Sx_display_save_under
, 0, 1, 0,
4693 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4694 The optional argument DISPLAY specifies which display to ask about.\n\
4695 DISPLAY should be either a frame or a display name (a string).\n\
4696 If omitted or nil, that stands for the selected frame's display.")
4698 Lisp_Object display
;
4700 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4702 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4710 register struct frame
*f
;
4712 return PIXEL_WIDTH (f
);
4717 register struct frame
*f
;
4719 return PIXEL_HEIGHT (f
);
4724 register struct frame
*f
;
4726 return FONT_WIDTH (f
->output_data
.x
->font
);
4731 register struct frame
*f
;
4733 return f
->output_data
.x
->line_height
;
4738 register struct frame
*f
;
4740 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4745 /************************************************************************
4747 ************************************************************************/
4750 /* Mapping visual names to visuals. */
4752 static struct visual_class
4759 {"StaticGray", StaticGray
},
4760 {"GrayScale", GrayScale
},
4761 {"StaticColor", StaticColor
},
4762 {"PseudoColor", PseudoColor
},
4763 {"TrueColor", TrueColor
},
4764 {"DirectColor", DirectColor
},
4769 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4771 /* Value is the screen number of screen SCR. This is a substitute for
4772 the X function with the same name when that doesn't exist. */
4775 XScreenNumberOfScreen (scr
)
4776 register Screen
*scr
;
4778 Display
*dpy
= scr
->display
;
4781 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4782 if (scr
== dpy
->screens
[i
])
4788 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4791 /* Select the visual that should be used on display DPYINFO. Set
4792 members of DPYINFO appropriately. Called from x_term_init. */
4795 select_visual (dpyinfo
)
4796 struct x_display_info
*dpyinfo
;
4798 Display
*dpy
= dpyinfo
->display
;
4799 Screen
*screen
= dpyinfo
->screen
;
4802 /* See if a visual is specified. */
4803 value
= display_x_get_resource (dpyinfo
,
4804 build_string ("visualClass"),
4805 build_string ("VisualClass"),
4807 if (STRINGP (value
))
4809 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4810 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4811 depth, a decimal number. NAME is compared with case ignored. */
4812 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4817 strcpy (s
, XSTRING (value
)->data
);
4818 dash
= index (s
, '-');
4821 dpyinfo
->n_planes
= atoi (dash
+ 1);
4825 /* We won't find a matching visual with depth 0, so that
4826 an error will be printed below. */
4827 dpyinfo
->n_planes
= 0;
4829 /* Determine the visual class. */
4830 for (i
= 0; visual_classes
[i
].name
; ++i
)
4831 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4833 class = visual_classes
[i
].class;
4837 /* Look up a matching visual for the specified class. */
4839 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4840 dpyinfo
->n_planes
, class, &vinfo
))
4841 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4843 dpyinfo
->visual
= vinfo
.visual
;
4848 XVisualInfo
*vinfo
, vinfo_template
;
4850 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
4853 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
4855 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
4857 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4858 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
4859 &vinfo_template
, &n_visuals
);
4861 fatal ("Can't get proper X visual info");
4863 dpyinfo
->n_planes
= vinfo
->depth
;
4864 XFree ((char *) vinfo
);
4869 /* Return the X display structure for the display named NAME.
4870 Open a new connection if necessary. */
4872 struct x_display_info
*
4873 x_display_info_for_name (name
)
4877 struct x_display_info
*dpyinfo
;
4879 CHECK_STRING (name
, 0);
4881 if (! EQ (Vwindow_system
, intern ("x")))
4882 error ("Not using X Windows");
4884 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
4886 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
4889 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
4894 /* Use this general default value to start with. */
4895 Vx_resource_name
= Vinvocation_name
;
4897 validate_x_resource_name ();
4899 dpyinfo
= x_term_init (name
, (unsigned char *)0,
4900 (char *) XSTRING (Vx_resource_name
)->data
);
4903 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
4906 XSETFASTINT (Vwindow_system_version
, 11);
4912 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4913 1, 3, 0, "Open a connection to an X server.\n\
4914 DISPLAY is the name of the display to connect to.\n\
4915 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4916 If the optional third arg MUST-SUCCEED is non-nil,\n\
4917 terminate Emacs if we can't open the connection.")
4918 (display
, xrm_string
, must_succeed
)
4919 Lisp_Object display
, xrm_string
, must_succeed
;
4921 unsigned char *xrm_option
;
4922 struct x_display_info
*dpyinfo
;
4924 CHECK_STRING (display
, 0);
4925 if (! NILP (xrm_string
))
4926 CHECK_STRING (xrm_string
, 1);
4928 if (! EQ (Vwindow_system
, intern ("x")))
4929 error ("Not using X Windows");
4931 if (! NILP (xrm_string
))
4932 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4934 xrm_option
= (unsigned char *) 0;
4936 validate_x_resource_name ();
4938 /* This is what opens the connection and sets x_current_display.
4939 This also initializes many symbols, such as those used for input. */
4940 dpyinfo
= x_term_init (display
, xrm_option
,
4941 (char *) XSTRING (Vx_resource_name
)->data
);
4945 if (!NILP (must_succeed
))
4946 fatal ("Cannot connect to X server %s.\n\
4947 Check the DISPLAY environment variable or use `-d'.\n\
4948 Also use the `xhost' program to verify that it is set to permit\n\
4949 connections from your machine.\n",
4950 XSTRING (display
)->data
);
4952 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
4957 XSETFASTINT (Vwindow_system_version
, 11);
4961 DEFUN ("x-close-connection", Fx_close_connection
,
4962 Sx_close_connection
, 1, 1, 0,
4963 "Close the connection to DISPLAY's X server.\n\
4964 For DISPLAY, specify either a frame or a display name (a string).\n\
4965 If DISPLAY is nil, that stands for the selected frame's display.")
4967 Lisp_Object display
;
4969 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4972 if (dpyinfo
->reference_count
> 0)
4973 error ("Display still has frames on it");
4976 /* Free the fonts in the font table. */
4977 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4978 if (dpyinfo
->font_table
[i
].name
)
4980 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
4981 xfree (dpyinfo
->font_table
[i
].full_name
);
4982 xfree (dpyinfo
->font_table
[i
].name
);
4983 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
4986 x_destroy_all_bitmaps (dpyinfo
);
4987 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
4989 #ifdef USE_X_TOOLKIT
4990 XtCloseDisplay (dpyinfo
->display
);
4992 XCloseDisplay (dpyinfo
->display
);
4995 x_delete_display (dpyinfo
);
5001 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5002 "Return the list of display names that Emacs has connections to.")
5005 Lisp_Object tail
, result
;
5008 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5009 result
= Fcons (XCAR (XCAR (tail
)), result
);
5014 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5015 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5016 If ON is nil, allow buffering of requests.\n\
5017 Turning on synchronization prohibits the Xlib routines from buffering\n\
5018 requests and seriously degrades performance, but makes debugging much\n\
5020 The optional second argument DISPLAY specifies which display to act on.\n\
5021 DISPLAY should be either a frame or a display name (a string).\n\
5022 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5024 Lisp_Object display
, on
;
5026 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5028 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5033 /* Wait for responses to all X commands issued so far for frame F. */
5040 XSync (FRAME_X_DISPLAY (f
), False
);
5045 /***********************************************************************
5047 ***********************************************************************/
5049 /* Value is the number of elements of vector VECTOR. */
5051 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5053 /* List of supported image types. Use define_image_type to add new
5054 types. Use lookup_image_type to find a type for a given symbol. */
5056 static struct image_type
*image_types
;
5058 /* The symbol `image' which is the car of the lists used to represent
5061 extern Lisp_Object Qimage
;
5063 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5069 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5070 extern Lisp_Object QCdata
;
5071 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5072 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
5073 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5075 /* Other symbols. */
5077 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5079 /* Time in seconds after which images should be removed from the cache
5080 if not displayed. */
5082 Lisp_Object Vimage_cache_eviction_delay
;
5084 /* Function prototypes. */
5086 static void define_image_type
P_ ((struct image_type
*type
));
5087 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5088 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5089 static void x_laplace
P_ ((struct frame
*, struct image
*));
5090 static void x_emboss
P_ ((struct frame
*, struct image
*));
5091 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5095 /* Define a new image type from TYPE. This adds a copy of TYPE to
5096 image_types and adds the symbol *TYPE->type to Vimage_types. */
5099 define_image_type (type
)
5100 struct image_type
*type
;
5102 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5103 The initialized data segment is read-only. */
5104 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5105 bcopy (type
, p
, sizeof *p
);
5106 p
->next
= image_types
;
5108 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5112 /* Look up image type SYMBOL, and return a pointer to its image_type
5113 structure. Value is null if SYMBOL is not a known image type. */
5115 static INLINE
struct image_type
*
5116 lookup_image_type (symbol
)
5119 struct image_type
*type
;
5121 for (type
= image_types
; type
; type
= type
->next
)
5122 if (EQ (symbol
, *type
->type
))
5129 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5130 valid image specification is a list whose car is the symbol
5131 `image', and whose rest is a property list. The property list must
5132 contain a value for key `:type'. That value must be the name of a
5133 supported image type. The rest of the property list depends on the
5137 valid_image_p (object
)
5142 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5144 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5145 struct image_type
*type
= lookup_image_type (symbol
);
5148 valid_p
= type
->valid_p (object
);
5155 /* Log error message with format string FORMAT and argument ARG.
5156 Signaling an error, e.g. when an image cannot be loaded, is not a
5157 good idea because this would interrupt redisplay, and the error
5158 message display would lead to another redisplay. This function
5159 therefore simply displays a message. */
5162 image_error (format
, arg1
, arg2
)
5164 Lisp_Object arg1
, arg2
;
5166 add_to_log (format
, arg1
, arg2
);
5171 /***********************************************************************
5172 Image specifications
5173 ***********************************************************************/
5175 enum image_value_type
5177 IMAGE_DONT_CHECK_VALUE_TYPE
,
5180 IMAGE_POSITIVE_INTEGER_VALUE
,
5181 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5183 IMAGE_INTEGER_VALUE
,
5184 IMAGE_FUNCTION_VALUE
,
5189 /* Structure used when parsing image specifications. */
5191 struct image_keyword
5193 /* Name of keyword. */
5196 /* The type of value allowed. */
5197 enum image_value_type type
;
5199 /* Non-zero means key must be present. */
5202 /* Used to recognize duplicate keywords in a property list. */
5205 /* The value that was found. */
5210 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5212 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5215 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5216 has the format (image KEYWORD VALUE ...). One of the keyword/
5217 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5218 image_keywords structures of size NKEYWORDS describing other
5219 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5222 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5224 struct image_keyword
*keywords
;
5231 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5234 plist
= XCDR (spec
);
5235 while (CONSP (plist
))
5237 Lisp_Object key
, value
;
5239 /* First element of a pair must be a symbol. */
5241 plist
= XCDR (plist
);
5245 /* There must follow a value. */
5248 value
= XCAR (plist
);
5249 plist
= XCDR (plist
);
5251 /* Find key in KEYWORDS. Error if not found. */
5252 for (i
= 0; i
< nkeywords
; ++i
)
5253 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5259 /* Record that we recognized the keyword. If a keywords
5260 was found more than once, it's an error. */
5261 keywords
[i
].value
= value
;
5262 ++keywords
[i
].count
;
5264 if (keywords
[i
].count
> 1)
5267 /* Check type of value against allowed type. */
5268 switch (keywords
[i
].type
)
5270 case IMAGE_STRING_VALUE
:
5271 if (!STRINGP (value
))
5275 case IMAGE_SYMBOL_VALUE
:
5276 if (!SYMBOLP (value
))
5280 case IMAGE_POSITIVE_INTEGER_VALUE
:
5281 if (!INTEGERP (value
) || XINT (value
) <= 0)
5285 case IMAGE_ASCENT_VALUE
:
5286 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5288 else if (INTEGERP (value
)
5289 && XINT (value
) >= 0
5290 && XINT (value
) <= 100)
5294 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5295 if (!INTEGERP (value
) || XINT (value
) < 0)
5299 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5302 case IMAGE_FUNCTION_VALUE
:
5303 value
= indirect_function (value
);
5305 || COMPILEDP (value
)
5306 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5310 case IMAGE_NUMBER_VALUE
:
5311 if (!INTEGERP (value
) && !FLOATP (value
))
5315 case IMAGE_INTEGER_VALUE
:
5316 if (!INTEGERP (value
))
5320 case IMAGE_BOOL_VALUE
:
5321 if (!NILP (value
) && !EQ (value
, Qt
))
5330 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5334 /* Check that all mandatory fields are present. */
5335 for (i
= 0; i
< nkeywords
; ++i
)
5336 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5339 return NILP (plist
);
5343 /* Return the value of KEY in image specification SPEC. Value is nil
5344 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5345 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5348 image_spec_value (spec
, key
, found
)
5349 Lisp_Object spec
, key
;
5354 xassert (valid_image_p (spec
));
5356 for (tail
= XCDR (spec
);
5357 CONSP (tail
) && CONSP (XCDR (tail
));
5358 tail
= XCDR (XCDR (tail
)))
5360 if (EQ (XCAR (tail
), key
))
5364 return XCAR (XCDR (tail
));
5374 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5375 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5376 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5377 size in canonical character units.\n\
5378 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5379 or omitted means use the selected frame.")
5380 (spec
, pixels
, frame
)
5381 Lisp_Object spec
, pixels
, frame
;
5386 if (valid_image_p (spec
))
5388 struct frame
*f
= check_x_frame (frame
);
5389 int id
= lookup_image (f
, spec
);
5390 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5391 int width
= img
->width
+ 2 * img
->margin
;
5392 int height
= img
->height
+ 2 * img
->margin
;
5395 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5396 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5398 size
= Fcons (make_number (width
), make_number (height
));
5401 error ("Invalid image specification");
5407 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5408 "Return t if image SPEC has a mask bitmap.\n\
5409 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5410 or omitted means use the selected frame.")
5412 Lisp_Object spec
, frame
;
5417 if (valid_image_p (spec
))
5419 struct frame
*f
= check_x_frame (frame
);
5420 int id
= lookup_image (f
, spec
);
5421 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5426 error ("Invalid image specification");
5433 /***********************************************************************
5434 Image type independent image structures
5435 ***********************************************************************/
5437 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5438 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5441 /* Allocate and return a new image structure for image specification
5442 SPEC. SPEC has a hash value of HASH. */
5444 static struct image
*
5445 make_image (spec
, hash
)
5449 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5451 xassert (valid_image_p (spec
));
5452 bzero (img
, sizeof *img
);
5453 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5454 xassert (img
->type
!= NULL
);
5456 img
->data
.lisp_val
= Qnil
;
5457 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5463 /* Free image IMG which was used on frame F, including its resources. */
5472 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5474 /* Remove IMG from the hash table of its cache. */
5476 img
->prev
->next
= img
->next
;
5478 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5481 img
->next
->prev
= img
->prev
;
5483 c
->images
[img
->id
] = NULL
;
5485 /* Free resources, then free IMG. */
5486 img
->type
->free (f
, img
);
5492 /* Prepare image IMG for display on frame F. Must be called before
5493 drawing an image. */
5496 prepare_image_for_display (f
, img
)
5502 /* We're about to display IMG, so set its timestamp to `now'. */
5504 img
->timestamp
= EMACS_SECS (t
);
5506 /* If IMG doesn't have a pixmap yet, load it now, using the image
5507 type dependent loader function. */
5508 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5509 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5513 /* Value is the number of pixels for the ascent of image IMG when
5514 drawn in face FACE. */
5517 image_ascent (img
, face
)
5521 int height
= img
->height
+ img
->margin
;
5524 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5527 /* This expression is arranged so that if the image can't be
5528 exactly centered, it will be moved slightly up. This is
5529 because a typical font is `top-heavy' (due to the presence
5530 uppercase letters), so the image placement should err towards
5531 being top-heavy too. It also just generally looks better. */
5532 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5534 ascent
= height
/ 2;
5537 ascent
= height
* img
->ascent
/ 100.0;
5544 /***********************************************************************
5545 Helper functions for X image types
5546 ***********************************************************************/
5548 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5550 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5551 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5553 Lisp_Object color_name
,
5554 unsigned long dflt
));
5557 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5558 free the pixmap if any. MASK_P non-zero means clear the mask
5559 pixmap if any. COLORS_P non-zero means free colors allocated for
5560 the image, if any. */
5563 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5566 int pixmap_p
, mask_p
, colors_p
;
5568 if (pixmap_p
&& img
->pixmap
)
5570 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5574 if (mask_p
&& img
->mask
)
5576 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5580 if (colors_p
&& img
->ncolors
)
5582 x_free_colors (f
, img
->colors
, img
->ncolors
);
5583 xfree (img
->colors
);
5589 /* Free X resources of image IMG which is used on frame F. */
5592 x_clear_image (f
, img
)
5597 x_clear_image_1 (f
, img
, 1, 1, 1);
5602 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5603 cannot be allocated, use DFLT. Add a newly allocated color to
5604 IMG->colors, so that it can be freed again. Value is the pixel
5607 static unsigned long
5608 x_alloc_image_color (f
, img
, color_name
, dflt
)
5611 Lisp_Object color_name
;
5615 unsigned long result
;
5617 xassert (STRINGP (color_name
));
5619 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5621 /* This isn't called frequently so we get away with simply
5622 reallocating the color vector to the needed size, here. */
5625 (unsigned long *) xrealloc (img
->colors
,
5626 img
->ncolors
* sizeof *img
->colors
);
5627 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5628 result
= color
.pixel
;
5638 /***********************************************************************
5640 ***********************************************************************/
5642 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5645 /* Return a new, initialized image cache that is allocated from the
5646 heap. Call free_image_cache to free an image cache. */
5648 struct image_cache
*
5651 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5654 bzero (c
, sizeof *c
);
5656 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5657 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5658 c
->buckets
= (struct image
**) xmalloc (size
);
5659 bzero (c
->buckets
, size
);
5664 /* Free image cache of frame F. Be aware that X frames share images
5668 free_image_cache (f
)
5671 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5676 /* Cache should not be referenced by any frame when freed. */
5677 xassert (c
->refcount
== 0);
5679 for (i
= 0; i
< c
->used
; ++i
)
5680 free_image (f
, c
->images
[i
]);
5684 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5689 /* Clear image cache of frame F. FORCE_P non-zero means free all
5690 images. FORCE_P zero means clear only images that haven't been
5691 displayed for some time. Should be called from time to time to
5692 reduce the number of loaded images. If image-eviction-seconds is
5693 non-nil, this frees images in the cache which weren't displayed for
5694 at least that many seconds. */
5697 clear_image_cache (f
, force_p
)
5701 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5703 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5710 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5712 /* Block input so that we won't be interrupted by a SIGIO
5713 while being in an inconsistent state. */
5716 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5718 struct image
*img
= c
->images
[i
];
5720 && (force_p
|| img
->timestamp
< old
))
5722 free_image (f
, img
);
5727 /* We may be clearing the image cache because, for example,
5728 Emacs was iconified for a longer period of time. In that
5729 case, current matrices may still contain references to
5730 images freed above. So, clear these matrices. */
5733 Lisp_Object tail
, frame
;
5735 FOR_EACH_FRAME (tail
, frame
)
5737 struct frame
*f
= XFRAME (frame
);
5739 && FRAME_X_IMAGE_CACHE (f
) == c
)
5740 clear_current_matrices (f
);
5743 ++windows_or_buffers_changed
;
5751 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5753 "Clear the image cache of FRAME.\n\
5754 FRAME nil or omitted means use the selected frame.\n\
5755 FRAME t means clear the image caches of all frames.")
5763 FOR_EACH_FRAME (tail
, frame
)
5764 if (FRAME_X_P (XFRAME (frame
)))
5765 clear_image_cache (XFRAME (frame
), 1);
5768 clear_image_cache (check_x_frame (frame
), 1);
5774 /* Return the id of image with Lisp specification SPEC on frame F.
5775 SPEC must be a valid Lisp image specification (see valid_image_p). */
5778 lookup_image (f
, spec
)
5782 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5786 struct gcpro gcpro1
;
5789 /* F must be a window-system frame, and SPEC must be a valid image
5791 xassert (FRAME_WINDOW_P (f
));
5792 xassert (valid_image_p (spec
));
5796 /* Look up SPEC in the hash table of the image cache. */
5797 hash
= sxhash (spec
, 0);
5798 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5800 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
5801 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
5804 /* If not found, create a new image and cache it. */
5808 img
= make_image (spec
, hash
);
5809 cache_image (f
, img
);
5810 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5812 /* If we can't load the image, and we don't have a width and
5813 height, use some arbitrary width and height so that we can
5814 draw a rectangle for it. */
5815 if (img
->load_failed_p
)
5819 value
= image_spec_value (spec
, QCwidth
, NULL
);
5820 img
->width
= (INTEGERP (value
)
5821 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
5822 value
= image_spec_value (spec
, QCheight
, NULL
);
5823 img
->height
= (INTEGERP (value
)
5824 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
5828 /* Handle image type independent image attributes
5829 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
5830 Lisp_Object ascent
, margin
, relief
;
5833 ascent
= image_spec_value (spec
, QCascent
, NULL
);
5834 if (INTEGERP (ascent
))
5835 img
->ascent
= XFASTINT (ascent
);
5836 else if (EQ (ascent
, Qcenter
))
5837 img
->ascent
= CENTERED_IMAGE_ASCENT
;
5839 margin
= image_spec_value (spec
, QCmargin
, NULL
);
5840 if (INTEGERP (margin
) && XINT (margin
) >= 0)
5841 img
->margin
= XFASTINT (margin
);
5843 relief
= image_spec_value (spec
, QCrelief
, NULL
);
5844 if (INTEGERP (relief
))
5846 img
->relief
= XINT (relief
);
5847 img
->margin
+= abs (img
->relief
);
5850 /* Manipulation of the image's mask. */
5853 /* `:heuristic-mask t'
5855 means build a mask heuristically.
5856 `:heuristic-mask (R G B)'
5857 `:mask (heuristic (R G B))'
5858 means build a mask from color (R G B) in the
5861 means remove a mask, if any. */
5865 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
5867 x_build_heuristic_mask (f
, img
, mask
);
5872 mask
= image_spec_value (spec
, QCmask
, &found_p
);
5874 if (EQ (mask
, Qheuristic
))
5875 x_build_heuristic_mask (f
, img
, Qt
);
5876 else if (CONSP (mask
)
5877 && EQ (XCAR (mask
), Qheuristic
))
5879 if (CONSP (XCDR (mask
)))
5880 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
5882 x_build_heuristic_mask (f
, img
, XCDR (mask
));
5884 else if (NILP (mask
) && found_p
&& img
->mask
)
5886 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5892 /* Should we apply an image transformation algorithm? */
5895 Lisp_Object algorithm
;
5897 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
5898 if (EQ (algorithm
, Qdisabled
))
5899 x_disable_image (f
, img
);
5900 else if (EQ (algorithm
, Qlaplace
))
5902 else if (EQ (algorithm
, Qemboss
))
5904 else if (CONSP (algorithm
)
5905 && EQ (XCAR (algorithm
), Qedge_detection
))
5908 tem
= XCDR (algorithm
);
5910 x_edge_detection (f
, img
,
5911 Fplist_get (tem
, QCmatrix
),
5912 Fplist_get (tem
, QCcolor_adjustment
));
5918 xassert (!interrupt_input_blocked
);
5921 /* We're using IMG, so set its timestamp to `now'. */
5922 EMACS_GET_TIME (now
);
5923 img
->timestamp
= EMACS_SECS (now
);
5927 /* Value is the image id. */
5932 /* Cache image IMG in the image cache of frame F. */
5935 cache_image (f
, img
)
5939 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5942 /* Find a free slot in c->images. */
5943 for (i
= 0; i
< c
->used
; ++i
)
5944 if (c
->images
[i
] == NULL
)
5947 /* If no free slot found, maybe enlarge c->images. */
5948 if (i
== c
->used
&& c
->used
== c
->size
)
5951 c
->images
= (struct image
**) xrealloc (c
->images
,
5952 c
->size
* sizeof *c
->images
);
5955 /* Add IMG to c->images, and assign IMG an id. */
5961 /* Add IMG to the cache's hash table. */
5962 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5963 img
->next
= c
->buckets
[i
];
5965 img
->next
->prev
= img
;
5967 c
->buckets
[i
] = img
;
5971 /* Call FN on every image in the image cache of frame F. Used to mark
5972 Lisp Objects in the image cache. */
5975 forall_images_in_image_cache (f
, fn
)
5977 void (*fn
) P_ ((struct image
*img
));
5979 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
5981 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5985 for (i
= 0; i
< c
->used
; ++i
)
5994 /***********************************************************************
5996 ***********************************************************************/
5998 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
5999 XImage
**, Pixmap
*));
6000 static void x_destroy_x_image
P_ ((XImage
*));
6001 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6004 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6005 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6006 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6007 via xmalloc. Print error messages via image_error if an error
6008 occurs. Value is non-zero if successful. */
6011 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6013 int width
, height
, depth
;
6017 Display
*display
= FRAME_X_DISPLAY (f
);
6018 Screen
*screen
= FRAME_X_SCREEN (f
);
6019 Window window
= FRAME_X_WINDOW (f
);
6021 xassert (interrupt_input_blocked
);
6024 depth
= DefaultDepthOfScreen (screen
);
6025 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6026 depth
, ZPixmap
, 0, NULL
, width
, height
,
6027 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6030 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6034 /* Allocate image raster. */
6035 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6037 /* Allocate a pixmap of the same size. */
6038 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6039 if (*pixmap
== None
)
6041 x_destroy_x_image (*ximg
);
6043 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6051 /* Destroy XImage XIMG. Free XIMG->data. */
6054 x_destroy_x_image (ximg
)
6057 xassert (interrupt_input_blocked
);
6062 XDestroyImage (ximg
);
6067 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6068 are width and height of both the image and pixmap. */
6071 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6078 xassert (interrupt_input_blocked
);
6079 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6080 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6081 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6086 /***********************************************************************
6088 ***********************************************************************/
6090 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6091 static char *slurp_file
P_ ((char *, int *));
6094 /* Find image file FILE. Look in data-directory, then
6095 x-bitmap-file-path. Value is the full name of the file found, or
6096 nil if not found. */
6099 x_find_image_file (file
)
6102 Lisp_Object file_found
, search_path
;
6103 struct gcpro gcpro1
, gcpro2
;
6107 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6108 GCPRO2 (file_found
, search_path
);
6110 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6111 fd
= openp (search_path
, file
, "", &file_found
, 0);
6123 /* Read FILE into memory. Value is a pointer to a buffer allocated
6124 with xmalloc holding FILE's contents. Value is null if an error
6125 occurred. *SIZE is set to the size of the file. */
6128 slurp_file (file
, size
)
6136 if (stat (file
, &st
) == 0
6137 && (fp
= fopen (file
, "r")) != NULL
6138 && (buf
= (char *) xmalloc (st
.st_size
),
6139 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6160 /***********************************************************************
6162 ***********************************************************************/
6164 static int xbm_scan
P_ ((char **, char *, char *, int *));
6165 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6166 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6168 static int xbm_image_p
P_ ((Lisp_Object object
));
6169 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6171 static int xbm_file_p
P_ ((Lisp_Object
));
6174 /* Indices of image specification fields in xbm_format, below. */
6176 enum xbm_keyword_index
6194 /* Vector of image_keyword structures describing the format
6195 of valid XBM image specifications. */
6197 static struct image_keyword xbm_format
[XBM_LAST
] =
6199 {":type", IMAGE_SYMBOL_VALUE
, 1},
6200 {":file", IMAGE_STRING_VALUE
, 0},
6201 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6202 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6203 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6204 {":foreground", IMAGE_STRING_VALUE
, 0},
6205 {":background", IMAGE_STRING_VALUE
, 0},
6206 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6207 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6208 {":relief", IMAGE_INTEGER_VALUE
, 0},
6209 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6210 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6211 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6214 /* Structure describing the image type XBM. */
6216 static struct image_type xbm_type
=
6225 /* Tokens returned from xbm_scan. */
6234 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6235 A valid specification is a list starting with the symbol `image'
6236 The rest of the list is a property list which must contain an
6239 If the specification specifies a file to load, it must contain
6240 an entry `:file FILENAME' where FILENAME is a string.
6242 If the specification is for a bitmap loaded from memory it must
6243 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6244 WIDTH and HEIGHT are integers > 0. DATA may be:
6246 1. a string large enough to hold the bitmap data, i.e. it must
6247 have a size >= (WIDTH + 7) / 8 * HEIGHT
6249 2. a bool-vector of size >= WIDTH * HEIGHT
6251 3. a vector of strings or bool-vectors, one for each line of the
6254 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6255 may not be specified in this case because they are defined in the
6258 Both the file and data forms may contain the additional entries
6259 `:background COLOR' and `:foreground COLOR'. If not present,
6260 foreground and background of the frame on which the image is
6261 displayed is used. */
6264 xbm_image_p (object
)
6267 struct image_keyword kw
[XBM_LAST
];
6269 bcopy (xbm_format
, kw
, sizeof kw
);
6270 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6273 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6275 if (kw
[XBM_FILE
].count
)
6277 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6280 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6282 /* In-memory XBM file. */
6283 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6291 /* Entries for `:width', `:height' and `:data' must be present. */
6292 if (!kw
[XBM_WIDTH
].count
6293 || !kw
[XBM_HEIGHT
].count
6294 || !kw
[XBM_DATA
].count
)
6297 data
= kw
[XBM_DATA
].value
;
6298 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6299 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6301 /* Check type of data, and width and height against contents of
6307 /* Number of elements of the vector must be >= height. */
6308 if (XVECTOR (data
)->size
< height
)
6311 /* Each string or bool-vector in data must be large enough
6312 for one line of the image. */
6313 for (i
= 0; i
< height
; ++i
)
6315 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6319 if (XSTRING (elt
)->size
6320 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6323 else if (BOOL_VECTOR_P (elt
))
6325 if (XBOOL_VECTOR (elt
)->size
< width
)
6332 else if (STRINGP (data
))
6334 if (XSTRING (data
)->size
6335 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6338 else if (BOOL_VECTOR_P (data
))
6340 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6351 /* Scan a bitmap file. FP is the stream to read from. Value is
6352 either an enumerator from enum xbm_token, or a character for a
6353 single-character token, or 0 at end of file. If scanning an
6354 identifier, store the lexeme of the identifier in SVAL. If
6355 scanning a number, store its value in *IVAL. */
6358 xbm_scan (s
, end
, sval
, ival
)
6367 /* Skip white space. */
6368 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6373 else if (isdigit (c
))
6375 int value
= 0, digit
;
6377 if (c
== '0' && *s
< end
)
6380 if (c
== 'x' || c
== 'X')
6387 else if (c
>= 'a' && c
<= 'f')
6388 digit
= c
- 'a' + 10;
6389 else if (c
>= 'A' && c
<= 'F')
6390 digit
= c
- 'A' + 10;
6393 value
= 16 * value
+ digit
;
6396 else if (isdigit (c
))
6400 && (c
= *(*s
)++, isdigit (c
)))
6401 value
= 8 * value
+ c
- '0';
6408 && (c
= *(*s
)++, isdigit (c
)))
6409 value
= 10 * value
+ c
- '0';
6417 else if (isalpha (c
) || c
== '_')
6421 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6428 else if (c
== '/' && **s
== '*')
6430 /* C-style comment. */
6432 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6445 /* Replacement for XReadBitmapFileData which isn't available under old
6446 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6447 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6448 the image. Return in *DATA the bitmap data allocated with xmalloc.
6449 Value is non-zero if successful. DATA null means just test if
6450 CONTENTS looks like an in-memory XBM file. */
6453 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6454 char *contents
, *end
;
6455 int *width
, *height
;
6456 unsigned char **data
;
6459 char buffer
[BUFSIZ
];
6462 int bytes_per_line
, i
, nbytes
;
6468 LA1 = xbm_scan (&s, end, buffer, &value)
6470 #define expect(TOKEN) \
6471 if (LA1 != (TOKEN)) \
6476 #define expect_ident(IDENT) \
6477 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6482 *width
= *height
= -1;
6485 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6487 /* Parse defines for width, height and hot-spots. */
6491 expect_ident ("define");
6492 expect (XBM_TK_IDENT
);
6494 if (LA1
== XBM_TK_NUMBER
);
6496 char *p
= strrchr (buffer
, '_');
6497 p
= p
? p
+ 1 : buffer
;
6498 if (strcmp (p
, "width") == 0)
6500 else if (strcmp (p
, "height") == 0)
6503 expect (XBM_TK_NUMBER
);
6506 if (*width
< 0 || *height
< 0)
6508 else if (data
== NULL
)
6511 /* Parse bits. Must start with `static'. */
6512 expect_ident ("static");
6513 if (LA1
== XBM_TK_IDENT
)
6515 if (strcmp (buffer
, "unsigned") == 0)
6518 expect_ident ("char");
6520 else if (strcmp (buffer
, "short") == 0)
6524 if (*width
% 16 && *width
% 16 < 9)
6527 else if (strcmp (buffer
, "char") == 0)
6535 expect (XBM_TK_IDENT
);
6541 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6542 nbytes
= bytes_per_line
* *height
;
6543 p
= *data
= (char *) xmalloc (nbytes
);
6547 for (i
= 0; i
< nbytes
; i
+= 2)
6550 expect (XBM_TK_NUMBER
);
6553 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6556 if (LA1
== ',' || LA1
== '}')
6564 for (i
= 0; i
< nbytes
; ++i
)
6567 expect (XBM_TK_NUMBER
);
6571 if (LA1
== ',' || LA1
== '}')
6596 /* Load XBM image IMG which will be displayed on frame F from buffer
6597 CONTENTS. END is the end of the buffer. Value is non-zero if
6601 xbm_load_image (f
, img
, contents
, end
)
6604 char *contents
, *end
;
6607 unsigned char *data
;
6610 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6613 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6614 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6615 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6618 xassert (img
->width
> 0 && img
->height
> 0);
6620 /* Get foreground and background colors, maybe allocate colors. */
6621 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6623 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6625 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6627 background
= x_alloc_image_color (f
, img
, value
, background
);
6630 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6633 img
->width
, img
->height
,
6634 foreground
, background
,
6638 if (img
->pixmap
== None
)
6640 x_clear_image (f
, img
);
6641 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6647 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6653 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6660 return (STRINGP (data
)
6661 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6662 (XSTRING (data
)->data
6663 + STRING_BYTES (XSTRING (data
))),
6668 /* Fill image IMG which is used on frame F with pixmap data. Value is
6669 non-zero if successful. */
6677 Lisp_Object file_name
;
6679 xassert (xbm_image_p (img
->spec
));
6681 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6682 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6683 if (STRINGP (file_name
))
6688 struct gcpro gcpro1
;
6690 file
= x_find_image_file (file_name
);
6692 if (!STRINGP (file
))
6694 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6699 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6700 if (contents
== NULL
)
6702 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6707 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6712 struct image_keyword fmt
[XBM_LAST
];
6714 unsigned char *bitmap_data
;
6716 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6717 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6719 int parsed_p
, height
, width
;
6720 int in_memory_file_p
= 0;
6722 /* See if data looks like an in-memory XBM file. */
6723 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6724 in_memory_file_p
= xbm_file_p (data
);
6726 /* Parse the image specification. */
6727 bcopy (xbm_format
, fmt
, sizeof fmt
);
6728 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6731 /* Get specified width, and height. */
6732 if (!in_memory_file_p
)
6734 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6735 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6736 xassert (img
->width
> 0 && img
->height
> 0);
6739 /* Get foreground and background colors, maybe allocate colors. */
6740 if (fmt
[XBM_FOREGROUND
].count
)
6741 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6743 if (fmt
[XBM_BACKGROUND
].count
)
6744 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6747 if (in_memory_file_p
)
6748 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6749 (XSTRING (data
)->data
6750 + STRING_BYTES (XSTRING (data
))));
6757 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6759 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6760 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6762 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6764 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6766 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6769 else if (STRINGP (data
))
6770 bits
= XSTRING (data
)->data
;
6772 bits
= XBOOL_VECTOR (data
)->data
;
6774 /* Create the pixmap. */
6775 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6777 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6780 img
->width
, img
->height
,
6781 foreground
, background
,
6787 image_error ("Unable to create pixmap for XBM image `%s'",
6789 x_clear_image (f
, img
);
6799 /***********************************************************************
6801 ***********************************************************************/
6805 static int xpm_image_p
P_ ((Lisp_Object object
));
6806 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6807 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6809 #include "X11/xpm.h"
6811 /* The symbol `xpm' identifying XPM-format images. */
6815 /* Indices of image specification fields in xpm_format, below. */
6817 enum xpm_keyword_index
6832 /* Vector of image_keyword structures describing the format
6833 of valid XPM image specifications. */
6835 static struct image_keyword xpm_format
[XPM_LAST
] =
6837 {":type", IMAGE_SYMBOL_VALUE
, 1},
6838 {":file", IMAGE_STRING_VALUE
, 0},
6839 {":data", IMAGE_STRING_VALUE
, 0},
6840 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6841 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6842 {":relief", IMAGE_INTEGER_VALUE
, 0},
6843 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6844 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6845 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6846 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6849 /* Structure describing the image type XBM. */
6851 static struct image_type xpm_type
=
6861 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
6862 functions for allocating image colors. Our own functions handle
6863 color allocation failures more gracefully than the ones on the XPM
6866 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
6867 #define ALLOC_XPM_COLORS
6870 #ifdef ALLOC_XPM_COLORS
6872 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
6873 static void xpm_free_color_cache
P_ ((void));
6874 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
6875 static int xpm_color_bucket
P_ ((char *));
6876 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
6879 /* An entry in a hash table used to cache color definitions of named
6880 colors. This cache is necessary to speed up XPM image loading in
6881 case we do color allocations ourselves. Without it, we would need
6882 a call to XParseColor per pixel in the image. */
6884 struct xpm_cached_color
6886 /* Next in collision chain. */
6887 struct xpm_cached_color
*next
;
6889 /* Color definition (RGB and pixel color). */
6896 /* The hash table used for the color cache, and its bucket vector
6899 #define XPM_COLOR_CACHE_BUCKETS 1001
6900 struct xpm_cached_color
**xpm_color_cache
;
6902 /* Initialize the color cache. */
6905 xpm_init_color_cache (f
, attrs
)
6907 XpmAttributes
*attrs
;
6909 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
6910 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
6911 memset (xpm_color_cache
, 0, nbytes
);
6912 init_color_table ();
6914 if (attrs
->valuemask
& XpmColorSymbols
)
6919 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
6920 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
6921 attrs
->colorsymbols
[i
].value
, &color
))
6923 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
6925 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
6931 /* Free the color cache. */
6934 xpm_free_color_cache ()
6936 struct xpm_cached_color
*p
, *next
;
6939 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
6940 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
6946 xfree (xpm_color_cache
);
6947 xpm_color_cache
= NULL
;
6948 free_color_table ();
6952 /* Return the bucket index for color named COLOR_NAME in the color
6956 xpm_color_bucket (color_name
)
6962 for (s
= color_name
; *s
; ++s
)
6964 return h
%= XPM_COLOR_CACHE_BUCKETS
;
6968 /* On frame F, cache values COLOR for color with name COLOR_NAME.
6969 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
6972 static struct xpm_cached_color
*
6973 xpm_cache_color (f
, color_name
, color
, bucket
)
6980 struct xpm_cached_color
*p
;
6983 bucket
= xpm_color_bucket (color_name
);
6985 nbytes
= sizeof *p
+ strlen (color_name
);
6986 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
6987 strcpy (p
->name
, color_name
);
6989 p
->next
= xpm_color_cache
[bucket
];
6990 xpm_color_cache
[bucket
] = p
;
6995 /* Look up color COLOR_NAME for frame F in the color cache. If found,
6996 return the cached definition in *COLOR. Otherwise, make a new
6997 entry in the cache and allocate the color. Value is zero if color
6998 allocation failed. */
7001 xpm_lookup_color (f
, color_name
, color
)
7006 struct xpm_cached_color
*p
;
7007 int h
= xpm_color_bucket (color_name
);
7009 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7010 if (strcmp (p
->name
, color_name
) == 0)
7015 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7018 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7020 p
= xpm_cache_color (f
, color_name
, color
, h
);
7027 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7028 CLOSURE is a pointer to the frame on which we allocate the
7029 color. Return in *COLOR the allocated color. Value is non-zero
7033 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7040 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7044 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7045 is a pointer to the frame on which we allocate the color. Value is
7046 non-zero if successful. */
7049 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7059 #endif /* ALLOC_XPM_COLORS */
7062 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7063 for XPM images. Such a list must consist of conses whose car and
7067 xpm_valid_color_symbols_p (color_symbols
)
7068 Lisp_Object color_symbols
;
7070 while (CONSP (color_symbols
))
7072 Lisp_Object sym
= XCAR (color_symbols
);
7074 || !STRINGP (XCAR (sym
))
7075 || !STRINGP (XCDR (sym
)))
7077 color_symbols
= XCDR (color_symbols
);
7080 return NILP (color_symbols
);
7084 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7087 xpm_image_p (object
)
7090 struct image_keyword fmt
[XPM_LAST
];
7091 bcopy (xpm_format
, fmt
, sizeof fmt
);
7092 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7093 /* Either `:file' or `:data' must be present. */
7094 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7095 /* Either no `:color-symbols' or it's a list of conses
7096 whose car and cdr are strings. */
7097 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7098 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7102 /* Load image IMG which will be displayed on frame F. Value is
7103 non-zero if successful. */
7111 XpmAttributes attrs
;
7112 Lisp_Object specified_file
, color_symbols
;
7114 /* Configure the XPM lib. Use the visual of frame F. Allocate
7115 close colors. Return colors allocated. */
7116 bzero (&attrs
, sizeof attrs
);
7117 attrs
.visual
= FRAME_X_VISUAL (f
);
7118 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7119 attrs
.valuemask
|= XpmVisual
;
7120 attrs
.valuemask
|= XpmColormap
;
7122 #ifdef ALLOC_XPM_COLORS
7123 /* Allocate colors with our own functions which handle
7124 failing color allocation more gracefully. */
7125 attrs
.color_closure
= f
;
7126 attrs
.alloc_color
= xpm_alloc_color
;
7127 attrs
.free_colors
= xpm_free_colors
;
7128 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7129 #else /* not ALLOC_XPM_COLORS */
7130 /* Let the XPM lib allocate colors. */
7131 attrs
.valuemask
|= XpmReturnAllocPixels
;
7132 #ifdef XpmAllocCloseColors
7133 attrs
.alloc_close_colors
= 1;
7134 attrs
.valuemask
|= XpmAllocCloseColors
;
7135 #else /* not XpmAllocCloseColors */
7136 attrs
.closeness
= 600;
7137 attrs
.valuemask
|= XpmCloseness
;
7138 #endif /* not XpmAllocCloseColors */
7139 #endif /* ALLOC_XPM_COLORS */
7141 /* If image specification contains symbolic color definitions, add
7142 these to `attrs'. */
7143 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7144 if (CONSP (color_symbols
))
7147 XpmColorSymbol
*xpm_syms
;
7150 attrs
.valuemask
|= XpmColorSymbols
;
7152 /* Count number of symbols. */
7153 attrs
.numsymbols
= 0;
7154 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7157 /* Allocate an XpmColorSymbol array. */
7158 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7159 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7160 bzero (xpm_syms
, size
);
7161 attrs
.colorsymbols
= xpm_syms
;
7163 /* Fill the color symbol array. */
7164 for (tail
= color_symbols
, i
= 0;
7166 ++i
, tail
= XCDR (tail
))
7168 Lisp_Object name
= XCAR (XCAR (tail
));
7169 Lisp_Object color
= XCDR (XCAR (tail
));
7170 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7171 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7172 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7173 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7177 /* Create a pixmap for the image, either from a file, or from a
7178 string buffer containing data in the same format as an XPM file. */
7179 #ifdef ALLOC_XPM_COLORS
7180 xpm_init_color_cache (f
, &attrs
);
7183 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7184 if (STRINGP (specified_file
))
7186 Lisp_Object file
= x_find_image_file (specified_file
);
7187 if (!STRINGP (file
))
7189 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7193 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7194 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7199 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7200 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7201 XSTRING (buffer
)->data
,
7202 &img
->pixmap
, &img
->mask
,
7206 if (rc
== XpmSuccess
)
7208 #ifdef ALLOC_XPM_COLORS
7209 img
->colors
= colors_in_color_table (&img
->ncolors
);
7210 #else /* not ALLOC_XPM_COLORS */
7211 img
->ncolors
= attrs
.nalloc_pixels
;
7212 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7213 * sizeof *img
->colors
);
7214 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7216 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7217 #ifdef DEBUG_X_COLORS
7218 register_color (img
->colors
[i
]);
7221 #endif /* not ALLOC_XPM_COLORS */
7223 img
->width
= attrs
.width
;
7224 img
->height
= attrs
.height
;
7225 xassert (img
->width
> 0 && img
->height
> 0);
7227 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7228 XpmFreeAttributes (&attrs
);
7235 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7238 case XpmFileInvalid
:
7239 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7243 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7246 case XpmColorFailed
:
7247 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7251 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7256 #ifdef ALLOC_XPM_COLORS
7257 xpm_free_color_cache ();
7259 return rc
== XpmSuccess
;
7262 #endif /* HAVE_XPM != 0 */
7265 /***********************************************************************
7267 ***********************************************************************/
7269 /* An entry in the color table mapping an RGB color to a pixel color. */
7274 unsigned long pixel
;
7276 /* Next in color table collision list. */
7277 struct ct_color
*next
;
7280 /* The bucket vector size to use. Must be prime. */
7284 /* Value is a hash of the RGB color given by R, G, and B. */
7286 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7288 /* The color hash table. */
7290 struct ct_color
**ct_table
;
7292 /* Number of entries in the color table. */
7294 int ct_colors_allocated
;
7296 /* Initialize the color table. */
7301 int size
= CT_SIZE
* sizeof (*ct_table
);
7302 ct_table
= (struct ct_color
**) xmalloc (size
);
7303 bzero (ct_table
, size
);
7304 ct_colors_allocated
= 0;
7308 /* Free memory associated with the color table. */
7314 struct ct_color
*p
, *next
;
7316 for (i
= 0; i
< CT_SIZE
; ++i
)
7317 for (p
= ct_table
[i
]; p
; p
= next
)
7328 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7329 entry for that color already is in the color table, return the
7330 pixel color of that entry. Otherwise, allocate a new color for R,
7331 G, B, and make an entry in the color table. */
7333 static unsigned long
7334 lookup_rgb_color (f
, r
, g
, b
)
7338 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7339 int i
= hash
% CT_SIZE
;
7342 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7343 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7356 cmap
= FRAME_X_COLORMAP (f
);
7357 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7361 ++ct_colors_allocated
;
7363 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7367 p
->pixel
= color
.pixel
;
7368 p
->next
= ct_table
[i
];
7372 return FRAME_FOREGROUND_PIXEL (f
);
7379 /* Look up pixel color PIXEL which is used on frame F in the color
7380 table. If not already present, allocate it. Value is PIXEL. */
7382 static unsigned long
7383 lookup_pixel_color (f
, pixel
)
7385 unsigned long pixel
;
7387 int i
= pixel
% CT_SIZE
;
7390 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7391 if (p
->pixel
== pixel
)
7400 cmap
= FRAME_X_COLORMAP (f
);
7401 color
.pixel
= pixel
;
7402 x_query_color (f
, &color
);
7403 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7407 ++ct_colors_allocated
;
7409 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7414 p
->next
= ct_table
[i
];
7418 return FRAME_FOREGROUND_PIXEL (f
);
7425 /* Value is a vector of all pixel colors contained in the color table,
7426 allocated via xmalloc. Set *N to the number of colors. */
7428 static unsigned long *
7429 colors_in_color_table (n
)
7434 unsigned long *colors
;
7436 if (ct_colors_allocated
== 0)
7443 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7445 *n
= ct_colors_allocated
;
7447 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7448 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7449 colors
[j
++] = p
->pixel
;
7457 /***********************************************************************
7459 ***********************************************************************/
7461 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7462 int, XImage
*, int));
7463 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7464 XColor
*, int, XImage
*, int));
7465 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7466 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7467 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7469 /* Non-zero means draw a cross on images having `:algorithm
7472 int cross_disabled_images
;
7474 /* Edge detection matrices for different edge-detection
7477 static int emboss_matrix
[9] = {
7479 2, -1, 0, /* y - 1 */
7481 0, 1, -2 /* y + 1 */
7484 static int laplace_matrix
[9] = {
7486 1, 0, 0, /* y - 1 */
7488 0, 0, -1 /* y + 1 */
7491 /* Value is the intensity of the color whose red/green/blue values
7494 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7497 /* On frame F, return an array of XColor structures describing image
7498 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7499 non-zero means also fill the red/green/blue members of the XColor
7500 structures. Value is a pointer to the array of XColors structures,
7501 allocated with xmalloc; it must be freed by the caller. */
7504 x_to_xcolors (f
, img
, rgb_p
)
7513 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7515 /* Get the X image IMG->pixmap. */
7516 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7517 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7519 /* Fill the `pixel' members of the XColor array. I wished there
7520 were an easy and portable way to circumvent XGetPixel. */
7522 for (y
= 0; y
< img
->height
; ++y
)
7526 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7527 p
->pixel
= XGetPixel (ximg
, x
, y
);
7530 x_query_colors (f
, row
, img
->width
);
7533 XDestroyImage (ximg
);
7538 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7539 RGB members are set. F is the frame on which this all happens.
7540 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7543 x_from_xcolors (f
, img
, colors
)
7553 init_color_table ();
7555 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7558 for (y
= 0; y
< img
->height
; ++y
)
7559 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7561 unsigned long pixel
;
7562 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7563 XPutPixel (oimg
, x
, y
, pixel
);
7567 x_clear_image_1 (f
, img
, 1, 0, 1);
7569 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7570 x_destroy_x_image (oimg
);
7571 img
->pixmap
= pixmap
;
7572 img
->colors
= colors_in_color_table (&img
->ncolors
);
7573 free_color_table ();
7577 /* On frame F, perform edge-detection on image IMG.
7579 MATRIX is a nine-element array specifying the transformation
7580 matrix. See emboss_matrix for an example.
7582 COLOR_ADJUST is a color adjustment added to each pixel of the
7586 x_detect_edges (f
, img
, matrix
, color_adjust
)
7589 int matrix
[9], color_adjust
;
7591 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7595 for (i
= sum
= 0; i
< 9; ++i
)
7596 sum
+= abs (matrix
[i
]);
7598 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7600 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7602 for (y
= 0; y
< img
->height
; ++y
)
7604 p
= COLOR (new, 0, y
);
7605 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7606 p
= COLOR (new, img
->width
- 1, y
);
7607 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7610 for (x
= 1; x
< img
->width
- 1; ++x
)
7612 p
= COLOR (new, x
, 0);
7613 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7614 p
= COLOR (new, x
, img
->height
- 1);
7615 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7618 for (y
= 1; y
< img
->height
- 1; ++y
)
7620 p
= COLOR (new, 1, y
);
7622 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7624 int r
, g
, b
, y1
, x1
;
7627 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7628 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7631 XColor
*t
= COLOR (colors
, x1
, y1
);
7632 r
+= matrix
[i
] * t
->red
;
7633 g
+= matrix
[i
] * t
->green
;
7634 b
+= matrix
[i
] * t
->blue
;
7637 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7638 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7639 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7640 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7645 x_from_xcolors (f
, img
, new);
7651 /* Perform the pre-defined `emboss' edge-detection on image IMG
7659 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7663 /* Perform the pre-defined `laplace' edge-detection on image IMG
7671 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7675 /* Perform edge-detection on image IMG on frame F, with specified
7676 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7678 MATRIX must be either
7680 - a list of at least 9 numbers in row-major form
7681 - a vector of at least 9 numbers
7683 COLOR_ADJUST nil means use a default; otherwise it must be a
7687 x_edge_detection (f
, img
, matrix
, color_adjust
)
7690 Lisp_Object matrix
, color_adjust
;
7698 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7699 ++i
, matrix
= XCDR (matrix
))
7700 trans
[i
] = XFLOATINT (XCAR (matrix
));
7702 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7704 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7705 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7708 if (NILP (color_adjust
))
7709 color_adjust
= make_number (0xffff / 2);
7711 if (i
== 9 && NUMBERP (color_adjust
))
7712 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7716 /* Transform image IMG on frame F so that it looks disabled. */
7719 x_disable_image (f
, img
)
7723 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7725 if (dpyinfo
->n_planes
>= 2)
7727 /* Color (or grayscale). Convert to gray, and equalize. Just
7728 drawing such images with a stipple can look very odd, so
7729 we're using this method instead. */
7730 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7732 const int h
= 15000;
7733 const int l
= 30000;
7735 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7739 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7740 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7741 p
->red
= p
->green
= p
->blue
= i2
;
7744 x_from_xcolors (f
, img
, colors
);
7747 /* Draw a cross over the disabled image, if we must or if we
7749 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
7751 Display
*dpy
= FRAME_X_DISPLAY (f
);
7754 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
7755 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
7756 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
7757 img
->width
- 1, img
->height
- 1);
7758 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
7764 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
7765 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
7766 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
7767 img
->width
- 1, img
->height
- 1);
7768 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
7776 /* Build a mask for image IMG which is used on frame F. FILE is the
7777 name of an image file, for error messages. HOW determines how to
7778 determine the background color of IMG. If it is a list '(R G B)',
7779 with R, G, and B being integers >= 0, take that as the color of the
7780 background. Otherwise, determine the background color of IMG
7781 heuristically. Value is non-zero if successful. */
7784 x_build_heuristic_mask (f
, img
, how
)
7789 Display
*dpy
= FRAME_X_DISPLAY (f
);
7790 XImage
*ximg
, *mask_img
;
7791 int x
, y
, rc
, look_at_corners_p
;
7792 unsigned long bg
= 0;
7796 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
7800 /* Create an image and pixmap serving as mask. */
7801 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7802 &mask_img
, &img
->mask
);
7806 /* Get the X image of IMG->pixmap. */
7807 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7810 /* Determine the background color of ximg. If HOW is `(R G B)'
7811 take that as color. Otherwise, try to determine the color
7813 look_at_corners_p
= 1;
7821 && NATNUMP (XCAR (how
)))
7823 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7827 if (i
== 3 && NILP (how
))
7829 char color_name
[30];
7830 XColor exact
, color
;
7833 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7835 cmap
= FRAME_X_COLORMAP (f
);
7836 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7839 look_at_corners_p
= 0;
7844 if (look_at_corners_p
)
7846 unsigned long corners
[4];
7849 /* Get the colors at the corners of ximg. */
7850 corners
[0] = XGetPixel (ximg
, 0, 0);
7851 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7852 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7853 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7855 /* Choose the most frequently found color as background. */
7856 for (i
= best_count
= 0; i
< 4; ++i
)
7860 for (j
= n
= 0; j
< 4; ++j
)
7861 if (corners
[i
] == corners
[j
])
7865 bg
= corners
[i
], best_count
= n
;
7869 /* Set all bits in mask_img to 1 whose color in ximg is different
7870 from the background color bg. */
7871 for (y
= 0; y
< img
->height
; ++y
)
7872 for (x
= 0; x
< img
->width
; ++x
)
7873 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7875 /* Put mask_img into img->mask. */
7876 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7877 x_destroy_x_image (mask_img
);
7878 XDestroyImage (ximg
);
7885 /***********************************************************************
7886 PBM (mono, gray, color)
7887 ***********************************************************************/
7889 static int pbm_image_p
P_ ((Lisp_Object object
));
7890 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7891 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
7893 /* The symbol `pbm' identifying images of this type. */
7897 /* Indices of image specification fields in gs_format, below. */
7899 enum pbm_keyword_index
7915 /* Vector of image_keyword structures describing the format
7916 of valid user-defined image specifications. */
7918 static struct image_keyword pbm_format
[PBM_LAST
] =
7920 {":type", IMAGE_SYMBOL_VALUE
, 1},
7921 {":file", IMAGE_STRING_VALUE
, 0},
7922 {":data", IMAGE_STRING_VALUE
, 0},
7923 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7924 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7925 {":relief", IMAGE_INTEGER_VALUE
, 0},
7926 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7927 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7928 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7929 {":foreground", IMAGE_STRING_VALUE
, 0},
7930 {":background", IMAGE_STRING_VALUE
, 0}
7933 /* Structure describing the image type `pbm'. */
7935 static struct image_type pbm_type
=
7945 /* Return non-zero if OBJECT is a valid PBM image specification. */
7948 pbm_image_p (object
)
7951 struct image_keyword fmt
[PBM_LAST
];
7953 bcopy (pbm_format
, fmt
, sizeof fmt
);
7955 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
7958 /* Must specify either :data or :file. */
7959 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
7963 /* Scan a decimal number from *S and return it. Advance *S while
7964 reading the number. END is the end of the string. Value is -1 at
7968 pbm_scan_number (s
, end
)
7969 unsigned char **s
, *end
;
7971 int c
= 0, val
= -1;
7975 /* Skip white-space. */
7976 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
7981 /* Skip comment to end of line. */
7982 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
7985 else if (isdigit (c
))
7987 /* Read decimal number. */
7989 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
7990 val
= 10 * val
+ c
- '0';
8001 /* Load PBM image IMG for use on frame F. */
8009 int width
, height
, max_color_idx
= 0;
8011 Lisp_Object file
, specified_file
;
8012 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8013 struct gcpro gcpro1
;
8014 unsigned char *contents
= NULL
;
8015 unsigned char *end
, *p
;
8018 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8022 if (STRINGP (specified_file
))
8024 file
= x_find_image_file (specified_file
);
8025 if (!STRINGP (file
))
8027 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8032 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8033 if (contents
== NULL
)
8035 image_error ("Error reading `%s'", file
, Qnil
);
8041 end
= contents
+ size
;
8046 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8047 p
= XSTRING (data
)->data
;
8048 end
= p
+ STRING_BYTES (XSTRING (data
));
8051 /* Check magic number. */
8052 if (end
- p
< 2 || *p
++ != 'P')
8054 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8064 raw_p
= 0, type
= PBM_MONO
;
8068 raw_p
= 0, type
= PBM_GRAY
;
8072 raw_p
= 0, type
= PBM_COLOR
;
8076 raw_p
= 1, type
= PBM_MONO
;
8080 raw_p
= 1, type
= PBM_GRAY
;
8084 raw_p
= 1, type
= PBM_COLOR
;
8088 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8092 /* Read width, height, maximum color-component. Characters
8093 starting with `#' up to the end of a line are ignored. */
8094 width
= pbm_scan_number (&p
, end
);
8095 height
= pbm_scan_number (&p
, end
);
8097 if (type
!= PBM_MONO
)
8099 max_color_idx
= pbm_scan_number (&p
, end
);
8100 if (raw_p
&& max_color_idx
> 255)
8101 max_color_idx
= 255;
8106 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8109 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8110 &ximg
, &img
->pixmap
))
8113 /* Initialize the color hash table. */
8114 init_color_table ();
8116 if (type
== PBM_MONO
)
8119 struct image_keyword fmt
[PBM_LAST
];
8120 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8121 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8123 /* Parse the image specification. */
8124 bcopy (pbm_format
, fmt
, sizeof fmt
);
8125 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8127 /* Get foreground and background colors, maybe allocate colors. */
8128 if (fmt
[PBM_FOREGROUND
].count
)
8129 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8130 if (fmt
[PBM_BACKGROUND
].count
)
8131 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8133 for (y
= 0; y
< height
; ++y
)
8134 for (x
= 0; x
< width
; ++x
)
8144 g
= pbm_scan_number (&p
, end
);
8146 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8151 for (y
= 0; y
< height
; ++y
)
8152 for (x
= 0; x
< width
; ++x
)
8156 if (type
== PBM_GRAY
)
8157 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8166 r
= pbm_scan_number (&p
, end
);
8167 g
= pbm_scan_number (&p
, end
);
8168 b
= pbm_scan_number (&p
, end
);
8171 if (r
< 0 || g
< 0 || b
< 0)
8175 XDestroyImage (ximg
);
8176 image_error ("Invalid pixel value in image `%s'",
8181 /* RGB values are now in the range 0..max_color_idx.
8182 Scale this to the range 0..0xffff supported by X. */
8183 r
= (double) r
* 65535 / max_color_idx
;
8184 g
= (double) g
* 65535 / max_color_idx
;
8185 b
= (double) b
* 65535 / max_color_idx
;
8186 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8190 /* Store in IMG->colors the colors allocated for the image, and
8191 free the color table. */
8192 img
->colors
= colors_in_color_table (&img
->ncolors
);
8193 free_color_table ();
8195 /* Put the image into a pixmap. */
8196 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8197 x_destroy_x_image (ximg
);
8200 img
->height
= height
;
8209 /***********************************************************************
8211 ***********************************************************************/
8217 /* Function prototypes. */
8219 static int png_image_p
P_ ((Lisp_Object object
));
8220 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8222 /* The symbol `png' identifying images of this type. */
8226 /* Indices of image specification fields in png_format, below. */
8228 enum png_keyword_index
8242 /* Vector of image_keyword structures describing the format
8243 of valid user-defined image specifications. */
8245 static struct image_keyword png_format
[PNG_LAST
] =
8247 {":type", IMAGE_SYMBOL_VALUE
, 1},
8248 {":data", IMAGE_STRING_VALUE
, 0},
8249 {":file", IMAGE_STRING_VALUE
, 0},
8250 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8251 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8252 {":relief", IMAGE_INTEGER_VALUE
, 0},
8253 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8254 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8255 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8258 /* Structure describing the image type `png'. */
8260 static struct image_type png_type
=
8270 /* Return non-zero if OBJECT is a valid PNG image specification. */
8273 png_image_p (object
)
8276 struct image_keyword fmt
[PNG_LAST
];
8277 bcopy (png_format
, fmt
, sizeof fmt
);
8279 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8282 /* Must specify either the :data or :file keyword. */
8283 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8287 /* Error and warning handlers installed when the PNG library
8291 my_png_error (png_ptr
, msg
)
8292 png_struct
*png_ptr
;
8295 xassert (png_ptr
!= NULL
);
8296 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8297 longjmp (png_ptr
->jmpbuf
, 1);
8302 my_png_warning (png_ptr
, msg
)
8303 png_struct
*png_ptr
;
8306 xassert (png_ptr
!= NULL
);
8307 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8310 /* Memory source for PNG decoding. */
8312 struct png_memory_storage
8314 unsigned char *bytes
; /* The data */
8315 size_t len
; /* How big is it? */
8316 int index
; /* Where are we? */
8320 /* Function set as reader function when reading PNG image from memory.
8321 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8322 bytes from the input to DATA. */
8325 png_read_from_memory (png_ptr
, data
, length
)
8326 png_structp png_ptr
;
8330 struct png_memory_storage
*tbr
8331 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8333 if (length
> tbr
->len
- tbr
->index
)
8334 png_error (png_ptr
, "Read error");
8336 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8337 tbr
->index
= tbr
->index
+ length
;
8340 /* Load PNG image IMG for use on frame F. Value is non-zero if
8348 Lisp_Object file
, specified_file
;
8349 Lisp_Object specified_data
;
8351 XImage
*ximg
, *mask_img
= NULL
;
8352 struct gcpro gcpro1
;
8353 png_struct
*png_ptr
= NULL
;
8354 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8355 FILE *volatile fp
= NULL
;
8357 png_byte
* volatile pixels
= NULL
;
8358 png_byte
** volatile rows
= NULL
;
8359 png_uint_32 width
, height
;
8360 int bit_depth
, color_type
, interlace_type
;
8362 png_uint_32 row_bytes
;
8365 double screen_gamma
, image_gamma
;
8367 struct png_memory_storage tbr
; /* Data to be read */
8369 /* Find out what file to load. */
8370 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8371 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8375 if (NILP (specified_data
))
8377 file
= x_find_image_file (specified_file
);
8378 if (!STRINGP (file
))
8380 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8385 /* Open the image file. */
8386 fp
= fopen (XSTRING (file
)->data
, "rb");
8389 image_error ("Cannot open image file `%s'", file
, Qnil
);
8395 /* Check PNG signature. */
8396 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8397 || !png_check_sig (sig
, sizeof sig
))
8399 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8407 /* Read from memory. */
8408 tbr
.bytes
= XSTRING (specified_data
)->data
;
8409 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8412 /* Check PNG signature. */
8413 if (tbr
.len
< sizeof sig
8414 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8416 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8421 /* Need to skip past the signature. */
8422 tbr
.bytes
+= sizeof (sig
);
8425 /* Initialize read and info structs for PNG lib. */
8426 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8427 my_png_error
, my_png_warning
);
8430 if (fp
) fclose (fp
);
8435 info_ptr
= png_create_info_struct (png_ptr
);
8438 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8439 if (fp
) fclose (fp
);
8444 end_info
= png_create_info_struct (png_ptr
);
8447 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8448 if (fp
) fclose (fp
);
8453 /* Set error jump-back. We come back here when the PNG library
8454 detects an error. */
8455 if (setjmp (png_ptr
->jmpbuf
))
8459 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8462 if (fp
) fclose (fp
);
8467 /* Read image info. */
8468 if (!NILP (specified_data
))
8469 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8471 png_init_io (png_ptr
, fp
);
8473 png_set_sig_bytes (png_ptr
, sizeof sig
);
8474 png_read_info (png_ptr
, info_ptr
);
8475 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8476 &interlace_type
, NULL
, NULL
);
8478 /* If image contains simply transparency data, we prefer to
8479 construct a clipping mask. */
8480 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8485 /* This function is easier to write if we only have to handle
8486 one data format: RGB or RGBA with 8 bits per channel. Let's
8487 transform other formats into that format. */
8489 /* Strip more than 8 bits per channel. */
8490 if (bit_depth
== 16)
8491 png_set_strip_16 (png_ptr
);
8493 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8495 png_set_expand (png_ptr
);
8497 /* Convert grayscale images to RGB. */
8498 if (color_type
== PNG_COLOR_TYPE_GRAY
8499 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8500 png_set_gray_to_rgb (png_ptr
);
8502 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8503 gamma_str
= getenv ("SCREEN_GAMMA");
8504 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8506 /* Tell the PNG lib to handle gamma correction for us. */
8508 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8509 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8510 /* There is a special chunk in the image specifying the gamma. */
8511 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8514 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8515 /* Image contains gamma information. */
8516 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8518 /* Use a default of 0.5 for the image gamma. */
8519 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8521 /* Handle alpha channel by combining the image with a background
8522 color. Do this only if a real alpha channel is supplied. For
8523 simple transparency, we prefer a clipping mask. */
8526 png_color_16
*image_background
;
8528 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8529 /* Image contains a background color with which to
8530 combine the image. */
8531 png_set_background (png_ptr
, image_background
,
8532 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8535 /* Image does not contain a background color with which
8536 to combine the image data via an alpha channel. Use
8537 the frame's background instead. */
8540 png_color_16 frame_background
;
8542 cmap
= FRAME_X_COLORMAP (f
);
8543 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8544 x_query_color (f
, &color
);
8546 bzero (&frame_background
, sizeof frame_background
);
8547 frame_background
.red
= color
.red
;
8548 frame_background
.green
= color
.green
;
8549 frame_background
.blue
= color
.blue
;
8551 png_set_background (png_ptr
, &frame_background
,
8552 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8556 /* Update info structure. */
8557 png_read_update_info (png_ptr
, info_ptr
);
8559 /* Get number of channels. Valid values are 1 for grayscale images
8560 and images with a palette, 2 for grayscale images with transparency
8561 information (alpha channel), 3 for RGB images, and 4 for RGB
8562 images with alpha channel, i.e. RGBA. If conversions above were
8563 sufficient we should only have 3 or 4 channels here. */
8564 channels
= png_get_channels (png_ptr
, info_ptr
);
8565 xassert (channels
== 3 || channels
== 4);
8567 /* Number of bytes needed for one row of the image. */
8568 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8570 /* Allocate memory for the image. */
8571 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8572 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8573 for (i
= 0; i
< height
; ++i
)
8574 rows
[i
] = pixels
+ i
* row_bytes
;
8576 /* Read the entire image. */
8577 png_read_image (png_ptr
, rows
);
8578 png_read_end (png_ptr
, info_ptr
);
8585 /* Create the X image and pixmap. */
8586 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8590 /* Create an image and pixmap serving as mask if the PNG image
8591 contains an alpha channel. */
8594 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8595 &mask_img
, &img
->mask
))
8597 x_destroy_x_image (ximg
);
8598 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8603 /* Fill the X image and mask from PNG data. */
8604 init_color_table ();
8606 for (y
= 0; y
< height
; ++y
)
8608 png_byte
*p
= rows
[y
];
8610 for (x
= 0; x
< width
; ++x
)
8617 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8619 /* An alpha channel, aka mask channel, associates variable
8620 transparency with an image. Where other image formats
8621 support binary transparency---fully transparent or fully
8622 opaque---PNG allows up to 254 levels of partial transparency.
8623 The PNG library implements partial transparency by combining
8624 the image with a specified background color.
8626 I'm not sure how to handle this here nicely: because the
8627 background on which the image is displayed may change, for
8628 real alpha channel support, it would be necessary to create
8629 a new image for each possible background.
8631 What I'm doing now is that a mask is created if we have
8632 boolean transparency information. Otherwise I'm using
8633 the frame's background color to combine the image with. */
8638 XPutPixel (mask_img
, x
, y
, *p
> 0);
8644 /* Remember colors allocated for this image. */
8645 img
->colors
= colors_in_color_table (&img
->ncolors
);
8646 free_color_table ();
8649 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8654 img
->height
= height
;
8656 /* Put the image into the pixmap, then free the X image and its buffer. */
8657 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8658 x_destroy_x_image (ximg
);
8660 /* Same for the mask. */
8663 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8664 x_destroy_x_image (mask_img
);
8671 #endif /* HAVE_PNG != 0 */
8675 /***********************************************************************
8677 ***********************************************************************/
8681 /* Work around a warning about HAVE_STDLIB_H being redefined in
8683 #ifdef HAVE_STDLIB_H
8684 #define HAVE_STDLIB_H_1
8685 #undef HAVE_STDLIB_H
8686 #endif /* HAVE_STLIB_H */
8688 #include <jpeglib.h>
8692 #ifdef HAVE_STLIB_H_1
8693 #define HAVE_STDLIB_H 1
8696 static int jpeg_image_p
P_ ((Lisp_Object object
));
8697 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8699 /* The symbol `jpeg' identifying images of this type. */
8703 /* Indices of image specification fields in gs_format, below. */
8705 enum jpeg_keyword_index
8714 JPEG_HEURISTIC_MASK
,
8719 /* Vector of image_keyword structures describing the format
8720 of valid user-defined image specifications. */
8722 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8724 {":type", IMAGE_SYMBOL_VALUE
, 1},
8725 {":data", IMAGE_STRING_VALUE
, 0},
8726 {":file", IMAGE_STRING_VALUE
, 0},
8727 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8728 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8729 {":relief", IMAGE_INTEGER_VALUE
, 0},
8730 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8731 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8732 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8735 /* Structure describing the image type `jpeg'. */
8737 static struct image_type jpeg_type
=
8747 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8750 jpeg_image_p (object
)
8753 struct image_keyword fmt
[JPEG_LAST
];
8755 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8757 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8760 /* Must specify either the :data or :file keyword. */
8761 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8765 struct my_jpeg_error_mgr
8767 struct jpeg_error_mgr pub
;
8768 jmp_buf setjmp_buffer
;
8773 my_error_exit (cinfo
)
8776 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8777 longjmp (mgr
->setjmp_buffer
, 1);
8781 /* Init source method for JPEG data source manager. Called by
8782 jpeg_read_header() before any data is actually read. See
8783 libjpeg.doc from the JPEG lib distribution. */
8786 our_init_source (cinfo
)
8787 j_decompress_ptr cinfo
;
8792 /* Fill input buffer method for JPEG data source manager. Called
8793 whenever more data is needed. We read the whole image in one step,
8794 so this only adds a fake end of input marker at the end. */
8797 our_fill_input_buffer (cinfo
)
8798 j_decompress_ptr cinfo
;
8800 /* Insert a fake EOI marker. */
8801 struct jpeg_source_mgr
*src
= cinfo
->src
;
8802 static JOCTET buffer
[2];
8804 buffer
[0] = (JOCTET
) 0xFF;
8805 buffer
[1] = (JOCTET
) JPEG_EOI
;
8807 src
->next_input_byte
= buffer
;
8808 src
->bytes_in_buffer
= 2;
8813 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8814 is the JPEG data source manager. */
8817 our_skip_input_data (cinfo
, num_bytes
)
8818 j_decompress_ptr cinfo
;
8821 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8825 if (num_bytes
> src
->bytes_in_buffer
)
8826 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8828 src
->bytes_in_buffer
-= num_bytes
;
8829 src
->next_input_byte
+= num_bytes
;
8834 /* Method to terminate data source. Called by
8835 jpeg_finish_decompress() after all data has been processed. */
8838 our_term_source (cinfo
)
8839 j_decompress_ptr cinfo
;
8844 /* Set up the JPEG lib for reading an image from DATA which contains
8845 LEN bytes. CINFO is the decompression info structure created for
8846 reading the image. */
8849 jpeg_memory_src (cinfo
, data
, len
)
8850 j_decompress_ptr cinfo
;
8854 struct jpeg_source_mgr
*src
;
8856 if (cinfo
->src
== NULL
)
8858 /* First time for this JPEG object? */
8859 cinfo
->src
= (struct jpeg_source_mgr
*)
8860 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8861 sizeof (struct jpeg_source_mgr
));
8862 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8863 src
->next_input_byte
= data
;
8866 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8867 src
->init_source
= our_init_source
;
8868 src
->fill_input_buffer
= our_fill_input_buffer
;
8869 src
->skip_input_data
= our_skip_input_data
;
8870 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
8871 src
->term_source
= our_term_source
;
8872 src
->bytes_in_buffer
= len
;
8873 src
->next_input_byte
= data
;
8877 /* Load image IMG for use on frame F. Patterned after example.c
8878 from the JPEG lib. */
8885 struct jpeg_decompress_struct cinfo
;
8886 struct my_jpeg_error_mgr mgr
;
8887 Lisp_Object file
, specified_file
;
8888 Lisp_Object specified_data
;
8889 FILE * volatile fp
= NULL
;
8891 int row_stride
, x
, y
;
8892 XImage
*ximg
= NULL
;
8894 unsigned long *colors
;
8896 struct gcpro gcpro1
;
8898 /* Open the JPEG file. */
8899 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8900 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8904 if (NILP (specified_data
))
8906 file
= x_find_image_file (specified_file
);
8907 if (!STRINGP (file
))
8909 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8914 fp
= fopen (XSTRING (file
)->data
, "r");
8917 image_error ("Cannot open `%s'", file
, Qnil
);
8923 /* Customize libjpeg's error handling to call my_error_exit when an
8924 error is detected. This function will perform a longjmp. */
8925 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8926 mgr
.pub
.error_exit
= my_error_exit
;
8928 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8932 /* Called from my_error_exit. Display a JPEG error. */
8933 char buffer
[JMSG_LENGTH_MAX
];
8934 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8935 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
8936 build_string (buffer
));
8939 /* Close the input file and destroy the JPEG object. */
8941 fclose ((FILE *) fp
);
8942 jpeg_destroy_decompress (&cinfo
);
8944 /* If we already have an XImage, free that. */
8945 x_destroy_x_image (ximg
);
8947 /* Free pixmap and colors. */
8948 x_clear_image (f
, img
);
8954 /* Create the JPEG decompression object. Let it read from fp.
8955 Read the JPEG image header. */
8956 jpeg_create_decompress (&cinfo
);
8958 if (NILP (specified_data
))
8959 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
8961 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
8962 STRING_BYTES (XSTRING (specified_data
)));
8964 jpeg_read_header (&cinfo
, TRUE
);
8966 /* Customize decompression so that color quantization will be used.
8967 Start decompression. */
8968 cinfo
.quantize_colors
= TRUE
;
8969 jpeg_start_decompress (&cinfo
);
8970 width
= img
->width
= cinfo
.output_width
;
8971 height
= img
->height
= cinfo
.output_height
;
8973 /* Create X image and pixmap. */
8974 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8975 longjmp (mgr
.setjmp_buffer
, 2);
8977 /* Allocate colors. When color quantization is used,
8978 cinfo.actual_number_of_colors has been set with the number of
8979 colors generated, and cinfo.colormap is a two-dimensional array
8980 of color indices in the range 0..cinfo.actual_number_of_colors.
8981 No more than 255 colors will be generated. */
8985 if (cinfo
.out_color_components
> 2)
8986 ir
= 0, ig
= 1, ib
= 2;
8987 else if (cinfo
.out_color_components
> 1)
8988 ir
= 0, ig
= 1, ib
= 0;
8990 ir
= 0, ig
= 0, ib
= 0;
8992 /* Use the color table mechanism because it handles colors that
8993 cannot be allocated nicely. Such colors will be replaced with
8994 a default color, and we don't have to care about which colors
8995 can be freed safely, and which can't. */
8996 init_color_table ();
8997 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9000 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9002 /* Multiply RGB values with 255 because X expects RGB values
9003 in the range 0..0xffff. */
9004 int r
= cinfo
.colormap
[ir
][i
] << 8;
9005 int g
= cinfo
.colormap
[ig
][i
] << 8;
9006 int b
= cinfo
.colormap
[ib
][i
] << 8;
9007 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9010 /* Remember those colors actually allocated. */
9011 img
->colors
= colors_in_color_table (&img
->ncolors
);
9012 free_color_table ();
9016 row_stride
= width
* cinfo
.output_components
;
9017 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9019 for (y
= 0; y
< height
; ++y
)
9021 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9022 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9023 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9027 jpeg_finish_decompress (&cinfo
);
9028 jpeg_destroy_decompress (&cinfo
);
9030 fclose ((FILE *) fp
);
9032 /* Put the image into the pixmap. */
9033 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9034 x_destroy_x_image (ximg
);
9039 #endif /* HAVE_JPEG */
9043 /***********************************************************************
9045 ***********************************************************************/
9051 static int tiff_image_p
P_ ((Lisp_Object object
));
9052 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9054 /* The symbol `tiff' identifying images of this type. */
9058 /* Indices of image specification fields in tiff_format, below. */
9060 enum tiff_keyword_index
9069 TIFF_HEURISTIC_MASK
,
9074 /* Vector of image_keyword structures describing the format
9075 of valid user-defined image specifications. */
9077 static struct image_keyword tiff_format
[TIFF_LAST
] =
9079 {":type", IMAGE_SYMBOL_VALUE
, 1},
9080 {":data", IMAGE_STRING_VALUE
, 0},
9081 {":file", IMAGE_STRING_VALUE
, 0},
9082 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9083 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9084 {":relief", IMAGE_INTEGER_VALUE
, 0},
9085 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9086 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9087 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9090 /* Structure describing the image type `tiff'. */
9092 static struct image_type tiff_type
=
9102 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9105 tiff_image_p (object
)
9108 struct image_keyword fmt
[TIFF_LAST
];
9109 bcopy (tiff_format
, fmt
, sizeof fmt
);
9111 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9114 /* Must specify either the :data or :file keyword. */
9115 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9119 /* Reading from a memory buffer for TIFF images Based on the PNG
9120 memory source, but we have to provide a lot of extra functions.
9123 We really only need to implement read and seek, but I am not
9124 convinced that the TIFF library is smart enough not to destroy
9125 itself if we only hand it the function pointers we need to
9130 unsigned char *bytes
;
9138 tiff_read_from_memory (data
, buf
, size
)
9143 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9145 if (size
> src
->len
- src
->index
)
9147 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9154 tiff_write_from_memory (data
, buf
, size
)
9164 tiff_seek_in_memory (data
, off
, whence
)
9169 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9174 case SEEK_SET
: /* Go from beginning of source. */
9178 case SEEK_END
: /* Go from end of source. */
9179 idx
= src
->len
+ off
;
9182 case SEEK_CUR
: /* Go from current position. */
9183 idx
= src
->index
+ off
;
9186 default: /* Invalid `whence'. */
9190 if (idx
> src
->len
|| idx
< 0)
9199 tiff_close_memory (data
)
9208 tiff_mmap_memory (data
, pbase
, psize
)
9213 /* It is already _IN_ memory. */
9219 tiff_unmap_memory (data
, base
, size
)
9224 /* We don't need to do this. */
9229 tiff_size_of_memory (data
)
9232 return ((tiff_memory_source
*) data
)->len
;
9236 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9244 Lisp_Object file
, specified_file
;
9245 Lisp_Object specified_data
;
9247 int width
, height
, x
, y
;
9251 struct gcpro gcpro1
;
9252 tiff_memory_source memsrc
;
9254 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9255 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9259 if (NILP (specified_data
))
9261 /* Read from a file */
9262 file
= x_find_image_file (specified_file
);
9263 if (!STRINGP (file
))
9265 image_error ("Cannot find image file `%s'", file
, Qnil
);
9270 /* Try to open the image file. */
9271 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9274 image_error ("Cannot open `%s'", file
, Qnil
);
9281 /* Memory source! */
9282 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9283 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9286 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9287 (TIFFReadWriteProc
) tiff_read_from_memory
,
9288 (TIFFReadWriteProc
) tiff_write_from_memory
,
9289 tiff_seek_in_memory
,
9291 tiff_size_of_memory
,
9297 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9303 /* Get width and height of the image, and allocate a raster buffer
9304 of width x height 32-bit values. */
9305 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9306 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9307 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9309 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9313 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9319 /* Create the X image and pixmap. */
9320 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9327 /* Initialize the color table. */
9328 init_color_table ();
9330 /* Process the pixel raster. Origin is in the lower-left corner. */
9331 for (y
= 0; y
< height
; ++y
)
9333 uint32
*row
= buf
+ y
* width
;
9335 for (x
= 0; x
< width
; ++x
)
9337 uint32 abgr
= row
[x
];
9338 int r
= TIFFGetR (abgr
) << 8;
9339 int g
= TIFFGetG (abgr
) << 8;
9340 int b
= TIFFGetB (abgr
) << 8;
9341 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9345 /* Remember the colors allocated for the image. Free the color table. */
9346 img
->colors
= colors_in_color_table (&img
->ncolors
);
9347 free_color_table ();
9349 /* Put the image into the pixmap, then free the X image and its buffer. */
9350 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9351 x_destroy_x_image (ximg
);
9355 img
->height
= height
;
9361 #endif /* HAVE_TIFF != 0 */
9365 /***********************************************************************
9367 ***********************************************************************/
9371 #include <gif_lib.h>
9373 static int gif_image_p
P_ ((Lisp_Object object
));
9374 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9376 /* The symbol `gif' identifying images of this type. */
9380 /* Indices of image specification fields in gif_format, below. */
9382 enum gif_keyword_index
9397 /* Vector of image_keyword structures describing the format
9398 of valid user-defined image specifications. */
9400 static struct image_keyword gif_format
[GIF_LAST
] =
9402 {":type", IMAGE_SYMBOL_VALUE
, 1},
9403 {":data", IMAGE_STRING_VALUE
, 0},
9404 {":file", IMAGE_STRING_VALUE
, 0},
9405 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9406 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9407 {":relief", IMAGE_INTEGER_VALUE
, 0},
9408 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9409 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9410 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9411 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9414 /* Structure describing the image type `gif'. */
9416 static struct image_type gif_type
=
9426 /* Return non-zero if OBJECT is a valid GIF image specification. */
9429 gif_image_p (object
)
9432 struct image_keyword fmt
[GIF_LAST
];
9433 bcopy (gif_format
, fmt
, sizeof fmt
);
9435 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9438 /* Must specify either the :data or :file keyword. */
9439 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9443 /* Reading a GIF image from memory
9444 Based on the PNG memory stuff to a certain extent. */
9448 unsigned char *bytes
;
9455 /* Make the current memory source available to gif_read_from_memory.
9456 It's done this way because not all versions of libungif support
9457 a UserData field in the GifFileType structure. */
9458 static gif_memory_source
*current_gif_memory_src
;
9461 gif_read_from_memory (file
, buf
, len
)
9466 gif_memory_source
*src
= current_gif_memory_src
;
9468 if (len
> src
->len
- src
->index
)
9471 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9477 /* Load GIF image IMG for use on frame F. Value is non-zero if
9485 Lisp_Object file
, specified_file
;
9486 Lisp_Object specified_data
;
9487 int rc
, width
, height
, x
, y
, i
;
9489 ColorMapObject
*gif_color_map
;
9490 unsigned long pixel_colors
[256];
9492 struct gcpro gcpro1
;
9494 int ino
, image_left
, image_top
, image_width
, image_height
;
9495 gif_memory_source memsrc
;
9496 unsigned char *raster
;
9498 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9499 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9503 if (NILP (specified_data
))
9505 file
= x_find_image_file (specified_file
);
9506 if (!STRINGP (file
))
9508 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9513 /* Open the GIF file. */
9514 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9517 image_error ("Cannot open `%s'", file
, Qnil
);
9524 /* Read from memory! */
9525 current_gif_memory_src
= &memsrc
;
9526 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9527 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9530 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9533 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9539 /* Read entire contents. */
9540 rc
= DGifSlurp (gif
);
9541 if (rc
== GIF_ERROR
)
9543 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9544 DGifCloseFile (gif
);
9549 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9550 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9551 if (ino
>= gif
->ImageCount
)
9553 image_error ("Invalid image number `%s' in image `%s'",
9555 DGifCloseFile (gif
);
9560 width
= img
->width
= gif
->SWidth
;
9561 height
= img
->height
= gif
->SHeight
;
9563 /* Create the X image and pixmap. */
9564 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9566 DGifCloseFile (gif
);
9571 /* Allocate colors. */
9572 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9574 gif_color_map
= gif
->SColorMap
;
9575 init_color_table ();
9576 bzero (pixel_colors
, sizeof pixel_colors
);
9578 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9580 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9581 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9582 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9583 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9586 img
->colors
= colors_in_color_table (&img
->ncolors
);
9587 free_color_table ();
9589 /* Clear the part of the screen image that are not covered by
9590 the image from the GIF file. Full animated GIF support
9591 requires more than can be done here (see the gif89 spec,
9592 disposal methods). Let's simply assume that the part
9593 not covered by a sub-image is in the frame's background color. */
9594 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9595 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9596 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9597 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9599 for (y
= 0; y
< image_top
; ++y
)
9600 for (x
= 0; x
< width
; ++x
)
9601 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9603 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9604 for (x
= 0; x
< width
; ++x
)
9605 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9607 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9609 for (x
= 0; x
< image_left
; ++x
)
9610 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9611 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9612 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9615 /* Read the GIF image into the X image. We use a local variable
9616 `raster' here because RasterBits below is a char *, and invites
9617 problems with bytes >= 0x80. */
9618 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9620 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9622 static int interlace_start
[] = {0, 4, 2, 1};
9623 static int interlace_increment
[] = {8, 8, 4, 2};
9625 int row
= interlace_start
[0];
9629 for (y
= 0; y
< image_height
; y
++)
9631 if (row
>= image_height
)
9633 row
= interlace_start
[++pass
];
9634 while (row
>= image_height
)
9635 row
= interlace_start
[++pass
];
9638 for (x
= 0; x
< image_width
; x
++)
9640 int i
= raster
[(y
* image_width
) + x
];
9641 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9645 row
+= interlace_increment
[pass
];
9650 for (y
= 0; y
< image_height
; ++y
)
9651 for (x
= 0; x
< image_width
; ++x
)
9653 int i
= raster
[y
* image_width
+ x
];
9654 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9658 DGifCloseFile (gif
);
9660 /* Put the image into the pixmap, then free the X image and its buffer. */
9661 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9662 x_destroy_x_image (ximg
);
9668 #endif /* HAVE_GIF != 0 */
9672 /***********************************************************************
9674 ***********************************************************************/
9676 static int gs_image_p
P_ ((Lisp_Object object
));
9677 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9678 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9680 /* The symbol `postscript' identifying images of this type. */
9682 Lisp_Object Qpostscript
;
9684 /* Keyword symbols. */
9686 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9688 /* Indices of image specification fields in gs_format, below. */
9690 enum gs_keyword_index
9707 /* Vector of image_keyword structures describing the format
9708 of valid user-defined image specifications. */
9710 static struct image_keyword gs_format
[GS_LAST
] =
9712 {":type", IMAGE_SYMBOL_VALUE
, 1},
9713 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9714 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9715 {":file", IMAGE_STRING_VALUE
, 1},
9716 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9717 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9718 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9719 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9720 {":relief", IMAGE_INTEGER_VALUE
, 0},
9721 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9722 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9723 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9726 /* Structure describing the image type `ghostscript'. */
9728 static struct image_type gs_type
=
9738 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9741 gs_clear_image (f
, img
)
9745 /* IMG->data.ptr_val may contain a recorded colormap. */
9746 xfree (img
->data
.ptr_val
);
9747 x_clear_image (f
, img
);
9751 /* Return non-zero if OBJECT is a valid Ghostscript image
9758 struct image_keyword fmt
[GS_LAST
];
9762 bcopy (gs_format
, fmt
, sizeof fmt
);
9764 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
9767 /* Bounding box must be a list or vector containing 4 integers. */
9768 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9771 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9772 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9777 else if (VECTORP (tem
))
9779 if (XVECTOR (tem
)->size
!= 4)
9781 for (i
= 0; i
< 4; ++i
)
9782 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9792 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9801 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9802 struct gcpro gcpro1
, gcpro2
;
9804 double in_width
, in_height
;
9805 Lisp_Object pixel_colors
= Qnil
;
9807 /* Compute pixel size of pixmap needed from the given size in the
9808 image specification. Sizes in the specification are in pt. 1 pt
9809 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9811 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9812 in_width
= XFASTINT (pt_width
) / 72.0;
9813 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9814 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9815 in_height
= XFASTINT (pt_height
) / 72.0;
9816 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9818 /* Create the pixmap. */
9819 xassert (img
->pixmap
== None
);
9820 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9821 img
->width
, img
->height
,
9822 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9826 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9830 /* Call the loader to fill the pixmap. It returns a process object
9831 if successful. We do not record_unwind_protect here because
9832 other places in redisplay like calling window scroll functions
9833 don't either. Let the Lisp loader use `unwind-protect' instead. */
9834 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9836 sprintf (buffer
, "%lu %lu",
9837 (unsigned long) FRAME_X_WINDOW (f
),
9838 (unsigned long) img
->pixmap
);
9839 window_and_pixmap_id
= build_string (buffer
);
9841 sprintf (buffer
, "%lu %lu",
9842 FRAME_FOREGROUND_PIXEL (f
),
9843 FRAME_BACKGROUND_PIXEL (f
));
9844 pixel_colors
= build_string (buffer
);
9846 XSETFRAME (frame
, f
);
9847 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9849 loader
= intern ("gs-load-image");
9851 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9852 make_number (img
->width
),
9853 make_number (img
->height
),
9854 window_and_pixmap_id
,
9857 return PROCESSP (img
->data
.lisp_val
);
9861 /* Kill the Ghostscript process that was started to fill PIXMAP on
9862 frame F. Called from XTread_socket when receiving an event
9863 telling Emacs that Ghostscript has finished drawing. */
9866 x_kill_gs_process (pixmap
, f
)
9870 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9874 /* Find the image containing PIXMAP. */
9875 for (i
= 0; i
< c
->used
; ++i
)
9876 if (c
->images
[i
]->pixmap
== pixmap
)
9879 /* Kill the GS process. We should have found PIXMAP in the image
9880 cache and its image should contain a process object. */
9881 xassert (i
< c
->used
);
9883 xassert (PROCESSP (img
->data
.lisp_val
));
9884 Fkill_process (img
->data
.lisp_val
, Qnil
);
9885 img
->data
.lisp_val
= Qnil
;
9887 /* On displays with a mutable colormap, figure out the colors
9888 allocated for the image by looking at the pixels of an XImage for
9890 class = FRAME_X_VISUAL (f
)->class;
9891 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9897 /* Try to get an XImage for img->pixmep. */
9898 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9899 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9904 /* Initialize the color table. */
9905 init_color_table ();
9907 /* For each pixel of the image, look its color up in the
9908 color table. After having done so, the color table will
9909 contain an entry for each color used by the image. */
9910 for (y
= 0; y
< img
->height
; ++y
)
9911 for (x
= 0; x
< img
->width
; ++x
)
9913 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9914 lookup_pixel_color (f
, pixel
);
9917 /* Record colors in the image. Free color table and XImage. */
9918 img
->colors
= colors_in_color_table (&img
->ncolors
);
9919 free_color_table ();
9920 XDestroyImage (ximg
);
9922 #if 0 /* This doesn't seem to be the case. If we free the colors
9923 here, we get a BadAccess later in x_clear_image when
9924 freeing the colors. */
9925 /* We have allocated colors once, but Ghostscript has also
9926 allocated colors on behalf of us. So, to get the
9927 reference counts right, free them once. */
9929 x_free_colors (f
, img
->colors
, img
->ncolors
);
9933 image_error ("Cannot get X image of `%s'; colors will not be freed",
9942 /***********************************************************************
9944 ***********************************************************************/
9946 DEFUN ("x-change-window-property", Fx_change_window_property
,
9947 Sx_change_window_property
, 2, 3, 0,
9948 "Change window property PROP to VALUE on the X window of FRAME.\n\
9949 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9950 selected frame. Value is VALUE.")
9951 (prop
, value
, frame
)
9952 Lisp_Object frame
, prop
, value
;
9954 struct frame
*f
= check_x_frame (frame
);
9957 CHECK_STRING (prop
, 1);
9958 CHECK_STRING (value
, 2);
9961 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9962 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9963 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9964 XSTRING (value
)->data
, XSTRING (value
)->size
);
9966 /* Make sure the property is set when we return. */
9967 XFlush (FRAME_X_DISPLAY (f
));
9974 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9975 Sx_delete_window_property
, 1, 2, 0,
9976 "Remove window property PROP from X window of FRAME.\n\
9977 FRAME nil or omitted means use the selected frame. Value is PROP.")
9979 Lisp_Object prop
, frame
;
9981 struct frame
*f
= check_x_frame (frame
);
9984 CHECK_STRING (prop
, 1);
9986 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9987 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9989 /* Make sure the property is removed when we return. */
9990 XFlush (FRAME_X_DISPLAY (f
));
9997 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
9999 "Value is the value of window property PROP on FRAME.\n\
10000 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10001 if FRAME hasn't a property with name PROP or if PROP has no string\n\
10004 Lisp_Object prop
, frame
;
10006 struct frame
*f
= check_x_frame (frame
);
10009 Lisp_Object prop_value
= Qnil
;
10010 char *tmp_data
= NULL
;
10013 unsigned long actual_size
, bytes_remaining
;
10015 CHECK_STRING (prop
, 1);
10017 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10018 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10019 prop_atom
, 0, 0, False
, XA_STRING
,
10020 &actual_type
, &actual_format
, &actual_size
,
10021 &bytes_remaining
, (unsigned char **) &tmp_data
);
10024 int size
= bytes_remaining
;
10029 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10030 prop_atom
, 0, bytes_remaining
,
10032 &actual_type
, &actual_format
,
10033 &actual_size
, &bytes_remaining
,
10034 (unsigned char **) &tmp_data
);
10036 prop_value
= make_string (tmp_data
, size
);
10047 /***********************************************************************
10049 ***********************************************************************/
10051 /* If non-null, an asynchronous timer that, when it expires, displays
10052 a busy cursor on all frames. */
10054 static struct atimer
*busy_cursor_atimer
;
10056 /* Non-zero means a busy cursor is currently shown. */
10058 static int busy_cursor_shown_p
;
10060 /* Number of seconds to wait before displaying a busy cursor. */
10062 static Lisp_Object Vbusy_cursor_delay
;
10064 /* Default number of seconds to wait before displaying a busy
10067 #define DEFAULT_BUSY_CURSOR_DELAY 1
10069 /* Function prototypes. */
10071 static void show_busy_cursor
P_ ((struct atimer
*));
10072 static void hide_busy_cursor
P_ ((void));
10075 /* Cancel a currently active busy-cursor timer, and start a new one. */
10078 start_busy_cursor ()
10081 int secs
, usecs
= 0;
10083 cancel_busy_cursor ();
10085 if (INTEGERP (Vbusy_cursor_delay
)
10086 && XINT (Vbusy_cursor_delay
) > 0)
10087 secs
= XFASTINT (Vbusy_cursor_delay
);
10088 else if (FLOATP (Vbusy_cursor_delay
)
10089 && XFLOAT_DATA (Vbusy_cursor_delay
) > 0)
10092 tem
= Ftruncate (Vbusy_cursor_delay
, Qnil
);
10093 secs
= XFASTINT (tem
);
10094 usecs
= (XFLOAT_DATA (Vbusy_cursor_delay
) - secs
) * 1000000;
10097 secs
= DEFAULT_BUSY_CURSOR_DELAY
;
10099 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10100 busy_cursor_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10101 show_busy_cursor
, NULL
);
10105 /* Cancel the busy cursor timer if active, hide a busy cursor if
10109 cancel_busy_cursor ()
10111 if (busy_cursor_atimer
)
10113 cancel_atimer (busy_cursor_atimer
);
10114 busy_cursor_atimer
= NULL
;
10117 if (busy_cursor_shown_p
)
10118 hide_busy_cursor ();
10122 /* Timer function of busy_cursor_atimer. TIMER is equal to
10123 busy_cursor_atimer.
10125 Display a busy cursor on all frames by mapping the frames'
10126 busy_window. Set the busy_p flag in the frames' output_data.x
10127 structure to indicate that a busy cursor is shown on the
10131 show_busy_cursor (timer
)
10132 struct atimer
*timer
;
10134 /* The timer implementation will cancel this timer automatically
10135 after this function has run. Set busy_cursor_atimer to null
10136 so that we know the timer doesn't have to be canceled. */
10137 busy_cursor_atimer
= NULL
;
10139 if (!busy_cursor_shown_p
)
10141 Lisp_Object rest
, frame
;
10145 FOR_EACH_FRAME (rest
, frame
)
10146 if (FRAME_X_P (XFRAME (frame
)))
10148 struct frame
*f
= XFRAME (frame
);
10150 f
->output_data
.x
->busy_p
= 1;
10152 if (!f
->output_data
.x
->busy_window
)
10154 unsigned long mask
= CWCursor
;
10155 XSetWindowAttributes attrs
;
10157 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
10159 f
->output_data
.x
->busy_window
10160 = XCreateWindow (FRAME_X_DISPLAY (f
),
10161 FRAME_OUTER_WINDOW (f
),
10162 0, 0, 32000, 32000, 0, 0,
10168 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10169 XFlush (FRAME_X_DISPLAY (f
));
10172 busy_cursor_shown_p
= 1;
10178 /* Hide the busy cursor on all frames, if it is currently shown. */
10181 hide_busy_cursor ()
10183 if (busy_cursor_shown_p
)
10185 Lisp_Object rest
, frame
;
10188 FOR_EACH_FRAME (rest
, frame
)
10190 struct frame
*f
= XFRAME (frame
);
10193 /* Watch out for newly created frames. */
10194 && f
->output_data
.x
->busy_window
)
10196 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10197 /* Sync here because XTread_socket looks at the busy_p flag
10198 that is reset to zero below. */
10199 XSync (FRAME_X_DISPLAY (f
), False
);
10200 f
->output_data
.x
->busy_p
= 0;
10204 busy_cursor_shown_p
= 0;
10211 /***********************************************************************
10213 ***********************************************************************/
10215 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10218 /* The frame of a currently visible tooltip, or null. */
10220 struct frame
*tip_frame
;
10222 /* If non-nil, a timer started that hides the last tooltip when it
10225 Lisp_Object tip_timer
;
10228 /* Create a frame for a tooltip on the display described by DPYINFO.
10229 PARMS is a list of frame parameters. Value is the frame. */
10232 x_create_tip_frame (dpyinfo
, parms
)
10233 struct x_display_info
*dpyinfo
;
10237 Lisp_Object frame
, tem
;
10239 long window_prompting
= 0;
10241 int count
= specpdl_ptr
- specpdl
;
10242 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10247 /* Use this general default value to start with until we know if
10248 this frame has a specified name. */
10249 Vx_resource_name
= Vinvocation_name
;
10251 #ifdef MULTI_KBOARD
10252 kb
= dpyinfo
->kboard
;
10254 kb
= &the_only_kboard
;
10257 /* Get the name of the frame to use for resource lookup. */
10258 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10259 if (!STRINGP (name
)
10260 && !EQ (name
, Qunbound
)
10262 error ("Invalid frame name--not a string or nil");
10263 Vx_resource_name
= name
;
10266 GCPRO3 (parms
, name
, frame
);
10267 tip_frame
= f
= make_frame (1);
10268 XSETFRAME (frame
, f
);
10269 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10271 f
->output_method
= output_x_window
;
10272 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10273 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10274 f
->output_data
.x
->icon_bitmap
= -1;
10275 f
->output_data
.x
->fontset
= -1;
10276 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10277 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10278 f
->icon_name
= Qnil
;
10279 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10280 #ifdef MULTI_KBOARD
10281 FRAME_KBOARD (f
) = kb
;
10283 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10284 f
->output_data
.x
->explicit_parent
= 0;
10286 /* These colors will be set anyway later, but it's important
10287 to get the color reference counts right, so initialize them! */
10290 struct gcpro gcpro1
;
10292 black
= build_string ("black");
10294 f
->output_data
.x
->foreground_pixel
10295 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10296 f
->output_data
.x
->background_pixel
10297 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10298 f
->output_data
.x
->cursor_pixel
10299 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10300 f
->output_data
.x
->cursor_foreground_pixel
10301 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10302 f
->output_data
.x
->border_pixel
10303 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10304 f
->output_data
.x
->mouse_pixel
10305 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10309 /* Set the name; the functions to which we pass f expect the name to
10311 if (EQ (name
, Qunbound
) || NILP (name
))
10313 f
->name
= build_string (dpyinfo
->x_id_name
);
10314 f
->explicit_name
= 0;
10319 f
->explicit_name
= 1;
10320 /* use the frame's title when getting resources for this frame. */
10321 specbind (Qx_resource_name
, name
);
10324 /* Extract the window parameters from the supplied values
10325 that are needed to determine window geometry. */
10329 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10332 /* First, try whatever font the caller has specified. */
10333 if (STRINGP (font
))
10335 tem
= Fquery_fontset (font
, Qnil
);
10337 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10339 font
= x_new_font (f
, XSTRING (font
)->data
);
10342 /* Try out a font which we hope has bold and italic variations. */
10343 if (!STRINGP (font
))
10344 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10345 if (!STRINGP (font
))
10346 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10347 if (! STRINGP (font
))
10348 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10349 if (! STRINGP (font
))
10350 /* This was formerly the first thing tried, but it finds too many fonts
10351 and takes too long. */
10352 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10353 /* If those didn't work, look for something which will at least work. */
10354 if (! STRINGP (font
))
10355 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10357 if (! STRINGP (font
))
10358 font
= build_string ("fixed");
10360 x_default_parameter (f
, parms
, Qfont
, font
,
10361 "font", "Font", RES_TYPE_STRING
);
10364 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10365 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10367 /* This defaults to 2 in order to match xterm. We recognize either
10368 internalBorderWidth or internalBorder (which is what xterm calls
10370 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10374 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10375 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10376 if (! EQ (value
, Qunbound
))
10377 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10381 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10382 "internalBorderWidth", "internalBorderWidth",
10385 /* Also do the stuff which must be set before the window exists. */
10386 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10387 "foreground", "Foreground", RES_TYPE_STRING
);
10388 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10389 "background", "Background", RES_TYPE_STRING
);
10390 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10391 "pointerColor", "Foreground", RES_TYPE_STRING
);
10392 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10393 "cursorColor", "Foreground", RES_TYPE_STRING
);
10394 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10395 "borderColor", "BorderColor", RES_TYPE_STRING
);
10397 /* Init faces before x_default_parameter is called for scroll-bar
10398 parameters because that function calls x_set_scroll_bar_width,
10399 which calls change_frame_size, which calls Fset_window_buffer,
10400 which runs hooks, which call Fvertical_motion. At the end, we
10401 end up in init_iterator with a null face cache, which should not
10403 init_frame_faces (f
);
10405 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10406 window_prompting
= x_figure_window_size (f
, parms
);
10408 if (window_prompting
& XNegative
)
10410 if (window_prompting
& YNegative
)
10411 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10413 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10417 if (window_prompting
& YNegative
)
10418 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10420 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10423 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10425 XSetWindowAttributes attrs
;
10426 unsigned long mask
;
10429 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
10430 /* Window managers look at the override-redirect flag to determine
10431 whether or net to give windows a decoration (Xlib spec, chapter
10433 attrs
.override_redirect
= True
;
10434 attrs
.save_under
= True
;
10435 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10436 /* Arrange for getting MapNotify and UnmapNotify events. */
10437 attrs
.event_mask
= StructureNotifyMask
;
10439 = FRAME_X_WINDOW (f
)
10440 = XCreateWindow (FRAME_X_DISPLAY (f
),
10441 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10442 /* x, y, width, height */
10446 CopyFromParent
, InputOutput
, CopyFromParent
,
10453 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10454 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10455 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10456 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10457 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10458 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10460 /* Dimensions, especially f->height, must be done via change_frame_size.
10461 Change will not be effected unless different from the current
10464 height
= f
->height
;
10466 SET_FRAME_WIDTH (f
, 0);
10467 change_frame_size (f
, height
, width
, 1, 0, 0);
10473 /* It is now ok to make the frame official even if we get an error
10474 below. And the frame needs to be on Vframe_list or making it
10475 visible won't work. */
10476 Vframe_list
= Fcons (frame
, Vframe_list
);
10478 /* Now that the frame is official, it counts as a reference to
10480 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10482 return unbind_to (count
, frame
);
10486 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10487 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10488 A tooltip window is a small X window displaying a string.\n\
10490 FRAME nil or omitted means use the selected frame.\n\
10492 PARMS is an optional list of frame parameters which can be\n\
10493 used to change the tooltip's appearance.\n\
10495 Automatically hide the tooltip after TIMEOUT seconds.\n\
10496 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10498 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10499 the tooltip is displayed at that x-position. Otherwise it is\n\
10500 displayed at the mouse position, with offset DX added (default is 5 if\n\
10501 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10502 parameter is specified, it determines the y-position of the tooltip\n\
10503 window, otherwise it is displayed at the mouse position, with offset\n\
10504 DY added (default is -5).")
10505 (string
, frame
, parms
, timeout
, dx
, dy
)
10506 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10510 Window root
, child
;
10511 Lisp_Object buffer
, top
, left
;
10512 struct buffer
*old_buffer
;
10513 struct text_pos pos
;
10514 int i
, width
, height
;
10515 int root_x
, root_y
, win_x
, win_y
;
10517 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10518 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10519 int count
= specpdl_ptr
- specpdl
;
10521 specbind (Qinhibit_redisplay
, Qt
);
10523 GCPRO4 (string
, parms
, frame
, timeout
);
10525 CHECK_STRING (string
, 0);
10526 f
= check_x_frame (frame
);
10527 if (NILP (timeout
))
10528 timeout
= make_number (5);
10530 CHECK_NATNUM (timeout
, 2);
10533 dx
= make_number (5);
10535 CHECK_NUMBER (dx
, 5);
10538 dy
= make_number (-5);
10540 CHECK_NUMBER (dy
, 6);
10542 /* Hide a previous tip, if any. */
10545 /* Add default values to frame parameters. */
10546 if (NILP (Fassq (Qname
, parms
)))
10547 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10548 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10549 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10550 if (NILP (Fassq (Qborder_width
, parms
)))
10551 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10552 if (NILP (Fassq (Qborder_color
, parms
)))
10553 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10554 if (NILP (Fassq (Qbackground_color
, parms
)))
10555 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10558 /* Create a frame for the tooltip, and record it in the global
10559 variable tip_frame. */
10560 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
10561 tip_frame
= f
= XFRAME (frame
);
10563 /* Set up the frame's root window. Currently we use a size of 80
10564 columns x 40 lines. If someone wants to show a larger tip, he
10565 will loose. I don't think this is a realistic case. */
10566 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10567 w
->left
= w
->top
= make_number (0);
10568 w
->width
= make_number (80);
10569 w
->height
= make_number (40);
10571 w
->pseudo_window_p
= 1;
10573 /* Display the tooltip text in a temporary buffer. */
10574 buffer
= Fget_buffer_create (build_string (" *tip*"));
10575 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10576 old_buffer
= current_buffer
;
10577 set_buffer_internal_1 (XBUFFER (buffer
));
10579 Finsert (1, &string
);
10580 clear_glyph_matrix (w
->desired_matrix
);
10581 clear_glyph_matrix (w
->current_matrix
);
10582 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10583 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10585 /* Compute width and height of the tooltip. */
10586 width
= height
= 0;
10587 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10589 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10590 struct glyph
*last
;
10593 /* Stop at the first empty row at the end. */
10594 if (!row
->enabled_p
|| !row
->displays_text_p
)
10597 /* Let the row go over the full width of the frame. */
10598 row
->full_width_p
= 1;
10600 /* There's a glyph at the end of rows that is used to place
10601 the cursor there. Don't include the width of this glyph. */
10602 if (row
->used
[TEXT_AREA
])
10604 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10605 row_width
= row
->pixel_width
- last
->pixel_width
;
10608 row_width
= row
->pixel_width
;
10610 height
+= row
->height
;
10611 width
= max (width
, row_width
);
10614 /* Add the frame's internal border to the width and height the X
10615 window should have. */
10616 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10617 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10619 /* User-specified position? */
10620 left
= Fcdr (Fassq (Qleft
, parms
));
10621 top
= Fcdr (Fassq (Qtop
, parms
));
10623 /* Move the tooltip window where the mouse pointer is. Resize and
10626 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10627 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
10630 root_x
+= XINT (dx
);
10631 root_y
+= XINT (dy
);
10633 if (INTEGERP (left
))
10634 root_x
= XINT (left
);
10635 if (INTEGERP (top
))
10636 root_y
= XINT (top
);
10639 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10640 root_x
, root_y
- height
, width
, height
);
10641 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10644 /* Draw into the window. */
10645 w
->must_be_updated_p
= 1;
10646 update_single_window (w
, 1);
10648 /* Restore original current buffer. */
10649 set_buffer_internal_1 (old_buffer
);
10650 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
10652 /* Let the tip disappear after timeout seconds. */
10653 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
10654 intern ("x-hide-tip"));
10657 return unbind_to (count
, Qnil
);
10661 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
10662 "Hide the current tooltip window, if there is any.\n\
10663 Value is t is tooltip was open, nil otherwise.")
10666 int count
= specpdl_ptr
- specpdl
;
10669 specbind (Qinhibit_redisplay
, Qt
);
10671 if (!NILP (tip_timer
))
10673 call1 (intern ("cancel-timer"), tip_timer
);
10681 XSETFRAME (frame
, tip_frame
);
10682 Fdelete_frame (frame
, Qt
);
10687 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
10692 /***********************************************************************
10693 File selection dialog
10694 ***********************************************************************/
10698 /* Callback for "OK" and "Cancel" on file selection dialog. */
10701 file_dialog_cb (widget
, client_data
, call_data
)
10703 XtPointer call_data
, client_data
;
10705 int *result
= (int *) client_data
;
10706 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
10707 *result
= cb
->reason
;
10711 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
10712 "Read file name, prompting with PROMPT in directory DIR.\n\
10713 Use a file selection dialog.\n\
10714 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10715 specified. Don't let the user enter a file name in the file\n\
10716 selection dialog's entry field, if MUSTMATCH is non-nil.")
10717 (prompt
, dir
, default_filename
, mustmatch
)
10718 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
10721 struct frame
*f
= SELECTED_FRAME ();
10722 Lisp_Object file
= Qnil
;
10723 Widget dialog
, text
, list
, help
;
10726 extern XtAppContext Xt_app_con
;
10728 XmString dir_xmstring
, pattern_xmstring
;
10729 int popup_activated_flag
;
10730 int count
= specpdl_ptr
- specpdl
;
10731 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
10733 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
10734 CHECK_STRING (prompt
, 0);
10735 CHECK_STRING (dir
, 1);
10737 /* Prevent redisplay. */
10738 specbind (Qinhibit_redisplay
, Qt
);
10742 /* Create the dialog with PROMPT as title, using DIR as initial
10743 directory and using "*" as pattern. */
10744 dir
= Fexpand_file_name (dir
, Qnil
);
10745 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
10746 pattern_xmstring
= XmStringCreateLocalized ("*");
10748 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
10749 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
10750 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
10751 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
10752 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
10753 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
10755 XmStringFree (dir_xmstring
);
10756 XmStringFree (pattern_xmstring
);
10758 /* Add callbacks for OK and Cancel. */
10759 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
10760 (XtPointer
) &result
);
10761 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
10762 (XtPointer
) &result
);
10764 /* Disable the help button since we can't display help. */
10765 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
10766 XtSetSensitive (help
, False
);
10768 /* Mark OK button as default. */
10769 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
10770 XmNshowAsDefault
, True
, NULL
);
10772 /* If MUSTMATCH is non-nil, disable the file entry field of the
10773 dialog, so that the user must select a file from the files list
10774 box. We can't remove it because we wouldn't have a way to get at
10775 the result file name, then. */
10776 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
10777 if (!NILP (mustmatch
))
10780 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
10781 XtSetSensitive (text
, False
);
10782 XtSetSensitive (label
, False
);
10785 /* Manage the dialog, so that list boxes get filled. */
10786 XtManageChild (dialog
);
10788 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10789 must include the path for this to work. */
10790 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
10791 if (STRINGP (default_filename
))
10793 XmString default_xmstring
;
10797 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
10799 if (!XmListItemExists (list
, default_xmstring
))
10801 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10802 XmListAddItem (list
, default_xmstring
, 0);
10806 item_pos
= XmListItemPos (list
, default_xmstring
);
10807 XmStringFree (default_xmstring
);
10809 /* Select the item and scroll it into view. */
10810 XmListSelectPos (list
, item_pos
, True
);
10811 XmListSetPos (list
, item_pos
);
10814 #ifdef HAVE_MOTIF_2_1
10816 /* Process events until the user presses Cancel or OK. */
10818 while (result
== 0 || XtAppPending (Xt_app_con
))
10819 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
10821 #else /* not HAVE_MOTIF_2_1 */
10823 /* Process all events until the user presses Cancel or OK. */
10824 for (result
= 0; result
== 0;)
10827 Widget widget
, parent
;
10829 XtAppNextEvent (Xt_app_con
, &event
);
10831 /* See if the receiver of the event is one of the widgets of
10832 the file selection dialog. If so, dispatch it. If not,
10834 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
10836 while (parent
&& parent
!= dialog
)
10837 parent
= XtParent (parent
);
10839 if (parent
== dialog
10840 || (event
.type
== Expose
10841 && !process_expose_from_menu (event
)))
10842 XtDispatchEvent (&event
);
10845 #endif /* not HAVE_MOTIF_2_1 */
10847 /* Get the result. */
10848 if (result
== XmCR_OK
)
10853 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
10854 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
10855 XmStringFree (text
);
10856 file
= build_string (data
);
10863 XtUnmanageChild (dialog
);
10864 XtDestroyWidget (dialog
);
10868 /* Make "Cancel" equivalent to C-g. */
10870 Fsignal (Qquit
, Qnil
);
10872 return unbind_to (count
, file
);
10875 #endif /* USE_MOTIF */
10879 /***********************************************************************
10881 ***********************************************************************/
10886 /* This is zero if not using X windows. */
10889 /* The section below is built by the lisp expression at the top of the file,
10890 just above where these variables are declared. */
10891 /*&&& init symbols here &&&*/
10892 Qauto_raise
= intern ("auto-raise");
10893 staticpro (&Qauto_raise
);
10894 Qauto_lower
= intern ("auto-lower");
10895 staticpro (&Qauto_lower
);
10896 Qbar
= intern ("bar");
10898 Qborder_color
= intern ("border-color");
10899 staticpro (&Qborder_color
);
10900 Qborder_width
= intern ("border-width");
10901 staticpro (&Qborder_width
);
10902 Qbox
= intern ("box");
10904 Qcursor_color
= intern ("cursor-color");
10905 staticpro (&Qcursor_color
);
10906 Qcursor_type
= intern ("cursor-type");
10907 staticpro (&Qcursor_type
);
10908 Qgeometry
= intern ("geometry");
10909 staticpro (&Qgeometry
);
10910 Qicon_left
= intern ("icon-left");
10911 staticpro (&Qicon_left
);
10912 Qicon_top
= intern ("icon-top");
10913 staticpro (&Qicon_top
);
10914 Qicon_type
= intern ("icon-type");
10915 staticpro (&Qicon_type
);
10916 Qicon_name
= intern ("icon-name");
10917 staticpro (&Qicon_name
);
10918 Qinternal_border_width
= intern ("internal-border-width");
10919 staticpro (&Qinternal_border_width
);
10920 Qleft
= intern ("left");
10921 staticpro (&Qleft
);
10922 Qright
= intern ("right");
10923 staticpro (&Qright
);
10924 Qmouse_color
= intern ("mouse-color");
10925 staticpro (&Qmouse_color
);
10926 Qnone
= intern ("none");
10927 staticpro (&Qnone
);
10928 Qparent_id
= intern ("parent-id");
10929 staticpro (&Qparent_id
);
10930 Qscroll_bar_width
= intern ("scroll-bar-width");
10931 staticpro (&Qscroll_bar_width
);
10932 Qsuppress_icon
= intern ("suppress-icon");
10933 staticpro (&Qsuppress_icon
);
10934 Qundefined_color
= intern ("undefined-color");
10935 staticpro (&Qundefined_color
);
10936 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10937 staticpro (&Qvertical_scroll_bars
);
10938 Qvisibility
= intern ("visibility");
10939 staticpro (&Qvisibility
);
10940 Qwindow_id
= intern ("window-id");
10941 staticpro (&Qwindow_id
);
10942 Qouter_window_id
= intern ("outer-window-id");
10943 staticpro (&Qouter_window_id
);
10944 Qx_frame_parameter
= intern ("x-frame-parameter");
10945 staticpro (&Qx_frame_parameter
);
10946 Qx_resource_name
= intern ("x-resource-name");
10947 staticpro (&Qx_resource_name
);
10948 Quser_position
= intern ("user-position");
10949 staticpro (&Quser_position
);
10950 Quser_size
= intern ("user-size");
10951 staticpro (&Quser_size
);
10952 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10953 staticpro (&Qscroll_bar_foreground
);
10954 Qscroll_bar_background
= intern ("scroll-bar-background");
10955 staticpro (&Qscroll_bar_background
);
10956 Qscreen_gamma
= intern ("screen-gamma");
10957 staticpro (&Qscreen_gamma
);
10958 Qline_spacing
= intern ("line-spacing");
10959 staticpro (&Qline_spacing
);
10960 Qcenter
= intern ("center");
10961 staticpro (&Qcenter
);
10962 Qcompound_text
= intern ("compound-text");
10963 staticpro (&Qcompound_text
);
10964 /* This is the end of symbol initialization. */
10966 /* Text property `display' should be nonsticky by default. */
10967 Vtext_property_default_nonsticky
10968 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
10971 Qlaplace
= intern ("laplace");
10972 staticpro (&Qlaplace
);
10973 Qemboss
= intern ("emboss");
10974 staticpro (&Qemboss
);
10975 Qedge_detection
= intern ("edge-detection");
10976 staticpro (&Qedge_detection
);
10977 Qheuristic
= intern ("heuristic");
10978 staticpro (&Qheuristic
);
10979 QCmatrix
= intern (":matrix");
10980 staticpro (&QCmatrix
);
10981 QCcolor_adjustment
= intern (":color-adjustment");
10982 staticpro (&QCcolor_adjustment
);
10983 QCmask
= intern (":mask");
10984 staticpro (&QCmask
);
10986 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10987 staticpro (&Qface_set_after_frame_default
);
10989 Fput (Qundefined_color
, Qerror_conditions
,
10990 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10991 Fput (Qundefined_color
, Qerror_message
,
10992 build_string ("Undefined color"));
10994 init_x_parm_symbols ();
10996 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
10997 "Non-nil means always draw a cross over disabled images.\n\
10998 Disabled images are those having an `:algorithm disabled' property.\n\
10999 A cross is always drawn on black & white displays.");
11000 cross_disabled_images
= 0;
11002 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11003 "List of directories to search for bitmap files for X.");
11004 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11006 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11007 "The shape of the pointer when over text.\n\
11008 Changing the value does not affect existing frames\n\
11009 unless you set the mouse color.");
11010 Vx_pointer_shape
= Qnil
;
11012 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11013 "The name Emacs uses to look up X resources.\n\
11014 `x-get-resource' uses this as the first component of the instance name\n\
11015 when requesting resource values.\n\
11016 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
11017 was invoked, or to the value specified with the `-name' or `-rn'\n\
11018 switches, if present.\n\
11020 It may be useful to bind this variable locally around a call\n\
11021 to `x-get-resource'. See also the variable `x-resource-class'.");
11022 Vx_resource_name
= Qnil
;
11024 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11025 "The class Emacs uses to look up X resources.\n\
11026 `x-get-resource' uses this as the first component of the instance class\n\
11027 when requesting resource values.\n\
11028 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
11030 Setting this variable permanently is not a reasonable thing to do,\n\
11031 but binding this variable locally around a call to `x-get-resource'\n\
11032 is a reasonable practice. See also the variable `x-resource-name'.");
11033 Vx_resource_class
= build_string (EMACS_CLASS
);
11035 #if 0 /* This doesn't really do anything. */
11036 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11037 "The shape of the pointer when not over text.\n\
11038 This variable takes effect when you create a new frame\n\
11039 or when you set the mouse color.");
11041 Vx_nontext_pointer_shape
= Qnil
;
11043 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
11044 "The shape of the pointer when Emacs is busy.\n\
11045 This variable takes effect when you create a new frame\n\
11046 or when you set the mouse color.");
11047 Vx_busy_pointer_shape
= Qnil
;
11049 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
11050 "Non-zero means Emacs displays a busy cursor on window systems.");
11051 display_busy_cursor_p
= 1;
11053 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay
,
11054 "*Seconds to wait before displaying a busy-cursor.\n\
11055 Value must be an integer or float.");
11056 Vbusy_cursor_delay
= make_number (DEFAULT_BUSY_CURSOR_DELAY
);
11058 #if 0 /* This doesn't really do anything. */
11059 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11060 "The shape of the pointer when over the mode line.\n\
11061 This variable takes effect when you create a new frame\n\
11062 or when you set the mouse color.");
11064 Vx_mode_pointer_shape
= Qnil
;
11066 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11067 &Vx_sensitive_text_pointer_shape
,
11068 "The shape of the pointer when over mouse-sensitive text.\n\
11069 This variable takes effect when you create a new frame\n\
11070 or when you set the mouse color.");
11071 Vx_sensitive_text_pointer_shape
= Qnil
;
11073 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11074 "A string indicating the foreground color of the cursor box.");
11075 Vx_cursor_fore_pixel
= Qnil
;
11077 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11078 "Non-nil if no X window manager is in use.\n\
11079 Emacs doesn't try to figure this out; this is always nil\n\
11080 unless you set it to something else.");
11081 /* We don't have any way to find this out, so set it to nil
11082 and maybe the user would like to set it to t. */
11083 Vx_no_window_manager
= Qnil
;
11085 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11086 &Vx_pixel_size_width_font_regexp
,
11087 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11089 Since Emacs gets width of a font matching with this regexp from\n\
11090 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11091 such a font. This is especially effective for such large fonts as\n\
11092 Chinese, Japanese, and Korean.");
11093 Vx_pixel_size_width_font_regexp
= Qnil
;
11095 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11096 "Time after which cached images are removed from the cache.\n\
11097 When an image has not been displayed this many seconds, remove it\n\
11098 from the image cache. Value must be an integer or nil with nil\n\
11099 meaning don't clear the cache.");
11100 Vimage_cache_eviction_delay
= make_number (30 * 60);
11102 #ifdef USE_X_TOOLKIT
11103 Fprovide (intern ("x-toolkit"));
11106 Fprovide (intern ("motif"));
11109 defsubr (&Sx_get_resource
);
11111 /* X window properties. */
11112 defsubr (&Sx_change_window_property
);
11113 defsubr (&Sx_delete_window_property
);
11114 defsubr (&Sx_window_property
);
11116 defsubr (&Sxw_display_color_p
);
11117 defsubr (&Sx_display_grayscale_p
);
11118 defsubr (&Sxw_color_defined_p
);
11119 defsubr (&Sxw_color_values
);
11120 defsubr (&Sx_server_max_request_size
);
11121 defsubr (&Sx_server_vendor
);
11122 defsubr (&Sx_server_version
);
11123 defsubr (&Sx_display_pixel_width
);
11124 defsubr (&Sx_display_pixel_height
);
11125 defsubr (&Sx_display_mm_width
);
11126 defsubr (&Sx_display_mm_height
);
11127 defsubr (&Sx_display_screens
);
11128 defsubr (&Sx_display_planes
);
11129 defsubr (&Sx_display_color_cells
);
11130 defsubr (&Sx_display_visual_class
);
11131 defsubr (&Sx_display_backing_store
);
11132 defsubr (&Sx_display_save_under
);
11133 defsubr (&Sx_parse_geometry
);
11134 defsubr (&Sx_create_frame
);
11135 defsubr (&Sx_open_connection
);
11136 defsubr (&Sx_close_connection
);
11137 defsubr (&Sx_display_list
);
11138 defsubr (&Sx_synchronize
);
11139 defsubr (&Sx_focus_frame
);
11141 /* Setting callback functions for fontset handler. */
11142 get_font_info_func
= x_get_font_info
;
11144 #if 0 /* This function pointer doesn't seem to be used anywhere.
11145 And the pointer assigned has the wrong type, anyway. */
11146 list_fonts_func
= x_list_fonts
;
11149 load_font_func
= x_load_font
;
11150 find_ccl_program_func
= x_find_ccl_program
;
11151 query_font_func
= x_query_font
;
11152 set_frame_fontset_func
= x_set_font
;
11153 check_window_system_func
= check_x
;
11156 Qxbm
= intern ("xbm");
11158 QCtype
= intern (":type");
11159 staticpro (&QCtype
);
11160 QCalgorithm
= intern (":algorithm");
11161 staticpro (&QCalgorithm
);
11162 QCheuristic_mask
= intern (":heuristic-mask");
11163 staticpro (&QCheuristic_mask
);
11164 QCcolor_symbols
= intern (":color-symbols");
11165 staticpro (&QCcolor_symbols
);
11166 QCascent
= intern (":ascent");
11167 staticpro (&QCascent
);
11168 QCmargin
= intern (":margin");
11169 staticpro (&QCmargin
);
11170 QCrelief
= intern (":relief");
11171 staticpro (&QCrelief
);
11172 Qpostscript
= intern ("postscript");
11173 staticpro (&Qpostscript
);
11174 QCloader
= intern (":loader");
11175 staticpro (&QCloader
);
11176 QCbounding_box
= intern (":bounding-box");
11177 staticpro (&QCbounding_box
);
11178 QCpt_width
= intern (":pt-width");
11179 staticpro (&QCpt_width
);
11180 QCpt_height
= intern (":pt-height");
11181 staticpro (&QCpt_height
);
11182 QCindex
= intern (":index");
11183 staticpro (&QCindex
);
11184 Qpbm
= intern ("pbm");
11188 Qxpm
= intern ("xpm");
11193 Qjpeg
= intern ("jpeg");
11194 staticpro (&Qjpeg
);
11198 Qtiff
= intern ("tiff");
11199 staticpro (&Qtiff
);
11203 Qgif
= intern ("gif");
11208 Qpng
= intern ("png");
11212 defsubr (&Sclear_image_cache
);
11213 defsubr (&Simage_size
);
11214 defsubr (&Simage_mask_p
);
11216 busy_cursor_atimer
= NULL
;
11217 busy_cursor_shown_p
= 0;
11219 defsubr (&Sx_show_tip
);
11220 defsubr (&Sx_hide_tip
);
11221 staticpro (&tip_timer
);
11225 defsubr (&Sx_file_dialog
);
11233 image_types
= NULL
;
11234 Vimage_types
= Qnil
;
11236 define_image_type (&xbm_type
);
11237 define_image_type (&gs_type
);
11238 define_image_type (&pbm_type
);
11241 define_image_type (&xpm_type
);
11245 define_image_type (&jpeg_type
);
11249 define_image_type (&tiff_type
);
11253 define_image_type (&gif_type
);
11257 define_image_type (&png_type
);
11261 #endif /* HAVE_X_WINDOWS */