1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999, 2000, 2001
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
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 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 /* If non-nil, the pointer shape to indicate that windows can be
153 dragged horizontally. */
155 Lisp_Object Vx_window_horizontal_drag_shape
;
157 /* Color of chars displayed in cursor box. */
159 Lisp_Object Vx_cursor_fore_pixel
;
161 /* Nonzero if using X. */
165 /* Non nil if no window manager is in use. */
167 Lisp_Object Vx_no_window_manager
;
169 /* Search path for bitmap files. */
171 Lisp_Object Vx_bitmap_file_path
;
173 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
175 Lisp_Object Vx_pixel_size_width_font_regexp
;
177 /* Evaluate this expression to rebuild the section of syms_of_xfns
178 that initializes and staticpros the symbols declared below. Note
179 that Emacs 18 has a bug that keeps C-x C-e from being able to
180 evaluate this expression.
183 ;; Accumulate a list of the symbols we want to initialize from the
184 ;; declarations at the top of the file.
185 (goto-char (point-min))
186 (search-forward "/\*&&& symbols declared here &&&*\/\n")
188 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
190 (cons (buffer-substring (match-beginning 1) (match-end 1))
193 (setq symbol-list (nreverse symbol-list))
194 ;; Delete the section of syms_of_... where we initialize the symbols.
195 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
196 (let ((start (point)))
197 (while (looking-at "^ Q")
199 (kill-region start (point)))
200 ;; Write a new symbol initialization section.
202 (insert (format " %s = intern (\"" (car symbol-list)))
203 (let ((start (point)))
204 (insert (substring (car symbol-list) 1))
205 (subst-char-in-region start (point) ?_ ?-))
206 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
207 (setq symbol-list (cdr symbol-list)))))
211 /*&&& symbols declared here &&&*/
212 Lisp_Object Qauto_raise
;
213 Lisp_Object Qauto_lower
;
215 Lisp_Object Qborder_color
;
216 Lisp_Object Qborder_width
;
218 Lisp_Object Qcursor_color
;
219 Lisp_Object Qcursor_type
;
220 Lisp_Object Qgeometry
;
221 Lisp_Object Qicon_left
;
222 Lisp_Object Qicon_top
;
223 Lisp_Object Qicon_type
;
224 Lisp_Object Qicon_name
;
225 Lisp_Object Qinternal_border_width
;
228 Lisp_Object Qmouse_color
;
230 Lisp_Object Qouter_window_id
;
231 Lisp_Object Qparent_id
;
232 Lisp_Object Qscroll_bar_width
;
233 Lisp_Object Qsuppress_icon
;
234 extern Lisp_Object Qtop
;
235 Lisp_Object Qundefined_color
;
236 Lisp_Object Qvertical_scroll_bars
;
237 Lisp_Object Qvisibility
;
238 Lisp_Object Qwindow_id
;
239 Lisp_Object Qx_frame_parameter
;
240 Lisp_Object Qx_resource_name
;
241 Lisp_Object Quser_position
;
242 Lisp_Object Quser_size
;
243 extern Lisp_Object Qdisplay
;
244 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
245 Lisp_Object Qscreen_gamma
, Qline_spacing
, Qcenter
;
246 Lisp_Object Qcompound_text
;
248 /* The below are defined in frame.c. */
250 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
251 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
252 extern Lisp_Object Qtool_bar_lines
;
254 extern Lisp_Object Vwindow_system_version
;
256 Lisp_Object Qface_set_after_frame_default
;
259 int image_cache_refcount
, dpyinfo_refcount
;
264 /* Error if we are not connected to X. */
270 error ("X windows are not in use or not initialized");
273 /* Nonzero if we can use mouse menus.
274 You should not call this unless HAVE_MENUS is defined. */
282 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
283 and checking validity for X. */
286 check_x_frame (frame
)
292 frame
= selected_frame
;
293 CHECK_LIVE_FRAME (frame
, 0);
296 error ("Non-X frame used");
300 /* Let the user specify an X display with a frame.
301 nil stands for the selected frame--or, if that is not an X frame,
302 the first X display on the list. */
304 static struct x_display_info
*
305 check_x_display_info (frame
)
308 struct x_display_info
*dpyinfo
= NULL
;
312 struct frame
*sf
= XFRAME (selected_frame
);
314 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
315 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
316 else if (x_display_list
!= 0)
317 dpyinfo
= x_display_list
;
319 error ("X windows are not in use or not initialized");
321 else if (STRINGP (frame
))
322 dpyinfo
= x_display_info_for_name (frame
);
327 CHECK_LIVE_FRAME (frame
, 0);
330 error ("Non-X frame used");
331 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
338 /* Return the Emacs frame-object corresponding to an X window.
339 It could be the frame's main window or an icon window. */
341 /* This function can be called during GC, so use GC_xxx type test macros. */
344 x_window_to_frame (dpyinfo
, wdesc
)
345 struct x_display_info
*dpyinfo
;
348 Lisp_Object tail
, frame
;
351 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
354 if (!GC_FRAMEP (frame
))
357 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
359 if (f
->output_data
.x
->busy_window
== wdesc
)
362 if ((f
->output_data
.x
->edit_widget
363 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
364 /* A tooltip frame? */
365 || (!f
->output_data
.x
->edit_widget
366 && FRAME_X_WINDOW (f
) == wdesc
)
367 || f
->output_data
.x
->icon_desc
== wdesc
)
369 #else /* not USE_X_TOOLKIT */
370 if (FRAME_X_WINDOW (f
) == wdesc
371 || f
->output_data
.x
->icon_desc
== wdesc
)
373 #endif /* not USE_X_TOOLKIT */
379 /* Like x_window_to_frame but also compares the window with the widget's
383 x_any_window_to_frame (dpyinfo
, wdesc
)
384 struct x_display_info
*dpyinfo
;
387 Lisp_Object tail
, frame
;
388 struct frame
*f
, *found
;
392 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
395 if (!GC_FRAMEP (frame
))
399 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
401 /* This frame matches if the window is any of its widgets. */
402 x
= f
->output_data
.x
;
403 if (x
->busy_window
== wdesc
)
407 if (wdesc
== XtWindow (x
->widget
)
408 || wdesc
== XtWindow (x
->column_widget
)
409 || wdesc
== XtWindow (x
->edit_widget
))
411 /* Match if the window is this frame's menubar. */
412 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
415 else if (FRAME_X_WINDOW (f
) == wdesc
)
416 /* A tooltip frame. */
424 /* Likewise, but exclude the menu bar widget. */
427 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
428 struct x_display_info
*dpyinfo
;
431 Lisp_Object tail
, frame
;
435 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
438 if (!GC_FRAMEP (frame
))
441 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
443 x
= f
->output_data
.x
;
444 /* This frame matches if the window is any of its widgets. */
445 if (x
->busy_window
== wdesc
)
449 if (wdesc
== XtWindow (x
->widget
)
450 || wdesc
== XtWindow (x
->column_widget
)
451 || wdesc
== XtWindow (x
->edit_widget
))
454 else if (FRAME_X_WINDOW (f
) == wdesc
)
455 /* A tooltip frame. */
461 /* Likewise, but consider only the menu bar widget. */
464 x_menubar_window_to_frame (dpyinfo
, wdesc
)
465 struct x_display_info
*dpyinfo
;
468 Lisp_Object tail
, frame
;
472 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
475 if (!GC_FRAMEP (frame
))
478 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
480 x
= f
->output_data
.x
;
481 /* Match if the window is this frame's menubar. */
482 if (x
->menubar_widget
483 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
489 /* Return the frame whose principal (outermost) window is WDESC.
490 If WDESC is some other (smaller) window, we return 0. */
493 x_top_window_to_frame (dpyinfo
, wdesc
)
494 struct x_display_info
*dpyinfo
;
497 Lisp_Object tail
, frame
;
501 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
504 if (!GC_FRAMEP (frame
))
507 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
509 x
= f
->output_data
.x
;
513 /* This frame matches if the window is its topmost widget. */
514 if (wdesc
== XtWindow (x
->widget
))
516 #if 0 /* I don't know why it did this,
517 but it seems logically wrong,
518 and it causes trouble for MapNotify events. */
519 /* Match if the window is this frame's menubar. */
520 if (x
->menubar_widget
521 && wdesc
== XtWindow (x
->menubar_widget
))
525 else if (FRAME_X_WINDOW (f
) == wdesc
)
531 #endif /* USE_X_TOOLKIT */
535 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
536 id, which is just an int that this section returns. Bitmaps are
537 reference counted so they can be shared among frames.
539 Bitmap indices are guaranteed to be > 0, so a negative number can
540 be used to indicate no bitmap.
542 If you use x_create_bitmap_from_data, then you must keep track of
543 the bitmaps yourself. That is, creating a bitmap from the same
544 data more than once will not be caught. */
547 /* Functions to access the contents of a bitmap, given an id. */
550 x_bitmap_height (f
, id
)
554 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
558 x_bitmap_width (f
, id
)
562 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
566 x_bitmap_pixmap (f
, id
)
570 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
574 /* Allocate a new bitmap record. Returns index of new record. */
577 x_allocate_bitmap_record (f
)
580 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
583 if (dpyinfo
->bitmaps
== NULL
)
585 dpyinfo
->bitmaps_size
= 10;
587 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
588 dpyinfo
->bitmaps_last
= 1;
592 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
593 return ++dpyinfo
->bitmaps_last
;
595 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
596 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
599 dpyinfo
->bitmaps_size
*= 2;
601 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
602 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
603 return ++dpyinfo
->bitmaps_last
;
606 /* Add one reference to the reference count of the bitmap with id ID. */
609 x_reference_bitmap (f
, id
)
613 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
616 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
619 x_create_bitmap_from_data (f
, bits
, width
, height
)
622 unsigned int width
, height
;
624 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
628 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
629 bits
, width
, height
);
634 id
= x_allocate_bitmap_record (f
);
635 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
636 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
637 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
638 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
639 dpyinfo
->bitmaps
[id
- 1].height
= height
;
640 dpyinfo
->bitmaps
[id
- 1].width
= width
;
645 /* Create bitmap from file FILE for frame F. */
648 x_create_bitmap_from_file (f
, file
)
652 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
653 unsigned int width
, height
;
655 int xhot
, yhot
, result
, id
;
660 /* Look for an existing bitmap with the same name. */
661 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
663 if (dpyinfo
->bitmaps
[id
].refcount
664 && dpyinfo
->bitmaps
[id
].file
665 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
667 ++dpyinfo
->bitmaps
[id
].refcount
;
672 /* Search bitmap-file-path for the file, if appropriate. */
673 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
678 filename
= (char *) XSTRING (found
)->data
;
680 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
681 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
682 if (result
!= BitmapSuccess
)
685 id
= x_allocate_bitmap_record (f
);
686 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
687 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
688 dpyinfo
->bitmaps
[id
- 1].file
689 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
690 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
691 dpyinfo
->bitmaps
[id
- 1].height
= height
;
692 dpyinfo
->bitmaps
[id
- 1].width
= width
;
693 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
698 /* Remove reference to bitmap with id number ID. */
701 x_destroy_bitmap (f
, id
)
705 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
709 --dpyinfo
->bitmaps
[id
- 1].refcount
;
710 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
713 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
714 if (dpyinfo
->bitmaps
[id
- 1].file
)
716 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
717 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
724 /* Free all the bitmaps for the display specified by DPYINFO. */
727 x_destroy_all_bitmaps (dpyinfo
)
728 struct x_display_info
*dpyinfo
;
731 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
732 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
734 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
735 if (dpyinfo
->bitmaps
[i
].file
)
736 xfree (dpyinfo
->bitmaps
[i
].file
);
738 dpyinfo
->bitmaps_last
= 0;
741 /* Connect the frame-parameter names for X frames
742 to the ways of passing the parameter values to the window system.
744 The name of a parameter, as a Lisp symbol,
745 has an `x-frame-parameter' property which is an integer in Lisp
746 that is an index in this table. */
748 struct x_frame_parm_table
751 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
755 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
756 static void x_change_window_heights
P_ ((Lisp_Object
, int));
757 static void x_disable_image
P_ ((struct frame
*, struct image
*));
758 static void x_create_im
P_ ((struct frame
*));
759 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
760 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
761 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
762 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
763 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
764 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
765 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
766 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
767 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
768 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
769 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
770 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
772 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
773 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
774 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
775 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
777 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
778 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
779 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
780 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
781 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
782 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
783 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
785 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
787 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
792 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
793 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
795 static void init_color_table
P_ ((void));
796 static void free_color_table
P_ ((void));
797 static unsigned long *colors_in_color_table
P_ ((int *n
));
798 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
799 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
803 static struct x_frame_parm_table x_frame_parms
[] =
805 "auto-raise", x_set_autoraise
,
806 "auto-lower", x_set_autolower
,
807 "background-color", x_set_background_color
,
808 "border-color", x_set_border_color
,
809 "border-width", x_set_border_width
,
810 "cursor-color", x_set_cursor_color
,
811 "cursor-type", x_set_cursor_type
,
813 "foreground-color", x_set_foreground_color
,
814 "icon-name", x_set_icon_name
,
815 "icon-type", x_set_icon_type
,
816 "internal-border-width", x_set_internal_border_width
,
817 "menu-bar-lines", x_set_menu_bar_lines
,
818 "mouse-color", x_set_mouse_color
,
819 "name", x_explicitly_set_name
,
820 "scroll-bar-width", x_set_scroll_bar_width
,
821 "title", x_set_title
,
822 "unsplittable", x_set_unsplittable
,
823 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
824 "visibility", x_set_visibility
,
825 "tool-bar-lines", x_set_tool_bar_lines
,
826 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
827 "scroll-bar-background", x_set_scroll_bar_background
,
828 "screen-gamma", x_set_screen_gamma
,
829 "line-spacing", x_set_line_spacing
832 /* Attach the `x-frame-parameter' properties to
833 the Lisp symbol names of parameters relevant to X. */
836 init_x_parm_symbols ()
840 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
841 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
845 /* Change the parameters of frame F as specified by ALIST.
846 If a parameter is not specially recognized, do nothing special;
847 otherwise call the `x_set_...' function for that parameter.
848 Except for certain geometry properties, always call store_frame_param
849 to store the new value in the parameter alist. */
852 x_set_frame_parameters (f
, alist
)
858 /* If both of these parameters are present, it's more efficient to
859 set them both at once. So we wait until we've looked at the
860 entire list before we set them. */
864 Lisp_Object left
, top
;
866 /* Same with these. */
867 Lisp_Object icon_left
, icon_top
;
869 /* Record in these vectors all the parms specified. */
873 int left_no_change
= 0, top_no_change
= 0;
874 int icon_left_no_change
= 0, icon_top_no_change
= 0;
876 struct gcpro gcpro1
, gcpro2
;
879 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
882 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
883 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
885 /* Extract parm names and values into those vectors. */
888 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
893 parms
[i
] = Fcar (elt
);
894 values
[i
] = Fcdr (elt
);
897 /* TAIL and ALIST are not used again below here. */
900 GCPRO2 (*parms
, *values
);
904 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
905 because their values appear in VALUES and strings are not valid. */
906 top
= left
= Qunbound
;
907 icon_left
= icon_top
= Qunbound
;
909 /* Provide default values for HEIGHT and WIDTH. */
910 if (FRAME_NEW_WIDTH (f
))
911 width
= FRAME_NEW_WIDTH (f
);
913 width
= FRAME_WIDTH (f
);
915 if (FRAME_NEW_HEIGHT (f
))
916 height
= FRAME_NEW_HEIGHT (f
);
918 height
= FRAME_HEIGHT (f
);
920 /* Process foreground_color and background_color before anything else.
921 They are independent of other properties, but other properties (e.g.,
922 cursor_color) are dependent upon them. */
923 for (p
= 0; p
< i
; p
++)
925 Lisp_Object prop
, val
;
929 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
931 register Lisp_Object param_index
, old_value
;
933 param_index
= Fget (prop
, Qx_frame_parameter
);
934 old_value
= get_frame_param (f
, prop
);
935 store_frame_param (f
, prop
, val
);
936 if (NATNUMP (param_index
)
937 && (XFASTINT (param_index
)
938 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
939 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
943 /* Now process them in reverse of specified order. */
944 for (i
--; i
>= 0; i
--)
946 Lisp_Object prop
, val
;
951 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
952 width
= XFASTINT (val
);
953 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
954 height
= XFASTINT (val
);
955 else if (EQ (prop
, Qtop
))
957 else if (EQ (prop
, Qleft
))
959 else if (EQ (prop
, Qicon_top
))
961 else if (EQ (prop
, Qicon_left
))
963 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
964 /* Processed above. */
968 register Lisp_Object param_index
, old_value
;
970 param_index
= Fget (prop
, Qx_frame_parameter
);
971 old_value
= get_frame_param (f
, prop
);
972 store_frame_param (f
, prop
, val
);
973 if (NATNUMP (param_index
)
974 && (XFASTINT (param_index
)
975 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
976 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
980 /* Don't die if just one of these was set. */
981 if (EQ (left
, Qunbound
))
984 if (f
->output_data
.x
->left_pos
< 0)
985 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
987 XSETINT (left
, f
->output_data
.x
->left_pos
);
989 if (EQ (top
, Qunbound
))
992 if (f
->output_data
.x
->top_pos
< 0)
993 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
995 XSETINT (top
, f
->output_data
.x
->top_pos
);
998 /* If one of the icon positions was not set, preserve or default it. */
999 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
1001 icon_left_no_change
= 1;
1002 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
1003 if (NILP (icon_left
))
1004 XSETINT (icon_left
, 0);
1006 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
1008 icon_top_no_change
= 1;
1009 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
1010 if (NILP (icon_top
))
1011 XSETINT (icon_top
, 0);
1014 /* Don't set these parameters unless they've been explicitly
1015 specified. The window might be mapped or resized while we're in
1016 this function, and we don't want to override that unless the lisp
1017 code has asked for it.
1019 Don't set these parameters unless they actually differ from the
1020 window's current parameters; the window may not actually exist
1025 check_frame_size (f
, &height
, &width
);
1027 XSETFRAME (frame
, f
);
1029 if (width
!= FRAME_WIDTH (f
)
1030 || height
!= FRAME_HEIGHT (f
)
1031 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1032 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1034 if ((!NILP (left
) || !NILP (top
))
1035 && ! (left_no_change
&& top_no_change
)
1036 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1037 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1042 /* Record the signs. */
1043 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1044 if (EQ (left
, Qminus
))
1045 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1046 else if (INTEGERP (left
))
1048 leftpos
= XINT (left
);
1050 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1052 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1053 && CONSP (XCDR (left
))
1054 && INTEGERP (XCAR (XCDR (left
))))
1056 leftpos
= - XINT (XCAR (XCDR (left
)));
1057 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1059 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1060 && CONSP (XCDR (left
))
1061 && INTEGERP (XCAR (XCDR (left
))))
1063 leftpos
= XINT (XCAR (XCDR (left
)));
1066 if (EQ (top
, Qminus
))
1067 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1068 else if (INTEGERP (top
))
1070 toppos
= XINT (top
);
1072 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1074 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1075 && CONSP (XCDR (top
))
1076 && INTEGERP (XCAR (XCDR (top
))))
1078 toppos
= - XINT (XCAR (XCDR (top
)));
1079 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1081 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1082 && CONSP (XCDR (top
))
1083 && INTEGERP (XCAR (XCDR (top
))))
1085 toppos
= XINT (XCAR (XCDR (top
)));
1089 /* Store the numeric value of the position. */
1090 f
->output_data
.x
->top_pos
= toppos
;
1091 f
->output_data
.x
->left_pos
= leftpos
;
1093 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1095 /* Actually set that position, and convert to absolute. */
1096 x_set_offset (f
, leftpos
, toppos
, -1);
1099 if ((!NILP (icon_left
) || !NILP (icon_top
))
1100 && ! (icon_left_no_change
&& icon_top_no_change
))
1101 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1107 /* Store the screen positions of frame F into XPTR and YPTR.
1108 These are the positions of the containing window manager window,
1109 not Emacs's own window. */
1112 x_real_positions (f
, xptr
, yptr
)
1119 /* This is pretty gross, but seems to be the easiest way out of
1120 the problem that arises when restarting window-managers. */
1122 #ifdef USE_X_TOOLKIT
1123 Window outer
= (f
->output_data
.x
->widget
1124 ? XtWindow (f
->output_data
.x
->widget
)
1125 : FRAME_X_WINDOW (f
));
1127 Window outer
= f
->output_data
.x
->window_desc
;
1129 Window tmp_root_window
;
1130 Window
*tmp_children
;
1131 unsigned int tmp_nchildren
;
1135 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1136 Window outer_window
;
1138 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1139 &f
->output_data
.x
->parent_desc
,
1140 &tmp_children
, &tmp_nchildren
);
1141 XFree ((char *) tmp_children
);
1145 /* Find the position of the outside upper-left corner of
1146 the inner window, with respect to the outer window. */
1147 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1148 outer_window
= f
->output_data
.x
->parent_desc
;
1150 outer_window
= outer
;
1152 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1154 /* From-window, to-window. */
1156 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1158 /* From-position, to-position. */
1159 0, 0, &win_x
, &win_y
,
1164 /* It is possible for the window returned by the XQueryNotify
1165 to become invalid by the time we call XTranslateCoordinates.
1166 That can happen when you restart some window managers.
1167 If so, we get an error in XTranslateCoordinates.
1168 Detect that and try the whole thing over. */
1169 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1171 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1175 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1182 /* Insert a description of internally-recorded parameters of frame X
1183 into the parameter alist *ALISTPTR that is to be given to the user.
1184 Only parameters that are specific to the X window system
1185 and whose values are not correctly recorded in the frame's
1186 param_alist need to be considered here. */
1189 x_report_frame_params (f
, alistptr
)
1191 Lisp_Object
*alistptr
;
1196 /* Represent negative positions (off the top or left screen edge)
1197 in a way that Fmodify_frame_parameters will understand correctly. */
1198 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1199 if (f
->output_data
.x
->left_pos
>= 0)
1200 store_in_alist (alistptr
, Qleft
, tem
);
1202 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1204 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1205 if (f
->output_data
.x
->top_pos
>= 0)
1206 store_in_alist (alistptr
, Qtop
, tem
);
1208 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1210 store_in_alist (alistptr
, Qborder_width
,
1211 make_number (f
->output_data
.x
->border_width
));
1212 store_in_alist (alistptr
, Qinternal_border_width
,
1213 make_number (f
->output_data
.x
->internal_border_width
));
1214 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1215 store_in_alist (alistptr
, Qwindow_id
,
1216 build_string (buf
));
1217 #ifdef USE_X_TOOLKIT
1218 /* Tooltip frame may not have this widget. */
1219 if (f
->output_data
.x
->widget
)
1221 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1222 store_in_alist (alistptr
, Qouter_window_id
,
1223 build_string (buf
));
1224 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1225 FRAME_SAMPLE_VISIBILITY (f
);
1226 store_in_alist (alistptr
, Qvisibility
,
1227 (FRAME_VISIBLE_P (f
) ? Qt
1228 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1229 store_in_alist (alistptr
, Qdisplay
,
1230 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1232 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1235 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1236 store_in_alist (alistptr
, Qparent_id
, tem
);
1241 /* Gamma-correct COLOR on frame F. */
1244 gamma_correct (f
, color
)
1250 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1251 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1252 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1257 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1258 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1259 allocate the color. Value is zero if COLOR_NAME is invalid, or
1260 no color could be allocated. */
1263 x_defined_color (f
, color_name
, color
, alloc_p
)
1270 Display
*dpy
= FRAME_X_DISPLAY (f
);
1271 Colormap cmap
= FRAME_X_COLORMAP (f
);
1274 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1275 if (success_p
&& alloc_p
)
1276 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1283 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1284 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1285 Signal an error if color can't be allocated. */
1288 x_decode_color (f
, color_name
, mono_color
)
1290 Lisp_Object color_name
;
1295 CHECK_STRING (color_name
, 0);
1297 #if 0 /* Don't do this. It's wrong when we're not using the default
1298 colormap, it makes freeing difficult, and it's probably not
1299 an important optimization. */
1300 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1301 return BLACK_PIX_DEFAULT (f
);
1302 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1303 return WHITE_PIX_DEFAULT (f
);
1306 /* Return MONO_COLOR for monochrome frames. */
1307 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1310 /* x_defined_color is responsible for coping with failures
1311 by looking for a near-miss. */
1312 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1315 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1316 Fcons (color_name
, Qnil
)));
1322 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1323 the previous value of that parameter, NEW_VALUE is the new value. */
1326 x_set_line_spacing (f
, new_value
, old_value
)
1328 Lisp_Object new_value
, old_value
;
1330 if (NILP (new_value
))
1331 f
->extra_line_spacing
= 0;
1332 else if (NATNUMP (new_value
))
1333 f
->extra_line_spacing
= XFASTINT (new_value
);
1335 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1336 Fcons (new_value
, Qnil
)));
1337 if (FRAME_VISIBLE_P (f
))
1342 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1343 the previous value of that parameter, NEW_VALUE is the new value. */
1346 x_set_screen_gamma (f
, new_value
, old_value
)
1348 Lisp_Object new_value
, old_value
;
1350 if (NILP (new_value
))
1352 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1353 /* The value 0.4545 is the normal viewing gamma. */
1354 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1356 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1357 Fcons (new_value
, Qnil
)));
1359 clear_face_cache (0);
1363 /* Functions called only from `x_set_frame_param'
1364 to set individual parameters.
1366 If FRAME_X_WINDOW (f) is 0,
1367 the frame is being created and its X-window does not exist yet.
1368 In that case, just record the parameter's new value
1369 in the standard place; do not attempt to change the window. */
1372 x_set_foreground_color (f
, arg
, oldval
)
1374 Lisp_Object arg
, oldval
;
1377 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1379 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1380 f
->output_data
.x
->foreground_pixel
= pixel
;
1382 if (FRAME_X_WINDOW (f
) != 0)
1385 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1386 f
->output_data
.x
->foreground_pixel
);
1387 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1388 f
->output_data
.x
->foreground_pixel
);
1390 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1391 if (FRAME_VISIBLE_P (f
))
1397 x_set_background_color (f
, arg
, oldval
)
1399 Lisp_Object arg
, oldval
;
1402 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1404 unload_color (f
, f
->output_data
.x
->background_pixel
);
1405 f
->output_data
.x
->background_pixel
= pixel
;
1407 if (FRAME_X_WINDOW (f
) != 0)
1410 /* The main frame area. */
1411 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1412 f
->output_data
.x
->background_pixel
);
1413 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1414 f
->output_data
.x
->background_pixel
);
1415 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1416 f
->output_data
.x
->background_pixel
);
1417 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1418 f
->output_data
.x
->background_pixel
);
1421 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1422 bar
= XSCROLL_BAR (bar
)->next
)
1423 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1424 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1425 f
->output_data
.x
->background_pixel
);
1429 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1431 if (FRAME_VISIBLE_P (f
))
1437 x_set_mouse_color (f
, arg
, oldval
)
1439 Lisp_Object arg
, oldval
;
1441 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1442 Cursor busy_cursor
, horizontal_drag_cursor
;
1444 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1445 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1447 /* Don't let pointers be invisible. */
1448 if (mask_color
== pixel
1449 && mask_color
== f
->output_data
.x
->background_pixel
)
1450 pixel
= f
->output_data
.x
->foreground_pixel
;
1452 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1453 f
->output_data
.x
->mouse_pixel
= pixel
;
1457 /* It's not okay to crash if the user selects a screwy cursor. */
1458 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1460 if (!EQ (Qnil
, Vx_pointer_shape
))
1462 CHECK_NUMBER (Vx_pointer_shape
, 0);
1463 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1466 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1467 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1469 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1471 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1472 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1473 XINT (Vx_nontext_pointer_shape
));
1476 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1477 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1479 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1481 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1482 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1483 XINT (Vx_busy_pointer_shape
));
1486 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1487 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1489 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1490 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1492 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1493 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1494 XINT (Vx_mode_pointer_shape
));
1497 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1498 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1500 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1502 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1504 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1505 XINT (Vx_sensitive_text_pointer_shape
));
1508 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1510 if (!NILP (Vx_window_horizontal_drag_shape
))
1512 CHECK_NUMBER (Vx_window_horizontal_drag_shape
, 0);
1513 horizontal_drag_cursor
1514 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1515 XINT (Vx_window_horizontal_drag_shape
));
1518 horizontal_drag_cursor
1519 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
1521 /* Check and report errors with the above calls. */
1522 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1523 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1526 XColor fore_color
, back_color
;
1528 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1529 x_query_color (f
, &fore_color
);
1530 back_color
.pixel
= mask_color
;
1531 x_query_color (f
, &back_color
);
1533 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1534 &fore_color
, &back_color
);
1535 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1536 &fore_color
, &back_color
);
1537 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1538 &fore_color
, &back_color
);
1539 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1540 &fore_color
, &back_color
);
1541 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1542 &fore_color
, &back_color
);
1543 XRecolorCursor (FRAME_X_DISPLAY (f
), horizontal_drag_cursor
,
1544 &fore_color
, &back_color
);
1547 if (FRAME_X_WINDOW (f
) != 0)
1548 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1550 if (cursor
!= f
->output_data
.x
->text_cursor
1551 && f
->output_data
.x
->text_cursor
!= 0)
1552 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1553 f
->output_data
.x
->text_cursor
= cursor
;
1555 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1556 && f
->output_data
.x
->nontext_cursor
!= 0)
1557 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1558 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1560 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1561 && f
->output_data
.x
->busy_cursor
!= 0)
1562 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1563 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1565 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1566 && f
->output_data
.x
->modeline_cursor
!= 0)
1567 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1568 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1570 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1571 && f
->output_data
.x
->cross_cursor
!= 0)
1572 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1573 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1575 if (horizontal_drag_cursor
!= f
->output_data
.x
->horizontal_drag_cursor
1576 && f
->output_data
.x
->horizontal_drag_cursor
!= 0)
1577 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->horizontal_drag_cursor
);
1578 f
->output_data
.x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1580 XFlush (FRAME_X_DISPLAY (f
));
1583 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1587 x_set_cursor_color (f
, arg
, oldval
)
1589 Lisp_Object arg
, oldval
;
1591 unsigned long fore_pixel
, pixel
;
1592 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1594 if (!NILP (Vx_cursor_fore_pixel
))
1596 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1597 WHITE_PIX_DEFAULT (f
));
1598 fore_pixel_allocated_p
= 1;
1601 fore_pixel
= f
->output_data
.x
->background_pixel
;
1603 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1604 pixel_allocated_p
= 1;
1606 /* Make sure that the cursor color differs from the background color. */
1607 if (pixel
== f
->output_data
.x
->background_pixel
)
1609 if (pixel_allocated_p
)
1611 x_free_colors (f
, &pixel
, 1);
1612 pixel_allocated_p
= 0;
1615 pixel
= f
->output_data
.x
->mouse_pixel
;
1616 if (pixel
== fore_pixel
)
1618 if (fore_pixel_allocated_p
)
1620 x_free_colors (f
, &fore_pixel
, 1);
1621 fore_pixel_allocated_p
= 0;
1623 fore_pixel
= f
->output_data
.x
->background_pixel
;
1627 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1628 if (!fore_pixel_allocated_p
)
1629 fore_pixel
= x_copy_color (f
, fore_pixel
);
1630 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1632 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1633 if (!pixel_allocated_p
)
1634 pixel
= x_copy_color (f
, pixel
);
1635 f
->output_data
.x
->cursor_pixel
= pixel
;
1637 if (FRAME_X_WINDOW (f
) != 0)
1640 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1641 f
->output_data
.x
->cursor_pixel
);
1642 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1646 if (FRAME_VISIBLE_P (f
))
1648 x_update_cursor (f
, 0);
1649 x_update_cursor (f
, 1);
1653 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1656 /* Set the border-color of frame F to value described by ARG.
1657 ARG can be a string naming a color.
1658 The border-color is used for the border that is drawn by the X server.
1659 Note that this does not fully take effect if done before
1660 F has an x-window; it must be redone when the window is created.
1662 Note: this is done in two routines because of the way X10 works.
1664 Note: under X11, this is normally the province of the window manager,
1665 and so emacs' border colors may be overridden. */
1668 x_set_border_color (f
, arg
, oldval
)
1670 Lisp_Object arg
, oldval
;
1674 CHECK_STRING (arg
, 0);
1675 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1676 x_set_border_pixel (f
, pix
);
1677 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1680 /* Set the border-color of frame F to pixel value PIX.
1681 Note that this does not fully take effect if done before
1682 F has an x-window. */
1685 x_set_border_pixel (f
, pix
)
1689 unload_color (f
, f
->output_data
.x
->border_pixel
);
1690 f
->output_data
.x
->border_pixel
= pix
;
1692 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1695 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1696 (unsigned long)pix
);
1699 if (FRAME_VISIBLE_P (f
))
1705 /* Value is the internal representation of the specified cursor type
1706 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1707 of the bar cursor. */
1709 enum text_cursor_kinds
1710 x_specified_cursor_type (arg
, width
)
1714 enum text_cursor_kinds type
;
1721 else if (CONSP (arg
)
1722 && EQ (XCAR (arg
), Qbar
)
1723 && INTEGERP (XCDR (arg
))
1724 && XINT (XCDR (arg
)) >= 0)
1727 *width
= XINT (XCDR (arg
));
1729 else if (NILP (arg
))
1732 /* Treat anything unknown as "box cursor".
1733 It was bad to signal an error; people have trouble fixing
1734 .Xdefaults with Emacs, when it has something bad in it. */
1735 type
= FILLED_BOX_CURSOR
;
1741 x_set_cursor_type (f
, arg
, oldval
)
1743 Lisp_Object arg
, oldval
;
1747 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1748 f
->output_data
.x
->cursor_width
= width
;
1750 /* Make sure the cursor gets redrawn. This is overkill, but how
1751 often do people change cursor types? */
1752 update_mode_lines
++;
1756 x_set_icon_type (f
, arg
, oldval
)
1758 Lisp_Object arg
, oldval
;
1764 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1767 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1772 result
= x_text_icon (f
,
1773 (char *) XSTRING ((!NILP (f
->icon_name
)
1777 result
= x_bitmap_icon (f
, arg
);
1782 error ("No icon window available");
1785 XFlush (FRAME_X_DISPLAY (f
));
1789 /* Return non-nil if frame F wants a bitmap icon. */
1797 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1805 x_set_icon_name (f
, arg
, oldval
)
1807 Lisp_Object arg
, oldval
;
1813 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1816 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1821 if (f
->output_data
.x
->icon_bitmap
!= 0)
1826 result
= x_text_icon (f
,
1827 (char *) XSTRING ((!NILP (f
->icon_name
)
1836 error ("No icon window available");
1839 XFlush (FRAME_X_DISPLAY (f
));
1844 x_set_font (f
, arg
, oldval
)
1846 Lisp_Object arg
, oldval
;
1849 Lisp_Object fontset_name
;
1852 CHECK_STRING (arg
, 1);
1854 fontset_name
= Fquery_fontset (arg
, Qnil
);
1857 result
= (STRINGP (fontset_name
)
1858 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1859 : x_new_font (f
, XSTRING (arg
)->data
));
1862 if (EQ (result
, Qnil
))
1863 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1864 else if (EQ (result
, Qt
))
1865 error ("The characters of the given font have varying widths");
1866 else if (STRINGP (result
))
1868 store_frame_param (f
, Qfont
, result
);
1869 recompute_basic_faces (f
);
1874 do_pending_window_change (0);
1876 /* Don't call `face-set-after-frame-default' when faces haven't been
1877 initialized yet. This is the case when called from
1878 Fx_create_frame. In that case, the X widget or window doesn't
1879 exist either, and we can end up in x_report_frame_params with a
1880 null widget which gives a segfault. */
1881 if (FRAME_FACE_CACHE (f
))
1883 XSETFRAME (frame
, f
);
1884 call1 (Qface_set_after_frame_default
, frame
);
1889 x_set_border_width (f
, arg
, oldval
)
1891 Lisp_Object arg
, oldval
;
1893 CHECK_NUMBER (arg
, 0);
1895 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1898 if (FRAME_X_WINDOW (f
) != 0)
1899 error ("Cannot change the border width of a window");
1901 f
->output_data
.x
->border_width
= XINT (arg
);
1905 x_set_internal_border_width (f
, arg
, oldval
)
1907 Lisp_Object arg
, oldval
;
1909 int old
= f
->output_data
.x
->internal_border_width
;
1911 CHECK_NUMBER (arg
, 0);
1912 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1913 if (f
->output_data
.x
->internal_border_width
< 0)
1914 f
->output_data
.x
->internal_border_width
= 0;
1916 #ifdef USE_X_TOOLKIT
1917 if (f
->output_data
.x
->edit_widget
)
1918 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1921 if (f
->output_data
.x
->internal_border_width
== old
)
1924 if (FRAME_X_WINDOW (f
) != 0)
1926 x_set_window_size (f
, 0, f
->width
, f
->height
);
1927 SET_FRAME_GARBAGED (f
);
1928 do_pending_window_change (0);
1933 x_set_visibility (f
, value
, oldval
)
1935 Lisp_Object value
, oldval
;
1938 XSETFRAME (frame
, f
);
1941 Fmake_frame_invisible (frame
, Qt
);
1942 else if (EQ (value
, Qicon
))
1943 Ficonify_frame (frame
);
1945 Fmake_frame_visible (frame
);
1949 /* Change window heights in windows rooted in WINDOW by N lines. */
1952 x_change_window_heights (window
, n
)
1956 struct window
*w
= XWINDOW (window
);
1958 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1959 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1961 if (INTEGERP (w
->orig_top
))
1962 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1963 if (INTEGERP (w
->orig_height
))
1964 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1966 /* Handle just the top child in a vertical split. */
1967 if (!NILP (w
->vchild
))
1968 x_change_window_heights (w
->vchild
, n
);
1970 /* Adjust all children in a horizontal split. */
1971 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1973 w
= XWINDOW (window
);
1974 x_change_window_heights (window
, n
);
1979 x_set_menu_bar_lines (f
, value
, oldval
)
1981 Lisp_Object value
, oldval
;
1984 #ifndef USE_X_TOOLKIT
1985 int olines
= FRAME_MENU_BAR_LINES (f
);
1988 /* Right now, menu bars don't work properly in minibuf-only frames;
1989 most of the commands try to apply themselves to the minibuffer
1990 frame itself, and get an error because you can't switch buffers
1991 in or split the minibuffer window. */
1992 if (FRAME_MINIBUF_ONLY_P (f
))
1995 if (INTEGERP (value
))
1996 nlines
= XINT (value
);
2000 /* Make sure we redisplay all windows in this frame. */
2001 windows_or_buffers_changed
++;
2003 #ifdef USE_X_TOOLKIT
2004 FRAME_MENU_BAR_LINES (f
) = 0;
2007 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2008 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
2009 /* Make sure next redisplay shows the menu bar. */
2010 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2014 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2015 free_frame_menubar (f
);
2016 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2018 f
->output_data
.x
->menubar_widget
= 0;
2020 #else /* not USE_X_TOOLKIT */
2021 FRAME_MENU_BAR_LINES (f
) = nlines
;
2022 x_change_window_heights (f
->root_window
, nlines
- olines
);
2023 #endif /* not USE_X_TOOLKIT */
2028 /* Set the number of lines used for the tool bar of frame F to VALUE.
2029 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2030 is the old number of tool bar lines. This function changes the
2031 height of all windows on frame F to match the new tool bar height.
2032 The frame's height doesn't change. */
2035 x_set_tool_bar_lines (f
, value
, oldval
)
2037 Lisp_Object value
, oldval
;
2039 int delta
, nlines
, root_height
;
2040 Lisp_Object root_window
;
2042 /* Use VALUE only if an integer >= 0. */
2043 if (INTEGERP (value
) && XINT (value
) >= 0)
2044 nlines
= XFASTINT (value
);
2048 /* Make sure we redisplay all windows in this frame. */
2049 ++windows_or_buffers_changed
;
2051 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2053 /* Don't resize the tool-bar to more than we have room for. */
2054 root_window
= FRAME_ROOT_WINDOW (f
);
2055 root_height
= XINT (XWINDOW (root_window
)->height
);
2056 if (root_height
- delta
< 1)
2058 delta
= root_height
- 1;
2059 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2062 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2063 x_change_window_heights (root_window
, delta
);
2066 /* We also have to make sure that the internal border at the top of
2067 the frame, below the menu bar or tool bar, is redrawn when the
2068 tool bar disappears. This is so because the internal border is
2069 below the tool bar if one is displayed, but is below the menu bar
2070 if there isn't a tool bar. The tool bar draws into the area
2071 below the menu bar. */
2072 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2076 clear_current_matrices (f
);
2077 updating_frame
= NULL
;
2080 /* If the tool bar gets smaller, the internal border below it
2081 has to be cleared. It was formerly part of the display
2082 of the larger tool bar, and updating windows won't clear it. */
2085 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2086 int width
= PIXEL_WIDTH (f
);
2087 int y
= nlines
* CANON_Y_UNIT (f
);
2090 XClearArea (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2091 0, y
, width
, height
, False
);
2097 /* Set the foreground color for scroll bars on frame F to VALUE.
2098 VALUE should be a string, a color name. If it isn't a string or
2099 isn't a valid color name, do nothing. OLDVAL is the old value of
2100 the frame parameter. */
2103 x_set_scroll_bar_foreground (f
, value
, oldval
)
2105 Lisp_Object value
, oldval
;
2107 unsigned long pixel
;
2109 if (STRINGP (value
))
2110 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2114 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2115 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2117 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2118 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2120 /* Remove all scroll bars because they have wrong colors. */
2121 if (condemn_scroll_bars_hook
)
2122 (*condemn_scroll_bars_hook
) (f
);
2123 if (judge_scroll_bars_hook
)
2124 (*judge_scroll_bars_hook
) (f
);
2126 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2132 /* Set the background color for scroll bars on frame F to VALUE VALUE
2133 should be a string, a color name. If it isn't a string or isn't a
2134 valid color name, do nothing. OLDVAL is the old value of the frame
2138 x_set_scroll_bar_background (f
, value
, oldval
)
2140 Lisp_Object value
, oldval
;
2142 unsigned long pixel
;
2144 if (STRINGP (value
))
2145 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2149 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2150 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2152 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2153 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2155 /* Remove all scroll bars because they have wrong colors. */
2156 if (condemn_scroll_bars_hook
)
2157 (*condemn_scroll_bars_hook
) (f
);
2158 if (judge_scroll_bars_hook
)
2159 (*judge_scroll_bars_hook
) (f
);
2161 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2167 /* Encode Lisp string STRING as a text in a format appropriate for
2168 XICCC (X Inter Client Communication Conventions).
2170 If STRING contains only ASCII characters, do no conversion and
2171 return the string data of STRING. Otherwise, encode the text by
2172 CODING_SYSTEM, and return a newly allocated memory area which
2173 should be freed by `xfree' by a caller.
2175 Store the byte length of resulting text in *TEXT_BYTES.
2177 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2178 which means that the `encoding' of the result can be `STRING'.
2179 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2180 the result should be `COMPOUND_TEXT'. */
2183 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2184 Lisp_Object string
, coding_system
;
2185 int *text_bytes
, *stringp
;
2187 unsigned char *str
= XSTRING (string
)->data
;
2188 int chars
= XSTRING (string
)->size
;
2189 int bytes
= STRING_BYTES (XSTRING (string
));
2193 struct coding_system coding
;
2195 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2196 if (charset_info
== 0)
2198 /* No multibyte character in OBJ. We need not encode it. */
2199 *text_bytes
= bytes
;
2204 setup_coding_system (coding_system
, &coding
);
2205 coding
.src_multibyte
= 1;
2206 coding
.dst_multibyte
= 0;
2207 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2208 if (coding
.type
== coding_type_iso2022
)
2209 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2210 /* We suppress producing escape sequences for composition. */
2211 coding
.composing
= COMPOSITION_DISABLED
;
2212 bufsize
= encoding_buffer_size (&coding
, bytes
);
2213 buf
= (unsigned char *) xmalloc (bufsize
);
2214 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2215 *text_bytes
= coding
.produced
;
2216 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2221 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2224 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2225 name; if NAME is a string, set F's name to NAME and set
2226 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2228 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2229 suggesting a new name, which lisp code should override; if
2230 F->explicit_name is set, ignore the new name; otherwise, set it. */
2233 x_set_name (f
, name
, explicit)
2238 /* Make sure that requests from lisp code override requests from
2239 Emacs redisplay code. */
2242 /* If we're switching from explicit to implicit, we had better
2243 update the mode lines and thereby update the title. */
2244 if (f
->explicit_name
&& NILP (name
))
2245 update_mode_lines
= 1;
2247 f
->explicit_name
= ! NILP (name
);
2249 else if (f
->explicit_name
)
2252 /* If NAME is nil, set the name to the x_id_name. */
2255 /* Check for no change needed in this very common case
2256 before we do any consing. */
2257 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2258 XSTRING (f
->name
)->data
))
2260 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2263 CHECK_STRING (name
, 0);
2265 /* Don't change the name if it's already NAME. */
2266 if (! NILP (Fstring_equal (name
, f
->name
)))
2271 /* For setting the frame title, the title parameter should override
2272 the name parameter. */
2273 if (! NILP (f
->title
))
2276 if (FRAME_X_WINDOW (f
))
2281 XTextProperty text
, icon
;
2283 Lisp_Object coding_system
;
2285 coding_system
= Vlocale_coding_system
;
2286 if (NILP (coding_system
))
2287 coding_system
= Qcompound_text
;
2288 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2289 text
.encoding
= (stringp
? XA_STRING
2290 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2292 text
.nitems
= bytes
;
2294 if (NILP (f
->icon_name
))
2300 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2302 icon
.encoding
= (stringp
? XA_STRING
2303 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2305 icon
.nitems
= bytes
;
2307 #ifdef USE_X_TOOLKIT
2308 XSetWMName (FRAME_X_DISPLAY (f
),
2309 XtWindow (f
->output_data
.x
->widget
), &text
);
2310 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2312 #else /* not USE_X_TOOLKIT */
2313 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2314 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2315 #endif /* not USE_X_TOOLKIT */
2316 if (!NILP (f
->icon_name
)
2317 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2319 if (text
.value
!= XSTRING (name
)->data
)
2322 #else /* not HAVE_X11R4 */
2323 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2324 XSTRING (name
)->data
);
2325 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2326 XSTRING (name
)->data
);
2327 #endif /* not HAVE_X11R4 */
2332 /* This function should be called when the user's lisp code has
2333 specified a name for the frame; the name will override any set by the
2336 x_explicitly_set_name (f
, arg
, oldval
)
2338 Lisp_Object arg
, oldval
;
2340 x_set_name (f
, arg
, 1);
2343 /* This function should be called by Emacs redisplay code to set the
2344 name; names set this way will never override names set by the user's
2347 x_implicitly_set_name (f
, arg
, oldval
)
2349 Lisp_Object arg
, oldval
;
2351 x_set_name (f
, arg
, 0);
2354 /* Change the title of frame F to NAME.
2355 If NAME is nil, use the frame name as the title.
2357 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2358 name; if NAME is a string, set F's name to NAME and set
2359 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2361 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2362 suggesting a new name, which lisp code should override; if
2363 F->explicit_name is set, ignore the new name; otherwise, set it. */
2366 x_set_title (f
, name
, old_name
)
2368 Lisp_Object name
, old_name
;
2370 /* Don't change the title if it's already NAME. */
2371 if (EQ (name
, f
->title
))
2374 update_mode_lines
= 1;
2381 CHECK_STRING (name
, 0);
2383 if (FRAME_X_WINDOW (f
))
2388 XTextProperty text
, icon
;
2390 Lisp_Object coding_system
;
2392 coding_system
= Vlocale_coding_system
;
2393 if (NILP (coding_system
))
2394 coding_system
= Qcompound_text
;
2395 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2396 text
.encoding
= (stringp
? XA_STRING
2397 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2399 text
.nitems
= bytes
;
2401 if (NILP (f
->icon_name
))
2407 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2409 icon
.encoding
= (stringp
? XA_STRING
2410 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2412 icon
.nitems
= bytes
;
2414 #ifdef USE_X_TOOLKIT
2415 XSetWMName (FRAME_X_DISPLAY (f
),
2416 XtWindow (f
->output_data
.x
->widget
), &text
);
2417 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2419 #else /* not USE_X_TOOLKIT */
2420 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2421 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2422 #endif /* not USE_X_TOOLKIT */
2423 if (!NILP (f
->icon_name
)
2424 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2426 if (text
.value
!= XSTRING (name
)->data
)
2429 #else /* not HAVE_X11R4 */
2430 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2431 XSTRING (name
)->data
);
2432 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2433 XSTRING (name
)->data
);
2434 #endif /* not HAVE_X11R4 */
2440 x_set_autoraise (f
, arg
, oldval
)
2442 Lisp_Object arg
, oldval
;
2444 f
->auto_raise
= !EQ (Qnil
, arg
);
2448 x_set_autolower (f
, arg
, oldval
)
2450 Lisp_Object arg
, oldval
;
2452 f
->auto_lower
= !EQ (Qnil
, arg
);
2456 x_set_unsplittable (f
, arg
, oldval
)
2458 Lisp_Object arg
, oldval
;
2460 f
->no_split
= !NILP (arg
);
2464 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2466 Lisp_Object arg
, oldval
;
2468 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2469 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2470 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2471 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2473 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2475 ? vertical_scroll_bar_none
2477 ? vertical_scroll_bar_right
2478 : vertical_scroll_bar_left
);
2480 /* We set this parameter before creating the X window for the
2481 frame, so we can get the geometry right from the start.
2482 However, if the window hasn't been created yet, we shouldn't
2483 call x_set_window_size. */
2484 if (FRAME_X_WINDOW (f
))
2485 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2486 do_pending_window_change (0);
2491 x_set_scroll_bar_width (f
, arg
, oldval
)
2493 Lisp_Object arg
, oldval
;
2495 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2499 #ifdef USE_TOOLKIT_SCROLL_BARS
2500 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2501 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2502 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2503 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2505 /* Make the actual width at least 14 pixels and a multiple of a
2507 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2509 /* Use all of that space (aside from required margins) for the
2511 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2514 if (FRAME_X_WINDOW (f
))
2515 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2516 do_pending_window_change (0);
2518 else if (INTEGERP (arg
) && XINT (arg
) > 0
2519 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2521 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2522 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2524 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2525 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2526 if (FRAME_X_WINDOW (f
))
2527 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2530 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2531 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2532 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2537 /* Subroutines of creating an X frame. */
2539 /* Make sure that Vx_resource_name is set to a reasonable value.
2540 Fix it up, or set it to `emacs' if it is too hopeless. */
2543 validate_x_resource_name ()
2546 /* Number of valid characters in the resource name. */
2548 /* Number of invalid characters in the resource name. */
2553 if (!STRINGP (Vx_resource_class
))
2554 Vx_resource_class
= build_string (EMACS_CLASS
);
2556 if (STRINGP (Vx_resource_name
))
2558 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2561 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2563 /* Only letters, digits, - and _ are valid in resource names.
2564 Count the valid characters and count the invalid ones. */
2565 for (i
= 0; i
< len
; i
++)
2568 if (! ((c
>= 'a' && c
<= 'z')
2569 || (c
>= 'A' && c
<= 'Z')
2570 || (c
>= '0' && c
<= '9')
2571 || c
== '-' || c
== '_'))
2578 /* Not a string => completely invalid. */
2579 bad_count
= 5, good_count
= 0;
2581 /* If name is valid already, return. */
2585 /* If name is entirely invalid, or nearly so, use `emacs'. */
2587 || (good_count
== 1 && bad_count
> 0))
2589 Vx_resource_name
= build_string ("emacs");
2593 /* Name is partly valid. Copy it and replace the invalid characters
2594 with underscores. */
2596 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2598 for (i
= 0; i
< len
; i
++)
2600 int c
= XSTRING (new)->data
[i
];
2601 if (! ((c
>= 'a' && c
<= 'z')
2602 || (c
>= 'A' && c
<= 'Z')
2603 || (c
>= '0' && c
<= '9')
2604 || c
== '-' || c
== '_'))
2605 XSTRING (new)->data
[i
] = '_';
2610 extern char *x_get_string_resource ();
2612 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2613 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2614 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2615 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2616 the name specified by the `-name' or `-rn' command-line arguments.\n\
2618 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2619 class, respectively. You must specify both of them or neither.\n\
2620 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2621 and the class is `Emacs.CLASS.SUBCLASS'.")
2622 (attribute
, class, component
, subclass
)
2623 Lisp_Object attribute
, class, component
, subclass
;
2625 register char *value
;
2631 CHECK_STRING (attribute
, 0);
2632 CHECK_STRING (class, 0);
2634 if (!NILP (component
))
2635 CHECK_STRING (component
, 1);
2636 if (!NILP (subclass
))
2637 CHECK_STRING (subclass
, 2);
2638 if (NILP (component
) != NILP (subclass
))
2639 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2641 validate_x_resource_name ();
2643 /* Allocate space for the components, the dots which separate them,
2644 and the final '\0'. Make them big enough for the worst case. */
2645 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2646 + (STRINGP (component
)
2647 ? STRING_BYTES (XSTRING (component
)) : 0)
2648 + STRING_BYTES (XSTRING (attribute
))
2651 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2652 + STRING_BYTES (XSTRING (class))
2653 + (STRINGP (subclass
)
2654 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2657 /* Start with emacs.FRAMENAME for the name (the specific one)
2658 and with `Emacs' for the class key (the general one). */
2659 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2660 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2662 strcat (class_key
, ".");
2663 strcat (class_key
, XSTRING (class)->data
);
2665 if (!NILP (component
))
2667 strcat (class_key
, ".");
2668 strcat (class_key
, XSTRING (subclass
)->data
);
2670 strcat (name_key
, ".");
2671 strcat (name_key
, XSTRING (component
)->data
);
2674 strcat (name_key
, ".");
2675 strcat (name_key
, XSTRING (attribute
)->data
);
2677 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2678 name_key
, class_key
);
2680 if (value
!= (char *) 0)
2681 return build_string (value
);
2686 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2689 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2690 struct x_display_info
*dpyinfo
;
2691 Lisp_Object attribute
, class, component
, subclass
;
2693 register char *value
;
2697 CHECK_STRING (attribute
, 0);
2698 CHECK_STRING (class, 0);
2700 if (!NILP (component
))
2701 CHECK_STRING (component
, 1);
2702 if (!NILP (subclass
))
2703 CHECK_STRING (subclass
, 2);
2704 if (NILP (component
) != NILP (subclass
))
2705 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2707 validate_x_resource_name ();
2709 /* Allocate space for the components, the dots which separate them,
2710 and the final '\0'. Make them big enough for the worst case. */
2711 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2712 + (STRINGP (component
)
2713 ? STRING_BYTES (XSTRING (component
)) : 0)
2714 + STRING_BYTES (XSTRING (attribute
))
2717 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2718 + STRING_BYTES (XSTRING (class))
2719 + (STRINGP (subclass
)
2720 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2723 /* Start with emacs.FRAMENAME for the name (the specific one)
2724 and with `Emacs' for the class key (the general one). */
2725 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2726 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2728 strcat (class_key
, ".");
2729 strcat (class_key
, XSTRING (class)->data
);
2731 if (!NILP (component
))
2733 strcat (class_key
, ".");
2734 strcat (class_key
, XSTRING (subclass
)->data
);
2736 strcat (name_key
, ".");
2737 strcat (name_key
, XSTRING (component
)->data
);
2740 strcat (name_key
, ".");
2741 strcat (name_key
, XSTRING (attribute
)->data
);
2743 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2745 if (value
!= (char *) 0)
2746 return build_string (value
);
2751 /* Used when C code wants a resource value. */
2754 x_get_resource_string (attribute
, class)
2755 char *attribute
, *class;
2759 struct frame
*sf
= SELECTED_FRAME ();
2761 /* Allocate space for the components, the dots which separate them,
2762 and the final '\0'. */
2763 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2764 + strlen (attribute
) + 2);
2765 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2766 + strlen (class) + 2);
2768 sprintf (name_key
, "%s.%s",
2769 XSTRING (Vinvocation_name
)->data
,
2771 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2773 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2774 name_key
, class_key
);
2777 /* Types we might convert a resource string into. */
2787 /* Return the value of parameter PARAM.
2789 First search ALIST, then Vdefault_frame_alist, then the X defaults
2790 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2792 Convert the resource to the type specified by desired_type.
2794 If no default is specified, return Qunbound. If you call
2795 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2796 and don't let it get stored in any Lisp-visible variables! */
2799 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2800 struct x_display_info
*dpyinfo
;
2801 Lisp_Object alist
, param
;
2804 enum resource_types type
;
2806 register Lisp_Object tem
;
2808 tem
= Fassq (param
, alist
);
2810 tem
= Fassq (param
, Vdefault_frame_alist
);
2816 tem
= display_x_get_resource (dpyinfo
,
2817 build_string (attribute
),
2818 build_string (class),
2826 case RES_TYPE_NUMBER
:
2827 return make_number (atoi (XSTRING (tem
)->data
));
2829 case RES_TYPE_FLOAT
:
2830 return make_float (atof (XSTRING (tem
)->data
));
2832 case RES_TYPE_BOOLEAN
:
2833 tem
= Fdowncase (tem
);
2834 if (!strcmp (XSTRING (tem
)->data
, "on")
2835 || !strcmp (XSTRING (tem
)->data
, "true"))
2840 case RES_TYPE_STRING
:
2843 case RES_TYPE_SYMBOL
:
2844 /* As a special case, we map the values `true' and `on'
2845 to Qt, and `false' and `off' to Qnil. */
2848 lower
= Fdowncase (tem
);
2849 if (!strcmp (XSTRING (lower
)->data
, "on")
2850 || !strcmp (XSTRING (lower
)->data
, "true"))
2852 else if (!strcmp (XSTRING (lower
)->data
, "off")
2853 || !strcmp (XSTRING (lower
)->data
, "false"))
2856 return Fintern (tem
, Qnil
);
2869 /* Like x_get_arg, but also record the value in f->param_alist. */
2872 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2874 Lisp_Object alist
, param
;
2877 enum resource_types type
;
2881 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2882 attribute
, class, type
);
2884 store_frame_param (f
, param
, value
);
2889 /* Record in frame F the specified or default value according to ALIST
2890 of the parameter named PROP (a Lisp symbol).
2891 If no value is specified for PROP, look for an X default for XPROP
2892 on the frame named NAME.
2893 If that is not found either, use the value DEFLT. */
2896 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2903 enum resource_types type
;
2907 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2908 if (EQ (tem
, Qunbound
))
2910 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2915 /* Record in frame F the specified or default value according to ALIST
2916 of the parameter named PROP (a Lisp symbol). If no value is
2917 specified for PROP, look for an X default for XPROP on the frame
2918 named NAME. If that is not found either, use the value DEFLT. */
2921 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2930 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2933 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2934 if (EQ (tem
, Qunbound
))
2936 #ifdef USE_TOOLKIT_SCROLL_BARS
2938 /* See if an X resource for the scroll bar color has been
2940 tem
= display_x_get_resource (dpyinfo
,
2941 build_string (foreground_p
2945 build_string ("verticalScrollBar"),
2949 /* If nothing has been specified, scroll bars will use a
2950 toolkit-dependent default. Because these defaults are
2951 difficult to get at without actually creating a scroll
2952 bar, use nil to indicate that no color has been
2957 #else /* not USE_TOOLKIT_SCROLL_BARS */
2961 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2964 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2970 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2971 "Parse an X-style geometry string STRING.\n\
2972 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2973 The properties returned may include `top', `left', `height', and `width'.\n\
2974 The value of `left' or `top' may be an integer,\n\
2975 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2976 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2981 unsigned int width
, height
;
2984 CHECK_STRING (string
, 0);
2986 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2987 &x
, &y
, &width
, &height
);
2990 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2991 error ("Must specify both x and y position, or neither");
2995 if (geometry
& XValue
)
2997 Lisp_Object element
;
2999 if (x
>= 0 && (geometry
& XNegative
))
3000 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3001 else if (x
< 0 && ! (geometry
& XNegative
))
3002 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3004 element
= Fcons (Qleft
, make_number (x
));
3005 result
= Fcons (element
, result
);
3008 if (geometry
& YValue
)
3010 Lisp_Object element
;
3012 if (y
>= 0 && (geometry
& YNegative
))
3013 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3014 else if (y
< 0 && ! (geometry
& YNegative
))
3015 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3017 element
= Fcons (Qtop
, make_number (y
));
3018 result
= Fcons (element
, result
);
3021 if (geometry
& WidthValue
)
3022 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3023 if (geometry
& HeightValue
)
3024 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3029 /* Calculate the desired size and position of this window,
3030 and return the flags saying which aspects were specified.
3032 This function does not make the coordinates positive. */
3034 #define DEFAULT_ROWS 40
3035 #define DEFAULT_COLS 80
3038 x_figure_window_size (f
, parms
)
3042 register Lisp_Object tem0
, tem1
, tem2
;
3043 long window_prompting
= 0;
3044 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3046 /* Default values if we fall through.
3047 Actually, if that happens we should get
3048 window manager prompting. */
3049 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3050 f
->height
= DEFAULT_ROWS
;
3051 /* Window managers expect that if program-specified
3052 positions are not (0,0), they're intentional, not defaults. */
3053 f
->output_data
.x
->top_pos
= 0;
3054 f
->output_data
.x
->left_pos
= 0;
3056 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3057 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3058 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3059 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3061 if (!EQ (tem0
, Qunbound
))
3063 CHECK_NUMBER (tem0
, 0);
3064 f
->height
= XINT (tem0
);
3066 if (!EQ (tem1
, Qunbound
))
3068 CHECK_NUMBER (tem1
, 0);
3069 SET_FRAME_WIDTH (f
, XINT (tem1
));
3071 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3072 window_prompting
|= USSize
;
3074 window_prompting
|= PSize
;
3077 f
->output_data
.x
->vertical_scroll_bar_extra
3078 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3080 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3081 f
->output_data
.x
->flags_areas_extra
3082 = FRAME_FLAGS_AREA_WIDTH (f
);
3083 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3084 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3086 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3087 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3088 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3089 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3091 if (EQ (tem0
, Qminus
))
3093 f
->output_data
.x
->top_pos
= 0;
3094 window_prompting
|= YNegative
;
3096 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3097 && CONSP (XCDR (tem0
))
3098 && INTEGERP (XCAR (XCDR (tem0
))))
3100 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3101 window_prompting
|= YNegative
;
3103 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3104 && CONSP (XCDR (tem0
))
3105 && INTEGERP (XCAR (XCDR (tem0
))))
3107 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3109 else if (EQ (tem0
, Qunbound
))
3110 f
->output_data
.x
->top_pos
= 0;
3113 CHECK_NUMBER (tem0
, 0);
3114 f
->output_data
.x
->top_pos
= XINT (tem0
);
3115 if (f
->output_data
.x
->top_pos
< 0)
3116 window_prompting
|= YNegative
;
3119 if (EQ (tem1
, Qminus
))
3121 f
->output_data
.x
->left_pos
= 0;
3122 window_prompting
|= XNegative
;
3124 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3125 && CONSP (XCDR (tem1
))
3126 && INTEGERP (XCAR (XCDR (tem1
))))
3128 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3129 window_prompting
|= XNegative
;
3131 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3132 && CONSP (XCDR (tem1
))
3133 && INTEGERP (XCAR (XCDR (tem1
))))
3135 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3137 else if (EQ (tem1
, Qunbound
))
3138 f
->output_data
.x
->left_pos
= 0;
3141 CHECK_NUMBER (tem1
, 0);
3142 f
->output_data
.x
->left_pos
= XINT (tem1
);
3143 if (f
->output_data
.x
->left_pos
< 0)
3144 window_prompting
|= XNegative
;
3147 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3148 window_prompting
|= USPosition
;
3150 window_prompting
|= PPosition
;
3153 return window_prompting
;
3156 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3159 XSetWMProtocols (dpy
, w
, protocols
, count
)
3166 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3167 if (prop
== None
) return False
;
3168 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3169 (unsigned char *) protocols
, count
);
3172 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3174 #ifdef USE_X_TOOLKIT
3176 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3177 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3178 already be present because of the toolkit (Motif adds some of them,
3179 for example, but Xt doesn't). */
3182 hack_wm_protocols (f
, widget
)
3186 Display
*dpy
= XtDisplay (widget
);
3187 Window w
= XtWindow (widget
);
3188 int need_delete
= 1;
3194 Atom type
, *atoms
= 0;
3196 unsigned long nitems
= 0;
3197 unsigned long bytes_after
;
3199 if ((XGetWindowProperty (dpy
, w
,
3200 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3201 (long)0, (long)100, False
, XA_ATOM
,
3202 &type
, &format
, &nitems
, &bytes_after
,
3203 (unsigned char **) &atoms
)
3205 && format
== 32 && type
== XA_ATOM
)
3209 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3211 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3213 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3216 if (atoms
) XFree ((char *) atoms
);
3222 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3224 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3226 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3228 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3229 XA_ATOM
, 32, PropModeAppend
,
3230 (unsigned char *) props
, count
);
3238 /* Support routines for XIC (X Input Context). */
3242 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3243 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3246 /* Supported XIM styles, ordered by preferenc. */
3248 static XIMStyle supported_xim_styles
[] =
3250 XIMPreeditPosition
| XIMStatusArea
,
3251 XIMPreeditPosition
| XIMStatusNothing
,
3252 XIMPreeditPosition
| XIMStatusNone
,
3253 XIMPreeditNothing
| XIMStatusArea
,
3254 XIMPreeditNothing
| XIMStatusNothing
,
3255 XIMPreeditNothing
| XIMStatusNone
,
3256 XIMPreeditNone
| XIMStatusArea
,
3257 XIMPreeditNone
| XIMStatusNothing
,
3258 XIMPreeditNone
| XIMStatusNone
,
3263 /* Create an X fontset on frame F with base font name
3267 xic_create_xfontset (f
, base_fontname
)
3269 char *base_fontname
;
3272 char **missing_list
;
3276 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3277 base_fontname
, &missing_list
,
3278 &missing_count
, &def_string
);
3280 XFreeStringList (missing_list
);
3282 /* No need to free def_string. */
3287 /* Value is the best input style, given user preferences USER (already
3288 checked to be supported by Emacs), and styles supported by the
3289 input method XIM. */
3292 best_xim_style (user
, xim
)
3298 for (i
= 0; i
< user
->count_styles
; ++i
)
3299 for (j
= 0; j
< xim
->count_styles
; ++j
)
3300 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3301 return user
->supported_styles
[i
];
3303 /* Return the default style. */
3304 return XIMPreeditNothing
| XIMStatusNothing
;
3307 /* Create XIC for frame F. */
3310 create_frame_xic (f
)
3315 XFontSet xfs
= NULL
;
3316 static XIMStyle xic_style
;
3321 xim
= FRAME_X_XIM (f
);
3326 XVaNestedList preedit_attr
;
3327 XVaNestedList status_attr
;
3328 char *base_fontname
;
3331 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3332 spot
.x
= 0; spot
.y
= 1;
3333 /* Create X fontset. */
3334 fontset
= FRAME_FONTSET (f
);
3336 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3339 /* Determine the base fontname from the ASCII font name of
3341 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3342 char *p
= ascii_font
;
3345 for (i
= 0; *p
; p
++)
3348 /* As the font name doesn't conform to XLFD, we can't
3349 modify it to get a suitable base fontname for the
3351 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3354 int len
= strlen (ascii_font
) + 1;
3357 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3366 base_fontname
= (char *) alloca (len
);
3367 bzero (base_fontname
, len
);
3368 strcpy (base_fontname
, "-*-*-");
3369 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3370 strcat (base_fontname
, "*-*-*-*-*-*-*");
3373 xfs
= xic_create_xfontset (f
, base_fontname
);
3375 /* Determine XIC style. */
3378 XIMStyles supported_list
;
3379 supported_list
.count_styles
= (sizeof supported_xim_styles
3380 / sizeof supported_xim_styles
[0]);
3381 supported_list
.supported_styles
= supported_xim_styles
;
3382 xic_style
= best_xim_style (&supported_list
,
3383 FRAME_X_XIM_STYLES (f
));
3386 preedit_attr
= XVaCreateNestedList (0,
3389 FRAME_FOREGROUND_PIXEL (f
),
3391 FRAME_BACKGROUND_PIXEL (f
),
3392 (xic_style
& XIMPreeditPosition
3397 status_attr
= XVaCreateNestedList (0,
3403 FRAME_FOREGROUND_PIXEL (f
),
3405 FRAME_BACKGROUND_PIXEL (f
),
3408 xic
= XCreateIC (xim
,
3409 XNInputStyle
, xic_style
,
3410 XNClientWindow
, FRAME_X_WINDOW(f
),
3411 XNFocusWindow
, FRAME_X_WINDOW(f
),
3412 XNStatusAttributes
, status_attr
,
3413 XNPreeditAttributes
, preedit_attr
,
3415 XFree (preedit_attr
);
3416 XFree (status_attr
);
3419 FRAME_XIC (f
) = xic
;
3420 FRAME_XIC_STYLE (f
) = xic_style
;
3421 FRAME_XIC_FONTSET (f
) = xfs
;
3425 /* Destroy XIC and free XIC fontset of frame F, if any. */
3431 if (FRAME_XIC (f
) == NULL
)
3434 XDestroyIC (FRAME_XIC (f
));
3435 if (FRAME_XIC_FONTSET (f
))
3436 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3438 FRAME_XIC (f
) = NULL
;
3439 FRAME_XIC_FONTSET (f
) = NULL
;
3443 /* Place preedit area for XIC of window W's frame to specified
3444 pixel position X/Y. X and Y are relative to window W. */
3447 xic_set_preeditarea (w
, x
, y
)
3451 struct frame
*f
= XFRAME (w
->frame
);
3455 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3456 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3457 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3458 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3463 /* Place status area for XIC in bottom right corner of frame F.. */
3466 xic_set_statusarea (f
)
3469 XIC xic
= FRAME_XIC (f
);
3474 /* Negotiate geometry of status area. If input method has existing
3475 status area, use its current size. */
3476 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3477 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3478 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3481 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3482 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3485 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3487 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3488 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3492 area
.width
= needed
->width
;
3493 area
.height
= needed
->height
;
3494 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3495 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3496 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3499 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3500 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3505 /* Set X fontset for XIC of frame F, using base font name
3506 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3509 xic_set_xfontset (f
, base_fontname
)
3511 char *base_fontname
;
3516 xfs
= xic_create_xfontset (f
, base_fontname
);
3518 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3519 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3520 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3521 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3522 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3525 if (FRAME_XIC_FONTSET (f
))
3526 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3527 FRAME_XIC_FONTSET (f
) = xfs
;
3530 #endif /* HAVE_X_I18N */
3534 #ifdef USE_X_TOOLKIT
3536 /* Create and set up the X widget for frame F. */
3539 x_window (f
, window_prompting
, minibuffer_only
)
3541 long window_prompting
;
3542 int minibuffer_only
;
3544 XClassHint class_hints
;
3545 XSetWindowAttributes attributes
;
3546 unsigned long attribute_mask
;
3547 Widget shell_widget
;
3549 Widget frame_widget
;
3555 /* Use the resource name as the top-level widget name
3556 for looking up resources. Make a non-Lisp copy
3557 for the window manager, so GC relocation won't bother it.
3559 Elsewhere we specify the window name for the window manager. */
3562 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3563 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3564 strcpy (f
->namebuf
, str
);
3568 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3569 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3570 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3571 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3572 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3573 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3574 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3575 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3576 applicationShellWidgetClass
,
3577 FRAME_X_DISPLAY (f
), al
, ac
);
3579 f
->output_data
.x
->widget
= shell_widget
;
3580 /* maybe_set_screen_title_format (shell_widget); */
3582 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3583 (widget_value
*) NULL
,
3584 shell_widget
, False
,
3588 (lw_callback
) NULL
);
3591 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3592 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3593 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3594 XtSetValues (pane_widget
, al
, ac
);
3595 f
->output_data
.x
->column_widget
= pane_widget
;
3597 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3598 the emacs screen when changing menubar. This reduces flickering. */
3601 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3602 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3603 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3604 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3605 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3606 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3607 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3608 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3609 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3612 f
->output_data
.x
->edit_widget
= frame_widget
;
3614 XtManageChild (frame_widget
);
3616 /* Do some needed geometry management. */
3619 char *tem
, shell_position
[32];
3622 int extra_borders
= 0;
3624 = (f
->output_data
.x
->menubar_widget
3625 ? (f
->output_data
.x
->menubar_widget
->core
.height
3626 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3629 #if 0 /* Experimentally, we now get the right results
3630 for -geometry -0-0 without this. 24 Aug 96, rms. */
3631 if (FRAME_EXTERNAL_MENU_BAR (f
))
3634 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3635 menubar_size
+= ibw
;
3639 f
->output_data
.x
->menubar_height
= menubar_size
;
3642 /* Motif seems to need this amount added to the sizes
3643 specified for the shell widget. The Athena/Lucid widgets don't.
3644 Both conclusions reached experimentally. -- rms. */
3645 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3646 &extra_borders
, NULL
);
3650 /* Convert our geometry parameters into a geometry string
3652 Note that we do not specify here whether the position
3653 is a user-specified or program-specified one.
3654 We pass that information later, in x_wm_set_size_hints. */
3656 int left
= f
->output_data
.x
->left_pos
;
3657 int xneg
= window_prompting
& XNegative
;
3658 int top
= f
->output_data
.x
->top_pos
;
3659 int yneg
= window_prompting
& YNegative
;
3665 if (window_prompting
& USPosition
)
3666 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3667 PIXEL_WIDTH (f
) + extra_borders
,
3668 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3669 (xneg
? '-' : '+'), left
,
3670 (yneg
? '-' : '+'), top
);
3672 sprintf (shell_position
, "=%dx%d",
3673 PIXEL_WIDTH (f
) + extra_borders
,
3674 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3677 len
= strlen (shell_position
) + 1;
3678 /* We don't free this because we don't know whether
3679 it is safe to free it while the frame exists.
3680 It isn't worth the trouble of arranging to free it
3681 when the frame is deleted. */
3682 tem
= (char *) xmalloc (len
);
3683 strncpy (tem
, shell_position
, len
);
3684 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3685 XtSetValues (shell_widget
, al
, ac
);
3688 XtManageChild (pane_widget
);
3689 XtRealizeWidget (shell_widget
);
3691 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3693 validate_x_resource_name ();
3695 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3696 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3697 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3700 FRAME_XIC (f
) = NULL
;
3702 create_frame_xic (f
);
3706 f
->output_data
.x
->wm_hints
.input
= True
;
3707 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3708 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3709 &f
->output_data
.x
->wm_hints
);
3711 hack_wm_protocols (f
, shell_widget
);
3714 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3717 /* Do a stupid property change to force the server to generate a
3718 PropertyNotify event so that the event_stream server timestamp will
3719 be initialized to something relevant to the time we created the window.
3721 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3722 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3723 XA_ATOM
, 32, PropModeAppend
,
3724 (unsigned char*) NULL
, 0);
3726 /* Make all the standard events reach the Emacs frame. */
3727 attributes
.event_mask
= STANDARD_EVENT_SET
;
3732 /* XIM server might require some X events. */
3733 unsigned long fevent
= NoEventMask
;
3734 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3735 attributes
.event_mask
|= fevent
;
3737 #endif /* HAVE_X_I18N */
3739 attribute_mask
= CWEventMask
;
3740 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3741 attribute_mask
, &attributes
);
3743 XtMapWidget (frame_widget
);
3745 /* x_set_name normally ignores requests to set the name if the
3746 requested name is the same as the current name. This is the one
3747 place where that assumption isn't correct; f->name is set, but
3748 the X server hasn't been told. */
3751 int explicit = f
->explicit_name
;
3753 f
->explicit_name
= 0;
3756 x_set_name (f
, name
, explicit);
3759 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3760 f
->output_data
.x
->text_cursor
);
3764 /* This is a no-op, except under Motif. Make sure main areas are
3765 set to something reasonable, in case we get an error later. */
3766 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3769 #else /* not USE_X_TOOLKIT */
3771 /* Create and set up the X window for frame F. */
3778 XClassHint class_hints
;
3779 XSetWindowAttributes attributes
;
3780 unsigned long attribute_mask
;
3782 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3783 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3784 attributes
.bit_gravity
= StaticGravity
;
3785 attributes
.backing_store
= NotUseful
;
3786 attributes
.save_under
= True
;
3787 attributes
.event_mask
= STANDARD_EVENT_SET
;
3788 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3789 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3794 = XCreateWindow (FRAME_X_DISPLAY (f
),
3795 f
->output_data
.x
->parent_desc
,
3796 f
->output_data
.x
->left_pos
,
3797 f
->output_data
.x
->top_pos
,
3798 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3799 f
->output_data
.x
->border_width
,
3800 CopyFromParent
, /* depth */
3801 InputOutput
, /* class */
3803 attribute_mask
, &attributes
);
3807 create_frame_xic (f
);
3810 /* XIM server might require some X events. */
3811 unsigned long fevent
= NoEventMask
;
3812 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3813 attributes
.event_mask
|= fevent
;
3814 attribute_mask
= CWEventMask
;
3815 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3816 attribute_mask
, &attributes
);
3819 #endif /* HAVE_X_I18N */
3821 validate_x_resource_name ();
3823 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3824 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3825 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3827 /* The menubar is part of the ordinary display;
3828 it does not count in addition to the height of the window. */
3829 f
->output_data
.x
->menubar_height
= 0;
3831 /* This indicates that we use the "Passive Input" input model.
3832 Unless we do this, we don't get the Focus{In,Out} events that we
3833 need to draw the cursor correctly. Accursed bureaucrats.
3834 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3836 f
->output_data
.x
->wm_hints
.input
= True
;
3837 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3838 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3839 &f
->output_data
.x
->wm_hints
);
3840 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3842 /* Request "save yourself" and "delete window" commands from wm. */
3845 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3846 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3847 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3850 /* x_set_name normally ignores requests to set the name if the
3851 requested name is the same as the current name. This is the one
3852 place where that assumption isn't correct; f->name is set, but
3853 the X server hasn't been told. */
3856 int explicit = f
->explicit_name
;
3858 f
->explicit_name
= 0;
3861 x_set_name (f
, name
, explicit);
3864 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3865 f
->output_data
.x
->text_cursor
);
3869 if (FRAME_X_WINDOW (f
) == 0)
3870 error ("Unable to create window");
3873 #endif /* not USE_X_TOOLKIT */
3875 /* Handle the icon stuff for this window. Perhaps later we might
3876 want an x_set_icon_position which can be called interactively as
3884 Lisp_Object icon_x
, icon_y
;
3885 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3887 /* Set the position of the icon. Note that twm groups all
3888 icons in an icon window. */
3889 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3890 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3891 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3893 CHECK_NUMBER (icon_x
, 0);
3894 CHECK_NUMBER (icon_y
, 0);
3896 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3897 error ("Both left and top icon corners of icon must be specified");
3901 if (! EQ (icon_x
, Qunbound
))
3902 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3904 /* Start up iconic or window? */
3905 x_wm_set_window_state
3906 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3911 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3918 /* Make the GCs needed for this window, setting the
3919 background, border and mouse colors; also create the
3920 mouse cursor and the gray border tile. */
3922 static char cursor_bits
[] =
3924 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3925 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3926 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3927 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3934 XGCValues gc_values
;
3938 /* Create the GCs of this frame.
3939 Note that many default values are used. */
3942 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3943 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3944 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3945 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3946 f
->output_data
.x
->normal_gc
3947 = XCreateGC (FRAME_X_DISPLAY (f
),
3949 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
3952 /* Reverse video style. */
3953 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3954 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3955 f
->output_data
.x
->reverse_gc
3956 = XCreateGC (FRAME_X_DISPLAY (f
),
3958 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
3961 /* Cursor has cursor-color background, background-color foreground. */
3962 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3963 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3964 gc_values
.fill_style
= FillOpaqueStippled
;
3966 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3967 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3968 cursor_bits
, 16, 16);
3969 f
->output_data
.x
->cursor_gc
3970 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3971 (GCFont
| GCForeground
| GCBackground
3972 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3976 f
->output_data
.x
->white_relief
.gc
= 0;
3977 f
->output_data
.x
->black_relief
.gc
= 0;
3979 /* Create the gray border tile used when the pointer is not in
3980 the frame. Since this depends on the frame's pixel values,
3981 this must be done on a per-frame basis. */
3982 f
->output_data
.x
->border_tile
3983 = (XCreatePixmapFromBitmapData
3984 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3985 gray_bits
, gray_width
, gray_height
,
3986 f
->output_data
.x
->foreground_pixel
,
3987 f
->output_data
.x
->background_pixel
,
3988 DefaultDepth (FRAME_X_DISPLAY (f
),
3989 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3995 /* Free what was was allocated in x_make_gc. */
4001 Display
*dpy
= FRAME_X_DISPLAY (f
);
4005 if (f
->output_data
.x
->normal_gc
)
4007 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
4008 f
->output_data
.x
->normal_gc
= 0;
4011 if (f
->output_data
.x
->reverse_gc
)
4013 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4014 f
->output_data
.x
->reverse_gc
= 0;
4017 if (f
->output_data
.x
->cursor_gc
)
4019 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4020 f
->output_data
.x
->cursor_gc
= 0;
4023 if (f
->output_data
.x
->border_tile
)
4025 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4026 f
->output_data
.x
->border_tile
= 0;
4033 /* Handler for signals raised during x_create_frame and
4034 x_create_top_frame. FRAME is the frame which is partially
4038 unwind_create_frame (frame
)
4041 struct frame
*f
= XFRAME (frame
);
4043 /* If frame is ``official'', nothing to do. */
4044 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4047 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4050 x_free_frame_resources (f
);
4052 /* Check that reference counts are indeed correct. */
4053 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4054 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4062 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4064 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
4065 Returns an Emacs frame object.\n\
4066 ALIST is an alist of frame parameters.\n\
4067 If the parameters specify that the frame should not have a minibuffer,\n\
4068 and do not specify a specific minibuffer window to use,\n\
4069 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4070 be shared by the new frame.\n\
4072 This function is an internal primitive--use `make-frame' instead.")
4077 Lisp_Object frame
, tem
;
4079 int minibuffer_only
= 0;
4080 long window_prompting
= 0;
4082 int count
= BINDING_STACK_SIZE ();
4083 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4084 Lisp_Object display
;
4085 struct x_display_info
*dpyinfo
= NULL
;
4091 /* Use this general default value to start with
4092 until we know if this frame has a specified name. */
4093 Vx_resource_name
= Vinvocation_name
;
4095 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4096 if (EQ (display
, Qunbound
))
4098 dpyinfo
= check_x_display_info (display
);
4100 kb
= dpyinfo
->kboard
;
4102 kb
= &the_only_kboard
;
4105 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4107 && ! EQ (name
, Qunbound
)
4109 error ("Invalid frame name--not a string or nil");
4112 Vx_resource_name
= name
;
4114 /* See if parent window is specified. */
4115 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4116 if (EQ (parent
, Qunbound
))
4118 if (! NILP (parent
))
4119 CHECK_NUMBER (parent
, 0);
4121 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4122 /* No need to protect DISPLAY because that's not used after passing
4123 it to make_frame_without_minibuffer. */
4125 GCPRO4 (parms
, parent
, name
, frame
);
4126 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4128 if (EQ (tem
, Qnone
) || NILP (tem
))
4129 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4130 else if (EQ (tem
, Qonly
))
4132 f
= make_minibuffer_frame ();
4133 minibuffer_only
= 1;
4135 else if (WINDOWP (tem
))
4136 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4140 XSETFRAME (frame
, f
);
4142 /* Note that X Windows does support scroll bars. */
4143 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4145 f
->output_method
= output_x_window
;
4146 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4147 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4148 f
->output_data
.x
->icon_bitmap
= -1;
4149 f
->output_data
.x
->fontset
= -1;
4150 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4151 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4152 record_unwind_protect (unwind_create_frame
, frame
);
4155 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4157 if (! STRINGP (f
->icon_name
))
4158 f
->icon_name
= Qnil
;
4160 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4162 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4163 dpyinfo_refcount
= dpyinfo
->reference_count
;
4164 #endif /* GLYPH_DEBUG */
4166 FRAME_KBOARD (f
) = kb
;
4169 /* These colors will be set anyway later, but it's important
4170 to get the color reference counts right, so initialize them! */
4173 struct gcpro gcpro1
;
4175 black
= build_string ("black");
4177 f
->output_data
.x
->foreground_pixel
4178 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4179 f
->output_data
.x
->background_pixel
4180 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4181 f
->output_data
.x
->cursor_pixel
4182 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4183 f
->output_data
.x
->cursor_foreground_pixel
4184 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4185 f
->output_data
.x
->border_pixel
4186 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4187 f
->output_data
.x
->mouse_pixel
4188 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4192 /* Specify the parent under which to make this X window. */
4196 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4197 f
->output_data
.x
->explicit_parent
= 1;
4201 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4202 f
->output_data
.x
->explicit_parent
= 0;
4205 /* Set the name; the functions to which we pass f expect the name to
4207 if (EQ (name
, Qunbound
) || NILP (name
))
4209 f
->name
= build_string (dpyinfo
->x_id_name
);
4210 f
->explicit_name
= 0;
4215 f
->explicit_name
= 1;
4216 /* use the frame's title when getting resources for this frame. */
4217 specbind (Qx_resource_name
, name
);
4220 /* Extract the window parameters from the supplied values
4221 that are needed to determine window geometry. */
4225 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4228 /* First, try whatever font the caller has specified. */
4231 tem
= Fquery_fontset (font
, Qnil
);
4233 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4235 font
= x_new_font (f
, XSTRING (font
)->data
);
4238 /* Try out a font which we hope has bold and italic variations. */
4239 if (!STRINGP (font
))
4240 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4241 if (!STRINGP (font
))
4242 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4243 if (! STRINGP (font
))
4244 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4245 if (! STRINGP (font
))
4246 /* This was formerly the first thing tried, but it finds too many fonts
4247 and takes too long. */
4248 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4249 /* If those didn't work, look for something which will at least work. */
4250 if (! STRINGP (font
))
4251 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4253 if (! STRINGP (font
))
4254 font
= build_string ("fixed");
4256 x_default_parameter (f
, parms
, Qfont
, font
,
4257 "font", "Font", RES_TYPE_STRING
);
4261 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4262 whereby it fails to get any font. */
4263 xlwmenu_default_font
= f
->output_data
.x
->font
;
4266 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4267 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4269 /* This defaults to 2 in order to match xterm. We recognize either
4270 internalBorderWidth or internalBorder (which is what xterm calls
4272 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4276 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4277 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4278 if (! EQ (value
, Qunbound
))
4279 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4282 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4283 "internalBorderWidth", "internalBorderWidth",
4285 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4286 "verticalScrollBars", "ScrollBars",
4289 /* Also do the stuff which must be set before the window exists. */
4290 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4291 "foreground", "Foreground", RES_TYPE_STRING
);
4292 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4293 "background", "Background", RES_TYPE_STRING
);
4294 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4295 "pointerColor", "Foreground", RES_TYPE_STRING
);
4296 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4297 "cursorColor", "Foreground", RES_TYPE_STRING
);
4298 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4299 "borderColor", "BorderColor", RES_TYPE_STRING
);
4300 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4301 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4302 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4303 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4305 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4306 "scrollBarForeground",
4307 "ScrollBarForeground", 1);
4308 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4309 "scrollBarBackground",
4310 "ScrollBarBackground", 0);
4312 /* Init faces before x_default_parameter is called for scroll-bar
4313 parameters because that function calls x_set_scroll_bar_width,
4314 which calls change_frame_size, which calls Fset_window_buffer,
4315 which runs hooks, which call Fvertical_motion. At the end, we
4316 end up in init_iterator with a null face cache, which should not
4318 init_frame_faces (f
);
4320 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4321 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4322 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4323 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4324 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4325 "bufferPredicate", "BufferPredicate",
4327 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4328 "title", "Title", RES_TYPE_STRING
);
4330 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4331 window_prompting
= x_figure_window_size (f
, parms
);
4333 if (window_prompting
& XNegative
)
4335 if (window_prompting
& YNegative
)
4336 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4338 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4342 if (window_prompting
& YNegative
)
4343 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4345 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4348 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4350 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4351 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4353 /* Create the X widget or window. Add the tool-bar height to the
4354 initial frame height so that the user gets a text display area of
4355 the size he specified with -g or via .Xdefaults. Later changes
4356 of the tool-bar height don't change the frame size. This is done
4357 so that users can create tall Emacs frames without having to
4358 guess how tall the tool-bar will get. */
4359 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
4361 #ifdef USE_X_TOOLKIT
4362 x_window (f
, window_prompting
, minibuffer_only
);
4370 /* Now consider the frame official. */
4371 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4372 Vframe_list
= Fcons (frame
, Vframe_list
);
4374 /* We need to do this after creating the X window, so that the
4375 icon-creation functions can say whose icon they're describing. */
4376 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4377 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4379 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4380 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4381 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4382 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4383 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4384 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4385 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4386 "scrollBarWidth", "ScrollBarWidth",
4389 /* Dimensions, especially f->height, must be done via change_frame_size.
4390 Change will not be effected unless different from the current
4395 SET_FRAME_WIDTH (f
, 0);
4396 change_frame_size (f
, height
, width
, 1, 0, 0);
4398 /* Set up faces after all frame parameters are known. This call
4399 also merges in face attributes specified for new frames. If we
4400 don't do this, the `menu' face for instance won't have the right
4401 colors, and the menu bar won't appear in the specified colors for
4403 call1 (Qface_set_after_frame_default
, frame
);
4405 #ifdef USE_X_TOOLKIT
4406 /* Create the menu bar. */
4407 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4409 /* If this signals an error, we haven't set size hints for the
4410 frame and we didn't make it visible. */
4411 initialize_frame_menubar (f
);
4413 /* This is a no-op, except under Motif where it arranges the
4414 main window for the widgets on it. */
4415 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4416 f
->output_data
.x
->menubar_widget
,
4417 f
->output_data
.x
->edit_widget
);
4419 #endif /* USE_X_TOOLKIT */
4421 /* Tell the server what size and position, etc, we want, and how
4422 badly we want them. This should be done after we have the menu
4423 bar so that its size can be taken into account. */
4425 x_wm_set_size_hint (f
, window_prompting
, 0);
4428 /* Make the window appear on the frame and enable display, unless
4429 the caller says not to. However, with explicit parent, Emacs
4430 cannot control visibility, so don't try. */
4431 if (! f
->output_data
.x
->explicit_parent
)
4433 Lisp_Object visibility
;
4435 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4437 if (EQ (visibility
, Qunbound
))
4440 if (EQ (visibility
, Qicon
))
4441 x_iconify_frame (f
);
4442 else if (! NILP (visibility
))
4443 x_make_frame_visible (f
);
4445 /* Must have been Qnil. */
4450 return unbind_to (count
, frame
);
4454 /* FRAME is used only to get a handle on the X display. We don't pass the
4455 display info directly because we're called from frame.c, which doesn't
4456 know about that structure. */
4459 x_get_focus_frame (frame
)
4460 struct frame
*frame
;
4462 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4464 if (! dpyinfo
->x_focus_frame
)
4467 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4472 /* In certain situations, when the window manager follows a
4473 click-to-focus policy, there seems to be no way around calling
4474 XSetInputFocus to give another frame the input focus .
4476 In an ideal world, XSetInputFocus should generally be avoided so
4477 that applications don't interfere with the window manager's focus
4478 policy. But I think it's okay to use when it's clearly done
4479 following a user-command. */
4481 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4482 "Set the input focus to FRAME.\n\
4483 FRAME nil means use the selected frame.")
4487 struct frame
*f
= check_x_frame (frame
);
4488 Display
*dpy
= FRAME_X_DISPLAY (f
);
4492 count
= x_catch_errors (dpy
);
4493 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4494 RevertToParent
, CurrentTime
);
4495 x_uncatch_errors (dpy
, count
);
4502 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4503 "Internal function called by `color-defined-p', which see.")
4505 Lisp_Object color
, frame
;
4508 FRAME_PTR f
= check_x_frame (frame
);
4510 CHECK_STRING (color
, 1);
4512 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4518 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4519 "Internal function called by `color-values', which see.")
4521 Lisp_Object color
, frame
;
4524 FRAME_PTR f
= check_x_frame (frame
);
4526 CHECK_STRING (color
, 1);
4528 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4532 rgb
[0] = make_number (foo
.red
);
4533 rgb
[1] = make_number (foo
.green
);
4534 rgb
[2] = make_number (foo
.blue
);
4535 return Flist (3, rgb
);
4541 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4542 "Internal function called by `display-color-p', which see.")
4544 Lisp_Object display
;
4546 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4548 if (dpyinfo
->n_planes
<= 2)
4551 switch (dpyinfo
->visual
->class)
4564 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4566 "Return t if the X display supports shades of gray.\n\
4567 Note that color displays do support shades of gray.\n\
4568 The optional argument DISPLAY specifies which display to ask about.\n\
4569 DISPLAY should be either a frame or a display name (a string).\n\
4570 If omitted or nil, that stands for the selected frame's display.")
4572 Lisp_Object display
;
4574 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4576 if (dpyinfo
->n_planes
<= 1)
4579 switch (dpyinfo
->visual
->class)
4594 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4596 "Returns the width in pixels of the X display DISPLAY.\n\
4597 The optional argument DISPLAY specifies which display to ask about.\n\
4598 DISPLAY should be either a frame or a display name (a string).\n\
4599 If omitted or nil, that stands for the selected frame's display.")
4601 Lisp_Object display
;
4603 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4605 return make_number (dpyinfo
->width
);
4608 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4609 Sx_display_pixel_height
, 0, 1, 0,
4610 "Returns the height in pixels of the X display DISPLAY.\n\
4611 The optional argument DISPLAY specifies which display to ask about.\n\
4612 DISPLAY should be either a frame or a display name (a string).\n\
4613 If omitted or nil, that stands for the selected frame's display.")
4615 Lisp_Object display
;
4617 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4619 return make_number (dpyinfo
->height
);
4622 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4624 "Returns the number of bitplanes of the X display DISPLAY.\n\
4625 The optional argument DISPLAY specifies which display to ask about.\n\
4626 DISPLAY should be either a frame or a display name (a string).\n\
4627 If omitted or nil, that stands for the selected frame's display.")
4629 Lisp_Object display
;
4631 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4633 return make_number (dpyinfo
->n_planes
);
4636 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4638 "Returns the number of color cells of the X display DISPLAY.\n\
4639 The optional argument DISPLAY specifies which display to ask about.\n\
4640 DISPLAY should be either a frame or a display name (a string).\n\
4641 If omitted or nil, that stands for the selected frame's display.")
4643 Lisp_Object display
;
4645 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4647 return make_number (DisplayCells (dpyinfo
->display
,
4648 XScreenNumberOfScreen (dpyinfo
->screen
)));
4651 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4652 Sx_server_max_request_size
,
4654 "Returns the maximum request size of the X server of display DISPLAY.\n\
4655 The optional argument DISPLAY specifies which display to ask about.\n\
4656 DISPLAY should be either a frame or a display name (a string).\n\
4657 If omitted or nil, that stands for the selected frame's display.")
4659 Lisp_Object display
;
4661 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4663 return make_number (MAXREQUEST (dpyinfo
->display
));
4666 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4667 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4668 The optional argument DISPLAY specifies which display to ask about.\n\
4669 DISPLAY should be either a frame or a display name (a string).\n\
4670 If omitted or nil, that stands for the selected frame's display.")
4672 Lisp_Object display
;
4674 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4675 char *vendor
= ServerVendor (dpyinfo
->display
);
4677 if (! vendor
) vendor
= "";
4678 return build_string (vendor
);
4681 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4682 "Returns the version numbers of the X server of display DISPLAY.\n\
4683 The value is a list of three integers: the major and minor\n\
4684 version numbers of the X Protocol in use, and the vendor-specific release\n\
4685 number. See also the function `x-server-vendor'.\n\n\
4686 The optional argument DISPLAY specifies which display to ask about.\n\
4687 DISPLAY should be either a frame or a display name (a string).\n\
4688 If omitted or nil, that stands for the selected frame's display.")
4690 Lisp_Object display
;
4692 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4693 Display
*dpy
= dpyinfo
->display
;
4695 return Fcons (make_number (ProtocolVersion (dpy
)),
4696 Fcons (make_number (ProtocolRevision (dpy
)),
4697 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4700 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4701 "Returns the number of screens on the X server of display DISPLAY.\n\
4702 The optional argument DISPLAY specifies which display to ask about.\n\
4703 DISPLAY should be either a frame or a display name (a string).\n\
4704 If omitted or nil, that stands for the selected frame's display.")
4706 Lisp_Object display
;
4708 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4710 return make_number (ScreenCount (dpyinfo
->display
));
4713 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4714 "Returns the height in millimeters of the X display DISPLAY.\n\
4715 The optional argument DISPLAY specifies which display to ask about.\n\
4716 DISPLAY should be either a frame or a display name (a string).\n\
4717 If omitted or nil, that stands for the selected frame's display.")
4719 Lisp_Object display
;
4721 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4723 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4726 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4727 "Returns the width in millimeters of the X display DISPLAY.\n\
4728 The optional argument DISPLAY specifies which display to ask about.\n\
4729 DISPLAY should be either a frame or a display name (a string).\n\
4730 If omitted or nil, that stands for the selected frame's display.")
4732 Lisp_Object display
;
4734 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4736 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4739 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4740 Sx_display_backing_store
, 0, 1, 0,
4741 "Returns an indication of whether X display DISPLAY does backing store.\n\
4742 The value may be `always', `when-mapped', or `not-useful'.\n\
4743 The optional argument DISPLAY specifies which display to ask about.\n\
4744 DISPLAY should be either a frame or a display name (a string).\n\
4745 If omitted or nil, that stands for the selected frame's display.")
4747 Lisp_Object display
;
4749 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4752 switch (DoesBackingStore (dpyinfo
->screen
))
4755 result
= intern ("always");
4759 result
= intern ("when-mapped");
4763 result
= intern ("not-useful");
4767 error ("Strange value for BackingStore parameter of screen");
4774 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4775 Sx_display_visual_class
, 0, 1, 0,
4776 "Returns the visual class of the X display DISPLAY.\n\
4777 The value is one of the symbols `static-gray', `gray-scale',\n\
4778 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4779 The optional argument DISPLAY specifies which display to ask about.\n\
4780 DISPLAY should be either a frame or a display name (a string).\n\
4781 If omitted or nil, that stands for the selected frame's display.")
4783 Lisp_Object display
;
4785 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4788 switch (dpyinfo
->visual
->class)
4791 result
= intern ("static-gray");
4794 result
= intern ("gray-scale");
4797 result
= intern ("static-color");
4800 result
= intern ("pseudo-color");
4803 result
= intern ("true-color");
4806 result
= intern ("direct-color");
4809 error ("Display has an unknown visual class");
4816 DEFUN ("x-display-save-under", Fx_display_save_under
,
4817 Sx_display_save_under
, 0, 1, 0,
4818 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4819 The optional argument DISPLAY specifies which display to ask about.\n\
4820 DISPLAY should be either a frame or a display name (a string).\n\
4821 If omitted or nil, that stands for the selected frame's display.")
4823 Lisp_Object display
;
4825 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4827 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4835 register struct frame
*f
;
4837 return PIXEL_WIDTH (f
);
4842 register struct frame
*f
;
4844 return PIXEL_HEIGHT (f
);
4849 register struct frame
*f
;
4851 return FONT_WIDTH (f
->output_data
.x
->font
);
4856 register struct frame
*f
;
4858 return f
->output_data
.x
->line_height
;
4863 register struct frame
*f
;
4865 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4870 /************************************************************************
4872 ************************************************************************/
4875 /* Mapping visual names to visuals. */
4877 static struct visual_class
4884 {"StaticGray", StaticGray
},
4885 {"GrayScale", GrayScale
},
4886 {"StaticColor", StaticColor
},
4887 {"PseudoColor", PseudoColor
},
4888 {"TrueColor", TrueColor
},
4889 {"DirectColor", DirectColor
},
4894 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4896 /* Value is the screen number of screen SCR. This is a substitute for
4897 the X function with the same name when that doesn't exist. */
4900 XScreenNumberOfScreen (scr
)
4901 register Screen
*scr
;
4903 Display
*dpy
= scr
->display
;
4906 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4907 if (scr
== dpy
->screens
[i
])
4913 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4916 /* Select the visual that should be used on display DPYINFO. Set
4917 members of DPYINFO appropriately. Called from x_term_init. */
4920 select_visual (dpyinfo
)
4921 struct x_display_info
*dpyinfo
;
4923 Display
*dpy
= dpyinfo
->display
;
4924 Screen
*screen
= dpyinfo
->screen
;
4927 /* See if a visual is specified. */
4928 value
= display_x_get_resource (dpyinfo
,
4929 build_string ("visualClass"),
4930 build_string ("VisualClass"),
4932 if (STRINGP (value
))
4934 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4935 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4936 depth, a decimal number. NAME is compared with case ignored. */
4937 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4942 strcpy (s
, XSTRING (value
)->data
);
4943 dash
= index (s
, '-');
4946 dpyinfo
->n_planes
= atoi (dash
+ 1);
4950 /* We won't find a matching visual with depth 0, so that
4951 an error will be printed below. */
4952 dpyinfo
->n_planes
= 0;
4954 /* Determine the visual class. */
4955 for (i
= 0; visual_classes
[i
].name
; ++i
)
4956 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4958 class = visual_classes
[i
].class;
4962 /* Look up a matching visual for the specified class. */
4964 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4965 dpyinfo
->n_planes
, class, &vinfo
))
4966 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4968 dpyinfo
->visual
= vinfo
.visual
;
4973 XVisualInfo
*vinfo
, vinfo_template
;
4975 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
4978 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
4980 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
4982 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4983 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
4984 &vinfo_template
, &n_visuals
);
4986 fatal ("Can't get proper X visual info");
4988 dpyinfo
->n_planes
= vinfo
->depth
;
4989 XFree ((char *) vinfo
);
4994 /* Return the X display structure for the display named NAME.
4995 Open a new connection if necessary. */
4997 struct x_display_info
*
4998 x_display_info_for_name (name
)
5002 struct x_display_info
*dpyinfo
;
5004 CHECK_STRING (name
, 0);
5006 if (! EQ (Vwindow_system
, intern ("x")))
5007 error ("Not using X Windows");
5009 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5011 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5014 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5019 /* Use this general default value to start with. */
5020 Vx_resource_name
= Vinvocation_name
;
5022 validate_x_resource_name ();
5024 dpyinfo
= x_term_init (name
, (char *)0,
5025 (char *) XSTRING (Vx_resource_name
)->data
);
5028 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5031 XSETFASTINT (Vwindow_system_version
, 11);
5037 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5038 1, 3, 0, "Open a connection to an X server.\n\
5039 DISPLAY is the name of the display to connect to.\n\
5040 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5041 If the optional third arg MUST-SUCCEED is non-nil,\n\
5042 terminate Emacs if we can't open the connection.")
5043 (display
, xrm_string
, must_succeed
)
5044 Lisp_Object display
, xrm_string
, must_succeed
;
5046 unsigned char *xrm_option
;
5047 struct x_display_info
*dpyinfo
;
5049 CHECK_STRING (display
, 0);
5050 if (! NILP (xrm_string
))
5051 CHECK_STRING (xrm_string
, 1);
5053 if (! EQ (Vwindow_system
, intern ("x")))
5054 error ("Not using X Windows");
5056 if (! NILP (xrm_string
))
5057 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5059 xrm_option
= (unsigned char *) 0;
5061 validate_x_resource_name ();
5063 /* This is what opens the connection and sets x_current_display.
5064 This also initializes many symbols, such as those used for input. */
5065 dpyinfo
= x_term_init (display
, xrm_option
,
5066 (char *) XSTRING (Vx_resource_name
)->data
);
5070 if (!NILP (must_succeed
))
5071 fatal ("Cannot connect to X server %s.\n\
5072 Check the DISPLAY environment variable or use `-d'.\n\
5073 Also use the `xhost' program to verify that it is set to permit\n\
5074 connections from your machine.\n",
5075 XSTRING (display
)->data
);
5077 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5082 XSETFASTINT (Vwindow_system_version
, 11);
5086 DEFUN ("x-close-connection", Fx_close_connection
,
5087 Sx_close_connection
, 1, 1, 0,
5088 "Close the connection to DISPLAY's X server.\n\
5089 For DISPLAY, specify either a frame or a display name (a string).\n\
5090 If DISPLAY is nil, that stands for the selected frame's display.")
5092 Lisp_Object display
;
5094 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5097 if (dpyinfo
->reference_count
> 0)
5098 error ("Display still has frames on it");
5101 /* Free the fonts in the font table. */
5102 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5103 if (dpyinfo
->font_table
[i
].name
)
5105 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5106 xfree (dpyinfo
->font_table
[i
].full_name
);
5107 xfree (dpyinfo
->font_table
[i
].name
);
5108 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5111 x_destroy_all_bitmaps (dpyinfo
);
5112 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5114 #ifdef USE_X_TOOLKIT
5115 XtCloseDisplay (dpyinfo
->display
);
5117 XCloseDisplay (dpyinfo
->display
);
5120 x_delete_display (dpyinfo
);
5126 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5127 "Return the list of display names that Emacs has connections to.")
5130 Lisp_Object tail
, result
;
5133 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5134 result
= Fcons (XCAR (XCAR (tail
)), result
);
5139 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5140 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5141 If ON is nil, allow buffering of requests.\n\
5142 Turning on synchronization prohibits the Xlib routines from buffering\n\
5143 requests and seriously degrades performance, but makes debugging much\n\
5145 The optional second argument DISPLAY specifies which display to act on.\n\
5146 DISPLAY should be either a frame or a display name (a string).\n\
5147 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5149 Lisp_Object display
, on
;
5151 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5153 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5158 /* Wait for responses to all X commands issued so far for frame F. */
5165 XSync (FRAME_X_DISPLAY (f
), False
);
5170 /***********************************************************************
5172 ***********************************************************************/
5174 /* Value is the number of elements of vector VECTOR. */
5176 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5178 /* List of supported image types. Use define_image_type to add new
5179 types. Use lookup_image_type to find a type for a given symbol. */
5181 static struct image_type
*image_types
;
5183 /* The symbol `image' which is the car of the lists used to represent
5186 extern Lisp_Object Qimage
;
5188 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5194 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5195 extern Lisp_Object QCdata
;
5196 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5197 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
5198 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5200 /* Other symbols. */
5202 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5204 /* Time in seconds after which images should be removed from the cache
5205 if not displayed. */
5207 Lisp_Object Vimage_cache_eviction_delay
;
5209 /* Function prototypes. */
5211 static void define_image_type
P_ ((struct image_type
*type
));
5212 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5213 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5214 static void x_laplace
P_ ((struct frame
*, struct image
*));
5215 static void x_emboss
P_ ((struct frame
*, struct image
*));
5216 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5220 /* Define a new image type from TYPE. This adds a copy of TYPE to
5221 image_types and adds the symbol *TYPE->type to Vimage_types. */
5224 define_image_type (type
)
5225 struct image_type
*type
;
5227 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5228 The initialized data segment is read-only. */
5229 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5230 bcopy (type
, p
, sizeof *p
);
5231 p
->next
= image_types
;
5233 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5237 /* Look up image type SYMBOL, and return a pointer to its image_type
5238 structure. Value is null if SYMBOL is not a known image type. */
5240 static INLINE
struct image_type
*
5241 lookup_image_type (symbol
)
5244 struct image_type
*type
;
5246 for (type
= image_types
; type
; type
= type
->next
)
5247 if (EQ (symbol
, *type
->type
))
5254 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5255 valid image specification is a list whose car is the symbol
5256 `image', and whose rest is a property list. The property list must
5257 contain a value for key `:type'. That value must be the name of a
5258 supported image type. The rest of the property list depends on the
5262 valid_image_p (object
)
5267 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5269 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5270 struct image_type
*type
= lookup_image_type (symbol
);
5273 valid_p
= type
->valid_p (object
);
5280 /* Log error message with format string FORMAT and argument ARG.
5281 Signaling an error, e.g. when an image cannot be loaded, is not a
5282 good idea because this would interrupt redisplay, and the error
5283 message display would lead to another redisplay. This function
5284 therefore simply displays a message. */
5287 image_error (format
, arg1
, arg2
)
5289 Lisp_Object arg1
, arg2
;
5291 add_to_log (format
, arg1
, arg2
);
5296 /***********************************************************************
5297 Image specifications
5298 ***********************************************************************/
5300 enum image_value_type
5302 IMAGE_DONT_CHECK_VALUE_TYPE
,
5305 IMAGE_POSITIVE_INTEGER_VALUE
,
5306 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5308 IMAGE_INTEGER_VALUE
,
5309 IMAGE_FUNCTION_VALUE
,
5314 /* Structure used when parsing image specifications. */
5316 struct image_keyword
5318 /* Name of keyword. */
5321 /* The type of value allowed. */
5322 enum image_value_type type
;
5324 /* Non-zero means key must be present. */
5327 /* Used to recognize duplicate keywords in a property list. */
5330 /* The value that was found. */
5335 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5337 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5340 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5341 has the format (image KEYWORD VALUE ...). One of the keyword/
5342 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5343 image_keywords structures of size NKEYWORDS describing other
5344 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5347 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5349 struct image_keyword
*keywords
;
5356 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5359 plist
= XCDR (spec
);
5360 while (CONSP (plist
))
5362 Lisp_Object key
, value
;
5364 /* First element of a pair must be a symbol. */
5366 plist
= XCDR (plist
);
5370 /* There must follow a value. */
5373 value
= XCAR (plist
);
5374 plist
= XCDR (plist
);
5376 /* Find key in KEYWORDS. Error if not found. */
5377 for (i
= 0; i
< nkeywords
; ++i
)
5378 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5384 /* Record that we recognized the keyword. If a keywords
5385 was found more than once, it's an error. */
5386 keywords
[i
].value
= value
;
5387 ++keywords
[i
].count
;
5389 if (keywords
[i
].count
> 1)
5392 /* Check type of value against allowed type. */
5393 switch (keywords
[i
].type
)
5395 case IMAGE_STRING_VALUE
:
5396 if (!STRINGP (value
))
5400 case IMAGE_SYMBOL_VALUE
:
5401 if (!SYMBOLP (value
))
5405 case IMAGE_POSITIVE_INTEGER_VALUE
:
5406 if (!INTEGERP (value
) || XINT (value
) <= 0)
5410 case IMAGE_ASCENT_VALUE
:
5411 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5413 else if (INTEGERP (value
)
5414 && XINT (value
) >= 0
5415 && XINT (value
) <= 100)
5419 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5420 if (!INTEGERP (value
) || XINT (value
) < 0)
5424 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5427 case IMAGE_FUNCTION_VALUE
:
5428 value
= indirect_function (value
);
5430 || COMPILEDP (value
)
5431 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5435 case IMAGE_NUMBER_VALUE
:
5436 if (!INTEGERP (value
) && !FLOATP (value
))
5440 case IMAGE_INTEGER_VALUE
:
5441 if (!INTEGERP (value
))
5445 case IMAGE_BOOL_VALUE
:
5446 if (!NILP (value
) && !EQ (value
, Qt
))
5455 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5459 /* Check that all mandatory fields are present. */
5460 for (i
= 0; i
< nkeywords
; ++i
)
5461 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5464 return NILP (plist
);
5468 /* Return the value of KEY in image specification SPEC. Value is nil
5469 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5470 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5473 image_spec_value (spec
, key
, found
)
5474 Lisp_Object spec
, key
;
5479 xassert (valid_image_p (spec
));
5481 for (tail
= XCDR (spec
);
5482 CONSP (tail
) && CONSP (XCDR (tail
));
5483 tail
= XCDR (XCDR (tail
)))
5485 if (EQ (XCAR (tail
), key
))
5489 return XCAR (XCDR (tail
));
5499 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5500 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5501 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5502 size in canonical character units.\n\
5503 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5504 or omitted means use the selected frame.")
5505 (spec
, pixels
, frame
)
5506 Lisp_Object spec
, pixels
, frame
;
5511 if (valid_image_p (spec
))
5513 struct frame
*f
= check_x_frame (frame
);
5514 int id
= lookup_image (f
, spec
);
5515 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5516 int width
= img
->width
+ 2 * img
->margin
;
5517 int height
= img
->height
+ 2 * img
->margin
;
5520 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5521 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5523 size
= Fcons (make_number (width
), make_number (height
));
5526 error ("Invalid image specification");
5532 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5533 "Return t if image SPEC has a mask bitmap.\n\
5534 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5535 or omitted means use the selected frame.")
5537 Lisp_Object spec
, frame
;
5542 if (valid_image_p (spec
))
5544 struct frame
*f
= check_x_frame (frame
);
5545 int id
= lookup_image (f
, spec
);
5546 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5551 error ("Invalid image specification");
5558 /***********************************************************************
5559 Image type independent image structures
5560 ***********************************************************************/
5562 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5563 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5566 /* Allocate and return a new image structure for image specification
5567 SPEC. SPEC has a hash value of HASH. */
5569 static struct image
*
5570 make_image (spec
, hash
)
5574 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5576 xassert (valid_image_p (spec
));
5577 bzero (img
, sizeof *img
);
5578 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5579 xassert (img
->type
!= NULL
);
5581 img
->data
.lisp_val
= Qnil
;
5582 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5588 /* Free image IMG which was used on frame F, including its resources. */
5597 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5599 /* Remove IMG from the hash table of its cache. */
5601 img
->prev
->next
= img
->next
;
5603 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5606 img
->next
->prev
= img
->prev
;
5608 c
->images
[img
->id
] = NULL
;
5610 /* Free resources, then free IMG. */
5611 img
->type
->free (f
, img
);
5617 /* Prepare image IMG for display on frame F. Must be called before
5618 drawing an image. */
5621 prepare_image_for_display (f
, img
)
5627 /* We're about to display IMG, so set its timestamp to `now'. */
5629 img
->timestamp
= EMACS_SECS (t
);
5631 /* If IMG doesn't have a pixmap yet, load it now, using the image
5632 type dependent loader function. */
5633 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5634 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5638 /* Value is the number of pixels for the ascent of image IMG when
5639 drawn in face FACE. */
5642 image_ascent (img
, face
)
5646 int height
= img
->height
+ img
->margin
;
5649 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5652 /* This expression is arranged so that if the image can't be
5653 exactly centered, it will be moved slightly up. This is
5654 because a typical font is `top-heavy' (due to the presence
5655 uppercase letters), so the image placement should err towards
5656 being top-heavy too. It also just generally looks better. */
5657 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5659 ascent
= height
/ 2;
5662 ascent
= height
* img
->ascent
/ 100.0;
5669 /***********************************************************************
5670 Helper functions for X image types
5671 ***********************************************************************/
5673 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5675 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5676 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5678 Lisp_Object color_name
,
5679 unsigned long dflt
));
5682 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5683 free the pixmap if any. MASK_P non-zero means clear the mask
5684 pixmap if any. COLORS_P non-zero means free colors allocated for
5685 the image, if any. */
5688 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5691 int pixmap_p
, mask_p
, colors_p
;
5693 if (pixmap_p
&& img
->pixmap
)
5695 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5699 if (mask_p
&& img
->mask
)
5701 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5705 if (colors_p
&& img
->ncolors
)
5707 x_free_colors (f
, img
->colors
, img
->ncolors
);
5708 xfree (img
->colors
);
5714 /* Free X resources of image IMG which is used on frame F. */
5717 x_clear_image (f
, img
)
5722 x_clear_image_1 (f
, img
, 1, 1, 1);
5727 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5728 cannot be allocated, use DFLT. Add a newly allocated color to
5729 IMG->colors, so that it can be freed again. Value is the pixel
5732 static unsigned long
5733 x_alloc_image_color (f
, img
, color_name
, dflt
)
5736 Lisp_Object color_name
;
5740 unsigned long result
;
5742 xassert (STRINGP (color_name
));
5744 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5746 /* This isn't called frequently so we get away with simply
5747 reallocating the color vector to the needed size, here. */
5750 (unsigned long *) xrealloc (img
->colors
,
5751 img
->ncolors
* sizeof *img
->colors
);
5752 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5753 result
= color
.pixel
;
5763 /***********************************************************************
5765 ***********************************************************************/
5767 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5770 /* Return a new, initialized image cache that is allocated from the
5771 heap. Call free_image_cache to free an image cache. */
5773 struct image_cache
*
5776 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5779 bzero (c
, sizeof *c
);
5781 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5782 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5783 c
->buckets
= (struct image
**) xmalloc (size
);
5784 bzero (c
->buckets
, size
);
5789 /* Free image cache of frame F. Be aware that X frames share images
5793 free_image_cache (f
)
5796 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5801 /* Cache should not be referenced by any frame when freed. */
5802 xassert (c
->refcount
== 0);
5804 for (i
= 0; i
< c
->used
; ++i
)
5805 free_image (f
, c
->images
[i
]);
5809 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5814 /* Clear image cache of frame F. FORCE_P non-zero means free all
5815 images. FORCE_P zero means clear only images that haven't been
5816 displayed for some time. Should be called from time to time to
5817 reduce the number of loaded images. If image-eviction-seconds is
5818 non-nil, this frees images in the cache which weren't displayed for
5819 at least that many seconds. */
5822 clear_image_cache (f
, force_p
)
5826 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5828 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5835 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5837 /* Block input so that we won't be interrupted by a SIGIO
5838 while being in an inconsistent state. */
5841 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5843 struct image
*img
= c
->images
[i
];
5845 && (force_p
|| img
->timestamp
< old
))
5847 free_image (f
, img
);
5852 /* We may be clearing the image cache because, for example,
5853 Emacs was iconified for a longer period of time. In that
5854 case, current matrices may still contain references to
5855 images freed above. So, clear these matrices. */
5858 Lisp_Object tail
, frame
;
5860 FOR_EACH_FRAME (tail
, frame
)
5862 struct frame
*f
= XFRAME (frame
);
5864 && FRAME_X_IMAGE_CACHE (f
) == c
)
5865 clear_current_matrices (f
);
5868 ++windows_or_buffers_changed
;
5876 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5878 "Clear the image cache of FRAME.\n\
5879 FRAME nil or omitted means use the selected frame.\n\
5880 FRAME t means clear the image caches of all frames.")
5888 FOR_EACH_FRAME (tail
, frame
)
5889 if (FRAME_X_P (XFRAME (frame
)))
5890 clear_image_cache (XFRAME (frame
), 1);
5893 clear_image_cache (check_x_frame (frame
), 1);
5899 /* Return the id of image with Lisp specification SPEC on frame F.
5900 SPEC must be a valid Lisp image specification (see valid_image_p). */
5903 lookup_image (f
, spec
)
5907 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5911 struct gcpro gcpro1
;
5914 /* F must be a window-system frame, and SPEC must be a valid image
5916 xassert (FRAME_WINDOW_P (f
));
5917 xassert (valid_image_p (spec
));
5921 /* Look up SPEC in the hash table of the image cache. */
5922 hash
= sxhash (spec
, 0);
5923 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5925 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
5926 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
5929 /* If not found, create a new image and cache it. */
5933 img
= make_image (spec
, hash
);
5934 cache_image (f
, img
);
5935 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5937 /* If we can't load the image, and we don't have a width and
5938 height, use some arbitrary width and height so that we can
5939 draw a rectangle for it. */
5940 if (img
->load_failed_p
)
5944 value
= image_spec_value (spec
, QCwidth
, NULL
);
5945 img
->width
= (INTEGERP (value
)
5946 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
5947 value
= image_spec_value (spec
, QCheight
, NULL
);
5948 img
->height
= (INTEGERP (value
)
5949 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
5953 /* Handle image type independent image attributes
5954 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
5955 Lisp_Object ascent
, margin
, relief
;
5957 ascent
= image_spec_value (spec
, QCascent
, NULL
);
5958 if (INTEGERP (ascent
))
5959 img
->ascent
= XFASTINT (ascent
);
5960 else if (EQ (ascent
, Qcenter
))
5961 img
->ascent
= CENTERED_IMAGE_ASCENT
;
5963 margin
= image_spec_value (spec
, QCmargin
, NULL
);
5964 if (INTEGERP (margin
) && XINT (margin
) >= 0)
5965 img
->margin
= XFASTINT (margin
);
5967 relief
= image_spec_value (spec
, QCrelief
, NULL
);
5968 if (INTEGERP (relief
))
5970 img
->relief
= XINT (relief
);
5971 img
->margin
+= abs (img
->relief
);
5974 /* Manipulation of the image's mask. */
5977 /* `:heuristic-mask t'
5979 means build a mask heuristically.
5980 `:heuristic-mask (R G B)'
5981 `:mask (heuristic (R G B))'
5982 means build a mask from color (R G B) in the
5985 means remove a mask, if any. */
5989 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
5991 x_build_heuristic_mask (f
, img
, mask
);
5996 mask
= image_spec_value (spec
, QCmask
, &found_p
);
5998 if (EQ (mask
, Qheuristic
))
5999 x_build_heuristic_mask (f
, img
, Qt
);
6000 else if (CONSP (mask
)
6001 && EQ (XCAR (mask
), Qheuristic
))
6003 if (CONSP (XCDR (mask
)))
6004 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6006 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6008 else if (NILP (mask
) && found_p
&& img
->mask
)
6010 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6016 /* Should we apply an image transformation algorithm? */
6019 Lisp_Object algorithm
;
6021 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
6022 if (EQ (algorithm
, Qdisabled
))
6023 x_disable_image (f
, img
);
6024 else if (EQ (algorithm
, Qlaplace
))
6026 else if (EQ (algorithm
, Qemboss
))
6028 else if (CONSP (algorithm
)
6029 && EQ (XCAR (algorithm
), Qedge_detection
))
6032 tem
= XCDR (algorithm
);
6034 x_edge_detection (f
, img
,
6035 Fplist_get (tem
, QCmatrix
),
6036 Fplist_get (tem
, QCcolor_adjustment
));
6042 xassert (!interrupt_input_blocked
);
6045 /* We're using IMG, so set its timestamp to `now'. */
6046 EMACS_GET_TIME (now
);
6047 img
->timestamp
= EMACS_SECS (now
);
6051 /* Value is the image id. */
6056 /* Cache image IMG in the image cache of frame F. */
6059 cache_image (f
, img
)
6063 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6066 /* Find a free slot in c->images. */
6067 for (i
= 0; i
< c
->used
; ++i
)
6068 if (c
->images
[i
] == NULL
)
6071 /* If no free slot found, maybe enlarge c->images. */
6072 if (i
== c
->used
&& c
->used
== c
->size
)
6075 c
->images
= (struct image
**) xrealloc (c
->images
,
6076 c
->size
* sizeof *c
->images
);
6079 /* Add IMG to c->images, and assign IMG an id. */
6085 /* Add IMG to the cache's hash table. */
6086 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6087 img
->next
= c
->buckets
[i
];
6089 img
->next
->prev
= img
;
6091 c
->buckets
[i
] = img
;
6095 /* Call FN on every image in the image cache of frame F. Used to mark
6096 Lisp Objects in the image cache. */
6099 forall_images_in_image_cache (f
, fn
)
6101 void (*fn
) P_ ((struct image
*img
));
6103 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6105 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6109 for (i
= 0; i
< c
->used
; ++i
)
6118 /***********************************************************************
6120 ***********************************************************************/
6122 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6123 XImage
**, Pixmap
*));
6124 static void x_destroy_x_image
P_ ((XImage
*));
6125 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6128 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6129 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6130 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6131 via xmalloc. Print error messages via image_error if an error
6132 occurs. Value is non-zero if successful. */
6135 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6137 int width
, height
, depth
;
6141 Display
*display
= FRAME_X_DISPLAY (f
);
6142 Screen
*screen
= FRAME_X_SCREEN (f
);
6143 Window window
= FRAME_X_WINDOW (f
);
6145 xassert (interrupt_input_blocked
);
6148 depth
= DefaultDepthOfScreen (screen
);
6149 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6150 depth
, ZPixmap
, 0, NULL
, width
, height
,
6151 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6154 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6158 /* Allocate image raster. */
6159 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6161 /* Allocate a pixmap of the same size. */
6162 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6163 if (*pixmap
== None
)
6165 x_destroy_x_image (*ximg
);
6167 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6175 /* Destroy XImage XIMG. Free XIMG->data. */
6178 x_destroy_x_image (ximg
)
6181 xassert (interrupt_input_blocked
);
6186 XDestroyImage (ximg
);
6191 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6192 are width and height of both the image and pixmap. */
6195 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6202 xassert (interrupt_input_blocked
);
6203 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6204 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6205 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6210 /***********************************************************************
6212 ***********************************************************************/
6214 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6215 static char *slurp_file
P_ ((char *, int *));
6218 /* Find image file FILE. Look in data-directory, then
6219 x-bitmap-file-path. Value is the full name of the file found, or
6220 nil if not found. */
6223 x_find_image_file (file
)
6226 Lisp_Object file_found
, search_path
;
6227 struct gcpro gcpro1
, gcpro2
;
6231 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6232 GCPRO2 (file_found
, search_path
);
6234 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6235 fd
= openp (search_path
, file
, "", &file_found
, 0);
6247 /* Read FILE into memory. Value is a pointer to a buffer allocated
6248 with xmalloc holding FILE's contents. Value is null if an error
6249 occurred. *SIZE is set to the size of the file. */
6252 slurp_file (file
, size
)
6260 if (stat (file
, &st
) == 0
6261 && (fp
= fopen (file
, "r")) != NULL
6262 && (buf
= (char *) xmalloc (st
.st_size
),
6263 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6284 /***********************************************************************
6286 ***********************************************************************/
6288 static int xbm_scan
P_ ((char **, char *, char *, int *));
6289 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6290 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6292 static int xbm_image_p
P_ ((Lisp_Object object
));
6293 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6295 static int xbm_file_p
P_ ((Lisp_Object
));
6298 /* Indices of image specification fields in xbm_format, below. */
6300 enum xbm_keyword_index
6318 /* Vector of image_keyword structures describing the format
6319 of valid XBM image specifications. */
6321 static struct image_keyword xbm_format
[XBM_LAST
] =
6323 {":type", IMAGE_SYMBOL_VALUE
, 1},
6324 {":file", IMAGE_STRING_VALUE
, 0},
6325 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6326 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6327 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6328 {":foreground", IMAGE_STRING_VALUE
, 0},
6329 {":background", IMAGE_STRING_VALUE
, 0},
6330 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6331 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6332 {":relief", IMAGE_INTEGER_VALUE
, 0},
6333 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6334 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6335 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6338 /* Structure describing the image type XBM. */
6340 static struct image_type xbm_type
=
6349 /* Tokens returned from xbm_scan. */
6358 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6359 A valid specification is a list starting with the symbol `image'
6360 The rest of the list is a property list which must contain an
6363 If the specification specifies a file to load, it must contain
6364 an entry `:file FILENAME' where FILENAME is a string.
6366 If the specification is for a bitmap loaded from memory it must
6367 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6368 WIDTH and HEIGHT are integers > 0. DATA may be:
6370 1. a string large enough to hold the bitmap data, i.e. it must
6371 have a size >= (WIDTH + 7) / 8 * HEIGHT
6373 2. a bool-vector of size >= WIDTH * HEIGHT
6375 3. a vector of strings or bool-vectors, one for each line of the
6378 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6379 may not be specified in this case because they are defined in the
6382 Both the file and data forms may contain the additional entries
6383 `:background COLOR' and `:foreground COLOR'. If not present,
6384 foreground and background of the frame on which the image is
6385 displayed is used. */
6388 xbm_image_p (object
)
6391 struct image_keyword kw
[XBM_LAST
];
6393 bcopy (xbm_format
, kw
, sizeof kw
);
6394 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6397 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6399 if (kw
[XBM_FILE
].count
)
6401 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6404 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6406 /* In-memory XBM file. */
6407 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6415 /* Entries for `:width', `:height' and `:data' must be present. */
6416 if (!kw
[XBM_WIDTH
].count
6417 || !kw
[XBM_HEIGHT
].count
6418 || !kw
[XBM_DATA
].count
)
6421 data
= kw
[XBM_DATA
].value
;
6422 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6423 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6425 /* Check type of data, and width and height against contents of
6431 /* Number of elements of the vector must be >= height. */
6432 if (XVECTOR (data
)->size
< height
)
6435 /* Each string or bool-vector in data must be large enough
6436 for one line of the image. */
6437 for (i
= 0; i
< height
; ++i
)
6439 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6443 if (XSTRING (elt
)->size
6444 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6447 else if (BOOL_VECTOR_P (elt
))
6449 if (XBOOL_VECTOR (elt
)->size
< width
)
6456 else if (STRINGP (data
))
6458 if (XSTRING (data
)->size
6459 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6462 else if (BOOL_VECTOR_P (data
))
6464 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6475 /* Scan a bitmap file. FP is the stream to read from. Value is
6476 either an enumerator from enum xbm_token, or a character for a
6477 single-character token, or 0 at end of file. If scanning an
6478 identifier, store the lexeme of the identifier in SVAL. If
6479 scanning a number, store its value in *IVAL. */
6482 xbm_scan (s
, end
, sval
, ival
)
6491 /* Skip white space. */
6492 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6497 else if (isdigit (c
))
6499 int value
= 0, digit
;
6501 if (c
== '0' && *s
< end
)
6504 if (c
== 'x' || c
== 'X')
6511 else if (c
>= 'a' && c
<= 'f')
6512 digit
= c
- 'a' + 10;
6513 else if (c
>= 'A' && c
<= 'F')
6514 digit
= c
- 'A' + 10;
6517 value
= 16 * value
+ digit
;
6520 else if (isdigit (c
))
6524 && (c
= *(*s
)++, isdigit (c
)))
6525 value
= 8 * value
+ c
- '0';
6532 && (c
= *(*s
)++, isdigit (c
)))
6533 value
= 10 * value
+ c
- '0';
6541 else if (isalpha (c
) || c
== '_')
6545 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6552 else if (c
== '/' && **s
== '*')
6554 /* C-style comment. */
6556 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6569 /* Replacement for XReadBitmapFileData which isn't available under old
6570 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6571 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6572 the image. Return in *DATA the bitmap data allocated with xmalloc.
6573 Value is non-zero if successful. DATA null means just test if
6574 CONTENTS looks like an in-memory XBM file. */
6577 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6578 char *contents
, *end
;
6579 int *width
, *height
;
6580 unsigned char **data
;
6583 char buffer
[BUFSIZ
];
6586 int bytes_per_line
, i
, nbytes
;
6592 LA1 = xbm_scan (&s, end, buffer, &value)
6594 #define expect(TOKEN) \
6595 if (LA1 != (TOKEN)) \
6600 #define expect_ident(IDENT) \
6601 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6606 *width
= *height
= -1;
6609 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6611 /* Parse defines for width, height and hot-spots. */
6615 expect_ident ("define");
6616 expect (XBM_TK_IDENT
);
6618 if (LA1
== XBM_TK_NUMBER
);
6620 char *p
= strrchr (buffer
, '_');
6621 p
= p
? p
+ 1 : buffer
;
6622 if (strcmp (p
, "width") == 0)
6624 else if (strcmp (p
, "height") == 0)
6627 expect (XBM_TK_NUMBER
);
6630 if (*width
< 0 || *height
< 0)
6632 else if (data
== NULL
)
6635 /* Parse bits. Must start with `static'. */
6636 expect_ident ("static");
6637 if (LA1
== XBM_TK_IDENT
)
6639 if (strcmp (buffer
, "unsigned") == 0)
6642 expect_ident ("char");
6644 else if (strcmp (buffer
, "short") == 0)
6648 if (*width
% 16 && *width
% 16 < 9)
6651 else if (strcmp (buffer
, "char") == 0)
6659 expect (XBM_TK_IDENT
);
6665 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6666 nbytes
= bytes_per_line
* *height
;
6667 p
= *data
= (char *) xmalloc (nbytes
);
6671 for (i
= 0; i
< nbytes
; i
+= 2)
6674 expect (XBM_TK_NUMBER
);
6677 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6680 if (LA1
== ',' || LA1
== '}')
6688 for (i
= 0; i
< nbytes
; ++i
)
6691 expect (XBM_TK_NUMBER
);
6695 if (LA1
== ',' || LA1
== '}')
6720 /* Load XBM image IMG which will be displayed on frame F from buffer
6721 CONTENTS. END is the end of the buffer. Value is non-zero if
6725 xbm_load_image (f
, img
, contents
, end
)
6728 char *contents
, *end
;
6731 unsigned char *data
;
6734 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6737 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6738 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6739 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6742 xassert (img
->width
> 0 && img
->height
> 0);
6744 /* Get foreground and background colors, maybe allocate colors. */
6745 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6747 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6749 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6751 background
= x_alloc_image_color (f
, img
, value
, background
);
6754 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6757 img
->width
, img
->height
,
6758 foreground
, background
,
6762 if (img
->pixmap
== None
)
6764 x_clear_image (f
, img
);
6765 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6771 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6777 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6784 return (STRINGP (data
)
6785 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6786 (XSTRING (data
)->data
6787 + STRING_BYTES (XSTRING (data
))),
6792 /* Fill image IMG which is used on frame F with pixmap data. Value is
6793 non-zero if successful. */
6801 Lisp_Object file_name
;
6803 xassert (xbm_image_p (img
->spec
));
6805 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6806 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6807 if (STRINGP (file_name
))
6812 struct gcpro gcpro1
;
6814 file
= x_find_image_file (file_name
);
6816 if (!STRINGP (file
))
6818 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6823 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6824 if (contents
== NULL
)
6826 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6831 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6836 struct image_keyword fmt
[XBM_LAST
];
6839 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6840 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6843 int in_memory_file_p
= 0;
6845 /* See if data looks like an in-memory XBM file. */
6846 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6847 in_memory_file_p
= xbm_file_p (data
);
6849 /* Parse the image specification. */
6850 bcopy (xbm_format
, fmt
, sizeof fmt
);
6851 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6854 /* Get specified width, and height. */
6855 if (!in_memory_file_p
)
6857 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6858 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6859 xassert (img
->width
> 0 && img
->height
> 0);
6862 /* Get foreground and background colors, maybe allocate colors. */
6863 if (fmt
[XBM_FOREGROUND
].count
)
6864 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6866 if (fmt
[XBM_BACKGROUND
].count
)
6867 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6870 if (in_memory_file_p
)
6871 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6872 (XSTRING (data
)->data
6873 + STRING_BYTES (XSTRING (data
))));
6880 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6882 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6883 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6885 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6887 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6889 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6892 else if (STRINGP (data
))
6893 bits
= XSTRING (data
)->data
;
6895 bits
= XBOOL_VECTOR (data
)->data
;
6897 /* Create the pixmap. */
6898 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6900 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6903 img
->width
, img
->height
,
6904 foreground
, background
,
6910 image_error ("Unable to create pixmap for XBM image `%s'",
6912 x_clear_image (f
, img
);
6922 /***********************************************************************
6924 ***********************************************************************/
6928 static int xpm_image_p
P_ ((Lisp_Object object
));
6929 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6930 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6932 #include "X11/xpm.h"
6934 /* The symbol `xpm' identifying XPM-format images. */
6938 /* Indices of image specification fields in xpm_format, below. */
6940 enum xpm_keyword_index
6955 /* Vector of image_keyword structures describing the format
6956 of valid XPM image specifications. */
6958 static struct image_keyword xpm_format
[XPM_LAST
] =
6960 {":type", IMAGE_SYMBOL_VALUE
, 1},
6961 {":file", IMAGE_STRING_VALUE
, 0},
6962 {":data", IMAGE_STRING_VALUE
, 0},
6963 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6964 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6965 {":relief", IMAGE_INTEGER_VALUE
, 0},
6966 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6967 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6968 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6969 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6972 /* Structure describing the image type XBM. */
6974 static struct image_type xpm_type
=
6984 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
6985 functions for allocating image colors. Our own functions handle
6986 color allocation failures more gracefully than the ones on the XPM
6989 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
6990 #define ALLOC_XPM_COLORS
6993 #ifdef ALLOC_XPM_COLORS
6995 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
6996 static void xpm_free_color_cache
P_ ((void));
6997 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
6998 static int xpm_color_bucket
P_ ((char *));
6999 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7002 /* An entry in a hash table used to cache color definitions of named
7003 colors. This cache is necessary to speed up XPM image loading in
7004 case we do color allocations ourselves. Without it, we would need
7005 a call to XParseColor per pixel in the image. */
7007 struct xpm_cached_color
7009 /* Next in collision chain. */
7010 struct xpm_cached_color
*next
;
7012 /* Color definition (RGB and pixel color). */
7019 /* The hash table used for the color cache, and its bucket vector
7022 #define XPM_COLOR_CACHE_BUCKETS 1001
7023 struct xpm_cached_color
**xpm_color_cache
;
7025 /* Initialize the color cache. */
7028 xpm_init_color_cache (f
, attrs
)
7030 XpmAttributes
*attrs
;
7032 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7033 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7034 memset (xpm_color_cache
, 0, nbytes
);
7035 init_color_table ();
7037 if (attrs
->valuemask
& XpmColorSymbols
)
7042 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7043 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7044 attrs
->colorsymbols
[i
].value
, &color
))
7046 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7048 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7054 /* Free the color cache. */
7057 xpm_free_color_cache ()
7059 struct xpm_cached_color
*p
, *next
;
7062 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7063 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7069 xfree (xpm_color_cache
);
7070 xpm_color_cache
= NULL
;
7071 free_color_table ();
7075 /* Return the bucket index for color named COLOR_NAME in the color
7079 xpm_color_bucket (color_name
)
7085 for (s
= color_name
; *s
; ++s
)
7087 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7091 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7092 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7095 static struct xpm_cached_color
*
7096 xpm_cache_color (f
, color_name
, color
, bucket
)
7103 struct xpm_cached_color
*p
;
7106 bucket
= xpm_color_bucket (color_name
);
7108 nbytes
= sizeof *p
+ strlen (color_name
);
7109 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7110 strcpy (p
->name
, color_name
);
7112 p
->next
= xpm_color_cache
[bucket
];
7113 xpm_color_cache
[bucket
] = p
;
7118 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7119 return the cached definition in *COLOR. Otherwise, make a new
7120 entry in the cache and allocate the color. Value is zero if color
7121 allocation failed. */
7124 xpm_lookup_color (f
, color_name
, color
)
7129 struct xpm_cached_color
*p
;
7130 int h
= xpm_color_bucket (color_name
);
7132 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7133 if (strcmp (p
->name
, color_name
) == 0)
7138 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7141 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7143 p
= xpm_cache_color (f
, color_name
, color
, h
);
7150 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7151 CLOSURE is a pointer to the frame on which we allocate the
7152 color. Return in *COLOR the allocated color. Value is non-zero
7156 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7163 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7167 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7168 is a pointer to the frame on which we allocate the color. Value is
7169 non-zero if successful. */
7172 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7182 #endif /* ALLOC_XPM_COLORS */
7185 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7186 for XPM images. Such a list must consist of conses whose car and
7190 xpm_valid_color_symbols_p (color_symbols
)
7191 Lisp_Object color_symbols
;
7193 while (CONSP (color_symbols
))
7195 Lisp_Object sym
= XCAR (color_symbols
);
7197 || !STRINGP (XCAR (sym
))
7198 || !STRINGP (XCDR (sym
)))
7200 color_symbols
= XCDR (color_symbols
);
7203 return NILP (color_symbols
);
7207 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7210 xpm_image_p (object
)
7213 struct image_keyword fmt
[XPM_LAST
];
7214 bcopy (xpm_format
, fmt
, sizeof fmt
);
7215 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7216 /* Either `:file' or `:data' must be present. */
7217 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7218 /* Either no `:color-symbols' or it's a list of conses
7219 whose car and cdr are strings. */
7220 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7221 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7225 /* Load image IMG which will be displayed on frame F. Value is
7226 non-zero if successful. */
7234 XpmAttributes attrs
;
7235 Lisp_Object specified_file
, color_symbols
;
7237 /* Configure the XPM lib. Use the visual of frame F. Allocate
7238 close colors. Return colors allocated. */
7239 bzero (&attrs
, sizeof attrs
);
7240 attrs
.visual
= FRAME_X_VISUAL (f
);
7241 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7242 attrs
.valuemask
|= XpmVisual
;
7243 attrs
.valuemask
|= XpmColormap
;
7245 #ifdef ALLOC_XPM_COLORS
7246 /* Allocate colors with our own functions which handle
7247 failing color allocation more gracefully. */
7248 attrs
.color_closure
= f
;
7249 attrs
.alloc_color
= xpm_alloc_color
;
7250 attrs
.free_colors
= xpm_free_colors
;
7251 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7252 #else /* not ALLOC_XPM_COLORS */
7253 /* Let the XPM lib allocate colors. */
7254 attrs
.valuemask
|= XpmReturnAllocPixels
;
7255 #ifdef XpmAllocCloseColors
7256 attrs
.alloc_close_colors
= 1;
7257 attrs
.valuemask
|= XpmAllocCloseColors
;
7258 #else /* not XpmAllocCloseColors */
7259 attrs
.closeness
= 600;
7260 attrs
.valuemask
|= XpmCloseness
;
7261 #endif /* not XpmAllocCloseColors */
7262 #endif /* ALLOC_XPM_COLORS */
7264 /* If image specification contains symbolic color definitions, add
7265 these to `attrs'. */
7266 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7267 if (CONSP (color_symbols
))
7270 XpmColorSymbol
*xpm_syms
;
7273 attrs
.valuemask
|= XpmColorSymbols
;
7275 /* Count number of symbols. */
7276 attrs
.numsymbols
= 0;
7277 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7280 /* Allocate an XpmColorSymbol array. */
7281 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7282 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7283 bzero (xpm_syms
, size
);
7284 attrs
.colorsymbols
= xpm_syms
;
7286 /* Fill the color symbol array. */
7287 for (tail
= color_symbols
, i
= 0;
7289 ++i
, tail
= XCDR (tail
))
7291 Lisp_Object name
= XCAR (XCAR (tail
));
7292 Lisp_Object color
= XCDR (XCAR (tail
));
7293 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7294 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7295 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7296 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7300 /* Create a pixmap for the image, either from a file, or from a
7301 string buffer containing data in the same format as an XPM file. */
7302 #ifdef ALLOC_XPM_COLORS
7303 xpm_init_color_cache (f
, &attrs
);
7306 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7307 if (STRINGP (specified_file
))
7309 Lisp_Object file
= x_find_image_file (specified_file
);
7310 if (!STRINGP (file
))
7312 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7316 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7317 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7322 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7323 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7324 XSTRING (buffer
)->data
,
7325 &img
->pixmap
, &img
->mask
,
7329 if (rc
== XpmSuccess
)
7331 #ifdef ALLOC_XPM_COLORS
7332 img
->colors
= colors_in_color_table (&img
->ncolors
);
7333 #else /* not ALLOC_XPM_COLORS */
7336 img
->ncolors
= attrs
.nalloc_pixels
;
7337 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7338 * sizeof *img
->colors
);
7339 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7341 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7342 #ifdef DEBUG_X_COLORS
7343 register_color (img
->colors
[i
]);
7346 #endif /* not ALLOC_XPM_COLORS */
7348 img
->width
= attrs
.width
;
7349 img
->height
= attrs
.height
;
7350 xassert (img
->width
> 0 && img
->height
> 0);
7352 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7353 XpmFreeAttributes (&attrs
);
7360 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7363 case XpmFileInvalid
:
7364 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7368 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7371 case XpmColorFailed
:
7372 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7376 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7381 #ifdef ALLOC_XPM_COLORS
7382 xpm_free_color_cache ();
7384 return rc
== XpmSuccess
;
7387 #endif /* HAVE_XPM != 0 */
7390 /***********************************************************************
7392 ***********************************************************************/
7394 /* An entry in the color table mapping an RGB color to a pixel color. */
7399 unsigned long pixel
;
7401 /* Next in color table collision list. */
7402 struct ct_color
*next
;
7405 /* The bucket vector size to use. Must be prime. */
7409 /* Value is a hash of the RGB color given by R, G, and B. */
7411 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7413 /* The color hash table. */
7415 struct ct_color
**ct_table
;
7417 /* Number of entries in the color table. */
7419 int ct_colors_allocated
;
7421 /* Initialize the color table. */
7426 int size
= CT_SIZE
* sizeof (*ct_table
);
7427 ct_table
= (struct ct_color
**) xmalloc (size
);
7428 bzero (ct_table
, size
);
7429 ct_colors_allocated
= 0;
7433 /* Free memory associated with the color table. */
7439 struct ct_color
*p
, *next
;
7441 for (i
= 0; i
< CT_SIZE
; ++i
)
7442 for (p
= ct_table
[i
]; p
; p
= next
)
7453 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7454 entry for that color already is in the color table, return the
7455 pixel color of that entry. Otherwise, allocate a new color for R,
7456 G, B, and make an entry in the color table. */
7458 static unsigned long
7459 lookup_rgb_color (f
, r
, g
, b
)
7463 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7464 int i
= hash
% CT_SIZE
;
7467 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7468 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7481 cmap
= FRAME_X_COLORMAP (f
);
7482 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7486 ++ct_colors_allocated
;
7488 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7492 p
->pixel
= color
.pixel
;
7493 p
->next
= ct_table
[i
];
7497 return FRAME_FOREGROUND_PIXEL (f
);
7504 /* Look up pixel color PIXEL which is used on frame F in the color
7505 table. If not already present, allocate it. Value is PIXEL. */
7507 static unsigned long
7508 lookup_pixel_color (f
, pixel
)
7510 unsigned long pixel
;
7512 int i
= pixel
% CT_SIZE
;
7515 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7516 if (p
->pixel
== pixel
)
7525 cmap
= FRAME_X_COLORMAP (f
);
7526 color
.pixel
= pixel
;
7527 x_query_color (f
, &color
);
7528 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7532 ++ct_colors_allocated
;
7534 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7539 p
->next
= ct_table
[i
];
7543 return FRAME_FOREGROUND_PIXEL (f
);
7550 /* Value is a vector of all pixel colors contained in the color table,
7551 allocated via xmalloc. Set *N to the number of colors. */
7553 static unsigned long *
7554 colors_in_color_table (n
)
7559 unsigned long *colors
;
7561 if (ct_colors_allocated
== 0)
7568 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7570 *n
= ct_colors_allocated
;
7572 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7573 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7574 colors
[j
++] = p
->pixel
;
7582 /***********************************************************************
7584 ***********************************************************************/
7586 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7587 int, XImage
*, int));
7588 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7589 XColor
*, int, XImage
*, int));
7590 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7591 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7592 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7594 /* Non-zero means draw a cross on images having `:algorithm
7597 int cross_disabled_images
;
7599 /* Edge detection matrices for different edge-detection
7602 static int emboss_matrix
[9] = {
7604 2, -1, 0, /* y - 1 */
7606 0, 1, -2 /* y + 1 */
7609 static int laplace_matrix
[9] = {
7611 1, 0, 0, /* y - 1 */
7613 0, 0, -1 /* y + 1 */
7616 /* Value is the intensity of the color whose red/green/blue values
7619 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7622 /* On frame F, return an array of XColor structures describing image
7623 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7624 non-zero means also fill the red/green/blue members of the XColor
7625 structures. Value is a pointer to the array of XColors structures,
7626 allocated with xmalloc; it must be freed by the caller. */
7629 x_to_xcolors (f
, img
, rgb_p
)
7638 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7640 /* Get the X image IMG->pixmap. */
7641 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7642 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7644 /* Fill the `pixel' members of the XColor array. I wished there
7645 were an easy and portable way to circumvent XGetPixel. */
7647 for (y
= 0; y
< img
->height
; ++y
)
7651 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7652 p
->pixel
= XGetPixel (ximg
, x
, y
);
7655 x_query_colors (f
, row
, img
->width
);
7658 XDestroyImage (ximg
);
7663 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7664 RGB members are set. F is the frame on which this all happens.
7665 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7668 x_from_xcolors (f
, img
, colors
)
7678 init_color_table ();
7680 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7683 for (y
= 0; y
< img
->height
; ++y
)
7684 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7686 unsigned long pixel
;
7687 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7688 XPutPixel (oimg
, x
, y
, pixel
);
7692 x_clear_image_1 (f
, img
, 1, 0, 1);
7694 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7695 x_destroy_x_image (oimg
);
7696 img
->pixmap
= pixmap
;
7697 img
->colors
= colors_in_color_table (&img
->ncolors
);
7698 free_color_table ();
7702 /* On frame F, perform edge-detection on image IMG.
7704 MATRIX is a nine-element array specifying the transformation
7705 matrix. See emboss_matrix for an example.
7707 COLOR_ADJUST is a color adjustment added to each pixel of the
7711 x_detect_edges (f
, img
, matrix
, color_adjust
)
7714 int matrix
[9], color_adjust
;
7716 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7720 for (i
= sum
= 0; i
< 9; ++i
)
7721 sum
+= abs (matrix
[i
]);
7723 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7725 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7727 for (y
= 0; y
< img
->height
; ++y
)
7729 p
= COLOR (new, 0, y
);
7730 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7731 p
= COLOR (new, img
->width
- 1, y
);
7732 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7735 for (x
= 1; x
< img
->width
- 1; ++x
)
7737 p
= COLOR (new, x
, 0);
7738 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7739 p
= COLOR (new, x
, img
->height
- 1);
7740 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7743 for (y
= 1; y
< img
->height
- 1; ++y
)
7745 p
= COLOR (new, 1, y
);
7747 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7749 int r
, g
, b
, y1
, x1
;
7752 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7753 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7756 XColor
*t
= COLOR (colors
, x1
, y1
);
7757 r
+= matrix
[i
] * t
->red
;
7758 g
+= matrix
[i
] * t
->green
;
7759 b
+= matrix
[i
] * t
->blue
;
7762 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7763 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7764 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7765 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7770 x_from_xcolors (f
, img
, new);
7776 /* Perform the pre-defined `emboss' edge-detection on image IMG
7784 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7788 /* Perform the pre-defined `laplace' edge-detection on image IMG
7796 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7800 /* Perform edge-detection on image IMG on frame F, with specified
7801 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7803 MATRIX must be either
7805 - a list of at least 9 numbers in row-major form
7806 - a vector of at least 9 numbers
7808 COLOR_ADJUST nil means use a default; otherwise it must be a
7812 x_edge_detection (f
, img
, matrix
, color_adjust
)
7815 Lisp_Object matrix
, color_adjust
;
7823 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7824 ++i
, matrix
= XCDR (matrix
))
7825 trans
[i
] = XFLOATINT (XCAR (matrix
));
7827 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7829 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7830 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7833 if (NILP (color_adjust
))
7834 color_adjust
= make_number (0xffff / 2);
7836 if (i
== 9 && NUMBERP (color_adjust
))
7837 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7841 /* Transform image IMG on frame F so that it looks disabled. */
7844 x_disable_image (f
, img
)
7848 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7850 if (dpyinfo
->n_planes
>= 2)
7852 /* Color (or grayscale). Convert to gray, and equalize. Just
7853 drawing such images with a stipple can look very odd, so
7854 we're using this method instead. */
7855 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7857 const int h
= 15000;
7858 const int l
= 30000;
7860 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7864 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7865 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7866 p
->red
= p
->green
= p
->blue
= i2
;
7869 x_from_xcolors (f
, img
, colors
);
7872 /* Draw a cross over the disabled image, if we must or if we
7874 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
7876 Display
*dpy
= FRAME_X_DISPLAY (f
);
7879 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
7880 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
7881 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
7882 img
->width
- 1, img
->height
- 1);
7883 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
7889 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
7890 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
7891 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
7892 img
->width
- 1, img
->height
- 1);
7893 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
7901 /* Build a mask for image IMG which is used on frame F. FILE is the
7902 name of an image file, for error messages. HOW determines how to
7903 determine the background color of IMG. If it is a list '(R G B)',
7904 with R, G, and B being integers >= 0, take that as the color of the
7905 background. Otherwise, determine the background color of IMG
7906 heuristically. Value is non-zero if successful. */
7909 x_build_heuristic_mask (f
, img
, how
)
7914 Display
*dpy
= FRAME_X_DISPLAY (f
);
7915 XImage
*ximg
, *mask_img
;
7916 int x
, y
, rc
, look_at_corners_p
;
7917 unsigned long bg
= 0;
7921 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
7925 /* Create an image and pixmap serving as mask. */
7926 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7927 &mask_img
, &img
->mask
);
7931 /* Get the X image of IMG->pixmap. */
7932 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7935 /* Determine the background color of ximg. If HOW is `(R G B)'
7936 take that as color. Otherwise, try to determine the color
7938 look_at_corners_p
= 1;
7946 && NATNUMP (XCAR (how
)))
7948 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7952 if (i
== 3 && NILP (how
))
7954 char color_name
[30];
7955 XColor exact
, color
;
7958 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7960 cmap
= FRAME_X_COLORMAP (f
);
7961 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7964 look_at_corners_p
= 0;
7969 if (look_at_corners_p
)
7971 unsigned long corners
[4];
7974 /* Get the colors at the corners of ximg. */
7975 corners
[0] = XGetPixel (ximg
, 0, 0);
7976 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7977 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7978 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7980 /* Choose the most frequently found color as background. */
7981 for (i
= best_count
= 0; i
< 4; ++i
)
7985 for (j
= n
= 0; j
< 4; ++j
)
7986 if (corners
[i
] == corners
[j
])
7990 bg
= corners
[i
], best_count
= n
;
7994 /* Set all bits in mask_img to 1 whose color in ximg is different
7995 from the background color bg. */
7996 for (y
= 0; y
< img
->height
; ++y
)
7997 for (x
= 0; x
< img
->width
; ++x
)
7998 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8000 /* Put mask_img into img->mask. */
8001 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8002 x_destroy_x_image (mask_img
);
8003 XDestroyImage (ximg
);
8010 /***********************************************************************
8011 PBM (mono, gray, color)
8012 ***********************************************************************/
8014 static int pbm_image_p
P_ ((Lisp_Object object
));
8015 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8016 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8018 /* The symbol `pbm' identifying images of this type. */
8022 /* Indices of image specification fields in gs_format, below. */
8024 enum pbm_keyword_index
8040 /* Vector of image_keyword structures describing the format
8041 of valid user-defined image specifications. */
8043 static struct image_keyword pbm_format
[PBM_LAST
] =
8045 {":type", IMAGE_SYMBOL_VALUE
, 1},
8046 {":file", IMAGE_STRING_VALUE
, 0},
8047 {":data", IMAGE_STRING_VALUE
, 0},
8048 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8049 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8050 {":relief", IMAGE_INTEGER_VALUE
, 0},
8051 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8052 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8053 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8054 {":foreground", IMAGE_STRING_VALUE
, 0},
8055 {":background", IMAGE_STRING_VALUE
, 0}
8058 /* Structure describing the image type `pbm'. */
8060 static struct image_type pbm_type
=
8070 /* Return non-zero if OBJECT is a valid PBM image specification. */
8073 pbm_image_p (object
)
8076 struct image_keyword fmt
[PBM_LAST
];
8078 bcopy (pbm_format
, fmt
, sizeof fmt
);
8080 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8083 /* Must specify either :data or :file. */
8084 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8088 /* Scan a decimal number from *S and return it. Advance *S while
8089 reading the number. END is the end of the string. Value is -1 at
8093 pbm_scan_number (s
, end
)
8094 unsigned char **s
, *end
;
8096 int c
= 0, val
= -1;
8100 /* Skip white-space. */
8101 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8106 /* Skip comment to end of line. */
8107 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8110 else if (isdigit (c
))
8112 /* Read decimal number. */
8114 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8115 val
= 10 * val
+ c
- '0';
8126 /* Load PBM image IMG for use on frame F. */
8134 int width
, height
, max_color_idx
= 0;
8136 Lisp_Object file
, specified_file
;
8137 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8138 struct gcpro gcpro1
;
8139 unsigned char *contents
= NULL
;
8140 unsigned char *end
, *p
;
8143 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8147 if (STRINGP (specified_file
))
8149 file
= x_find_image_file (specified_file
);
8150 if (!STRINGP (file
))
8152 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8157 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8158 if (contents
== NULL
)
8160 image_error ("Error reading `%s'", file
, Qnil
);
8166 end
= contents
+ size
;
8171 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8172 p
= XSTRING (data
)->data
;
8173 end
= p
+ STRING_BYTES (XSTRING (data
));
8176 /* Check magic number. */
8177 if (end
- p
< 2 || *p
++ != 'P')
8179 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8189 raw_p
= 0, type
= PBM_MONO
;
8193 raw_p
= 0, type
= PBM_GRAY
;
8197 raw_p
= 0, type
= PBM_COLOR
;
8201 raw_p
= 1, type
= PBM_MONO
;
8205 raw_p
= 1, type
= PBM_GRAY
;
8209 raw_p
= 1, type
= PBM_COLOR
;
8213 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8217 /* Read width, height, maximum color-component. Characters
8218 starting with `#' up to the end of a line are ignored. */
8219 width
= pbm_scan_number (&p
, end
);
8220 height
= pbm_scan_number (&p
, end
);
8222 if (type
!= PBM_MONO
)
8224 max_color_idx
= pbm_scan_number (&p
, end
);
8225 if (raw_p
&& max_color_idx
> 255)
8226 max_color_idx
= 255;
8231 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8234 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8235 &ximg
, &img
->pixmap
))
8238 /* Initialize the color hash table. */
8239 init_color_table ();
8241 if (type
== PBM_MONO
)
8244 struct image_keyword fmt
[PBM_LAST
];
8245 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8246 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8248 /* Parse the image specification. */
8249 bcopy (pbm_format
, fmt
, sizeof fmt
);
8250 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8252 /* Get foreground and background colors, maybe allocate colors. */
8253 if (fmt
[PBM_FOREGROUND
].count
)
8254 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8255 if (fmt
[PBM_BACKGROUND
].count
)
8256 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8258 for (y
= 0; y
< height
; ++y
)
8259 for (x
= 0; x
< width
; ++x
)
8269 g
= pbm_scan_number (&p
, end
);
8271 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8276 for (y
= 0; y
< height
; ++y
)
8277 for (x
= 0; x
< width
; ++x
)
8281 if (type
== PBM_GRAY
)
8282 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8291 r
= pbm_scan_number (&p
, end
);
8292 g
= pbm_scan_number (&p
, end
);
8293 b
= pbm_scan_number (&p
, end
);
8296 if (r
< 0 || g
< 0 || b
< 0)
8300 XDestroyImage (ximg
);
8301 image_error ("Invalid pixel value in image `%s'",
8306 /* RGB values are now in the range 0..max_color_idx.
8307 Scale this to the range 0..0xffff supported by X. */
8308 r
= (double) r
* 65535 / max_color_idx
;
8309 g
= (double) g
* 65535 / max_color_idx
;
8310 b
= (double) b
* 65535 / max_color_idx
;
8311 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8315 /* Store in IMG->colors the colors allocated for the image, and
8316 free the color table. */
8317 img
->colors
= colors_in_color_table (&img
->ncolors
);
8318 free_color_table ();
8320 /* Put the image into a pixmap. */
8321 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8322 x_destroy_x_image (ximg
);
8325 img
->height
= height
;
8334 /***********************************************************************
8336 ***********************************************************************/
8342 /* Function prototypes. */
8344 static int png_image_p
P_ ((Lisp_Object object
));
8345 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8347 /* The symbol `png' identifying images of this type. */
8351 /* Indices of image specification fields in png_format, below. */
8353 enum png_keyword_index
8367 /* Vector of image_keyword structures describing the format
8368 of valid user-defined image specifications. */
8370 static struct image_keyword png_format
[PNG_LAST
] =
8372 {":type", IMAGE_SYMBOL_VALUE
, 1},
8373 {":data", IMAGE_STRING_VALUE
, 0},
8374 {":file", IMAGE_STRING_VALUE
, 0},
8375 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8376 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8377 {":relief", IMAGE_INTEGER_VALUE
, 0},
8378 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8379 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8380 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8383 /* Structure describing the image type `png'. */
8385 static struct image_type png_type
=
8395 /* Return non-zero if OBJECT is a valid PNG image specification. */
8398 png_image_p (object
)
8401 struct image_keyword fmt
[PNG_LAST
];
8402 bcopy (png_format
, fmt
, sizeof fmt
);
8404 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8407 /* Must specify either the :data or :file keyword. */
8408 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8412 /* Error and warning handlers installed when the PNG library
8416 my_png_error (png_ptr
, msg
)
8417 png_struct
*png_ptr
;
8420 xassert (png_ptr
!= NULL
);
8421 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8422 longjmp (png_ptr
->jmpbuf
, 1);
8427 my_png_warning (png_ptr
, msg
)
8428 png_struct
*png_ptr
;
8431 xassert (png_ptr
!= NULL
);
8432 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8435 /* Memory source for PNG decoding. */
8437 struct png_memory_storage
8439 unsigned char *bytes
; /* The data */
8440 size_t len
; /* How big is it? */
8441 int index
; /* Where are we? */
8445 /* Function set as reader function when reading PNG image from memory.
8446 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8447 bytes from the input to DATA. */
8450 png_read_from_memory (png_ptr
, data
, length
)
8451 png_structp png_ptr
;
8455 struct png_memory_storage
*tbr
8456 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8458 if (length
> tbr
->len
- tbr
->index
)
8459 png_error (png_ptr
, "Read error");
8461 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8462 tbr
->index
= tbr
->index
+ length
;
8465 /* Load PNG image IMG for use on frame F. Value is non-zero if
8473 Lisp_Object file
, specified_file
;
8474 Lisp_Object specified_data
;
8476 XImage
*ximg
, *mask_img
= NULL
;
8477 struct gcpro gcpro1
;
8478 png_struct
*png_ptr
= NULL
;
8479 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8480 FILE *volatile fp
= NULL
;
8482 png_byte
* volatile pixels
= NULL
;
8483 png_byte
** volatile rows
= NULL
;
8484 png_uint_32 width
, height
;
8485 int bit_depth
, color_type
, interlace_type
;
8487 png_uint_32 row_bytes
;
8490 double screen_gamma
, image_gamma
;
8492 struct png_memory_storage tbr
; /* Data to be read */
8494 /* Find out what file to load. */
8495 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8496 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8500 if (NILP (specified_data
))
8502 file
= x_find_image_file (specified_file
);
8503 if (!STRINGP (file
))
8505 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8510 /* Open the image file. */
8511 fp
= fopen (XSTRING (file
)->data
, "rb");
8514 image_error ("Cannot open image file `%s'", file
, Qnil
);
8520 /* Check PNG signature. */
8521 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8522 || !png_check_sig (sig
, sizeof sig
))
8524 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8532 /* Read from memory. */
8533 tbr
.bytes
= XSTRING (specified_data
)->data
;
8534 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8537 /* Check PNG signature. */
8538 if (tbr
.len
< sizeof sig
8539 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8541 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8546 /* Need to skip past the signature. */
8547 tbr
.bytes
+= sizeof (sig
);
8550 /* Initialize read and info structs for PNG lib. */
8551 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8552 my_png_error
, my_png_warning
);
8555 if (fp
) fclose (fp
);
8560 info_ptr
= png_create_info_struct (png_ptr
);
8563 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8564 if (fp
) fclose (fp
);
8569 end_info
= png_create_info_struct (png_ptr
);
8572 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8573 if (fp
) fclose (fp
);
8578 /* Set error jump-back. We come back here when the PNG library
8579 detects an error. */
8580 if (setjmp (png_ptr
->jmpbuf
))
8584 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8587 if (fp
) fclose (fp
);
8592 /* Read image info. */
8593 if (!NILP (specified_data
))
8594 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8596 png_init_io (png_ptr
, fp
);
8598 png_set_sig_bytes (png_ptr
, sizeof sig
);
8599 png_read_info (png_ptr
, info_ptr
);
8600 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8601 &interlace_type
, NULL
, NULL
);
8603 /* If image contains simply transparency data, we prefer to
8604 construct a clipping mask. */
8605 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8610 /* This function is easier to write if we only have to handle
8611 one data format: RGB or RGBA with 8 bits per channel. Let's
8612 transform other formats into that format. */
8614 /* Strip more than 8 bits per channel. */
8615 if (bit_depth
== 16)
8616 png_set_strip_16 (png_ptr
);
8618 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8620 png_set_expand (png_ptr
);
8622 /* Convert grayscale images to RGB. */
8623 if (color_type
== PNG_COLOR_TYPE_GRAY
8624 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8625 png_set_gray_to_rgb (png_ptr
);
8627 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8628 gamma_str
= getenv ("SCREEN_GAMMA");
8629 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8631 /* Tell the PNG lib to handle gamma correction for us. */
8633 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8634 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8635 /* There is a special chunk in the image specifying the gamma. */
8636 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8639 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8640 /* Image contains gamma information. */
8641 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8643 /* Use a default of 0.5 for the image gamma. */
8644 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8646 /* Handle alpha channel by combining the image with a background
8647 color. Do this only if a real alpha channel is supplied. For
8648 simple transparency, we prefer a clipping mask. */
8651 png_color_16
*image_background
;
8653 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8654 /* Image contains a background color with which to
8655 combine the image. */
8656 png_set_background (png_ptr
, image_background
,
8657 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8660 /* Image does not contain a background color with which
8661 to combine the image data via an alpha channel. Use
8662 the frame's background instead. */
8665 png_color_16 frame_background
;
8667 cmap
= FRAME_X_COLORMAP (f
);
8668 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8669 x_query_color (f
, &color
);
8671 bzero (&frame_background
, sizeof frame_background
);
8672 frame_background
.red
= color
.red
;
8673 frame_background
.green
= color
.green
;
8674 frame_background
.blue
= color
.blue
;
8676 png_set_background (png_ptr
, &frame_background
,
8677 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8681 /* Update info structure. */
8682 png_read_update_info (png_ptr
, info_ptr
);
8684 /* Get number of channels. Valid values are 1 for grayscale images
8685 and images with a palette, 2 for grayscale images with transparency
8686 information (alpha channel), 3 for RGB images, and 4 for RGB
8687 images with alpha channel, i.e. RGBA. If conversions above were
8688 sufficient we should only have 3 or 4 channels here. */
8689 channels
= png_get_channels (png_ptr
, info_ptr
);
8690 xassert (channels
== 3 || channels
== 4);
8692 /* Number of bytes needed for one row of the image. */
8693 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8695 /* Allocate memory for the image. */
8696 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8697 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8698 for (i
= 0; i
< height
; ++i
)
8699 rows
[i
] = pixels
+ i
* row_bytes
;
8701 /* Read the entire image. */
8702 png_read_image (png_ptr
, rows
);
8703 png_read_end (png_ptr
, info_ptr
);
8710 /* Create the X image and pixmap. */
8711 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8715 /* Create an image and pixmap serving as mask if the PNG image
8716 contains an alpha channel. */
8719 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8720 &mask_img
, &img
->mask
))
8722 x_destroy_x_image (ximg
);
8723 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8728 /* Fill the X image and mask from PNG data. */
8729 init_color_table ();
8731 for (y
= 0; y
< height
; ++y
)
8733 png_byte
*p
= rows
[y
];
8735 for (x
= 0; x
< width
; ++x
)
8742 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8744 /* An alpha channel, aka mask channel, associates variable
8745 transparency with an image. Where other image formats
8746 support binary transparency---fully transparent or fully
8747 opaque---PNG allows up to 254 levels of partial transparency.
8748 The PNG library implements partial transparency by combining
8749 the image with a specified background color.
8751 I'm not sure how to handle this here nicely: because the
8752 background on which the image is displayed may change, for
8753 real alpha channel support, it would be necessary to create
8754 a new image for each possible background.
8756 What I'm doing now is that a mask is created if we have
8757 boolean transparency information. Otherwise I'm using
8758 the frame's background color to combine the image with. */
8763 XPutPixel (mask_img
, x
, y
, *p
> 0);
8769 /* Remember colors allocated for this image. */
8770 img
->colors
= colors_in_color_table (&img
->ncolors
);
8771 free_color_table ();
8774 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8779 img
->height
= height
;
8781 /* Put the image into the pixmap, then free the X image and its buffer. */
8782 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8783 x_destroy_x_image (ximg
);
8785 /* Same for the mask. */
8788 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8789 x_destroy_x_image (mask_img
);
8796 #endif /* HAVE_PNG != 0 */
8800 /***********************************************************************
8802 ***********************************************************************/
8806 /* Work around a warning about HAVE_STDLIB_H being redefined in
8808 #ifdef HAVE_STDLIB_H
8809 #define HAVE_STDLIB_H_1
8810 #undef HAVE_STDLIB_H
8811 #endif /* HAVE_STLIB_H */
8813 #include <jpeglib.h>
8817 #ifdef HAVE_STLIB_H_1
8818 #define HAVE_STDLIB_H 1
8821 static int jpeg_image_p
P_ ((Lisp_Object object
));
8822 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8824 /* The symbol `jpeg' identifying images of this type. */
8828 /* Indices of image specification fields in gs_format, below. */
8830 enum jpeg_keyword_index
8839 JPEG_HEURISTIC_MASK
,
8844 /* Vector of image_keyword structures describing the format
8845 of valid user-defined image specifications. */
8847 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8849 {":type", IMAGE_SYMBOL_VALUE
, 1},
8850 {":data", IMAGE_STRING_VALUE
, 0},
8851 {":file", IMAGE_STRING_VALUE
, 0},
8852 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8853 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8854 {":relief", IMAGE_INTEGER_VALUE
, 0},
8855 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8856 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8857 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8860 /* Structure describing the image type `jpeg'. */
8862 static struct image_type jpeg_type
=
8872 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8875 jpeg_image_p (object
)
8878 struct image_keyword fmt
[JPEG_LAST
];
8880 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8882 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8885 /* Must specify either the :data or :file keyword. */
8886 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8890 struct my_jpeg_error_mgr
8892 struct jpeg_error_mgr pub
;
8893 jmp_buf setjmp_buffer
;
8898 my_error_exit (cinfo
)
8901 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8902 longjmp (mgr
->setjmp_buffer
, 1);
8906 /* Init source method for JPEG data source manager. Called by
8907 jpeg_read_header() before any data is actually read. See
8908 libjpeg.doc from the JPEG lib distribution. */
8911 our_init_source (cinfo
)
8912 j_decompress_ptr cinfo
;
8917 /* Fill input buffer method for JPEG data source manager. Called
8918 whenever more data is needed. We read the whole image in one step,
8919 so this only adds a fake end of input marker at the end. */
8922 our_fill_input_buffer (cinfo
)
8923 j_decompress_ptr cinfo
;
8925 /* Insert a fake EOI marker. */
8926 struct jpeg_source_mgr
*src
= cinfo
->src
;
8927 static JOCTET buffer
[2];
8929 buffer
[0] = (JOCTET
) 0xFF;
8930 buffer
[1] = (JOCTET
) JPEG_EOI
;
8932 src
->next_input_byte
= buffer
;
8933 src
->bytes_in_buffer
= 2;
8938 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8939 is the JPEG data source manager. */
8942 our_skip_input_data (cinfo
, num_bytes
)
8943 j_decompress_ptr cinfo
;
8946 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8950 if (num_bytes
> src
->bytes_in_buffer
)
8951 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8953 src
->bytes_in_buffer
-= num_bytes
;
8954 src
->next_input_byte
+= num_bytes
;
8959 /* Method to terminate data source. Called by
8960 jpeg_finish_decompress() after all data has been processed. */
8963 our_term_source (cinfo
)
8964 j_decompress_ptr cinfo
;
8969 /* Set up the JPEG lib for reading an image from DATA which contains
8970 LEN bytes. CINFO is the decompression info structure created for
8971 reading the image. */
8974 jpeg_memory_src (cinfo
, data
, len
)
8975 j_decompress_ptr cinfo
;
8979 struct jpeg_source_mgr
*src
;
8981 if (cinfo
->src
== NULL
)
8983 /* First time for this JPEG object? */
8984 cinfo
->src
= (struct jpeg_source_mgr
*)
8985 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8986 sizeof (struct jpeg_source_mgr
));
8987 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8988 src
->next_input_byte
= data
;
8991 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8992 src
->init_source
= our_init_source
;
8993 src
->fill_input_buffer
= our_fill_input_buffer
;
8994 src
->skip_input_data
= our_skip_input_data
;
8995 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
8996 src
->term_source
= our_term_source
;
8997 src
->bytes_in_buffer
= len
;
8998 src
->next_input_byte
= data
;
9002 /* Load image IMG for use on frame F. Patterned after example.c
9003 from the JPEG lib. */
9010 struct jpeg_decompress_struct cinfo
;
9011 struct my_jpeg_error_mgr mgr
;
9012 Lisp_Object file
, specified_file
;
9013 Lisp_Object specified_data
;
9014 FILE * volatile fp
= NULL
;
9016 int row_stride
, x
, y
;
9017 XImage
*ximg
= NULL
;
9019 unsigned long *colors
;
9021 struct gcpro gcpro1
;
9023 /* Open the JPEG file. */
9024 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9025 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9029 if (NILP (specified_data
))
9031 file
= x_find_image_file (specified_file
);
9032 if (!STRINGP (file
))
9034 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9039 fp
= fopen (XSTRING (file
)->data
, "r");
9042 image_error ("Cannot open `%s'", file
, Qnil
);
9048 /* Customize libjpeg's error handling to call my_error_exit when an
9049 error is detected. This function will perform a longjmp. */
9050 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9051 mgr
.pub
.error_exit
= my_error_exit
;
9053 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9057 /* Called from my_error_exit. Display a JPEG error. */
9058 char buffer
[JMSG_LENGTH_MAX
];
9059 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9060 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9061 build_string (buffer
));
9064 /* Close the input file and destroy the JPEG object. */
9066 fclose ((FILE *) fp
);
9067 jpeg_destroy_decompress (&cinfo
);
9069 /* If we already have an XImage, free that. */
9070 x_destroy_x_image (ximg
);
9072 /* Free pixmap and colors. */
9073 x_clear_image (f
, img
);
9079 /* Create the JPEG decompression object. Let it read from fp.
9080 Read the JPEG image header. */
9081 jpeg_create_decompress (&cinfo
);
9083 if (NILP (specified_data
))
9084 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9086 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9087 STRING_BYTES (XSTRING (specified_data
)));
9089 jpeg_read_header (&cinfo
, TRUE
);
9091 /* Customize decompression so that color quantization will be used.
9092 Start decompression. */
9093 cinfo
.quantize_colors
= TRUE
;
9094 jpeg_start_decompress (&cinfo
);
9095 width
= img
->width
= cinfo
.output_width
;
9096 height
= img
->height
= cinfo
.output_height
;
9098 /* Create X image and pixmap. */
9099 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9100 longjmp (mgr
.setjmp_buffer
, 2);
9102 /* Allocate colors. When color quantization is used,
9103 cinfo.actual_number_of_colors has been set with the number of
9104 colors generated, and cinfo.colormap is a two-dimensional array
9105 of color indices in the range 0..cinfo.actual_number_of_colors.
9106 No more than 255 colors will be generated. */
9110 if (cinfo
.out_color_components
> 2)
9111 ir
= 0, ig
= 1, ib
= 2;
9112 else if (cinfo
.out_color_components
> 1)
9113 ir
= 0, ig
= 1, ib
= 0;
9115 ir
= 0, ig
= 0, ib
= 0;
9117 /* Use the color table mechanism because it handles colors that
9118 cannot be allocated nicely. Such colors will be replaced with
9119 a default color, and we don't have to care about which colors
9120 can be freed safely, and which can't. */
9121 init_color_table ();
9122 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9125 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9127 /* Multiply RGB values with 255 because X expects RGB values
9128 in the range 0..0xffff. */
9129 int r
= cinfo
.colormap
[ir
][i
] << 8;
9130 int g
= cinfo
.colormap
[ig
][i
] << 8;
9131 int b
= cinfo
.colormap
[ib
][i
] << 8;
9132 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9135 /* Remember those colors actually allocated. */
9136 img
->colors
= colors_in_color_table (&img
->ncolors
);
9137 free_color_table ();
9141 row_stride
= width
* cinfo
.output_components
;
9142 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9144 for (y
= 0; y
< height
; ++y
)
9146 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9147 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9148 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9152 jpeg_finish_decompress (&cinfo
);
9153 jpeg_destroy_decompress (&cinfo
);
9155 fclose ((FILE *) fp
);
9157 /* Put the image into the pixmap. */
9158 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9159 x_destroy_x_image (ximg
);
9164 #endif /* HAVE_JPEG */
9168 /***********************************************************************
9170 ***********************************************************************/
9176 static int tiff_image_p
P_ ((Lisp_Object object
));
9177 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9179 /* The symbol `tiff' identifying images of this type. */
9183 /* Indices of image specification fields in tiff_format, below. */
9185 enum tiff_keyword_index
9194 TIFF_HEURISTIC_MASK
,
9199 /* Vector of image_keyword structures describing the format
9200 of valid user-defined image specifications. */
9202 static struct image_keyword tiff_format
[TIFF_LAST
] =
9204 {":type", IMAGE_SYMBOL_VALUE
, 1},
9205 {":data", IMAGE_STRING_VALUE
, 0},
9206 {":file", IMAGE_STRING_VALUE
, 0},
9207 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9208 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9209 {":relief", IMAGE_INTEGER_VALUE
, 0},
9210 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9211 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9212 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9215 /* Structure describing the image type `tiff'. */
9217 static struct image_type tiff_type
=
9227 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9230 tiff_image_p (object
)
9233 struct image_keyword fmt
[TIFF_LAST
];
9234 bcopy (tiff_format
, fmt
, sizeof fmt
);
9236 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9239 /* Must specify either the :data or :file keyword. */
9240 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9244 /* Reading from a memory buffer for TIFF images Based on the PNG
9245 memory source, but we have to provide a lot of extra functions.
9248 We really only need to implement read and seek, but I am not
9249 convinced that the TIFF library is smart enough not to destroy
9250 itself if we only hand it the function pointers we need to
9255 unsigned char *bytes
;
9263 tiff_read_from_memory (data
, buf
, size
)
9268 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9270 if (size
> src
->len
- src
->index
)
9272 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9279 tiff_write_from_memory (data
, buf
, size
)
9289 tiff_seek_in_memory (data
, off
, whence
)
9294 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9299 case SEEK_SET
: /* Go from beginning of source. */
9303 case SEEK_END
: /* Go from end of source. */
9304 idx
= src
->len
+ off
;
9307 case SEEK_CUR
: /* Go from current position. */
9308 idx
= src
->index
+ off
;
9311 default: /* Invalid `whence'. */
9315 if (idx
> src
->len
|| idx
< 0)
9324 tiff_close_memory (data
)
9333 tiff_mmap_memory (data
, pbase
, psize
)
9338 /* It is already _IN_ memory. */
9344 tiff_unmap_memory (data
, base
, size
)
9349 /* We don't need to do this. */
9354 tiff_size_of_memory (data
)
9357 return ((tiff_memory_source
*) data
)->len
;
9361 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9369 Lisp_Object file
, specified_file
;
9370 Lisp_Object specified_data
;
9372 int width
, height
, x
, y
;
9376 struct gcpro gcpro1
;
9377 tiff_memory_source memsrc
;
9379 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9380 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9384 if (NILP (specified_data
))
9386 /* Read from a file */
9387 file
= x_find_image_file (specified_file
);
9388 if (!STRINGP (file
))
9390 image_error ("Cannot find image file `%s'", file
, Qnil
);
9395 /* Try to open the image file. */
9396 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9399 image_error ("Cannot open `%s'", file
, Qnil
);
9406 /* Memory source! */
9407 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9408 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9411 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9412 (TIFFReadWriteProc
) tiff_read_from_memory
,
9413 (TIFFReadWriteProc
) tiff_write_from_memory
,
9414 tiff_seek_in_memory
,
9416 tiff_size_of_memory
,
9422 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9428 /* Get width and height of the image, and allocate a raster buffer
9429 of width x height 32-bit values. */
9430 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9431 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9432 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9434 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9438 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9444 /* Create the X image and pixmap. */
9445 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9452 /* Initialize the color table. */
9453 init_color_table ();
9455 /* Process the pixel raster. Origin is in the lower-left corner. */
9456 for (y
= 0; y
< height
; ++y
)
9458 uint32
*row
= buf
+ y
* width
;
9460 for (x
= 0; x
< width
; ++x
)
9462 uint32 abgr
= row
[x
];
9463 int r
= TIFFGetR (abgr
) << 8;
9464 int g
= TIFFGetG (abgr
) << 8;
9465 int b
= TIFFGetB (abgr
) << 8;
9466 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9470 /* Remember the colors allocated for the image. Free the color table. */
9471 img
->colors
= colors_in_color_table (&img
->ncolors
);
9472 free_color_table ();
9474 /* Put the image into the pixmap, then free the X image and its buffer. */
9475 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9476 x_destroy_x_image (ximg
);
9480 img
->height
= height
;
9486 #endif /* HAVE_TIFF != 0 */
9490 /***********************************************************************
9492 ***********************************************************************/
9496 #include <gif_lib.h>
9498 static int gif_image_p
P_ ((Lisp_Object object
));
9499 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9501 /* The symbol `gif' identifying images of this type. */
9505 /* Indices of image specification fields in gif_format, below. */
9507 enum gif_keyword_index
9522 /* Vector of image_keyword structures describing the format
9523 of valid user-defined image specifications. */
9525 static struct image_keyword gif_format
[GIF_LAST
] =
9527 {":type", IMAGE_SYMBOL_VALUE
, 1},
9528 {":data", IMAGE_STRING_VALUE
, 0},
9529 {":file", IMAGE_STRING_VALUE
, 0},
9530 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9531 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9532 {":relief", IMAGE_INTEGER_VALUE
, 0},
9533 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9534 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9535 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9536 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9539 /* Structure describing the image type `gif'. */
9541 static struct image_type gif_type
=
9551 /* Return non-zero if OBJECT is a valid GIF image specification. */
9554 gif_image_p (object
)
9557 struct image_keyword fmt
[GIF_LAST
];
9558 bcopy (gif_format
, fmt
, sizeof fmt
);
9560 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9563 /* Must specify either the :data or :file keyword. */
9564 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9568 /* Reading a GIF image from memory
9569 Based on the PNG memory stuff to a certain extent. */
9573 unsigned char *bytes
;
9580 /* Make the current memory source available to gif_read_from_memory.
9581 It's done this way because not all versions of libungif support
9582 a UserData field in the GifFileType structure. */
9583 static gif_memory_source
*current_gif_memory_src
;
9586 gif_read_from_memory (file
, buf
, len
)
9591 gif_memory_source
*src
= current_gif_memory_src
;
9593 if (len
> src
->len
- src
->index
)
9596 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9602 /* Load GIF image IMG for use on frame F. Value is non-zero if
9610 Lisp_Object file
, specified_file
;
9611 Lisp_Object specified_data
;
9612 int rc
, width
, height
, x
, y
, i
;
9614 ColorMapObject
*gif_color_map
;
9615 unsigned long pixel_colors
[256];
9617 struct gcpro gcpro1
;
9619 int ino
, image_left
, image_top
, image_width
, image_height
;
9620 gif_memory_source memsrc
;
9621 unsigned char *raster
;
9623 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9624 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9628 if (NILP (specified_data
))
9630 file
= x_find_image_file (specified_file
);
9631 if (!STRINGP (file
))
9633 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9638 /* Open the GIF file. */
9639 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9642 image_error ("Cannot open `%s'", file
, Qnil
);
9649 /* Read from memory! */
9650 current_gif_memory_src
= &memsrc
;
9651 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9652 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9655 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9658 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9664 /* Read entire contents. */
9665 rc
= DGifSlurp (gif
);
9666 if (rc
== GIF_ERROR
)
9668 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9669 DGifCloseFile (gif
);
9674 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9675 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9676 if (ino
>= gif
->ImageCount
)
9678 image_error ("Invalid image number `%s' in image `%s'",
9680 DGifCloseFile (gif
);
9685 width
= img
->width
= gif
->SWidth
;
9686 height
= img
->height
= gif
->SHeight
;
9688 /* Create the X image and pixmap. */
9689 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9691 DGifCloseFile (gif
);
9696 /* Allocate colors. */
9697 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9699 gif_color_map
= gif
->SColorMap
;
9700 init_color_table ();
9701 bzero (pixel_colors
, sizeof pixel_colors
);
9703 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9705 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9706 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9707 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9708 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9711 img
->colors
= colors_in_color_table (&img
->ncolors
);
9712 free_color_table ();
9714 /* Clear the part of the screen image that are not covered by
9715 the image from the GIF file. Full animated GIF support
9716 requires more than can be done here (see the gif89 spec,
9717 disposal methods). Let's simply assume that the part
9718 not covered by a sub-image is in the frame's background color. */
9719 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9720 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9721 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9722 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9724 for (y
= 0; y
< image_top
; ++y
)
9725 for (x
= 0; x
< width
; ++x
)
9726 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9728 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9729 for (x
= 0; x
< width
; ++x
)
9730 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9732 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9734 for (x
= 0; x
< image_left
; ++x
)
9735 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9736 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9737 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9740 /* Read the GIF image into the X image. We use a local variable
9741 `raster' here because RasterBits below is a char *, and invites
9742 problems with bytes >= 0x80. */
9743 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9745 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9747 static int interlace_start
[] = {0, 4, 2, 1};
9748 static int interlace_increment
[] = {8, 8, 4, 2};
9750 int row
= interlace_start
[0];
9754 for (y
= 0; y
< image_height
; y
++)
9756 if (row
>= image_height
)
9758 row
= interlace_start
[++pass
];
9759 while (row
>= image_height
)
9760 row
= interlace_start
[++pass
];
9763 for (x
= 0; x
< image_width
; x
++)
9765 int i
= raster
[(y
* image_width
) + x
];
9766 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9770 row
+= interlace_increment
[pass
];
9775 for (y
= 0; y
< image_height
; ++y
)
9776 for (x
= 0; x
< image_width
; ++x
)
9778 int i
= raster
[y
* image_width
+ x
];
9779 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9783 DGifCloseFile (gif
);
9785 /* Put the image into the pixmap, then free the X image and its buffer. */
9786 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9787 x_destroy_x_image (ximg
);
9793 #endif /* HAVE_GIF != 0 */
9797 /***********************************************************************
9799 ***********************************************************************/
9801 static int gs_image_p
P_ ((Lisp_Object object
));
9802 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9803 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9805 /* The symbol `postscript' identifying images of this type. */
9807 Lisp_Object Qpostscript
;
9809 /* Keyword symbols. */
9811 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9813 /* Indices of image specification fields in gs_format, below. */
9815 enum gs_keyword_index
9832 /* Vector of image_keyword structures describing the format
9833 of valid user-defined image specifications. */
9835 static struct image_keyword gs_format
[GS_LAST
] =
9837 {":type", IMAGE_SYMBOL_VALUE
, 1},
9838 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9839 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9840 {":file", IMAGE_STRING_VALUE
, 1},
9841 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9842 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9843 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9844 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9845 {":relief", IMAGE_INTEGER_VALUE
, 0},
9846 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9847 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9848 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9851 /* Structure describing the image type `ghostscript'. */
9853 static struct image_type gs_type
=
9863 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9866 gs_clear_image (f
, img
)
9870 /* IMG->data.ptr_val may contain a recorded colormap. */
9871 xfree (img
->data
.ptr_val
);
9872 x_clear_image (f
, img
);
9876 /* Return non-zero if OBJECT is a valid Ghostscript image
9883 struct image_keyword fmt
[GS_LAST
];
9887 bcopy (gs_format
, fmt
, sizeof fmt
);
9889 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
9892 /* Bounding box must be a list or vector containing 4 integers. */
9893 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9896 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9897 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9902 else if (VECTORP (tem
))
9904 if (XVECTOR (tem
)->size
!= 4)
9906 for (i
= 0; i
< 4; ++i
)
9907 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9917 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9926 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9927 struct gcpro gcpro1
, gcpro2
;
9929 double in_width
, in_height
;
9930 Lisp_Object pixel_colors
= Qnil
;
9932 /* Compute pixel size of pixmap needed from the given size in the
9933 image specification. Sizes in the specification are in pt. 1 pt
9934 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9936 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9937 in_width
= XFASTINT (pt_width
) / 72.0;
9938 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9939 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9940 in_height
= XFASTINT (pt_height
) / 72.0;
9941 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9943 /* Create the pixmap. */
9944 xassert (img
->pixmap
== None
);
9945 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9946 img
->width
, img
->height
,
9947 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9951 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9955 /* Call the loader to fill the pixmap. It returns a process object
9956 if successful. We do not record_unwind_protect here because
9957 other places in redisplay like calling window scroll functions
9958 don't either. Let the Lisp loader use `unwind-protect' instead. */
9959 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9961 sprintf (buffer
, "%lu %lu",
9962 (unsigned long) FRAME_X_WINDOW (f
),
9963 (unsigned long) img
->pixmap
);
9964 window_and_pixmap_id
= build_string (buffer
);
9966 sprintf (buffer
, "%lu %lu",
9967 FRAME_FOREGROUND_PIXEL (f
),
9968 FRAME_BACKGROUND_PIXEL (f
));
9969 pixel_colors
= build_string (buffer
);
9971 XSETFRAME (frame
, f
);
9972 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9974 loader
= intern ("gs-load-image");
9976 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9977 make_number (img
->width
),
9978 make_number (img
->height
),
9979 window_and_pixmap_id
,
9982 return PROCESSP (img
->data
.lisp_val
);
9986 /* Kill the Ghostscript process that was started to fill PIXMAP on
9987 frame F. Called from XTread_socket when receiving an event
9988 telling Emacs that Ghostscript has finished drawing. */
9991 x_kill_gs_process (pixmap
, f
)
9995 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9999 /* Find the image containing PIXMAP. */
10000 for (i
= 0; i
< c
->used
; ++i
)
10001 if (c
->images
[i
]->pixmap
== pixmap
)
10004 /* Kill the GS process. We should have found PIXMAP in the image
10005 cache and its image should contain a process object. */
10006 xassert (i
< c
->used
);
10007 img
= c
->images
[i
];
10008 xassert (PROCESSP (img
->data
.lisp_val
));
10009 Fkill_process (img
->data
.lisp_val
, Qnil
);
10010 img
->data
.lisp_val
= Qnil
;
10012 /* On displays with a mutable colormap, figure out the colors
10013 allocated for the image by looking at the pixels of an XImage for
10015 class = FRAME_X_VISUAL (f
)->class;
10016 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10022 /* Try to get an XImage for img->pixmep. */
10023 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10024 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10029 /* Initialize the color table. */
10030 init_color_table ();
10032 /* For each pixel of the image, look its color up in the
10033 color table. After having done so, the color table will
10034 contain an entry for each color used by the image. */
10035 for (y
= 0; y
< img
->height
; ++y
)
10036 for (x
= 0; x
< img
->width
; ++x
)
10038 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10039 lookup_pixel_color (f
, pixel
);
10042 /* Record colors in the image. Free color table and XImage. */
10043 img
->colors
= colors_in_color_table (&img
->ncolors
);
10044 free_color_table ();
10045 XDestroyImage (ximg
);
10047 #if 0 /* This doesn't seem to be the case. If we free the colors
10048 here, we get a BadAccess later in x_clear_image when
10049 freeing the colors. */
10050 /* We have allocated colors once, but Ghostscript has also
10051 allocated colors on behalf of us. So, to get the
10052 reference counts right, free them once. */
10054 x_free_colors (f
, img
->colors
, img
->ncolors
);
10058 image_error ("Cannot get X image of `%s'; colors will not be freed",
10067 /***********************************************************************
10069 ***********************************************************************/
10071 DEFUN ("x-change-window-property", Fx_change_window_property
,
10072 Sx_change_window_property
, 2, 3, 0,
10073 "Change window property PROP to VALUE on the X window of FRAME.\n\
10074 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
10075 selected frame. Value is VALUE.")
10076 (prop
, value
, frame
)
10077 Lisp_Object frame
, prop
, value
;
10079 struct frame
*f
= check_x_frame (frame
);
10082 CHECK_STRING (prop
, 1);
10083 CHECK_STRING (value
, 2);
10086 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10087 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10088 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10089 XSTRING (value
)->data
, XSTRING (value
)->size
);
10091 /* Make sure the property is set when we return. */
10092 XFlush (FRAME_X_DISPLAY (f
));
10099 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10100 Sx_delete_window_property
, 1, 2, 0,
10101 "Remove window property PROP from X window of FRAME.\n\
10102 FRAME nil or omitted means use the selected frame. Value is PROP.")
10104 Lisp_Object prop
, frame
;
10106 struct frame
*f
= check_x_frame (frame
);
10109 CHECK_STRING (prop
, 1);
10111 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10112 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10114 /* Make sure the property is removed when we return. */
10115 XFlush (FRAME_X_DISPLAY (f
));
10122 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10124 "Value is the value of window property PROP on FRAME.\n\
10125 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10126 if FRAME hasn't a property with name PROP or if PROP has no string\n\
10129 Lisp_Object prop
, frame
;
10131 struct frame
*f
= check_x_frame (frame
);
10134 Lisp_Object prop_value
= Qnil
;
10135 char *tmp_data
= NULL
;
10138 unsigned long actual_size
, bytes_remaining
;
10140 CHECK_STRING (prop
, 1);
10142 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10143 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10144 prop_atom
, 0, 0, False
, XA_STRING
,
10145 &actual_type
, &actual_format
, &actual_size
,
10146 &bytes_remaining
, (unsigned char **) &tmp_data
);
10149 int size
= bytes_remaining
;
10154 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10155 prop_atom
, 0, bytes_remaining
,
10157 &actual_type
, &actual_format
,
10158 &actual_size
, &bytes_remaining
,
10159 (unsigned char **) &tmp_data
);
10161 prop_value
= make_string (tmp_data
, size
);
10172 /***********************************************************************
10174 ***********************************************************************/
10176 /* If non-null, an asynchronous timer that, when it expires, displays
10177 a busy cursor on all frames. */
10179 static struct atimer
*busy_cursor_atimer
;
10181 /* Non-zero means a busy cursor is currently shown. */
10183 static int busy_cursor_shown_p
;
10185 /* Number of seconds to wait before displaying a busy cursor. */
10187 static Lisp_Object Vbusy_cursor_delay
;
10189 /* Default number of seconds to wait before displaying a busy
10192 #define DEFAULT_BUSY_CURSOR_DELAY 1
10194 /* Function prototypes. */
10196 static void show_busy_cursor
P_ ((struct atimer
*));
10197 static void hide_busy_cursor
P_ ((void));
10200 /* Cancel a currently active busy-cursor timer, and start a new one. */
10203 start_busy_cursor ()
10206 int secs
, usecs
= 0;
10208 cancel_busy_cursor ();
10210 if (INTEGERP (Vbusy_cursor_delay
)
10211 && XINT (Vbusy_cursor_delay
) > 0)
10212 secs
= XFASTINT (Vbusy_cursor_delay
);
10213 else if (FLOATP (Vbusy_cursor_delay
)
10214 && XFLOAT_DATA (Vbusy_cursor_delay
) > 0)
10217 tem
= Ftruncate (Vbusy_cursor_delay
, Qnil
);
10218 secs
= XFASTINT (tem
);
10219 usecs
= (XFLOAT_DATA (Vbusy_cursor_delay
) - secs
) * 1000000;
10222 secs
= DEFAULT_BUSY_CURSOR_DELAY
;
10224 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10225 busy_cursor_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10226 show_busy_cursor
, NULL
);
10230 /* Cancel the busy cursor timer if active, hide a busy cursor if
10234 cancel_busy_cursor ()
10236 if (busy_cursor_atimer
)
10238 cancel_atimer (busy_cursor_atimer
);
10239 busy_cursor_atimer
= NULL
;
10242 if (busy_cursor_shown_p
)
10243 hide_busy_cursor ();
10247 /* Timer function of busy_cursor_atimer. TIMER is equal to
10248 busy_cursor_atimer.
10250 Display a busy cursor on all frames by mapping the frames'
10251 busy_window. Set the busy_p flag in the frames' output_data.x
10252 structure to indicate that a busy cursor is shown on the
10256 show_busy_cursor (timer
)
10257 struct atimer
*timer
;
10259 /* The timer implementation will cancel this timer automatically
10260 after this function has run. Set busy_cursor_atimer to null
10261 so that we know the timer doesn't have to be canceled. */
10262 busy_cursor_atimer
= NULL
;
10264 if (!busy_cursor_shown_p
)
10266 Lisp_Object rest
, frame
;
10270 FOR_EACH_FRAME (rest
, frame
)
10272 struct frame
*f
= XFRAME (frame
);
10274 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10276 Display
*dpy
= FRAME_X_DISPLAY (f
);
10278 #ifdef USE_X_TOOLKIT
10279 if (f
->output_data
.x
->widget
)
10281 if (FRAME_OUTER_WINDOW (f
))
10284 f
->output_data
.x
->busy_p
= 1;
10286 if (!f
->output_data
.x
->busy_window
)
10288 unsigned long mask
= CWCursor
;
10289 XSetWindowAttributes attrs
;
10291 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
10293 f
->output_data
.x
->busy_window
10294 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10295 0, 0, 32000, 32000, 0, 0,
10301 XMapRaised (dpy
, f
->output_data
.x
->busy_window
);
10307 busy_cursor_shown_p
= 1;
10313 /* Hide the busy cursor on all frames, if it is currently shown. */
10316 hide_busy_cursor ()
10318 if (busy_cursor_shown_p
)
10320 Lisp_Object rest
, frame
;
10323 FOR_EACH_FRAME (rest
, frame
)
10325 struct frame
*f
= XFRAME (frame
);
10328 /* Watch out for newly created frames. */
10329 && f
->output_data
.x
->busy_window
)
10331 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10332 /* Sync here because XTread_socket looks at the busy_p flag
10333 that is reset to zero below. */
10334 XSync (FRAME_X_DISPLAY (f
), False
);
10335 f
->output_data
.x
->busy_p
= 0;
10339 busy_cursor_shown_p
= 0;
10346 /***********************************************************************
10348 ***********************************************************************/
10350 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10352 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10353 Lisp_Object
, int *, int *));
10355 /* The frame of a currently visible tooltip. */
10357 Lisp_Object tip_frame
;
10359 /* If non-nil, a timer started that hides the last tooltip when it
10362 Lisp_Object tip_timer
;
10365 /* If non-nil, a vector of 3 elements containing the last args
10366 with which x-show-tip was called. See there. */
10368 Lisp_Object last_show_tip_args
;
10372 unwind_create_tip_frame (frame
)
10375 Lisp_Object deleted
;
10377 deleted
= unwind_create_frame (frame
);
10378 if (EQ (deleted
, Qt
))
10388 /* Create a frame for a tooltip on the display described by DPYINFO.
10389 PARMS is a list of frame parameters. Value is the frame.
10391 Note that functions called here, esp. x_default_parameter can
10392 signal errors, for instance when a specified color name is
10393 undefined. We have to make sure that we're in a consistent state
10394 when this happens. */
10397 x_create_tip_frame (dpyinfo
, parms
)
10398 struct x_display_info
*dpyinfo
;
10402 Lisp_Object frame
, tem
;
10404 long window_prompting
= 0;
10406 int count
= BINDING_STACK_SIZE ();
10407 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10409 int face_change_count_before
= face_change_count
;
10413 /* Use this general default value to start with until we know if
10414 this frame has a specified name. */
10415 Vx_resource_name
= Vinvocation_name
;
10417 #ifdef MULTI_KBOARD
10418 kb
= dpyinfo
->kboard
;
10420 kb
= &the_only_kboard
;
10423 /* Get the name of the frame to use for resource lookup. */
10424 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10425 if (!STRINGP (name
)
10426 && !EQ (name
, Qunbound
)
10428 error ("Invalid frame name--not a string or nil");
10429 Vx_resource_name
= name
;
10432 GCPRO3 (parms
, name
, frame
);
10433 f
= make_frame (1);
10434 XSETFRAME (frame
, f
);
10435 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10436 record_unwind_protect (unwind_create_tip_frame
, frame
);
10438 /* By setting the output method, we're essentially saying that
10439 the frame is live, as per FRAME_LIVE_P. If we get a signal
10440 from this point on, x_destroy_window might screw up reference
10442 f
->output_method
= output_x_window
;
10443 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10444 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10445 f
->output_data
.x
->icon_bitmap
= -1;
10446 f
->output_data
.x
->fontset
= -1;
10447 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10448 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10449 f
->icon_name
= Qnil
;
10450 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10452 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10453 dpyinfo_refcount
= dpyinfo
->reference_count
;
10454 #endif /* GLYPH_DEBUG */
10455 #ifdef MULTI_KBOARD
10456 FRAME_KBOARD (f
) = kb
;
10458 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10459 f
->output_data
.x
->explicit_parent
= 0;
10461 /* These colors will be set anyway later, but it's important
10462 to get the color reference counts right, so initialize them! */
10465 struct gcpro gcpro1
;
10467 black
= build_string ("black");
10469 f
->output_data
.x
->foreground_pixel
10470 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10471 f
->output_data
.x
->background_pixel
10472 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10473 f
->output_data
.x
->cursor_pixel
10474 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10475 f
->output_data
.x
->cursor_foreground_pixel
10476 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10477 f
->output_data
.x
->border_pixel
10478 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10479 f
->output_data
.x
->mouse_pixel
10480 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10484 /* Set the name; the functions to which we pass f expect the name to
10486 if (EQ (name
, Qunbound
) || NILP (name
))
10488 f
->name
= build_string (dpyinfo
->x_id_name
);
10489 f
->explicit_name
= 0;
10494 f
->explicit_name
= 1;
10495 /* use the frame's title when getting resources for this frame. */
10496 specbind (Qx_resource_name
, name
);
10499 /* Extract the window parameters from the supplied values that are
10500 needed to determine window geometry. */
10504 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10507 /* First, try whatever font the caller has specified. */
10508 if (STRINGP (font
))
10510 tem
= Fquery_fontset (font
, Qnil
);
10512 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10514 font
= x_new_font (f
, XSTRING (font
)->data
);
10517 /* Try out a font which we hope has bold and italic variations. */
10518 if (!STRINGP (font
))
10519 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10520 if (!STRINGP (font
))
10521 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10522 if (! STRINGP (font
))
10523 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10524 if (! STRINGP (font
))
10525 /* This was formerly the first thing tried, but it finds too many fonts
10526 and takes too long. */
10527 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10528 /* If those didn't work, look for something which will at least work. */
10529 if (! STRINGP (font
))
10530 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10532 if (! STRINGP (font
))
10533 font
= build_string ("fixed");
10535 x_default_parameter (f
, parms
, Qfont
, font
,
10536 "font", "Font", RES_TYPE_STRING
);
10539 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10540 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10542 /* This defaults to 2 in order to match xterm. We recognize either
10543 internalBorderWidth or internalBorder (which is what xterm calls
10545 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10549 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10550 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10551 if (! EQ (value
, Qunbound
))
10552 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10556 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10557 "internalBorderWidth", "internalBorderWidth",
10560 /* Also do the stuff which must be set before the window exists. */
10561 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10562 "foreground", "Foreground", RES_TYPE_STRING
);
10563 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10564 "background", "Background", RES_TYPE_STRING
);
10565 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10566 "pointerColor", "Foreground", RES_TYPE_STRING
);
10567 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10568 "cursorColor", "Foreground", RES_TYPE_STRING
);
10569 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10570 "borderColor", "BorderColor", RES_TYPE_STRING
);
10572 /* Init faces before x_default_parameter is called for scroll-bar
10573 parameters because that function calls x_set_scroll_bar_width,
10574 which calls change_frame_size, which calls Fset_window_buffer,
10575 which runs hooks, which call Fvertical_motion. At the end, we
10576 end up in init_iterator with a null face cache, which should not
10578 init_frame_faces (f
);
10580 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10581 window_prompting
= x_figure_window_size (f
, parms
);
10583 if (window_prompting
& XNegative
)
10585 if (window_prompting
& YNegative
)
10586 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10588 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10592 if (window_prompting
& YNegative
)
10593 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10595 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10598 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10600 XSetWindowAttributes attrs
;
10601 unsigned long mask
;
10604 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10605 if (DoesSaveUnders (dpyinfo
->screen
))
10606 mask
|= CWSaveUnder
;
10608 /* Window managers look at the override-redirect flag to determine
10609 whether or net to give windows a decoration (Xlib spec, chapter
10611 attrs
.override_redirect
= True
;
10612 attrs
.save_under
= True
;
10613 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10614 /* Arrange for getting MapNotify and UnmapNotify events. */
10615 attrs
.event_mask
= StructureNotifyMask
;
10617 = FRAME_X_WINDOW (f
)
10618 = XCreateWindow (FRAME_X_DISPLAY (f
),
10619 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10620 /* x, y, width, height */
10624 CopyFromParent
, InputOutput
, CopyFromParent
,
10631 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10632 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10633 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10634 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10635 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10636 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10638 /* Dimensions, especially f->height, must be done via change_frame_size.
10639 Change will not be effected unless different from the current
10642 height
= f
->height
;
10644 SET_FRAME_WIDTH (f
, 0);
10645 change_frame_size (f
, height
, width
, 1, 0, 0);
10647 /* Set up faces after all frame parameters are known. This call
10648 also merges in face attributes specified for new frames. If we
10649 don't do this, the `menu' face for instance won't have the right
10650 colors, and the menu bar won't appear in the specified colors for
10652 call1 (Qface_set_after_frame_default
, frame
);
10658 /* It is now ok to make the frame official even if we get an error
10659 below. And the frame needs to be on Vframe_list or making it
10660 visible won't work. */
10661 Vframe_list
= Fcons (frame
, Vframe_list
);
10664 /* Now that the frame is official, it counts as a reference to
10666 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10668 /* Setting attributes of faces of the tooltip frame from resources
10669 and similar will increment face_change_count, which leads to the
10670 clearing of all current matrices. Since this isn't necessary
10671 here, avoid it by resetting face_change_count to the value it
10672 had before we created the tip frame. */
10673 face_change_count
= face_change_count_before
;
10675 /* Discard the unwind_protect. */
10676 return unbind_to (count
, frame
);
10680 /* Compute where to display tip frame F. PARMS is the list of frame
10681 parameters for F. DX and DY are specified offsets from the current
10682 location of the mouse. Return coordinates relative to the root
10683 window of the display in *ROOT_X, and *ROOT_Y. */
10686 compute_tip_xy (f
, parms
, dx
, dy
, root_x
, root_y
)
10688 Lisp_Object parms
, dx
, dy
;
10689 int *root_x
, *root_y
;
10691 Lisp_Object left
, top
;
10693 Window root
, child
;
10696 /* User-specified position? */
10697 left
= Fcdr (Fassq (Qleft
, parms
));
10698 top
= Fcdr (Fassq (Qtop
, parms
));
10700 /* Move the tooltip window where the mouse pointer is. Resize and
10703 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10704 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
10707 *root_x
+= XINT (dx
);
10708 *root_y
+= XINT (dy
);
10710 if (INTEGERP (left
))
10711 *root_x
= XINT (left
);
10712 if (INTEGERP (top
))
10713 *root_y
= XINT (top
);
10717 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10718 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10719 A tooltip window is a small X window displaying a string.\n\
10721 FRAME nil or omitted means use the selected frame.\n\
10723 PARMS is an optional list of frame parameters which can be\n\
10724 used to change the tooltip's appearance.\n\
10726 Automatically hide the tooltip after TIMEOUT seconds.\n\
10727 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10729 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10730 the tooltip is displayed at that x-position. Otherwise it is\n\
10731 displayed at the mouse position, with offset DX added (default is 5 if\n\
10732 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10733 parameter is specified, it determines the y-position of the tooltip\n\
10734 window, otherwise it is displayed at the mouse position, with offset\n\
10735 DY added (default is -10).")
10736 (string
, frame
, parms
, timeout
, dx
, dy
)
10737 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10741 Lisp_Object buffer
, top
, left
;
10742 int root_x
, root_y
;
10743 struct buffer
*old_buffer
;
10744 struct text_pos pos
;
10745 int i
, width
, height
;
10746 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10747 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10748 int count
= BINDING_STACK_SIZE ();
10750 specbind (Qinhibit_redisplay
, Qt
);
10752 GCPRO4 (string
, parms
, frame
, timeout
);
10754 CHECK_STRING (string
, 0);
10755 f
= check_x_frame (frame
);
10756 if (NILP (timeout
))
10757 timeout
= make_number (5);
10759 CHECK_NATNUM (timeout
, 2);
10762 dx
= make_number (5);
10764 CHECK_NUMBER (dx
, 5);
10767 dy
= make_number (-10);
10769 CHECK_NUMBER (dy
, 6);
10771 if (NILP (last_show_tip_args
))
10772 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
10774 if (!NILP (tip_frame
))
10776 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
10777 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
10778 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
10780 if (EQ (frame
, last_frame
)
10781 && !NILP (Fequal (last_string
, string
))
10782 && !NILP (Fequal (last_parms
, parms
)))
10784 struct frame
*f
= XFRAME (tip_frame
);
10786 /* Only DX and DY have changed. */
10787 if (!NILP (tip_timer
))
10788 call1 (intern ("cancel-timer"), tip_timer
);
10791 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
10792 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10793 root_x
, root_y
- PIXEL_HEIGHT (f
));
10799 /* Hide a previous tip, if any. */
10802 ASET (last_show_tip_args
, 0, string
);
10803 ASET (last_show_tip_args
, 1, frame
);
10804 ASET (last_show_tip_args
, 2, parms
);
10806 /* Add default values to frame parameters. */
10807 if (NILP (Fassq (Qname
, parms
)))
10808 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10809 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10810 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10811 if (NILP (Fassq (Qborder_width
, parms
)))
10812 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10813 if (NILP (Fassq (Qborder_color
, parms
)))
10814 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10815 if (NILP (Fassq (Qbackground_color
, parms
)))
10816 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10819 /* Create a frame for the tooltip, and record it in the global
10820 variable tip_frame. */
10821 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
10822 f
= XFRAME (frame
);
10824 /* Set up the frame's root window. Currently we use a size of 80
10825 columns x 40 lines. If someone wants to show a larger tip, he
10826 will loose. I don't think this is a realistic case. */
10827 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10828 w
->left
= w
->top
= make_number (0);
10829 w
->width
= make_number (80);
10830 w
->height
= make_number (40);
10832 w
->pseudo_window_p
= 1;
10834 /* Display the tooltip text in a temporary buffer. */
10835 buffer
= Fget_buffer_create (build_string (" *tip*"));
10836 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10837 old_buffer
= current_buffer
;
10838 set_buffer_internal_1 (XBUFFER (buffer
));
10840 Finsert (1, &string
);
10841 clear_glyph_matrix (w
->desired_matrix
);
10842 clear_glyph_matrix (w
->current_matrix
);
10843 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10844 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10846 /* Compute width and height of the tooltip. */
10847 width
= height
= 0;
10848 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10850 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10851 struct glyph
*last
;
10854 /* Stop at the first empty row at the end. */
10855 if (!row
->enabled_p
|| !row
->displays_text_p
)
10858 /* Let the row go over the full width of the frame. */
10859 row
->full_width_p
= 1;
10861 /* There's a glyph at the end of rows that is used to place
10862 the cursor there. Don't include the width of this glyph. */
10863 if (row
->used
[TEXT_AREA
])
10865 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10866 row_width
= row
->pixel_width
- last
->pixel_width
;
10869 row_width
= row
->pixel_width
;
10871 height
+= row
->height
;
10872 width
= max (width
, row_width
);
10875 /* Add the frame's internal border to the width and height the X
10876 window should have. */
10877 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10878 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10880 /* Move the tooltip window where the mouse pointer is. Resize and
10882 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
10885 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10886 root_x
, root_y
- height
, width
, height
);
10887 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10890 /* Draw into the window. */
10891 w
->must_be_updated_p
= 1;
10892 update_single_window (w
, 1);
10894 /* Restore original current buffer. */
10895 set_buffer_internal_1 (old_buffer
);
10896 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
10899 /* Let the tip disappear after timeout seconds. */
10900 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
10901 intern ("x-hide-tip"));
10904 return unbind_to (count
, Qnil
);
10908 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
10909 "Hide the current tooltip window, if there is any.\n\
10910 Value is t is tooltip was open, nil otherwise.")
10914 Lisp_Object deleted
, frame
, timer
;
10915 struct gcpro gcpro1
, gcpro2
;
10917 /* Return quickly if nothing to do. */
10918 if (NILP (tip_timer
) && NILP (tip_frame
))
10923 GCPRO2 (frame
, timer
);
10924 tip_frame
= tip_timer
= deleted
= Qnil
;
10926 count
= BINDING_STACK_SIZE ();
10927 specbind (Qinhibit_redisplay
, Qt
);
10928 specbind (Qinhibit_quit
, Qt
);
10931 call1 (intern ("cancel-timer"), timer
);
10933 if (FRAMEP (frame
))
10935 Fdelete_frame (frame
, Qnil
);
10939 /* Bloodcurdling hack alert: The Lucid menu bar widget's
10940 redisplay procedure is not called when a tip frame over menu
10941 items is unmapped. Redisplay the menu manually... */
10943 struct frame
*f
= SELECTED_FRAME ();
10944 Widget w
= f
->output_data
.x
->menubar_widget
;
10945 extern void xlwmenu_redisplay
P_ ((Widget
));
10947 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
10951 xlwmenu_redisplay (w
);
10955 #endif /* USE_LUCID */
10959 return unbind_to (count
, deleted
);
10964 /***********************************************************************
10965 File selection dialog
10966 ***********************************************************************/
10970 /* Callback for "OK" and "Cancel" on file selection dialog. */
10973 file_dialog_cb (widget
, client_data
, call_data
)
10975 XtPointer call_data
, client_data
;
10977 int *result
= (int *) client_data
;
10978 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
10979 *result
= cb
->reason
;
10983 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
10984 "Read file name, prompting with PROMPT in directory DIR.\n\
10985 Use a file selection dialog.\n\
10986 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10987 specified. Don't let the user enter a file name in the file\n\
10988 selection dialog's entry field, if MUSTMATCH is non-nil.")
10989 (prompt
, dir
, default_filename
, mustmatch
)
10990 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
10993 struct frame
*f
= SELECTED_FRAME ();
10994 Lisp_Object file
= Qnil
;
10995 Widget dialog
, text
, list
, help
;
10998 extern XtAppContext Xt_app_con
;
11000 XmString dir_xmstring
, pattern_xmstring
;
11001 int popup_activated_flag
;
11002 int count
= specpdl_ptr
- specpdl
;
11003 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11005 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11006 CHECK_STRING (prompt
, 0);
11007 CHECK_STRING (dir
, 1);
11009 /* Prevent redisplay. */
11010 specbind (Qinhibit_redisplay
, Qt
);
11014 /* Create the dialog with PROMPT as title, using DIR as initial
11015 directory and using "*" as pattern. */
11016 dir
= Fexpand_file_name (dir
, Qnil
);
11017 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11018 pattern_xmstring
= XmStringCreateLocalized ("*");
11020 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11021 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11022 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11023 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11024 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11025 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11027 XmStringFree (dir_xmstring
);
11028 XmStringFree (pattern_xmstring
);
11030 /* Add callbacks for OK and Cancel. */
11031 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11032 (XtPointer
) &result
);
11033 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11034 (XtPointer
) &result
);
11036 /* Disable the help button since we can't display help. */
11037 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11038 XtSetSensitive (help
, False
);
11040 /* Mark OK button as default. */
11041 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11042 XmNshowAsDefault
, True
, NULL
);
11044 /* If MUSTMATCH is non-nil, disable the file entry field of the
11045 dialog, so that the user must select a file from the files list
11046 box. We can't remove it because we wouldn't have a way to get at
11047 the result file name, then. */
11048 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11049 if (!NILP (mustmatch
))
11052 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11053 XtSetSensitive (text
, False
);
11054 XtSetSensitive (label
, False
);
11057 /* Manage the dialog, so that list boxes get filled. */
11058 XtManageChild (dialog
);
11060 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11061 must include the path for this to work. */
11062 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11063 if (STRINGP (default_filename
))
11065 XmString default_xmstring
;
11069 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11071 if (!XmListItemExists (list
, default_xmstring
))
11073 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11074 XmListAddItem (list
, default_xmstring
, 0);
11078 item_pos
= XmListItemPos (list
, default_xmstring
);
11079 XmStringFree (default_xmstring
);
11081 /* Select the item and scroll it into view. */
11082 XmListSelectPos (list
, item_pos
, True
);
11083 XmListSetPos (list
, item_pos
);
11086 #ifdef HAVE_MOTIF_2_1
11088 /* Process events until the user presses Cancel or OK. */
11090 while (result
== 0 || XtAppPending (Xt_app_con
))
11091 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11093 #else /* not HAVE_MOTIF_2_1 */
11095 /* Process all events until the user presses Cancel or OK. */
11096 for (result
= 0; result
== 0;)
11099 Widget widget
, parent
;
11101 XtAppNextEvent (Xt_app_con
, &event
);
11103 /* See if the receiver of the event is one of the widgets of
11104 the file selection dialog. If so, dispatch it. If not,
11106 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
11108 while (parent
&& parent
!= dialog
)
11109 parent
= XtParent (parent
);
11111 if (parent
== dialog
11112 || (event
.type
== Expose
11113 && !process_expose_from_menu (event
)))
11114 XtDispatchEvent (&event
);
11117 #endif /* not HAVE_MOTIF_2_1 */
11119 /* Get the result. */
11120 if (result
== XmCR_OK
)
11125 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11126 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11127 XmStringFree (text
);
11128 file
= build_string (data
);
11135 XtUnmanageChild (dialog
);
11136 XtDestroyWidget (dialog
);
11140 /* Make "Cancel" equivalent to C-g. */
11142 Fsignal (Qquit
, Qnil
);
11144 return unbind_to (count
, file
);
11147 #endif /* USE_MOTIF */
11151 /***********************************************************************
11153 ***********************************************************************/
11155 #ifdef HAVE_XKBGETKEYBOARD
11156 #include <X11/XKBlib.h>
11157 #include <X11/keysym.h>
11160 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11161 Sx_backspace_delete_keys_p
, 0, 1, 0,
11162 "Check if both Backspace and Delete keys are on the keyboard of FRAME.\n\
11163 FRAME nil means use the selected frame.\n\
11164 Value is t if we know that both keys are present, and are mapped to the\n\
11169 #ifdef HAVE_XKBGETKEYBOARD
11171 struct frame
*f
= check_x_frame (frame
);
11172 Display
*dpy
= FRAME_X_DISPLAY (f
);
11173 Lisp_Object have_keys
;
11174 int major
, minor
, op
, event
, error
;
11178 /* Check library version in case we're dynamically linked. */
11179 major
= XkbMajorVersion
;
11180 minor
= XkbMinorVersion
;
11181 if (!XkbLibraryVersion (&major
, &minor
))
11184 /* Check that the server supports XKB. */
11185 major
= XkbMajorVersion
;
11186 minor
= XkbMinorVersion
;
11187 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11191 kb
= XkbGetKeyboard (dpy
, XkbAllComponentsMask
, XkbUseCoreKbd
);
11194 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11196 for (i
= kb
->min_key_code
;
11197 (i
< kb
->max_key_code
11198 && (delete_keycode
== 0 || backspace_keycode
== 0));
11201 /* The XKB symbolic key names can be seen most easily
11202 in the PS file generated by `xkbprint -label name $DISPLAY'. */
11203 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11204 delete_keycode
= i
;
11205 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11206 backspace_keycode
= i
;
11209 XkbFreeKeyboard (kb
, 0, True
);
11212 && backspace_keycode
11213 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11214 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11219 #else /* not HAVE_XKBGETKEYBOARD */
11221 #endif /* not HAVE_XKBGETKEYBOARD */
11226 /***********************************************************************
11228 ***********************************************************************/
11233 /* This is zero if not using X windows. */
11236 /* The section below is built by the lisp expression at the top of the file,
11237 just above where these variables are declared. */
11238 /*&&& init symbols here &&&*/
11239 Qauto_raise
= intern ("auto-raise");
11240 staticpro (&Qauto_raise
);
11241 Qauto_lower
= intern ("auto-lower");
11242 staticpro (&Qauto_lower
);
11243 Qbar
= intern ("bar");
11245 Qborder_color
= intern ("border-color");
11246 staticpro (&Qborder_color
);
11247 Qborder_width
= intern ("border-width");
11248 staticpro (&Qborder_width
);
11249 Qbox
= intern ("box");
11251 Qcursor_color
= intern ("cursor-color");
11252 staticpro (&Qcursor_color
);
11253 Qcursor_type
= intern ("cursor-type");
11254 staticpro (&Qcursor_type
);
11255 Qgeometry
= intern ("geometry");
11256 staticpro (&Qgeometry
);
11257 Qicon_left
= intern ("icon-left");
11258 staticpro (&Qicon_left
);
11259 Qicon_top
= intern ("icon-top");
11260 staticpro (&Qicon_top
);
11261 Qicon_type
= intern ("icon-type");
11262 staticpro (&Qicon_type
);
11263 Qicon_name
= intern ("icon-name");
11264 staticpro (&Qicon_name
);
11265 Qinternal_border_width
= intern ("internal-border-width");
11266 staticpro (&Qinternal_border_width
);
11267 Qleft
= intern ("left");
11268 staticpro (&Qleft
);
11269 Qright
= intern ("right");
11270 staticpro (&Qright
);
11271 Qmouse_color
= intern ("mouse-color");
11272 staticpro (&Qmouse_color
);
11273 Qnone
= intern ("none");
11274 staticpro (&Qnone
);
11275 Qparent_id
= intern ("parent-id");
11276 staticpro (&Qparent_id
);
11277 Qscroll_bar_width
= intern ("scroll-bar-width");
11278 staticpro (&Qscroll_bar_width
);
11279 Qsuppress_icon
= intern ("suppress-icon");
11280 staticpro (&Qsuppress_icon
);
11281 Qundefined_color
= intern ("undefined-color");
11282 staticpro (&Qundefined_color
);
11283 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11284 staticpro (&Qvertical_scroll_bars
);
11285 Qvisibility
= intern ("visibility");
11286 staticpro (&Qvisibility
);
11287 Qwindow_id
= intern ("window-id");
11288 staticpro (&Qwindow_id
);
11289 Qouter_window_id
= intern ("outer-window-id");
11290 staticpro (&Qouter_window_id
);
11291 Qx_frame_parameter
= intern ("x-frame-parameter");
11292 staticpro (&Qx_frame_parameter
);
11293 Qx_resource_name
= intern ("x-resource-name");
11294 staticpro (&Qx_resource_name
);
11295 Quser_position
= intern ("user-position");
11296 staticpro (&Quser_position
);
11297 Quser_size
= intern ("user-size");
11298 staticpro (&Quser_size
);
11299 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11300 staticpro (&Qscroll_bar_foreground
);
11301 Qscroll_bar_background
= intern ("scroll-bar-background");
11302 staticpro (&Qscroll_bar_background
);
11303 Qscreen_gamma
= intern ("screen-gamma");
11304 staticpro (&Qscreen_gamma
);
11305 Qline_spacing
= intern ("line-spacing");
11306 staticpro (&Qline_spacing
);
11307 Qcenter
= intern ("center");
11308 staticpro (&Qcenter
);
11309 Qcompound_text
= intern ("compound-text");
11310 staticpro (&Qcompound_text
);
11311 /* This is the end of symbol initialization. */
11313 /* Text property `display' should be nonsticky by default. */
11314 Vtext_property_default_nonsticky
11315 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11318 Qlaplace
= intern ("laplace");
11319 staticpro (&Qlaplace
);
11320 Qemboss
= intern ("emboss");
11321 staticpro (&Qemboss
);
11322 Qedge_detection
= intern ("edge-detection");
11323 staticpro (&Qedge_detection
);
11324 Qheuristic
= intern ("heuristic");
11325 staticpro (&Qheuristic
);
11326 QCmatrix
= intern (":matrix");
11327 staticpro (&QCmatrix
);
11328 QCcolor_adjustment
= intern (":color-adjustment");
11329 staticpro (&QCcolor_adjustment
);
11330 QCmask
= intern (":mask");
11331 staticpro (&QCmask
);
11333 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11334 staticpro (&Qface_set_after_frame_default
);
11336 Fput (Qundefined_color
, Qerror_conditions
,
11337 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11338 Fput (Qundefined_color
, Qerror_message
,
11339 build_string ("Undefined color"));
11341 init_x_parm_symbols ();
11343 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11344 "Non-nil means always draw a cross over disabled images.\n\
11345 Disabled images are those having an `:algorithm disabled' property.\n\
11346 A cross is always drawn on black & white displays.");
11347 cross_disabled_images
= 0;
11349 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11350 "List of directories to search for bitmap files for X.");
11351 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11353 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11354 "The shape of the pointer when over text.\n\
11355 Changing the value does not affect existing frames\n\
11356 unless you set the mouse color.");
11357 Vx_pointer_shape
= Qnil
;
11359 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11360 "The name Emacs uses to look up X resources.\n\
11361 `x-get-resource' uses this as the first component of the instance name\n\
11362 when requesting resource values.\n\
11363 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
11364 was invoked, or to the value specified with the `-name' or `-rn'\n\
11365 switches, if present.\n\
11367 It may be useful to bind this variable locally around a call\n\
11368 to `x-get-resource'. See also the variable `x-resource-class'.");
11369 Vx_resource_name
= Qnil
;
11371 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11372 "The class Emacs uses to look up X resources.\n\
11373 `x-get-resource' uses this as the first component of the instance class\n\
11374 when requesting resource values.\n\
11375 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
11377 Setting this variable permanently is not a reasonable thing to do,\n\
11378 but binding this variable locally around a call to `x-get-resource'\n\
11379 is a reasonable practice. See also the variable `x-resource-name'.");
11380 Vx_resource_class
= build_string (EMACS_CLASS
);
11382 #if 0 /* This doesn't really do anything. */
11383 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11384 "The shape of the pointer when not over text.\n\
11385 This variable takes effect when you create a new frame\n\
11386 or when you set the mouse color.");
11388 Vx_nontext_pointer_shape
= Qnil
;
11390 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
11391 "The shape of the pointer when Emacs is busy.\n\
11392 This variable takes effect when you create a new frame\n\
11393 or when you set the mouse color.");
11394 Vx_busy_pointer_shape
= Qnil
;
11396 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
11397 "Non-zero means Emacs displays a busy cursor on window systems.");
11398 display_busy_cursor_p
= 1;
11400 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay
,
11401 "*Seconds to wait before displaying a busy-cursor.\n\
11402 Value must be an integer or float.");
11403 Vbusy_cursor_delay
= make_number (DEFAULT_BUSY_CURSOR_DELAY
);
11405 #if 0 /* This doesn't really do anything. */
11406 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11407 "The shape of the pointer when over the mode line.\n\
11408 This variable takes effect when you create a new frame\n\
11409 or when you set the mouse color.");
11411 Vx_mode_pointer_shape
= Qnil
;
11413 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11414 &Vx_sensitive_text_pointer_shape
,
11415 "The shape of the pointer when over mouse-sensitive text.\n\
11416 This variable takes effect when you create a new frame\n\
11417 or when you set the mouse color.");
11418 Vx_sensitive_text_pointer_shape
= Qnil
;
11420 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11421 &Vx_window_horizontal_drag_shape
,
11422 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
11423 This variable takes effect when you create a new frame\n\
11424 or when you set the mouse color.");
11425 Vx_window_horizontal_drag_shape
= Qnil
;
11427 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11428 "A string indicating the foreground color of the cursor box.");
11429 Vx_cursor_fore_pixel
= Qnil
;
11431 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11432 "Non-nil if no X window manager is in use.\n\
11433 Emacs doesn't try to figure this out; this is always nil\n\
11434 unless you set it to something else.");
11435 /* We don't have any way to find this out, so set it to nil
11436 and maybe the user would like to set it to t. */
11437 Vx_no_window_manager
= Qnil
;
11439 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11440 &Vx_pixel_size_width_font_regexp
,
11441 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11443 Since Emacs gets width of a font matching with this regexp from\n\
11444 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11445 such a font. This is especially effective for such large fonts as\n\
11446 Chinese, Japanese, and Korean.");
11447 Vx_pixel_size_width_font_regexp
= Qnil
;
11449 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11450 "Time after which cached images are removed from the cache.\n\
11451 When an image has not been displayed this many seconds, remove it\n\
11452 from the image cache. Value must be an integer or nil with nil\n\
11453 meaning don't clear the cache.");
11454 Vimage_cache_eviction_delay
= make_number (30 * 60);
11456 #ifdef USE_X_TOOLKIT
11457 Fprovide (intern ("x-toolkit"));
11460 Fprovide (intern ("motif"));
11463 defsubr (&Sx_get_resource
);
11465 /* X window properties. */
11466 defsubr (&Sx_change_window_property
);
11467 defsubr (&Sx_delete_window_property
);
11468 defsubr (&Sx_window_property
);
11470 defsubr (&Sxw_display_color_p
);
11471 defsubr (&Sx_display_grayscale_p
);
11472 defsubr (&Sxw_color_defined_p
);
11473 defsubr (&Sxw_color_values
);
11474 defsubr (&Sx_server_max_request_size
);
11475 defsubr (&Sx_server_vendor
);
11476 defsubr (&Sx_server_version
);
11477 defsubr (&Sx_display_pixel_width
);
11478 defsubr (&Sx_display_pixel_height
);
11479 defsubr (&Sx_display_mm_width
);
11480 defsubr (&Sx_display_mm_height
);
11481 defsubr (&Sx_display_screens
);
11482 defsubr (&Sx_display_planes
);
11483 defsubr (&Sx_display_color_cells
);
11484 defsubr (&Sx_display_visual_class
);
11485 defsubr (&Sx_display_backing_store
);
11486 defsubr (&Sx_display_save_under
);
11487 defsubr (&Sx_parse_geometry
);
11488 defsubr (&Sx_create_frame
);
11489 defsubr (&Sx_open_connection
);
11490 defsubr (&Sx_close_connection
);
11491 defsubr (&Sx_display_list
);
11492 defsubr (&Sx_synchronize
);
11493 defsubr (&Sx_focus_frame
);
11494 defsubr (&Sx_backspace_delete_keys_p
);
11496 /* Setting callback functions for fontset handler. */
11497 get_font_info_func
= x_get_font_info
;
11499 #if 0 /* This function pointer doesn't seem to be used anywhere.
11500 And the pointer assigned has the wrong type, anyway. */
11501 list_fonts_func
= x_list_fonts
;
11504 load_font_func
= x_load_font
;
11505 find_ccl_program_func
= x_find_ccl_program
;
11506 query_font_func
= x_query_font
;
11507 set_frame_fontset_func
= x_set_font
;
11508 check_window_system_func
= check_x
;
11511 Qxbm
= intern ("xbm");
11513 QCtype
= intern (":type");
11514 staticpro (&QCtype
);
11515 QCalgorithm
= intern (":algorithm");
11516 staticpro (&QCalgorithm
);
11517 QCheuristic_mask
= intern (":heuristic-mask");
11518 staticpro (&QCheuristic_mask
);
11519 QCcolor_symbols
= intern (":color-symbols");
11520 staticpro (&QCcolor_symbols
);
11521 QCascent
= intern (":ascent");
11522 staticpro (&QCascent
);
11523 QCmargin
= intern (":margin");
11524 staticpro (&QCmargin
);
11525 QCrelief
= intern (":relief");
11526 staticpro (&QCrelief
);
11527 Qpostscript
= intern ("postscript");
11528 staticpro (&Qpostscript
);
11529 QCloader
= intern (":loader");
11530 staticpro (&QCloader
);
11531 QCbounding_box
= intern (":bounding-box");
11532 staticpro (&QCbounding_box
);
11533 QCpt_width
= intern (":pt-width");
11534 staticpro (&QCpt_width
);
11535 QCpt_height
= intern (":pt-height");
11536 staticpro (&QCpt_height
);
11537 QCindex
= intern (":index");
11538 staticpro (&QCindex
);
11539 Qpbm
= intern ("pbm");
11543 Qxpm
= intern ("xpm");
11548 Qjpeg
= intern ("jpeg");
11549 staticpro (&Qjpeg
);
11553 Qtiff
= intern ("tiff");
11554 staticpro (&Qtiff
);
11558 Qgif
= intern ("gif");
11563 Qpng
= intern ("png");
11567 defsubr (&Sclear_image_cache
);
11568 defsubr (&Simage_size
);
11569 defsubr (&Simage_mask_p
);
11571 busy_cursor_atimer
= NULL
;
11572 busy_cursor_shown_p
= 0;
11574 defsubr (&Sx_show_tip
);
11575 defsubr (&Sx_hide_tip
);
11577 staticpro (&tip_timer
);
11579 staticpro (&tip_frame
);
11581 last_show_tip_args
= Qnil
;
11582 staticpro (&last_show_tip_args
);
11585 defsubr (&Sx_file_dialog
);
11593 image_types
= NULL
;
11594 Vimage_types
= Qnil
;
11596 define_image_type (&xbm_type
);
11597 define_image_type (&gs_type
);
11598 define_image_type (&pbm_type
);
11601 define_image_type (&xpm_type
);
11605 define_image_type (&jpeg_type
);
11609 define_image_type (&tiff_type
);
11613 define_image_type (&gif_type
);
11617 define_image_type (&png_type
);
11621 #endif /* HAVE_X_WINDOWS */