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
;
1376 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1378 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1379 f
->output_data
.x
->foreground_pixel
= pixel
;
1381 if (FRAME_X_WINDOW (f
) != 0)
1384 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1385 f
->output_data
.x
->foreground_pixel
);
1386 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1387 f
->output_data
.x
->foreground_pixel
);
1389 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1390 if (FRAME_VISIBLE_P (f
))
1396 x_set_background_color (f
, arg
, oldval
)
1398 Lisp_Object arg
, oldval
;
1400 unsigned long pixel
= x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1402 unload_color (f
, f
->output_data
.x
->background_pixel
);
1403 f
->output_data
.x
->background_pixel
= pixel
;
1405 if (FRAME_X_WINDOW (f
) != 0)
1408 /* The main frame area. */
1409 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1410 f
->output_data
.x
->background_pixel
);
1411 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1412 f
->output_data
.x
->background_pixel
);
1413 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1414 f
->output_data
.x
->background_pixel
);
1415 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1416 f
->output_data
.x
->background_pixel
);
1419 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1420 bar
= XSCROLL_BAR (bar
)->next
)
1421 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1422 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1423 f
->output_data
.x
->background_pixel
);
1427 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1429 if (FRAME_VISIBLE_P (f
))
1435 x_set_mouse_color (f
, arg
, oldval
)
1437 Lisp_Object arg
, oldval
;
1439 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1440 Cursor busy_cursor
, horizontal_drag_cursor
;
1442 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1443 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1445 /* Don't let pointers be invisible. */
1446 if (mask_color
== pixel
1447 && mask_color
== f
->output_data
.x
->background_pixel
)
1449 x_free_colors (f
, &pixel
, 1);
1450 pixel
= x_copy_color (f
, f
->output_data
.x
->foreground_pixel
);
1453 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1454 f
->output_data
.x
->mouse_pixel
= pixel
;
1458 /* It's not okay to crash if the user selects a screwy cursor. */
1459 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1461 if (!EQ (Qnil
, Vx_pointer_shape
))
1463 CHECK_NUMBER (Vx_pointer_shape
, 0);
1464 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1467 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1468 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1470 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1472 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1473 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1474 XINT (Vx_nontext_pointer_shape
));
1477 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1478 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1480 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1482 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1483 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1484 XINT (Vx_busy_pointer_shape
));
1487 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1488 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1490 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1491 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1493 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1494 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1495 XINT (Vx_mode_pointer_shape
));
1498 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1499 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1501 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1503 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1505 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1506 XINT (Vx_sensitive_text_pointer_shape
));
1509 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1511 if (!NILP (Vx_window_horizontal_drag_shape
))
1513 CHECK_NUMBER (Vx_window_horizontal_drag_shape
, 0);
1514 horizontal_drag_cursor
1515 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1516 XINT (Vx_window_horizontal_drag_shape
));
1519 horizontal_drag_cursor
1520 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
1522 /* Check and report errors with the above calls. */
1523 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1524 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1527 XColor fore_color
, back_color
;
1529 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1530 x_query_color (f
, &fore_color
);
1531 back_color
.pixel
= mask_color
;
1532 x_query_color (f
, &back_color
);
1534 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1535 &fore_color
, &back_color
);
1536 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1537 &fore_color
, &back_color
);
1538 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1539 &fore_color
, &back_color
);
1540 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1541 &fore_color
, &back_color
);
1542 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1543 &fore_color
, &back_color
);
1544 XRecolorCursor (FRAME_X_DISPLAY (f
), horizontal_drag_cursor
,
1545 &fore_color
, &back_color
);
1548 if (FRAME_X_WINDOW (f
) != 0)
1549 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1551 if (cursor
!= f
->output_data
.x
->text_cursor
1552 && f
->output_data
.x
->text_cursor
!= 0)
1553 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1554 f
->output_data
.x
->text_cursor
= cursor
;
1556 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1557 && f
->output_data
.x
->nontext_cursor
!= 0)
1558 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1559 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1561 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1562 && f
->output_data
.x
->busy_cursor
!= 0)
1563 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1564 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1566 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1567 && f
->output_data
.x
->modeline_cursor
!= 0)
1568 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1569 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1571 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1572 && f
->output_data
.x
->cross_cursor
!= 0)
1573 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1574 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1576 if (horizontal_drag_cursor
!= f
->output_data
.x
->horizontal_drag_cursor
1577 && f
->output_data
.x
->horizontal_drag_cursor
!= 0)
1578 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->horizontal_drag_cursor
);
1579 f
->output_data
.x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1581 XFlush (FRAME_X_DISPLAY (f
));
1584 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1588 x_set_cursor_color (f
, arg
, oldval
)
1590 Lisp_Object arg
, oldval
;
1592 unsigned long fore_pixel
, pixel
;
1593 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1595 if (!NILP (Vx_cursor_fore_pixel
))
1597 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1598 WHITE_PIX_DEFAULT (f
));
1599 fore_pixel_allocated_p
= 1;
1602 fore_pixel
= f
->output_data
.x
->background_pixel
;
1604 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1605 pixel_allocated_p
= 1;
1607 /* Make sure that the cursor color differs from the background color. */
1608 if (pixel
== f
->output_data
.x
->background_pixel
)
1610 if (pixel_allocated_p
)
1612 x_free_colors (f
, &pixel
, 1);
1613 pixel_allocated_p
= 0;
1616 pixel
= f
->output_data
.x
->mouse_pixel
;
1617 if (pixel
== fore_pixel
)
1619 if (fore_pixel_allocated_p
)
1621 x_free_colors (f
, &fore_pixel
, 1);
1622 fore_pixel_allocated_p
= 0;
1624 fore_pixel
= f
->output_data
.x
->background_pixel
;
1628 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1629 if (!fore_pixel_allocated_p
)
1630 fore_pixel
= x_copy_color (f
, fore_pixel
);
1631 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1633 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1634 if (!pixel_allocated_p
)
1635 pixel
= x_copy_color (f
, pixel
);
1636 f
->output_data
.x
->cursor_pixel
= pixel
;
1638 if (FRAME_X_WINDOW (f
) != 0)
1641 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1642 f
->output_data
.x
->cursor_pixel
);
1643 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1647 if (FRAME_VISIBLE_P (f
))
1649 x_update_cursor (f
, 0);
1650 x_update_cursor (f
, 1);
1654 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1657 /* Set the border-color of frame F to value described by ARG.
1658 ARG can be a string naming a color.
1659 The border-color is used for the border that is drawn by the X server.
1660 Note that this does not fully take effect if done before
1661 F has an x-window; it must be redone when the window is created.
1663 Note: this is done in two routines because of the way X10 works.
1665 Note: under X11, this is normally the province of the window manager,
1666 and so emacs' border colors may be overridden. */
1669 x_set_border_color (f
, arg
, oldval
)
1671 Lisp_Object arg
, oldval
;
1675 CHECK_STRING (arg
, 0);
1676 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1677 x_set_border_pixel (f
, pix
);
1678 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1681 /* Set the border-color of frame F to pixel value PIX.
1682 Note that this does not fully take effect if done before
1683 F has an x-window. */
1686 x_set_border_pixel (f
, pix
)
1690 unload_color (f
, f
->output_data
.x
->border_pixel
);
1691 f
->output_data
.x
->border_pixel
= pix
;
1693 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1696 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1697 (unsigned long)pix
);
1700 if (FRAME_VISIBLE_P (f
))
1706 /* Value is the internal representation of the specified cursor type
1707 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1708 of the bar cursor. */
1710 enum text_cursor_kinds
1711 x_specified_cursor_type (arg
, width
)
1715 enum text_cursor_kinds type
;
1722 else if (CONSP (arg
)
1723 && EQ (XCAR (arg
), Qbar
)
1724 && INTEGERP (XCDR (arg
))
1725 && XINT (XCDR (arg
)) >= 0)
1728 *width
= XINT (XCDR (arg
));
1730 else if (NILP (arg
))
1733 /* Treat anything unknown as "box cursor".
1734 It was bad to signal an error; people have trouble fixing
1735 .Xdefaults with Emacs, when it has something bad in it. */
1736 type
= FILLED_BOX_CURSOR
;
1742 x_set_cursor_type (f
, arg
, oldval
)
1744 Lisp_Object arg
, oldval
;
1748 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1749 f
->output_data
.x
->cursor_width
= width
;
1751 /* Make sure the cursor gets redrawn. This is overkill, but how
1752 often do people change cursor types? */
1753 update_mode_lines
++;
1757 x_set_icon_type (f
, arg
, oldval
)
1759 Lisp_Object arg
, oldval
;
1765 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1768 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1773 result
= x_text_icon (f
,
1774 (char *) XSTRING ((!NILP (f
->icon_name
)
1778 result
= x_bitmap_icon (f
, arg
);
1783 error ("No icon window available");
1786 XFlush (FRAME_X_DISPLAY (f
));
1790 /* Return non-nil if frame F wants a bitmap icon. */
1798 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1806 x_set_icon_name (f
, arg
, oldval
)
1808 Lisp_Object arg
, oldval
;
1814 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1817 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1822 if (f
->output_data
.x
->icon_bitmap
!= 0)
1827 result
= x_text_icon (f
,
1828 (char *) XSTRING ((!NILP (f
->icon_name
)
1837 error ("No icon window available");
1840 XFlush (FRAME_X_DISPLAY (f
));
1845 x_set_font (f
, arg
, oldval
)
1847 Lisp_Object arg
, oldval
;
1850 Lisp_Object fontset_name
;
1853 CHECK_STRING (arg
, 1);
1855 fontset_name
= Fquery_fontset (arg
, Qnil
);
1858 result
= (STRINGP (fontset_name
)
1859 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1860 : x_new_font (f
, XSTRING (arg
)->data
));
1863 if (EQ (result
, Qnil
))
1864 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1865 else if (EQ (result
, Qt
))
1866 error ("The characters of the given font have varying widths");
1867 else if (STRINGP (result
))
1869 store_frame_param (f
, Qfont
, result
);
1870 recompute_basic_faces (f
);
1875 do_pending_window_change (0);
1877 /* Don't call `face-set-after-frame-default' when faces haven't been
1878 initialized yet. This is the case when called from
1879 Fx_create_frame. In that case, the X widget or window doesn't
1880 exist either, and we can end up in x_report_frame_params with a
1881 null widget which gives a segfault. */
1882 if (FRAME_FACE_CACHE (f
))
1884 XSETFRAME (frame
, f
);
1885 call1 (Qface_set_after_frame_default
, frame
);
1890 x_set_border_width (f
, arg
, oldval
)
1892 Lisp_Object arg
, oldval
;
1894 CHECK_NUMBER (arg
, 0);
1896 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1899 if (FRAME_X_WINDOW (f
) != 0)
1900 error ("Cannot change the border width of a window");
1902 f
->output_data
.x
->border_width
= XINT (arg
);
1906 x_set_internal_border_width (f
, arg
, oldval
)
1908 Lisp_Object arg
, oldval
;
1910 int old
= f
->output_data
.x
->internal_border_width
;
1912 CHECK_NUMBER (arg
, 0);
1913 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1914 if (f
->output_data
.x
->internal_border_width
< 0)
1915 f
->output_data
.x
->internal_border_width
= 0;
1917 #ifdef USE_X_TOOLKIT
1918 if (f
->output_data
.x
->edit_widget
)
1919 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1922 if (f
->output_data
.x
->internal_border_width
== old
)
1925 if (FRAME_X_WINDOW (f
) != 0)
1927 x_set_window_size (f
, 0, f
->width
, f
->height
);
1928 SET_FRAME_GARBAGED (f
);
1929 do_pending_window_change (0);
1934 x_set_visibility (f
, value
, oldval
)
1936 Lisp_Object value
, oldval
;
1939 XSETFRAME (frame
, f
);
1942 Fmake_frame_invisible (frame
, Qt
);
1943 else if (EQ (value
, Qicon
))
1944 Ficonify_frame (frame
);
1946 Fmake_frame_visible (frame
);
1950 /* Change window heights in windows rooted in WINDOW by N lines. */
1953 x_change_window_heights (window
, n
)
1957 struct window
*w
= XWINDOW (window
);
1959 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1960 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1962 if (INTEGERP (w
->orig_top
))
1963 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1964 if (INTEGERP (w
->orig_height
))
1965 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1967 /* Handle just the top child in a vertical split. */
1968 if (!NILP (w
->vchild
))
1969 x_change_window_heights (w
->vchild
, n
);
1971 /* Adjust all children in a horizontal split. */
1972 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1974 w
= XWINDOW (window
);
1975 x_change_window_heights (window
, n
);
1980 x_set_menu_bar_lines (f
, value
, oldval
)
1982 Lisp_Object value
, oldval
;
1985 #ifndef USE_X_TOOLKIT
1986 int olines
= FRAME_MENU_BAR_LINES (f
);
1989 /* Right now, menu bars don't work properly in minibuf-only frames;
1990 most of the commands try to apply themselves to the minibuffer
1991 frame itself, and get an error because you can't switch buffers
1992 in or split the minibuffer window. */
1993 if (FRAME_MINIBUF_ONLY_P (f
))
1996 if (INTEGERP (value
))
1997 nlines
= XINT (value
);
2001 /* Make sure we redisplay all windows in this frame. */
2002 windows_or_buffers_changed
++;
2004 #ifdef USE_X_TOOLKIT
2005 FRAME_MENU_BAR_LINES (f
) = 0;
2008 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2009 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
2010 /* Make sure next redisplay shows the menu bar. */
2011 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2015 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2016 free_frame_menubar (f
);
2017 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2019 f
->output_data
.x
->menubar_widget
= 0;
2021 #else /* not USE_X_TOOLKIT */
2022 FRAME_MENU_BAR_LINES (f
) = nlines
;
2023 x_change_window_heights (f
->root_window
, nlines
- olines
);
2024 #endif /* not USE_X_TOOLKIT */
2029 /* Set the number of lines used for the tool bar of frame F to VALUE.
2030 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2031 is the old number of tool bar lines. This function changes the
2032 height of all windows on frame F to match the new tool bar height.
2033 The frame's height doesn't change. */
2036 x_set_tool_bar_lines (f
, value
, oldval
)
2038 Lisp_Object value
, oldval
;
2040 int delta
, nlines
, root_height
;
2041 Lisp_Object root_window
;
2043 /* Use VALUE only if an integer >= 0. */
2044 if (INTEGERP (value
) && XINT (value
) >= 0)
2045 nlines
= XFASTINT (value
);
2049 /* Make sure we redisplay all windows in this frame. */
2050 ++windows_or_buffers_changed
;
2052 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2054 /* Don't resize the tool-bar to more than we have room for. */
2055 root_window
= FRAME_ROOT_WINDOW (f
);
2056 root_height
= XINT (XWINDOW (root_window
)->height
);
2057 if (root_height
- delta
< 1)
2059 delta
= root_height
- 1;
2060 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2063 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2064 x_change_window_heights (root_window
, delta
);
2067 /* We also have to make sure that the internal border at the top of
2068 the frame, below the menu bar or tool bar, is redrawn when the
2069 tool bar disappears. This is so because the internal border is
2070 below the tool bar if one is displayed, but is below the menu bar
2071 if there isn't a tool bar. The tool bar draws into the area
2072 below the menu bar. */
2073 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2077 clear_current_matrices (f
);
2078 updating_frame
= NULL
;
2081 /* If the tool bar gets smaller, the internal border below it
2082 has to be cleared. It was formerly part of the display
2083 of the larger tool bar, and updating windows won't clear it. */
2086 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2087 int width
= PIXEL_WIDTH (f
);
2088 int y
= nlines
* CANON_Y_UNIT (f
);
2091 XClearArea (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2092 0, y
, width
, height
, False
);
2098 /* Set the foreground color for scroll bars on frame F to VALUE.
2099 VALUE should be a string, a color name. If it isn't a string or
2100 isn't a valid color name, do nothing. OLDVAL is the old value of
2101 the frame parameter. */
2104 x_set_scroll_bar_foreground (f
, value
, oldval
)
2106 Lisp_Object value
, oldval
;
2108 unsigned long pixel
;
2110 if (STRINGP (value
))
2111 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2115 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2116 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2118 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2119 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2121 /* Remove all scroll bars because they have wrong colors. */
2122 if (condemn_scroll_bars_hook
)
2123 (*condemn_scroll_bars_hook
) (f
);
2124 if (judge_scroll_bars_hook
)
2125 (*judge_scroll_bars_hook
) (f
);
2127 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2133 /* Set the background color for scroll bars on frame F to VALUE VALUE
2134 should be a string, a color name. If it isn't a string or isn't a
2135 valid color name, do nothing. OLDVAL is the old value of the frame
2139 x_set_scroll_bar_background (f
, value
, oldval
)
2141 Lisp_Object value
, oldval
;
2143 unsigned long pixel
;
2145 if (STRINGP (value
))
2146 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2150 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2151 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2153 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2154 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2156 /* Remove all scroll bars because they have wrong colors. */
2157 if (condemn_scroll_bars_hook
)
2158 (*condemn_scroll_bars_hook
) (f
);
2159 if (judge_scroll_bars_hook
)
2160 (*judge_scroll_bars_hook
) (f
);
2162 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2168 /* Encode Lisp string STRING as a text in a format appropriate for
2169 XICCC (X Inter Client Communication Conventions).
2171 If STRING contains only ASCII characters, do no conversion and
2172 return the string data of STRING. Otherwise, encode the text by
2173 CODING_SYSTEM, and return a newly allocated memory area which
2174 should be freed by `xfree' by a caller.
2176 Store the byte length of resulting text in *TEXT_BYTES.
2178 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2179 which means that the `encoding' of the result can be `STRING'.
2180 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2181 the result should be `COMPOUND_TEXT'. */
2184 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2185 Lisp_Object string
, coding_system
;
2186 int *text_bytes
, *stringp
;
2188 unsigned char *str
= XSTRING (string
)->data
;
2189 int chars
= XSTRING (string
)->size
;
2190 int bytes
= STRING_BYTES (XSTRING (string
));
2194 struct coding_system coding
;
2196 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2197 if (charset_info
== 0)
2199 /* No multibyte character in OBJ. We need not encode it. */
2200 *text_bytes
= bytes
;
2205 setup_coding_system (coding_system
, &coding
);
2206 coding
.src_multibyte
= 1;
2207 coding
.dst_multibyte
= 0;
2208 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2209 if (coding
.type
== coding_type_iso2022
)
2210 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2211 /* We suppress producing escape sequences for composition. */
2212 coding
.composing
= COMPOSITION_DISABLED
;
2213 bufsize
= encoding_buffer_size (&coding
, bytes
);
2214 buf
= (unsigned char *) xmalloc (bufsize
);
2215 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2216 *text_bytes
= coding
.produced
;
2217 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2222 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2225 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2226 name; if NAME is a string, set F's name to NAME and set
2227 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2229 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2230 suggesting a new name, which lisp code should override; if
2231 F->explicit_name is set, ignore the new name; otherwise, set it. */
2234 x_set_name (f
, name
, explicit)
2239 /* Make sure that requests from lisp code override requests from
2240 Emacs redisplay code. */
2243 /* If we're switching from explicit to implicit, we had better
2244 update the mode lines and thereby update the title. */
2245 if (f
->explicit_name
&& NILP (name
))
2246 update_mode_lines
= 1;
2248 f
->explicit_name
= ! NILP (name
);
2250 else if (f
->explicit_name
)
2253 /* If NAME is nil, set the name to the x_id_name. */
2256 /* Check for no change needed in this very common case
2257 before we do any consing. */
2258 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2259 XSTRING (f
->name
)->data
))
2261 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2264 CHECK_STRING (name
, 0);
2266 /* Don't change the name if it's already NAME. */
2267 if (! NILP (Fstring_equal (name
, f
->name
)))
2272 /* For setting the frame title, the title parameter should override
2273 the name parameter. */
2274 if (! NILP (f
->title
))
2277 if (FRAME_X_WINDOW (f
))
2282 XTextProperty text
, icon
;
2284 Lisp_Object coding_system
;
2286 coding_system
= Vlocale_coding_system
;
2287 if (NILP (coding_system
))
2288 coding_system
= Qcompound_text
;
2289 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2290 text
.encoding
= (stringp
? XA_STRING
2291 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2293 text
.nitems
= bytes
;
2295 if (NILP (f
->icon_name
))
2301 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2303 icon
.encoding
= (stringp
? XA_STRING
2304 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2306 icon
.nitems
= bytes
;
2308 #ifdef USE_X_TOOLKIT
2309 XSetWMName (FRAME_X_DISPLAY (f
),
2310 XtWindow (f
->output_data
.x
->widget
), &text
);
2311 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2313 #else /* not USE_X_TOOLKIT */
2314 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2315 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2316 #endif /* not USE_X_TOOLKIT */
2317 if (!NILP (f
->icon_name
)
2318 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2320 if (text
.value
!= XSTRING (name
)->data
)
2323 #else /* not HAVE_X11R4 */
2324 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2325 XSTRING (name
)->data
);
2326 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2327 XSTRING (name
)->data
);
2328 #endif /* not HAVE_X11R4 */
2333 /* This function should be called when the user's lisp code has
2334 specified a name for the frame; the name will override any set by the
2337 x_explicitly_set_name (f
, arg
, oldval
)
2339 Lisp_Object arg
, oldval
;
2341 x_set_name (f
, arg
, 1);
2344 /* This function should be called by Emacs redisplay code to set the
2345 name; names set this way will never override names set by the user's
2348 x_implicitly_set_name (f
, arg
, oldval
)
2350 Lisp_Object arg
, oldval
;
2352 x_set_name (f
, arg
, 0);
2355 /* Change the title of frame F to NAME.
2356 If NAME is nil, use the frame name as the title.
2358 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2359 name; if NAME is a string, set F's name to NAME and set
2360 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2362 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2363 suggesting a new name, which lisp code should override; if
2364 F->explicit_name is set, ignore the new name; otherwise, set it. */
2367 x_set_title (f
, name
, old_name
)
2369 Lisp_Object name
, old_name
;
2371 /* Don't change the title if it's already NAME. */
2372 if (EQ (name
, f
->title
))
2375 update_mode_lines
= 1;
2382 CHECK_STRING (name
, 0);
2384 if (FRAME_X_WINDOW (f
))
2389 XTextProperty text
, icon
;
2391 Lisp_Object coding_system
;
2393 coding_system
= Vlocale_coding_system
;
2394 if (NILP (coding_system
))
2395 coding_system
= Qcompound_text
;
2396 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2397 text
.encoding
= (stringp
? XA_STRING
2398 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2400 text
.nitems
= bytes
;
2402 if (NILP (f
->icon_name
))
2408 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2410 icon
.encoding
= (stringp
? XA_STRING
2411 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2413 icon
.nitems
= bytes
;
2415 #ifdef USE_X_TOOLKIT
2416 XSetWMName (FRAME_X_DISPLAY (f
),
2417 XtWindow (f
->output_data
.x
->widget
), &text
);
2418 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2420 #else /* not USE_X_TOOLKIT */
2421 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2422 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2423 #endif /* not USE_X_TOOLKIT */
2424 if (!NILP (f
->icon_name
)
2425 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2427 if (text
.value
!= XSTRING (name
)->data
)
2430 #else /* not HAVE_X11R4 */
2431 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2432 XSTRING (name
)->data
);
2433 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2434 XSTRING (name
)->data
);
2435 #endif /* not HAVE_X11R4 */
2441 x_set_autoraise (f
, arg
, oldval
)
2443 Lisp_Object arg
, oldval
;
2445 f
->auto_raise
= !EQ (Qnil
, arg
);
2449 x_set_autolower (f
, arg
, oldval
)
2451 Lisp_Object arg
, oldval
;
2453 f
->auto_lower
= !EQ (Qnil
, arg
);
2457 x_set_unsplittable (f
, arg
, oldval
)
2459 Lisp_Object arg
, oldval
;
2461 f
->no_split
= !NILP (arg
);
2465 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2467 Lisp_Object arg
, oldval
;
2469 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2470 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2471 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2472 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2474 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2476 ? vertical_scroll_bar_none
2478 ? vertical_scroll_bar_right
2479 : vertical_scroll_bar_left
);
2481 /* We set this parameter before creating the X window for the
2482 frame, so we can get the geometry right from the start.
2483 However, if the window hasn't been created yet, we shouldn't
2484 call x_set_window_size. */
2485 if (FRAME_X_WINDOW (f
))
2486 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2487 do_pending_window_change (0);
2492 x_set_scroll_bar_width (f
, arg
, oldval
)
2494 Lisp_Object arg
, oldval
;
2496 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2500 #ifdef USE_TOOLKIT_SCROLL_BARS
2501 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2502 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2503 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2504 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2506 /* Make the actual width at least 14 pixels and a multiple of a
2508 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2510 /* Use all of that space (aside from required margins) for the
2512 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2515 if (FRAME_X_WINDOW (f
))
2516 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2517 do_pending_window_change (0);
2519 else if (INTEGERP (arg
) && XINT (arg
) > 0
2520 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2522 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2523 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2525 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2526 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2527 if (FRAME_X_WINDOW (f
))
2528 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2531 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2532 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2533 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2538 /* Subroutines of creating an X frame. */
2540 /* Make sure that Vx_resource_name is set to a reasonable value.
2541 Fix it up, or set it to `emacs' if it is too hopeless. */
2544 validate_x_resource_name ()
2547 /* Number of valid characters in the resource name. */
2549 /* Number of invalid characters in the resource name. */
2554 if (!STRINGP (Vx_resource_class
))
2555 Vx_resource_class
= build_string (EMACS_CLASS
);
2557 if (STRINGP (Vx_resource_name
))
2559 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2562 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2564 /* Only letters, digits, - and _ are valid in resource names.
2565 Count the valid characters and count the invalid ones. */
2566 for (i
= 0; i
< len
; i
++)
2569 if (! ((c
>= 'a' && c
<= 'z')
2570 || (c
>= 'A' && c
<= 'Z')
2571 || (c
>= '0' && c
<= '9')
2572 || c
== '-' || c
== '_'))
2579 /* Not a string => completely invalid. */
2580 bad_count
= 5, good_count
= 0;
2582 /* If name is valid already, return. */
2586 /* If name is entirely invalid, or nearly so, use `emacs'. */
2588 || (good_count
== 1 && bad_count
> 0))
2590 Vx_resource_name
= build_string ("emacs");
2594 /* Name is partly valid. Copy it and replace the invalid characters
2595 with underscores. */
2597 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2599 for (i
= 0; i
< len
; i
++)
2601 int c
= XSTRING (new)->data
[i
];
2602 if (! ((c
>= 'a' && c
<= 'z')
2603 || (c
>= 'A' && c
<= 'Z')
2604 || (c
>= '0' && c
<= '9')
2605 || c
== '-' || c
== '_'))
2606 XSTRING (new)->data
[i
] = '_';
2611 extern char *x_get_string_resource ();
2613 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2614 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2615 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2616 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2617 the name specified by the `-name' or `-rn' command-line arguments.\n\
2619 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2620 class, respectively. You must specify both of them or neither.\n\
2621 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2622 and the class is `Emacs.CLASS.SUBCLASS'.")
2623 (attribute
, class, component
, subclass
)
2624 Lisp_Object attribute
, class, component
, subclass
;
2626 register char *value
;
2632 CHECK_STRING (attribute
, 0);
2633 CHECK_STRING (class, 0);
2635 if (!NILP (component
))
2636 CHECK_STRING (component
, 1);
2637 if (!NILP (subclass
))
2638 CHECK_STRING (subclass
, 2);
2639 if (NILP (component
) != NILP (subclass
))
2640 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2642 validate_x_resource_name ();
2644 /* Allocate space for the components, the dots which separate them,
2645 and the final '\0'. Make them big enough for the worst case. */
2646 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2647 + (STRINGP (component
)
2648 ? STRING_BYTES (XSTRING (component
)) : 0)
2649 + STRING_BYTES (XSTRING (attribute
))
2652 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2653 + STRING_BYTES (XSTRING (class))
2654 + (STRINGP (subclass
)
2655 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2658 /* Start with emacs.FRAMENAME for the name (the specific one)
2659 and with `Emacs' for the class key (the general one). */
2660 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2661 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2663 strcat (class_key
, ".");
2664 strcat (class_key
, XSTRING (class)->data
);
2666 if (!NILP (component
))
2668 strcat (class_key
, ".");
2669 strcat (class_key
, XSTRING (subclass
)->data
);
2671 strcat (name_key
, ".");
2672 strcat (name_key
, XSTRING (component
)->data
);
2675 strcat (name_key
, ".");
2676 strcat (name_key
, XSTRING (attribute
)->data
);
2678 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2679 name_key
, class_key
);
2681 if (value
!= (char *) 0)
2682 return build_string (value
);
2687 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2690 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2691 struct x_display_info
*dpyinfo
;
2692 Lisp_Object attribute
, class, component
, subclass
;
2694 register char *value
;
2698 CHECK_STRING (attribute
, 0);
2699 CHECK_STRING (class, 0);
2701 if (!NILP (component
))
2702 CHECK_STRING (component
, 1);
2703 if (!NILP (subclass
))
2704 CHECK_STRING (subclass
, 2);
2705 if (NILP (component
) != NILP (subclass
))
2706 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2708 validate_x_resource_name ();
2710 /* Allocate space for the components, the dots which separate them,
2711 and the final '\0'. Make them big enough for the worst case. */
2712 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2713 + (STRINGP (component
)
2714 ? STRING_BYTES (XSTRING (component
)) : 0)
2715 + STRING_BYTES (XSTRING (attribute
))
2718 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2719 + STRING_BYTES (XSTRING (class))
2720 + (STRINGP (subclass
)
2721 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2724 /* Start with emacs.FRAMENAME for the name (the specific one)
2725 and with `Emacs' for the class key (the general one). */
2726 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2727 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2729 strcat (class_key
, ".");
2730 strcat (class_key
, XSTRING (class)->data
);
2732 if (!NILP (component
))
2734 strcat (class_key
, ".");
2735 strcat (class_key
, XSTRING (subclass
)->data
);
2737 strcat (name_key
, ".");
2738 strcat (name_key
, XSTRING (component
)->data
);
2741 strcat (name_key
, ".");
2742 strcat (name_key
, XSTRING (attribute
)->data
);
2744 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2746 if (value
!= (char *) 0)
2747 return build_string (value
);
2752 /* Used when C code wants a resource value. */
2755 x_get_resource_string (attribute
, class)
2756 char *attribute
, *class;
2760 struct frame
*sf
= SELECTED_FRAME ();
2762 /* Allocate space for the components, the dots which separate them,
2763 and the final '\0'. */
2764 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2765 + strlen (attribute
) + 2);
2766 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2767 + strlen (class) + 2);
2769 sprintf (name_key
, "%s.%s",
2770 XSTRING (Vinvocation_name
)->data
,
2772 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2774 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2775 name_key
, class_key
);
2778 /* Types we might convert a resource string into. */
2788 /* Return the value of parameter PARAM.
2790 First search ALIST, then Vdefault_frame_alist, then the X defaults
2791 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2793 Convert the resource to the type specified by desired_type.
2795 If no default is specified, return Qunbound. If you call
2796 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2797 and don't let it get stored in any Lisp-visible variables! */
2800 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2801 struct x_display_info
*dpyinfo
;
2802 Lisp_Object alist
, param
;
2805 enum resource_types type
;
2807 register Lisp_Object tem
;
2809 tem
= Fassq (param
, alist
);
2811 tem
= Fassq (param
, Vdefault_frame_alist
);
2817 tem
= display_x_get_resource (dpyinfo
,
2818 build_string (attribute
),
2819 build_string (class),
2827 case RES_TYPE_NUMBER
:
2828 return make_number (atoi (XSTRING (tem
)->data
));
2830 case RES_TYPE_FLOAT
:
2831 return make_float (atof (XSTRING (tem
)->data
));
2833 case RES_TYPE_BOOLEAN
:
2834 tem
= Fdowncase (tem
);
2835 if (!strcmp (XSTRING (tem
)->data
, "on")
2836 || !strcmp (XSTRING (tem
)->data
, "true"))
2841 case RES_TYPE_STRING
:
2844 case RES_TYPE_SYMBOL
:
2845 /* As a special case, we map the values `true' and `on'
2846 to Qt, and `false' and `off' to Qnil. */
2849 lower
= Fdowncase (tem
);
2850 if (!strcmp (XSTRING (lower
)->data
, "on")
2851 || !strcmp (XSTRING (lower
)->data
, "true"))
2853 else if (!strcmp (XSTRING (lower
)->data
, "off")
2854 || !strcmp (XSTRING (lower
)->data
, "false"))
2857 return Fintern (tem
, Qnil
);
2870 /* Like x_get_arg, but also record the value in f->param_alist. */
2873 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2875 Lisp_Object alist
, param
;
2878 enum resource_types type
;
2882 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2883 attribute
, class, type
);
2885 store_frame_param (f
, param
, value
);
2890 /* Record in frame F the specified or default value according to ALIST
2891 of the parameter named PROP (a Lisp symbol).
2892 If no value is specified for PROP, look for an X default for XPROP
2893 on the frame named NAME.
2894 If that is not found either, use the value DEFLT. */
2897 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2904 enum resource_types type
;
2908 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2909 if (EQ (tem
, Qunbound
))
2911 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2916 /* Record in frame F the specified or default value according to ALIST
2917 of the parameter named PROP (a Lisp symbol). If no value is
2918 specified for PROP, look for an X default for XPROP on the frame
2919 named NAME. If that is not found either, use the value DEFLT. */
2922 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2931 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2934 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2935 if (EQ (tem
, Qunbound
))
2937 #ifdef USE_TOOLKIT_SCROLL_BARS
2939 /* See if an X resource for the scroll bar color has been
2941 tem
= display_x_get_resource (dpyinfo
,
2942 build_string (foreground_p
2946 build_string ("verticalScrollBar"),
2950 /* If nothing has been specified, scroll bars will use a
2951 toolkit-dependent default. Because these defaults are
2952 difficult to get at without actually creating a scroll
2953 bar, use nil to indicate that no color has been
2958 #else /* not USE_TOOLKIT_SCROLL_BARS */
2962 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2965 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2971 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2972 "Parse an X-style geometry string STRING.\n\
2973 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2974 The properties returned may include `top', `left', `height', and `width'.\n\
2975 The value of `left' or `top' may be an integer,\n\
2976 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2977 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2982 unsigned int width
, height
;
2985 CHECK_STRING (string
, 0);
2987 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2988 &x
, &y
, &width
, &height
);
2991 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2992 error ("Must specify both x and y position, or neither");
2996 if (geometry
& XValue
)
2998 Lisp_Object element
;
3000 if (x
>= 0 && (geometry
& XNegative
))
3001 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3002 else if (x
< 0 && ! (geometry
& XNegative
))
3003 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3005 element
= Fcons (Qleft
, make_number (x
));
3006 result
= Fcons (element
, result
);
3009 if (geometry
& YValue
)
3011 Lisp_Object element
;
3013 if (y
>= 0 && (geometry
& YNegative
))
3014 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3015 else if (y
< 0 && ! (geometry
& YNegative
))
3016 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3018 element
= Fcons (Qtop
, make_number (y
));
3019 result
= Fcons (element
, result
);
3022 if (geometry
& WidthValue
)
3023 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3024 if (geometry
& HeightValue
)
3025 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3030 /* Calculate the desired size and position of this window,
3031 and return the flags saying which aspects were specified.
3033 This function does not make the coordinates positive. */
3035 #define DEFAULT_ROWS 40
3036 #define DEFAULT_COLS 80
3039 x_figure_window_size (f
, parms
)
3043 register Lisp_Object tem0
, tem1
, tem2
;
3044 long window_prompting
= 0;
3045 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3047 /* Default values if we fall through.
3048 Actually, if that happens we should get
3049 window manager prompting. */
3050 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3051 f
->height
= DEFAULT_ROWS
;
3052 /* Window managers expect that if program-specified
3053 positions are not (0,0), they're intentional, not defaults. */
3054 f
->output_data
.x
->top_pos
= 0;
3055 f
->output_data
.x
->left_pos
= 0;
3057 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3058 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3059 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3060 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3062 if (!EQ (tem0
, Qunbound
))
3064 CHECK_NUMBER (tem0
, 0);
3065 f
->height
= XINT (tem0
);
3067 if (!EQ (tem1
, Qunbound
))
3069 CHECK_NUMBER (tem1
, 0);
3070 SET_FRAME_WIDTH (f
, XINT (tem1
));
3072 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3073 window_prompting
|= USSize
;
3075 window_prompting
|= PSize
;
3078 f
->output_data
.x
->vertical_scroll_bar_extra
3079 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3081 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3082 f
->output_data
.x
->flags_areas_extra
3083 = FRAME_FLAGS_AREA_WIDTH (f
);
3084 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3085 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3087 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3088 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3089 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3090 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3092 if (EQ (tem0
, Qminus
))
3094 f
->output_data
.x
->top_pos
= 0;
3095 window_prompting
|= YNegative
;
3097 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3098 && CONSP (XCDR (tem0
))
3099 && INTEGERP (XCAR (XCDR (tem0
))))
3101 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3102 window_prompting
|= YNegative
;
3104 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3105 && CONSP (XCDR (tem0
))
3106 && INTEGERP (XCAR (XCDR (tem0
))))
3108 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3110 else if (EQ (tem0
, Qunbound
))
3111 f
->output_data
.x
->top_pos
= 0;
3114 CHECK_NUMBER (tem0
, 0);
3115 f
->output_data
.x
->top_pos
= XINT (tem0
);
3116 if (f
->output_data
.x
->top_pos
< 0)
3117 window_prompting
|= YNegative
;
3120 if (EQ (tem1
, Qminus
))
3122 f
->output_data
.x
->left_pos
= 0;
3123 window_prompting
|= XNegative
;
3125 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3126 && CONSP (XCDR (tem1
))
3127 && INTEGERP (XCAR (XCDR (tem1
))))
3129 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3130 window_prompting
|= XNegative
;
3132 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3133 && CONSP (XCDR (tem1
))
3134 && INTEGERP (XCAR (XCDR (tem1
))))
3136 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3138 else if (EQ (tem1
, Qunbound
))
3139 f
->output_data
.x
->left_pos
= 0;
3142 CHECK_NUMBER (tem1
, 0);
3143 f
->output_data
.x
->left_pos
= XINT (tem1
);
3144 if (f
->output_data
.x
->left_pos
< 0)
3145 window_prompting
|= XNegative
;
3148 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3149 window_prompting
|= USPosition
;
3151 window_prompting
|= PPosition
;
3154 return window_prompting
;
3157 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3160 XSetWMProtocols (dpy
, w
, protocols
, count
)
3167 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3168 if (prop
== None
) return False
;
3169 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3170 (unsigned char *) protocols
, count
);
3173 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3175 #ifdef USE_X_TOOLKIT
3177 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3178 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3179 already be present because of the toolkit (Motif adds some of them,
3180 for example, but Xt doesn't). */
3183 hack_wm_protocols (f
, widget
)
3187 Display
*dpy
= XtDisplay (widget
);
3188 Window w
= XtWindow (widget
);
3189 int need_delete
= 1;
3195 Atom type
, *atoms
= 0;
3197 unsigned long nitems
= 0;
3198 unsigned long bytes_after
;
3200 if ((XGetWindowProperty (dpy
, w
,
3201 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3202 (long)0, (long)100, False
, XA_ATOM
,
3203 &type
, &format
, &nitems
, &bytes_after
,
3204 (unsigned char **) &atoms
)
3206 && format
== 32 && type
== XA_ATOM
)
3210 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3212 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3214 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3217 if (atoms
) XFree ((char *) atoms
);
3223 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3225 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3227 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3229 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3230 XA_ATOM
, 32, PropModeAppend
,
3231 (unsigned char *) props
, count
);
3239 /* Support routines for XIC (X Input Context). */
3243 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3244 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3247 /* Supported XIM styles, ordered by preferenc. */
3249 static XIMStyle supported_xim_styles
[] =
3251 XIMPreeditPosition
| XIMStatusArea
,
3252 XIMPreeditPosition
| XIMStatusNothing
,
3253 XIMPreeditPosition
| XIMStatusNone
,
3254 XIMPreeditNothing
| XIMStatusArea
,
3255 XIMPreeditNothing
| XIMStatusNothing
,
3256 XIMPreeditNothing
| XIMStatusNone
,
3257 XIMPreeditNone
| XIMStatusArea
,
3258 XIMPreeditNone
| XIMStatusNothing
,
3259 XIMPreeditNone
| XIMStatusNone
,
3264 /* Create an X fontset on frame F with base font name
3268 xic_create_xfontset (f
, base_fontname
)
3270 char *base_fontname
;
3273 char **missing_list
;
3277 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3278 base_fontname
, &missing_list
,
3279 &missing_count
, &def_string
);
3281 XFreeStringList (missing_list
);
3283 /* No need to free def_string. */
3288 /* Value is the best input style, given user preferences USER (already
3289 checked to be supported by Emacs), and styles supported by the
3290 input method XIM. */
3293 best_xim_style (user
, xim
)
3299 for (i
= 0; i
< user
->count_styles
; ++i
)
3300 for (j
= 0; j
< xim
->count_styles
; ++j
)
3301 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3302 return user
->supported_styles
[i
];
3304 /* Return the default style. */
3305 return XIMPreeditNothing
| XIMStatusNothing
;
3308 /* Create XIC for frame F. */
3311 create_frame_xic (f
)
3316 XFontSet xfs
= NULL
;
3317 static XIMStyle xic_style
;
3322 xim
= FRAME_X_XIM (f
);
3327 XVaNestedList preedit_attr
;
3328 XVaNestedList status_attr
;
3329 char *base_fontname
;
3332 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3333 spot
.x
= 0; spot
.y
= 1;
3334 /* Create X fontset. */
3335 fontset
= FRAME_FONTSET (f
);
3337 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3340 /* Determine the base fontname from the ASCII font name of
3342 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3343 char *p
= ascii_font
;
3346 for (i
= 0; *p
; p
++)
3349 /* As the font name doesn't conform to XLFD, we can't
3350 modify it to get a suitable base fontname for the
3352 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3355 int len
= strlen (ascii_font
) + 1;
3358 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3367 base_fontname
= (char *) alloca (len
);
3368 bzero (base_fontname
, len
);
3369 strcpy (base_fontname
, "-*-*-");
3370 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3371 strcat (base_fontname
, "*-*-*-*-*-*-*");
3374 xfs
= xic_create_xfontset (f
, base_fontname
);
3376 /* Determine XIC style. */
3379 XIMStyles supported_list
;
3380 supported_list
.count_styles
= (sizeof supported_xim_styles
3381 / sizeof supported_xim_styles
[0]);
3382 supported_list
.supported_styles
= supported_xim_styles
;
3383 xic_style
= best_xim_style (&supported_list
,
3384 FRAME_X_XIM_STYLES (f
));
3387 preedit_attr
= XVaCreateNestedList (0,
3390 FRAME_FOREGROUND_PIXEL (f
),
3392 FRAME_BACKGROUND_PIXEL (f
),
3393 (xic_style
& XIMPreeditPosition
3398 status_attr
= XVaCreateNestedList (0,
3404 FRAME_FOREGROUND_PIXEL (f
),
3406 FRAME_BACKGROUND_PIXEL (f
),
3409 xic
= XCreateIC (xim
,
3410 XNInputStyle
, xic_style
,
3411 XNClientWindow
, FRAME_X_WINDOW(f
),
3412 XNFocusWindow
, FRAME_X_WINDOW(f
),
3413 XNStatusAttributes
, status_attr
,
3414 XNPreeditAttributes
, preedit_attr
,
3416 XFree (preedit_attr
);
3417 XFree (status_attr
);
3420 FRAME_XIC (f
) = xic
;
3421 FRAME_XIC_STYLE (f
) = xic_style
;
3422 FRAME_XIC_FONTSET (f
) = xfs
;
3426 /* Destroy XIC and free XIC fontset of frame F, if any. */
3432 if (FRAME_XIC (f
) == NULL
)
3435 XDestroyIC (FRAME_XIC (f
));
3436 if (FRAME_XIC_FONTSET (f
))
3437 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3439 FRAME_XIC (f
) = NULL
;
3440 FRAME_XIC_FONTSET (f
) = NULL
;
3444 /* Place preedit area for XIC of window W's frame to specified
3445 pixel position X/Y. X and Y are relative to window W. */
3448 xic_set_preeditarea (w
, x
, y
)
3452 struct frame
*f
= XFRAME (w
->frame
);
3456 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3457 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3458 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3459 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3464 /* Place status area for XIC in bottom right corner of frame F.. */
3467 xic_set_statusarea (f
)
3470 XIC xic
= FRAME_XIC (f
);
3475 /* Negotiate geometry of status area. If input method has existing
3476 status area, use its current size. */
3477 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3478 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3479 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3482 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3483 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3486 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3488 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3489 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3493 area
.width
= needed
->width
;
3494 area
.height
= needed
->height
;
3495 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3496 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3497 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3500 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3501 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3506 /* Set X fontset for XIC of frame F, using base font name
3507 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3510 xic_set_xfontset (f
, base_fontname
)
3512 char *base_fontname
;
3517 xfs
= xic_create_xfontset (f
, base_fontname
);
3519 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3520 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3521 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3522 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3523 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3526 if (FRAME_XIC_FONTSET (f
))
3527 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3528 FRAME_XIC_FONTSET (f
) = xfs
;
3531 #endif /* HAVE_X_I18N */
3535 #ifdef USE_X_TOOLKIT
3537 /* Create and set up the X widget for frame F. */
3540 x_window (f
, window_prompting
, minibuffer_only
)
3542 long window_prompting
;
3543 int minibuffer_only
;
3545 XClassHint class_hints
;
3546 XSetWindowAttributes attributes
;
3547 unsigned long attribute_mask
;
3548 Widget shell_widget
;
3550 Widget frame_widget
;
3556 /* Use the resource name as the top-level widget name
3557 for looking up resources. Make a non-Lisp copy
3558 for the window manager, so GC relocation won't bother it.
3560 Elsewhere we specify the window name for the window manager. */
3563 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3564 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3565 strcpy (f
->namebuf
, str
);
3569 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3570 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3571 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3572 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3573 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3574 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3575 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3576 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3577 applicationShellWidgetClass
,
3578 FRAME_X_DISPLAY (f
), al
, ac
);
3580 f
->output_data
.x
->widget
= shell_widget
;
3581 /* maybe_set_screen_title_format (shell_widget); */
3583 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3584 (widget_value
*) NULL
,
3585 shell_widget
, False
,
3589 (lw_callback
) NULL
);
3592 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3593 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3594 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3595 XtSetValues (pane_widget
, al
, ac
);
3596 f
->output_data
.x
->column_widget
= pane_widget
;
3598 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3599 the emacs screen when changing menubar. This reduces flickering. */
3602 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3603 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3604 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3605 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3606 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3607 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3608 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3609 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3610 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3613 f
->output_data
.x
->edit_widget
= frame_widget
;
3615 XtManageChild (frame_widget
);
3617 /* Do some needed geometry management. */
3620 char *tem
, shell_position
[32];
3623 int extra_borders
= 0;
3625 = (f
->output_data
.x
->menubar_widget
3626 ? (f
->output_data
.x
->menubar_widget
->core
.height
3627 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3630 #if 0 /* Experimentally, we now get the right results
3631 for -geometry -0-0 without this. 24 Aug 96, rms. */
3632 if (FRAME_EXTERNAL_MENU_BAR (f
))
3635 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3636 menubar_size
+= ibw
;
3640 f
->output_data
.x
->menubar_height
= menubar_size
;
3643 /* Motif seems to need this amount added to the sizes
3644 specified for the shell widget. The Athena/Lucid widgets don't.
3645 Both conclusions reached experimentally. -- rms. */
3646 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3647 &extra_borders
, NULL
);
3651 /* Convert our geometry parameters into a geometry string
3653 Note that we do not specify here whether the position
3654 is a user-specified or program-specified one.
3655 We pass that information later, in x_wm_set_size_hints. */
3657 int left
= f
->output_data
.x
->left_pos
;
3658 int xneg
= window_prompting
& XNegative
;
3659 int top
= f
->output_data
.x
->top_pos
;
3660 int yneg
= window_prompting
& YNegative
;
3666 if (window_prompting
& USPosition
)
3667 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3668 PIXEL_WIDTH (f
) + extra_borders
,
3669 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3670 (xneg
? '-' : '+'), left
,
3671 (yneg
? '-' : '+'), top
);
3673 sprintf (shell_position
, "=%dx%d",
3674 PIXEL_WIDTH (f
) + extra_borders
,
3675 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3678 len
= strlen (shell_position
) + 1;
3679 /* We don't free this because we don't know whether
3680 it is safe to free it while the frame exists.
3681 It isn't worth the trouble of arranging to free it
3682 when the frame is deleted. */
3683 tem
= (char *) xmalloc (len
);
3684 strncpy (tem
, shell_position
, len
);
3685 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3686 XtSetValues (shell_widget
, al
, ac
);
3689 XtManageChild (pane_widget
);
3690 XtRealizeWidget (shell_widget
);
3692 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3694 validate_x_resource_name ();
3696 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3697 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3698 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3701 FRAME_XIC (f
) = NULL
;
3703 create_frame_xic (f
);
3707 f
->output_data
.x
->wm_hints
.input
= True
;
3708 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3709 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3710 &f
->output_data
.x
->wm_hints
);
3712 hack_wm_protocols (f
, shell_widget
);
3715 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3718 /* Do a stupid property change to force the server to generate a
3719 PropertyNotify event so that the event_stream server timestamp will
3720 be initialized to something relevant to the time we created the window.
3722 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3723 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3724 XA_ATOM
, 32, PropModeAppend
,
3725 (unsigned char*) NULL
, 0);
3727 /* Make all the standard events reach the Emacs frame. */
3728 attributes
.event_mask
= STANDARD_EVENT_SET
;
3733 /* XIM server might require some X events. */
3734 unsigned long fevent
= NoEventMask
;
3735 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3736 attributes
.event_mask
|= fevent
;
3738 #endif /* HAVE_X_I18N */
3740 attribute_mask
= CWEventMask
;
3741 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3742 attribute_mask
, &attributes
);
3744 XtMapWidget (frame_widget
);
3746 /* x_set_name normally ignores requests to set the name if the
3747 requested name is the same as the current name. This is the one
3748 place where that assumption isn't correct; f->name is set, but
3749 the X server hasn't been told. */
3752 int explicit = f
->explicit_name
;
3754 f
->explicit_name
= 0;
3757 x_set_name (f
, name
, explicit);
3760 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3761 f
->output_data
.x
->text_cursor
);
3765 /* This is a no-op, except under Motif. Make sure main areas are
3766 set to something reasonable, in case we get an error later. */
3767 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3770 #else /* not USE_X_TOOLKIT */
3772 /* Create and set up the X window for frame F. */
3779 XClassHint class_hints
;
3780 XSetWindowAttributes attributes
;
3781 unsigned long attribute_mask
;
3783 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3784 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3785 attributes
.bit_gravity
= StaticGravity
;
3786 attributes
.backing_store
= NotUseful
;
3787 attributes
.save_under
= True
;
3788 attributes
.event_mask
= STANDARD_EVENT_SET
;
3789 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3790 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3795 = XCreateWindow (FRAME_X_DISPLAY (f
),
3796 f
->output_data
.x
->parent_desc
,
3797 f
->output_data
.x
->left_pos
,
3798 f
->output_data
.x
->top_pos
,
3799 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3800 f
->output_data
.x
->border_width
,
3801 CopyFromParent
, /* depth */
3802 InputOutput
, /* class */
3804 attribute_mask
, &attributes
);
3808 create_frame_xic (f
);
3811 /* XIM server might require some X events. */
3812 unsigned long fevent
= NoEventMask
;
3813 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3814 attributes
.event_mask
|= fevent
;
3815 attribute_mask
= CWEventMask
;
3816 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3817 attribute_mask
, &attributes
);
3820 #endif /* HAVE_X_I18N */
3822 validate_x_resource_name ();
3824 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3825 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3826 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3828 /* The menubar is part of the ordinary display;
3829 it does not count in addition to the height of the window. */
3830 f
->output_data
.x
->menubar_height
= 0;
3832 /* This indicates that we use the "Passive Input" input model.
3833 Unless we do this, we don't get the Focus{In,Out} events that we
3834 need to draw the cursor correctly. Accursed bureaucrats.
3835 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3837 f
->output_data
.x
->wm_hints
.input
= True
;
3838 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3839 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3840 &f
->output_data
.x
->wm_hints
);
3841 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3843 /* Request "save yourself" and "delete window" commands from wm. */
3846 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3847 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3848 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3851 /* x_set_name normally ignores requests to set the name if the
3852 requested name is the same as the current name. This is the one
3853 place where that assumption isn't correct; f->name is set, but
3854 the X server hasn't been told. */
3857 int explicit = f
->explicit_name
;
3859 f
->explicit_name
= 0;
3862 x_set_name (f
, name
, explicit);
3865 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3866 f
->output_data
.x
->text_cursor
);
3870 if (FRAME_X_WINDOW (f
) == 0)
3871 error ("Unable to create window");
3874 #endif /* not USE_X_TOOLKIT */
3876 /* Handle the icon stuff for this window. Perhaps later we might
3877 want an x_set_icon_position which can be called interactively as
3885 Lisp_Object icon_x
, icon_y
;
3886 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3888 /* Set the position of the icon. Note that twm groups all
3889 icons in an icon window. */
3890 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3891 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3892 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3894 CHECK_NUMBER (icon_x
, 0);
3895 CHECK_NUMBER (icon_y
, 0);
3897 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3898 error ("Both left and top icon corners of icon must be specified");
3902 if (! EQ (icon_x
, Qunbound
))
3903 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3905 /* Start up iconic or window? */
3906 x_wm_set_window_state
3907 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3912 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3919 /* Make the GCs needed for this window, setting the
3920 background, border and mouse colors; also create the
3921 mouse cursor and the gray border tile. */
3923 static char cursor_bits
[] =
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,
3928 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3935 XGCValues gc_values
;
3939 /* Create the GCs of this frame.
3940 Note that many default values are used. */
3943 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3944 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3945 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3946 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3947 f
->output_data
.x
->normal_gc
3948 = XCreateGC (FRAME_X_DISPLAY (f
),
3950 GCLineWidth
| GCFont
| GCForeground
| GCBackground
,
3953 /* Reverse video style. */
3954 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3955 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3956 f
->output_data
.x
->reverse_gc
3957 = XCreateGC (FRAME_X_DISPLAY (f
),
3959 GCFont
| GCForeground
| GCBackground
| GCLineWidth
,
3962 /* Cursor has cursor-color background, background-color foreground. */
3963 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3964 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3965 gc_values
.fill_style
= FillOpaqueStippled
;
3967 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3968 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3969 cursor_bits
, 16, 16);
3970 f
->output_data
.x
->cursor_gc
3971 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3972 (GCFont
| GCForeground
| GCBackground
3973 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3977 f
->output_data
.x
->white_relief
.gc
= 0;
3978 f
->output_data
.x
->black_relief
.gc
= 0;
3980 /* Create the gray border tile used when the pointer is not in
3981 the frame. Since this depends on the frame's pixel values,
3982 this must be done on a per-frame basis. */
3983 f
->output_data
.x
->border_tile
3984 = (XCreatePixmapFromBitmapData
3985 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3986 gray_bits
, gray_width
, gray_height
,
3987 f
->output_data
.x
->foreground_pixel
,
3988 f
->output_data
.x
->background_pixel
,
3989 DefaultDepth (FRAME_X_DISPLAY (f
),
3990 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3996 /* Free what was was allocated in x_make_gc. */
4002 Display
*dpy
= FRAME_X_DISPLAY (f
);
4006 if (f
->output_data
.x
->normal_gc
)
4008 XFreeGC (dpy
, f
->output_data
.x
->normal_gc
);
4009 f
->output_data
.x
->normal_gc
= 0;
4012 if (f
->output_data
.x
->reverse_gc
)
4014 XFreeGC (dpy
, f
->output_data
.x
->reverse_gc
);
4015 f
->output_data
.x
->reverse_gc
= 0;
4018 if (f
->output_data
.x
->cursor_gc
)
4020 XFreeGC (dpy
, f
->output_data
.x
->cursor_gc
);
4021 f
->output_data
.x
->cursor_gc
= 0;
4024 if (f
->output_data
.x
->border_tile
)
4026 XFreePixmap (dpy
, f
->output_data
.x
->border_tile
);
4027 f
->output_data
.x
->border_tile
= 0;
4034 /* Handler for signals raised during x_create_frame and
4035 x_create_top_frame. FRAME is the frame which is partially
4039 unwind_create_frame (frame
)
4042 struct frame
*f
= XFRAME (frame
);
4044 /* If frame is ``official'', nothing to do. */
4045 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4048 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4051 x_free_frame_resources (f
);
4053 /* Check that reference counts are indeed correct. */
4054 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4055 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4063 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4065 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
4066 Returns an Emacs frame object.\n\
4067 ALIST is an alist of frame parameters.\n\
4068 If the parameters specify that the frame should not have a minibuffer,\n\
4069 and do not specify a specific minibuffer window to use,\n\
4070 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4071 be shared by the new frame.\n\
4073 This function is an internal primitive--use `make-frame' instead.")
4078 Lisp_Object frame
, tem
;
4080 int minibuffer_only
= 0;
4081 long window_prompting
= 0;
4083 int count
= BINDING_STACK_SIZE ();
4084 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4085 Lisp_Object display
;
4086 struct x_display_info
*dpyinfo
= NULL
;
4092 /* Use this general default value to start with
4093 until we know if this frame has a specified name. */
4094 Vx_resource_name
= Vinvocation_name
;
4096 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4097 if (EQ (display
, Qunbound
))
4099 dpyinfo
= check_x_display_info (display
);
4101 kb
= dpyinfo
->kboard
;
4103 kb
= &the_only_kboard
;
4106 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4108 && ! EQ (name
, Qunbound
)
4110 error ("Invalid frame name--not a string or nil");
4113 Vx_resource_name
= name
;
4115 /* See if parent window is specified. */
4116 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4117 if (EQ (parent
, Qunbound
))
4119 if (! NILP (parent
))
4120 CHECK_NUMBER (parent
, 0);
4122 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4123 /* No need to protect DISPLAY because that's not used after passing
4124 it to make_frame_without_minibuffer. */
4126 GCPRO4 (parms
, parent
, name
, frame
);
4127 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4129 if (EQ (tem
, Qnone
) || NILP (tem
))
4130 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4131 else if (EQ (tem
, Qonly
))
4133 f
= make_minibuffer_frame ();
4134 minibuffer_only
= 1;
4136 else if (WINDOWP (tem
))
4137 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4141 XSETFRAME (frame
, f
);
4143 /* Note that X Windows does support scroll bars. */
4144 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4146 f
->output_method
= output_x_window
;
4147 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4148 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4149 f
->output_data
.x
->icon_bitmap
= -1;
4150 f
->output_data
.x
->fontset
= -1;
4151 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4152 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4153 record_unwind_protect (unwind_create_frame
, frame
);
4156 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4158 if (! STRINGP (f
->icon_name
))
4159 f
->icon_name
= Qnil
;
4161 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4163 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
4164 dpyinfo_refcount
= dpyinfo
->reference_count
;
4165 #endif /* GLYPH_DEBUG */
4167 FRAME_KBOARD (f
) = kb
;
4170 /* These colors will be set anyway later, but it's important
4171 to get the color reference counts right, so initialize them! */
4174 struct gcpro gcpro1
;
4176 black
= build_string ("black");
4178 f
->output_data
.x
->foreground_pixel
4179 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4180 f
->output_data
.x
->background_pixel
4181 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4182 f
->output_data
.x
->cursor_pixel
4183 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4184 f
->output_data
.x
->cursor_foreground_pixel
4185 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4186 f
->output_data
.x
->border_pixel
4187 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4188 f
->output_data
.x
->mouse_pixel
4189 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4193 /* Specify the parent under which to make this X window. */
4197 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4198 f
->output_data
.x
->explicit_parent
= 1;
4202 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4203 f
->output_data
.x
->explicit_parent
= 0;
4206 /* Set the name; the functions to which we pass f expect the name to
4208 if (EQ (name
, Qunbound
) || NILP (name
))
4210 f
->name
= build_string (dpyinfo
->x_id_name
);
4211 f
->explicit_name
= 0;
4216 f
->explicit_name
= 1;
4217 /* use the frame's title when getting resources for this frame. */
4218 specbind (Qx_resource_name
, name
);
4221 /* Extract the window parameters from the supplied values
4222 that are needed to determine window geometry. */
4226 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4229 /* First, try whatever font the caller has specified. */
4232 tem
= Fquery_fontset (font
, Qnil
);
4234 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4236 font
= x_new_font (f
, XSTRING (font
)->data
);
4239 /* Try out a font which we hope has bold and italic variations. */
4240 if (!STRINGP (font
))
4241 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4242 if (!STRINGP (font
))
4243 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4244 if (! STRINGP (font
))
4245 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4246 if (! STRINGP (font
))
4247 /* This was formerly the first thing tried, but it finds too many fonts
4248 and takes too long. */
4249 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4250 /* If those didn't work, look for something which will at least work. */
4251 if (! STRINGP (font
))
4252 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4254 if (! STRINGP (font
))
4255 font
= build_string ("fixed");
4257 x_default_parameter (f
, parms
, Qfont
, font
,
4258 "font", "Font", RES_TYPE_STRING
);
4262 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4263 whereby it fails to get any font. */
4264 xlwmenu_default_font
= f
->output_data
.x
->font
;
4267 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4268 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4270 /* This defaults to 2 in order to match xterm. We recognize either
4271 internalBorderWidth or internalBorder (which is what xterm calls
4273 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4277 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4278 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4279 if (! EQ (value
, Qunbound
))
4280 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4283 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4284 "internalBorderWidth", "internalBorderWidth",
4286 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4287 "verticalScrollBars", "ScrollBars",
4290 /* Also do the stuff which must be set before the window exists. */
4291 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4292 "foreground", "Foreground", RES_TYPE_STRING
);
4293 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4294 "background", "Background", RES_TYPE_STRING
);
4295 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4296 "pointerColor", "Foreground", RES_TYPE_STRING
);
4297 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4298 "cursorColor", "Foreground", RES_TYPE_STRING
);
4299 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4300 "borderColor", "BorderColor", RES_TYPE_STRING
);
4301 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4302 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4303 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4304 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4306 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4307 "scrollBarForeground",
4308 "ScrollBarForeground", 1);
4309 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4310 "scrollBarBackground",
4311 "ScrollBarBackground", 0);
4313 /* Init faces before x_default_parameter is called for scroll-bar
4314 parameters because that function calls x_set_scroll_bar_width,
4315 which calls change_frame_size, which calls Fset_window_buffer,
4316 which runs hooks, which call Fvertical_motion. At the end, we
4317 end up in init_iterator with a null face cache, which should not
4319 init_frame_faces (f
);
4321 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4322 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4323 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4324 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4325 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4326 "bufferPredicate", "BufferPredicate",
4328 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4329 "title", "Title", RES_TYPE_STRING
);
4331 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4332 window_prompting
= x_figure_window_size (f
, parms
);
4334 if (window_prompting
& XNegative
)
4336 if (window_prompting
& YNegative
)
4337 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4339 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4343 if (window_prompting
& YNegative
)
4344 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4346 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4349 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4351 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4352 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4354 /* Create the X widget or window. Add the tool-bar height to the
4355 initial frame height so that the user gets a text display area of
4356 the size he specified with -g or via .Xdefaults. Later changes
4357 of the tool-bar height don't change the frame size. This is done
4358 so that users can create tall Emacs frames without having to
4359 guess how tall the tool-bar will get. */
4360 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
4362 #ifdef USE_X_TOOLKIT
4363 x_window (f
, window_prompting
, minibuffer_only
);
4371 /* Now consider the frame official. */
4372 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4373 Vframe_list
= Fcons (frame
, Vframe_list
);
4375 /* We need to do this after creating the X window, so that the
4376 icon-creation functions can say whose icon they're describing. */
4377 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4378 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4380 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4381 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4382 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4383 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4384 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4385 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4386 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4387 "scrollBarWidth", "ScrollBarWidth",
4390 /* Dimensions, especially f->height, must be done via change_frame_size.
4391 Change will not be effected unless different from the current
4396 SET_FRAME_WIDTH (f
, 0);
4397 change_frame_size (f
, height
, width
, 1, 0, 0);
4399 /* Set up faces after all frame parameters are known. This call
4400 also merges in face attributes specified for new frames. If we
4401 don't do this, the `menu' face for instance won't have the right
4402 colors, and the menu bar won't appear in the specified colors for
4404 call1 (Qface_set_after_frame_default
, frame
);
4406 #ifdef USE_X_TOOLKIT
4407 /* Create the menu bar. */
4408 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4410 /* If this signals an error, we haven't set size hints for the
4411 frame and we didn't make it visible. */
4412 initialize_frame_menubar (f
);
4414 /* This is a no-op, except under Motif where it arranges the
4415 main window for the widgets on it. */
4416 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4417 f
->output_data
.x
->menubar_widget
,
4418 f
->output_data
.x
->edit_widget
);
4420 #endif /* USE_X_TOOLKIT */
4422 /* Tell the server what size and position, etc, we want, and how
4423 badly we want them. This should be done after we have the menu
4424 bar so that its size can be taken into account. */
4426 x_wm_set_size_hint (f
, window_prompting
, 0);
4429 /* Make the window appear on the frame and enable display, unless
4430 the caller says not to. However, with explicit parent, Emacs
4431 cannot control visibility, so don't try. */
4432 if (! f
->output_data
.x
->explicit_parent
)
4434 Lisp_Object visibility
;
4436 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4438 if (EQ (visibility
, Qunbound
))
4441 if (EQ (visibility
, Qicon
))
4442 x_iconify_frame (f
);
4443 else if (! NILP (visibility
))
4444 x_make_frame_visible (f
);
4446 /* Must have been Qnil. */
4451 return unbind_to (count
, frame
);
4455 /* FRAME is used only to get a handle on the X display. We don't pass the
4456 display info directly because we're called from frame.c, which doesn't
4457 know about that structure. */
4460 x_get_focus_frame (frame
)
4461 struct frame
*frame
;
4463 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4465 if (! dpyinfo
->x_focus_frame
)
4468 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4473 /* In certain situations, when the window manager follows a
4474 click-to-focus policy, there seems to be no way around calling
4475 XSetInputFocus to give another frame the input focus .
4477 In an ideal world, XSetInputFocus should generally be avoided so
4478 that applications don't interfere with the window manager's focus
4479 policy. But I think it's okay to use when it's clearly done
4480 following a user-command. */
4482 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4483 "Set the input focus to FRAME.\n\
4484 FRAME nil means use the selected frame.")
4488 struct frame
*f
= check_x_frame (frame
);
4489 Display
*dpy
= FRAME_X_DISPLAY (f
);
4493 count
= x_catch_errors (dpy
);
4494 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4495 RevertToParent
, CurrentTime
);
4496 x_uncatch_errors (dpy
, count
);
4503 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4504 "Internal function called by `color-defined-p', which see.")
4506 Lisp_Object color
, frame
;
4509 FRAME_PTR f
= check_x_frame (frame
);
4511 CHECK_STRING (color
, 1);
4513 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4519 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4520 "Internal function called by `color-values', which see.")
4522 Lisp_Object color
, frame
;
4525 FRAME_PTR f
= check_x_frame (frame
);
4527 CHECK_STRING (color
, 1);
4529 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4533 rgb
[0] = make_number (foo
.red
);
4534 rgb
[1] = make_number (foo
.green
);
4535 rgb
[2] = make_number (foo
.blue
);
4536 return Flist (3, rgb
);
4542 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4543 "Internal function called by `display-color-p', which see.")
4545 Lisp_Object display
;
4547 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4549 if (dpyinfo
->n_planes
<= 2)
4552 switch (dpyinfo
->visual
->class)
4565 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4567 "Return t if the X display supports shades of gray.\n\
4568 Note that color displays do support shades of gray.\n\
4569 The optional argument DISPLAY specifies which display to ask about.\n\
4570 DISPLAY should be either a frame or a display name (a string).\n\
4571 If omitted or nil, that stands for the selected frame's display.")
4573 Lisp_Object display
;
4575 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4577 if (dpyinfo
->n_planes
<= 1)
4580 switch (dpyinfo
->visual
->class)
4595 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4597 "Returns the width in pixels of the X display DISPLAY.\n\
4598 The optional argument DISPLAY specifies which display to ask about.\n\
4599 DISPLAY should be either a frame or a display name (a string).\n\
4600 If omitted or nil, that stands for the selected frame's display.")
4602 Lisp_Object display
;
4604 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4606 return make_number (dpyinfo
->width
);
4609 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4610 Sx_display_pixel_height
, 0, 1, 0,
4611 "Returns the height in pixels of the X display DISPLAY.\n\
4612 The optional argument DISPLAY specifies which display to ask about.\n\
4613 DISPLAY should be either a frame or a display name (a string).\n\
4614 If omitted or nil, that stands for the selected frame's display.")
4616 Lisp_Object display
;
4618 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4620 return make_number (dpyinfo
->height
);
4623 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4625 "Returns the number of bitplanes of the X display DISPLAY.\n\
4626 The optional argument DISPLAY specifies which display to ask about.\n\
4627 DISPLAY should be either a frame or a display name (a string).\n\
4628 If omitted or nil, that stands for the selected frame's display.")
4630 Lisp_Object display
;
4632 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4634 return make_number (dpyinfo
->n_planes
);
4637 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4639 "Returns the number of color cells of the X display DISPLAY.\n\
4640 The optional argument DISPLAY specifies which display to ask about.\n\
4641 DISPLAY should be either a frame or a display name (a string).\n\
4642 If omitted or nil, that stands for the selected frame's display.")
4644 Lisp_Object display
;
4646 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4648 return make_number (DisplayCells (dpyinfo
->display
,
4649 XScreenNumberOfScreen (dpyinfo
->screen
)));
4652 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4653 Sx_server_max_request_size
,
4655 "Returns the maximum request size of the X server of display DISPLAY.\n\
4656 The optional argument DISPLAY specifies which display to ask about.\n\
4657 DISPLAY should be either a frame or a display name (a string).\n\
4658 If omitted or nil, that stands for the selected frame's display.")
4660 Lisp_Object display
;
4662 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4664 return make_number (MAXREQUEST (dpyinfo
->display
));
4667 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4668 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4669 The optional argument DISPLAY specifies which display to ask about.\n\
4670 DISPLAY should be either a frame or a display name (a string).\n\
4671 If omitted or nil, that stands for the selected frame's display.")
4673 Lisp_Object display
;
4675 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4676 char *vendor
= ServerVendor (dpyinfo
->display
);
4678 if (! vendor
) vendor
= "";
4679 return build_string (vendor
);
4682 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4683 "Returns the version numbers of the X server of display DISPLAY.\n\
4684 The value is a list of three integers: the major and minor\n\
4685 version numbers of the X Protocol in use, and the vendor-specific release\n\
4686 number. See also the function `x-server-vendor'.\n\n\
4687 The optional argument DISPLAY specifies which display to ask about.\n\
4688 DISPLAY should be either a frame or a display name (a string).\n\
4689 If omitted or nil, that stands for the selected frame's display.")
4691 Lisp_Object display
;
4693 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4694 Display
*dpy
= dpyinfo
->display
;
4696 return Fcons (make_number (ProtocolVersion (dpy
)),
4697 Fcons (make_number (ProtocolRevision (dpy
)),
4698 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4701 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4702 "Returns the number of screens on the X server of display DISPLAY.\n\
4703 The optional argument DISPLAY specifies which display to ask about.\n\
4704 DISPLAY should be either a frame or a display name (a string).\n\
4705 If omitted or nil, that stands for the selected frame's display.")
4707 Lisp_Object display
;
4709 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4711 return make_number (ScreenCount (dpyinfo
->display
));
4714 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4715 "Returns the height in millimeters of the X display DISPLAY.\n\
4716 The optional argument DISPLAY specifies which display to ask about.\n\
4717 DISPLAY should be either a frame or a display name (a string).\n\
4718 If omitted or nil, that stands for the selected frame's display.")
4720 Lisp_Object display
;
4722 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4724 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4727 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4728 "Returns the width in millimeters of the X display DISPLAY.\n\
4729 The optional argument DISPLAY specifies which display to ask about.\n\
4730 DISPLAY should be either a frame or a display name (a string).\n\
4731 If omitted or nil, that stands for the selected frame's display.")
4733 Lisp_Object display
;
4735 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4737 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4740 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4741 Sx_display_backing_store
, 0, 1, 0,
4742 "Returns an indication of whether X display DISPLAY does backing store.\n\
4743 The value may be `always', `when-mapped', or `not-useful'.\n\
4744 The optional argument DISPLAY specifies which display to ask about.\n\
4745 DISPLAY should be either a frame or a display name (a string).\n\
4746 If omitted or nil, that stands for the selected frame's display.")
4748 Lisp_Object display
;
4750 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4753 switch (DoesBackingStore (dpyinfo
->screen
))
4756 result
= intern ("always");
4760 result
= intern ("when-mapped");
4764 result
= intern ("not-useful");
4768 error ("Strange value for BackingStore parameter of screen");
4775 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4776 Sx_display_visual_class
, 0, 1, 0,
4777 "Returns the visual class of the X display DISPLAY.\n\
4778 The value is one of the symbols `static-gray', `gray-scale',\n\
4779 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4780 The optional argument DISPLAY specifies which display to ask about.\n\
4781 DISPLAY should be either a frame or a display name (a string).\n\
4782 If omitted or nil, that stands for the selected frame's display.")
4784 Lisp_Object display
;
4786 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4789 switch (dpyinfo
->visual
->class)
4792 result
= intern ("static-gray");
4795 result
= intern ("gray-scale");
4798 result
= intern ("static-color");
4801 result
= intern ("pseudo-color");
4804 result
= intern ("true-color");
4807 result
= intern ("direct-color");
4810 error ("Display has an unknown visual class");
4817 DEFUN ("x-display-save-under", Fx_display_save_under
,
4818 Sx_display_save_under
, 0, 1, 0,
4819 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4820 The optional argument DISPLAY specifies which display to ask about.\n\
4821 DISPLAY should be either a frame or a display name (a string).\n\
4822 If omitted or nil, that stands for the selected frame's display.")
4824 Lisp_Object display
;
4826 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4828 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4836 register struct frame
*f
;
4838 return PIXEL_WIDTH (f
);
4843 register struct frame
*f
;
4845 return PIXEL_HEIGHT (f
);
4850 register struct frame
*f
;
4852 return FONT_WIDTH (f
->output_data
.x
->font
);
4857 register struct frame
*f
;
4859 return f
->output_data
.x
->line_height
;
4864 register struct frame
*f
;
4866 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4871 /************************************************************************
4873 ************************************************************************/
4876 /* Mapping visual names to visuals. */
4878 static struct visual_class
4885 {"StaticGray", StaticGray
},
4886 {"GrayScale", GrayScale
},
4887 {"StaticColor", StaticColor
},
4888 {"PseudoColor", PseudoColor
},
4889 {"TrueColor", TrueColor
},
4890 {"DirectColor", DirectColor
},
4895 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4897 /* Value is the screen number of screen SCR. This is a substitute for
4898 the X function with the same name when that doesn't exist. */
4901 XScreenNumberOfScreen (scr
)
4902 register Screen
*scr
;
4904 Display
*dpy
= scr
->display
;
4907 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4908 if (scr
== dpy
->screens
[i
])
4914 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4917 /* Select the visual that should be used on display DPYINFO. Set
4918 members of DPYINFO appropriately. Called from x_term_init. */
4921 select_visual (dpyinfo
)
4922 struct x_display_info
*dpyinfo
;
4924 Display
*dpy
= dpyinfo
->display
;
4925 Screen
*screen
= dpyinfo
->screen
;
4928 /* See if a visual is specified. */
4929 value
= display_x_get_resource (dpyinfo
,
4930 build_string ("visualClass"),
4931 build_string ("VisualClass"),
4933 if (STRINGP (value
))
4935 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4936 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4937 depth, a decimal number. NAME is compared with case ignored. */
4938 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4943 strcpy (s
, XSTRING (value
)->data
);
4944 dash
= index (s
, '-');
4947 dpyinfo
->n_planes
= atoi (dash
+ 1);
4951 /* We won't find a matching visual with depth 0, so that
4952 an error will be printed below. */
4953 dpyinfo
->n_planes
= 0;
4955 /* Determine the visual class. */
4956 for (i
= 0; visual_classes
[i
].name
; ++i
)
4957 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4959 class = visual_classes
[i
].class;
4963 /* Look up a matching visual for the specified class. */
4965 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4966 dpyinfo
->n_planes
, class, &vinfo
))
4967 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4969 dpyinfo
->visual
= vinfo
.visual
;
4974 XVisualInfo
*vinfo
, vinfo_template
;
4976 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
4979 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
4981 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
4983 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4984 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
4985 &vinfo_template
, &n_visuals
);
4987 fatal ("Can't get proper X visual info");
4989 dpyinfo
->n_planes
= vinfo
->depth
;
4990 XFree ((char *) vinfo
);
4995 /* Return the X display structure for the display named NAME.
4996 Open a new connection if necessary. */
4998 struct x_display_info
*
4999 x_display_info_for_name (name
)
5003 struct x_display_info
*dpyinfo
;
5005 CHECK_STRING (name
, 0);
5007 if (! EQ (Vwindow_system
, intern ("x")))
5008 error ("Not using X Windows");
5010 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5012 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5015 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5020 /* Use this general default value to start with. */
5021 Vx_resource_name
= Vinvocation_name
;
5023 validate_x_resource_name ();
5025 dpyinfo
= x_term_init (name
, (char *)0,
5026 (char *) XSTRING (Vx_resource_name
)->data
);
5029 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5032 XSETFASTINT (Vwindow_system_version
, 11);
5038 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5039 1, 3, 0, "Open a connection to an X server.\n\
5040 DISPLAY is the name of the display to connect to.\n\
5041 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5042 If the optional third arg MUST-SUCCEED is non-nil,\n\
5043 terminate Emacs if we can't open the connection.")
5044 (display
, xrm_string
, must_succeed
)
5045 Lisp_Object display
, xrm_string
, must_succeed
;
5047 unsigned char *xrm_option
;
5048 struct x_display_info
*dpyinfo
;
5050 CHECK_STRING (display
, 0);
5051 if (! NILP (xrm_string
))
5052 CHECK_STRING (xrm_string
, 1);
5054 if (! EQ (Vwindow_system
, intern ("x")))
5055 error ("Not using X Windows");
5057 if (! NILP (xrm_string
))
5058 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5060 xrm_option
= (unsigned char *) 0;
5062 validate_x_resource_name ();
5064 /* This is what opens the connection and sets x_current_display.
5065 This also initializes many symbols, such as those used for input. */
5066 dpyinfo
= x_term_init (display
, xrm_option
,
5067 (char *) XSTRING (Vx_resource_name
)->data
);
5071 if (!NILP (must_succeed
))
5072 fatal ("Cannot connect to X server %s.\n\
5073 Check the DISPLAY environment variable or use `-d'.\n\
5074 Also use the `xhost' program to verify that it is set to permit\n\
5075 connections from your machine.\n",
5076 XSTRING (display
)->data
);
5078 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5083 XSETFASTINT (Vwindow_system_version
, 11);
5087 DEFUN ("x-close-connection", Fx_close_connection
,
5088 Sx_close_connection
, 1, 1, 0,
5089 "Close the connection to DISPLAY's X server.\n\
5090 For DISPLAY, specify either a frame or a display name (a string).\n\
5091 If DISPLAY is nil, that stands for the selected frame's display.")
5093 Lisp_Object display
;
5095 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5098 if (dpyinfo
->reference_count
> 0)
5099 error ("Display still has frames on it");
5102 /* Free the fonts in the font table. */
5103 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5104 if (dpyinfo
->font_table
[i
].name
)
5106 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5107 xfree (dpyinfo
->font_table
[i
].full_name
);
5108 xfree (dpyinfo
->font_table
[i
].name
);
5109 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5112 x_destroy_all_bitmaps (dpyinfo
);
5113 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5115 #ifdef USE_X_TOOLKIT
5116 XtCloseDisplay (dpyinfo
->display
);
5118 XCloseDisplay (dpyinfo
->display
);
5121 x_delete_display (dpyinfo
);
5127 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5128 "Return the list of display names that Emacs has connections to.")
5131 Lisp_Object tail
, result
;
5134 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5135 result
= Fcons (XCAR (XCAR (tail
)), result
);
5140 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5141 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5142 If ON is nil, allow buffering of requests.\n\
5143 Turning on synchronization prohibits the Xlib routines from buffering\n\
5144 requests and seriously degrades performance, but makes debugging much\n\
5146 The optional second argument DISPLAY specifies which display to act on.\n\
5147 DISPLAY should be either a frame or a display name (a string).\n\
5148 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5150 Lisp_Object display
, on
;
5152 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5154 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5159 /* Wait for responses to all X commands issued so far for frame F. */
5166 XSync (FRAME_X_DISPLAY (f
), False
);
5171 /***********************************************************************
5173 ***********************************************************************/
5175 /* Value is the number of elements of vector VECTOR. */
5177 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5179 /* List of supported image types. Use define_image_type to add new
5180 types. Use lookup_image_type to find a type for a given symbol. */
5182 static struct image_type
*image_types
;
5184 /* The symbol `image' which is the car of the lists used to represent
5187 extern Lisp_Object Qimage
;
5189 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5195 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5196 extern Lisp_Object QCdata
;
5197 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5198 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
5199 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5201 /* Other symbols. */
5203 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5205 /* Time in seconds after which images should be removed from the cache
5206 if not displayed. */
5208 Lisp_Object Vimage_cache_eviction_delay
;
5210 /* Function prototypes. */
5212 static void define_image_type
P_ ((struct image_type
*type
));
5213 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5214 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5215 static void x_laplace
P_ ((struct frame
*, struct image
*));
5216 static void x_emboss
P_ ((struct frame
*, struct image
*));
5217 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5221 /* Define a new image type from TYPE. This adds a copy of TYPE to
5222 image_types and adds the symbol *TYPE->type to Vimage_types. */
5225 define_image_type (type
)
5226 struct image_type
*type
;
5228 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5229 The initialized data segment is read-only. */
5230 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5231 bcopy (type
, p
, sizeof *p
);
5232 p
->next
= image_types
;
5234 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5238 /* Look up image type SYMBOL, and return a pointer to its image_type
5239 structure. Value is null if SYMBOL is not a known image type. */
5241 static INLINE
struct image_type
*
5242 lookup_image_type (symbol
)
5245 struct image_type
*type
;
5247 for (type
= image_types
; type
; type
= type
->next
)
5248 if (EQ (symbol
, *type
->type
))
5255 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5256 valid image specification is a list whose car is the symbol
5257 `image', and whose rest is a property list. The property list must
5258 contain a value for key `:type'. That value must be the name of a
5259 supported image type. The rest of the property list depends on the
5263 valid_image_p (object
)
5268 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5270 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5271 struct image_type
*type
= lookup_image_type (symbol
);
5274 valid_p
= type
->valid_p (object
);
5281 /* Log error message with format string FORMAT and argument ARG.
5282 Signaling an error, e.g. when an image cannot be loaded, is not a
5283 good idea because this would interrupt redisplay, and the error
5284 message display would lead to another redisplay. This function
5285 therefore simply displays a message. */
5288 image_error (format
, arg1
, arg2
)
5290 Lisp_Object arg1
, arg2
;
5292 add_to_log (format
, arg1
, arg2
);
5297 /***********************************************************************
5298 Image specifications
5299 ***********************************************************************/
5301 enum image_value_type
5303 IMAGE_DONT_CHECK_VALUE_TYPE
,
5306 IMAGE_POSITIVE_INTEGER_VALUE
,
5307 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5309 IMAGE_INTEGER_VALUE
,
5310 IMAGE_FUNCTION_VALUE
,
5315 /* Structure used when parsing image specifications. */
5317 struct image_keyword
5319 /* Name of keyword. */
5322 /* The type of value allowed. */
5323 enum image_value_type type
;
5325 /* Non-zero means key must be present. */
5328 /* Used to recognize duplicate keywords in a property list. */
5331 /* The value that was found. */
5336 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5338 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5341 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5342 has the format (image KEYWORD VALUE ...). One of the keyword/
5343 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5344 image_keywords structures of size NKEYWORDS describing other
5345 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5348 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5350 struct image_keyword
*keywords
;
5357 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5360 plist
= XCDR (spec
);
5361 while (CONSP (plist
))
5363 Lisp_Object key
, value
;
5365 /* First element of a pair must be a symbol. */
5367 plist
= XCDR (plist
);
5371 /* There must follow a value. */
5374 value
= XCAR (plist
);
5375 plist
= XCDR (plist
);
5377 /* Find key in KEYWORDS. Error if not found. */
5378 for (i
= 0; i
< nkeywords
; ++i
)
5379 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5385 /* Record that we recognized the keyword. If a keywords
5386 was found more than once, it's an error. */
5387 keywords
[i
].value
= value
;
5388 ++keywords
[i
].count
;
5390 if (keywords
[i
].count
> 1)
5393 /* Check type of value against allowed type. */
5394 switch (keywords
[i
].type
)
5396 case IMAGE_STRING_VALUE
:
5397 if (!STRINGP (value
))
5401 case IMAGE_SYMBOL_VALUE
:
5402 if (!SYMBOLP (value
))
5406 case IMAGE_POSITIVE_INTEGER_VALUE
:
5407 if (!INTEGERP (value
) || XINT (value
) <= 0)
5411 case IMAGE_ASCENT_VALUE
:
5412 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5414 else if (INTEGERP (value
)
5415 && XINT (value
) >= 0
5416 && XINT (value
) <= 100)
5420 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5421 if (!INTEGERP (value
) || XINT (value
) < 0)
5425 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5428 case IMAGE_FUNCTION_VALUE
:
5429 value
= indirect_function (value
);
5431 || COMPILEDP (value
)
5432 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5436 case IMAGE_NUMBER_VALUE
:
5437 if (!INTEGERP (value
) && !FLOATP (value
))
5441 case IMAGE_INTEGER_VALUE
:
5442 if (!INTEGERP (value
))
5446 case IMAGE_BOOL_VALUE
:
5447 if (!NILP (value
) && !EQ (value
, Qt
))
5456 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5460 /* Check that all mandatory fields are present. */
5461 for (i
= 0; i
< nkeywords
; ++i
)
5462 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5465 return NILP (plist
);
5469 /* Return the value of KEY in image specification SPEC. Value is nil
5470 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5471 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5474 image_spec_value (spec
, key
, found
)
5475 Lisp_Object spec
, key
;
5480 xassert (valid_image_p (spec
));
5482 for (tail
= XCDR (spec
);
5483 CONSP (tail
) && CONSP (XCDR (tail
));
5484 tail
= XCDR (XCDR (tail
)))
5486 if (EQ (XCAR (tail
), key
))
5490 return XCAR (XCDR (tail
));
5500 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5501 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5502 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5503 size in canonical character units.\n\
5504 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5505 or omitted means use the selected frame.")
5506 (spec
, pixels
, frame
)
5507 Lisp_Object spec
, pixels
, frame
;
5512 if (valid_image_p (spec
))
5514 struct frame
*f
= check_x_frame (frame
);
5515 int id
= lookup_image (f
, spec
);
5516 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5517 int width
= img
->width
+ 2 * img
->margin
;
5518 int height
= img
->height
+ 2 * img
->margin
;
5521 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5522 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5524 size
= Fcons (make_number (width
), make_number (height
));
5527 error ("Invalid image specification");
5533 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5534 "Return t if image SPEC has a mask bitmap.\n\
5535 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5536 or omitted means use the selected frame.")
5538 Lisp_Object spec
, frame
;
5543 if (valid_image_p (spec
))
5545 struct frame
*f
= check_x_frame (frame
);
5546 int id
= lookup_image (f
, spec
);
5547 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5552 error ("Invalid image specification");
5559 /***********************************************************************
5560 Image type independent image structures
5561 ***********************************************************************/
5563 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5564 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5567 /* Allocate and return a new image structure for image specification
5568 SPEC. SPEC has a hash value of HASH. */
5570 static struct image
*
5571 make_image (spec
, hash
)
5575 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5577 xassert (valid_image_p (spec
));
5578 bzero (img
, sizeof *img
);
5579 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5580 xassert (img
->type
!= NULL
);
5582 img
->data
.lisp_val
= Qnil
;
5583 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5589 /* Free image IMG which was used on frame F, including its resources. */
5598 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5600 /* Remove IMG from the hash table of its cache. */
5602 img
->prev
->next
= img
->next
;
5604 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5607 img
->next
->prev
= img
->prev
;
5609 c
->images
[img
->id
] = NULL
;
5611 /* Free resources, then free IMG. */
5612 img
->type
->free (f
, img
);
5618 /* Prepare image IMG for display on frame F. Must be called before
5619 drawing an image. */
5622 prepare_image_for_display (f
, img
)
5628 /* We're about to display IMG, so set its timestamp to `now'. */
5630 img
->timestamp
= EMACS_SECS (t
);
5632 /* If IMG doesn't have a pixmap yet, load it now, using the image
5633 type dependent loader function. */
5634 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5635 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5639 /* Value is the number of pixels for the ascent of image IMG when
5640 drawn in face FACE. */
5643 image_ascent (img
, face
)
5647 int height
= img
->height
+ img
->margin
;
5650 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5653 /* This expression is arranged so that if the image can't be
5654 exactly centered, it will be moved slightly up. This is
5655 because a typical font is `top-heavy' (due to the presence
5656 uppercase letters), so the image placement should err towards
5657 being top-heavy too. It also just generally looks better. */
5658 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5660 ascent
= height
/ 2;
5663 ascent
= height
* img
->ascent
/ 100.0;
5670 /***********************************************************************
5671 Helper functions for X image types
5672 ***********************************************************************/
5674 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5676 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5677 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5679 Lisp_Object color_name
,
5680 unsigned long dflt
));
5683 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5684 free the pixmap if any. MASK_P non-zero means clear the mask
5685 pixmap if any. COLORS_P non-zero means free colors allocated for
5686 the image, if any. */
5689 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5692 int pixmap_p
, mask_p
, colors_p
;
5694 if (pixmap_p
&& img
->pixmap
)
5696 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5700 if (mask_p
&& img
->mask
)
5702 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5706 if (colors_p
&& img
->ncolors
)
5708 x_free_colors (f
, img
->colors
, img
->ncolors
);
5709 xfree (img
->colors
);
5715 /* Free X resources of image IMG which is used on frame F. */
5718 x_clear_image (f
, img
)
5723 x_clear_image_1 (f
, img
, 1, 1, 1);
5728 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5729 cannot be allocated, use DFLT. Add a newly allocated color to
5730 IMG->colors, so that it can be freed again. Value is the pixel
5733 static unsigned long
5734 x_alloc_image_color (f
, img
, color_name
, dflt
)
5737 Lisp_Object color_name
;
5741 unsigned long result
;
5743 xassert (STRINGP (color_name
));
5745 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5747 /* This isn't called frequently so we get away with simply
5748 reallocating the color vector to the needed size, here. */
5751 (unsigned long *) xrealloc (img
->colors
,
5752 img
->ncolors
* sizeof *img
->colors
);
5753 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5754 result
= color
.pixel
;
5764 /***********************************************************************
5766 ***********************************************************************/
5768 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5771 /* Return a new, initialized image cache that is allocated from the
5772 heap. Call free_image_cache to free an image cache. */
5774 struct image_cache
*
5777 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5780 bzero (c
, sizeof *c
);
5782 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5783 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5784 c
->buckets
= (struct image
**) xmalloc (size
);
5785 bzero (c
->buckets
, size
);
5790 /* Free image cache of frame F. Be aware that X frames share images
5794 free_image_cache (f
)
5797 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5802 /* Cache should not be referenced by any frame when freed. */
5803 xassert (c
->refcount
== 0);
5805 for (i
= 0; i
< c
->used
; ++i
)
5806 free_image (f
, c
->images
[i
]);
5810 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5815 /* Clear image cache of frame F. FORCE_P non-zero means free all
5816 images. FORCE_P zero means clear only images that haven't been
5817 displayed for some time. Should be called from time to time to
5818 reduce the number of loaded images. If image-eviction-seconds is
5819 non-nil, this frees images in the cache which weren't displayed for
5820 at least that many seconds. */
5823 clear_image_cache (f
, force_p
)
5827 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5829 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5836 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5838 /* Block input so that we won't be interrupted by a SIGIO
5839 while being in an inconsistent state. */
5842 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5844 struct image
*img
= c
->images
[i
];
5846 && (force_p
|| img
->timestamp
< old
))
5848 free_image (f
, img
);
5853 /* We may be clearing the image cache because, for example,
5854 Emacs was iconified for a longer period of time. In that
5855 case, current matrices may still contain references to
5856 images freed above. So, clear these matrices. */
5859 Lisp_Object tail
, frame
;
5861 FOR_EACH_FRAME (tail
, frame
)
5863 struct frame
*f
= XFRAME (frame
);
5865 && FRAME_X_IMAGE_CACHE (f
) == c
)
5866 clear_current_matrices (f
);
5869 ++windows_or_buffers_changed
;
5877 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5879 "Clear the image cache of FRAME.\n\
5880 FRAME nil or omitted means use the selected frame.\n\
5881 FRAME t means clear the image caches of all frames.")
5889 FOR_EACH_FRAME (tail
, frame
)
5890 if (FRAME_X_P (XFRAME (frame
)))
5891 clear_image_cache (XFRAME (frame
), 1);
5894 clear_image_cache (check_x_frame (frame
), 1);
5900 /* Return the id of image with Lisp specification SPEC on frame F.
5901 SPEC must be a valid Lisp image specification (see valid_image_p). */
5904 lookup_image (f
, spec
)
5908 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5912 struct gcpro gcpro1
;
5915 /* F must be a window-system frame, and SPEC must be a valid image
5917 xassert (FRAME_WINDOW_P (f
));
5918 xassert (valid_image_p (spec
));
5922 /* Look up SPEC in the hash table of the image cache. */
5923 hash
= sxhash (spec
, 0);
5924 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5926 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
5927 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
5930 /* If not found, create a new image and cache it. */
5934 img
= make_image (spec
, hash
);
5935 cache_image (f
, img
);
5936 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5938 /* If we can't load the image, and we don't have a width and
5939 height, use some arbitrary width and height so that we can
5940 draw a rectangle for it. */
5941 if (img
->load_failed_p
)
5945 value
= image_spec_value (spec
, QCwidth
, NULL
);
5946 img
->width
= (INTEGERP (value
)
5947 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
5948 value
= image_spec_value (spec
, QCheight
, NULL
);
5949 img
->height
= (INTEGERP (value
)
5950 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
5954 /* Handle image type independent image attributes
5955 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
5956 Lisp_Object ascent
, margin
, relief
;
5958 ascent
= image_spec_value (spec
, QCascent
, NULL
);
5959 if (INTEGERP (ascent
))
5960 img
->ascent
= XFASTINT (ascent
);
5961 else if (EQ (ascent
, Qcenter
))
5962 img
->ascent
= CENTERED_IMAGE_ASCENT
;
5964 margin
= image_spec_value (spec
, QCmargin
, NULL
);
5965 if (INTEGERP (margin
) && XINT (margin
) >= 0)
5966 img
->margin
= XFASTINT (margin
);
5968 relief
= image_spec_value (spec
, QCrelief
, NULL
);
5969 if (INTEGERP (relief
))
5971 img
->relief
= XINT (relief
);
5972 img
->margin
+= abs (img
->relief
);
5975 /* Manipulation of the image's mask. */
5978 /* `:heuristic-mask t'
5980 means build a mask heuristically.
5981 `:heuristic-mask (R G B)'
5982 `:mask (heuristic (R G B))'
5983 means build a mask from color (R G B) in the
5986 means remove a mask, if any. */
5990 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
5992 x_build_heuristic_mask (f
, img
, mask
);
5997 mask
= image_spec_value (spec
, QCmask
, &found_p
);
5999 if (EQ (mask
, Qheuristic
))
6000 x_build_heuristic_mask (f
, img
, Qt
);
6001 else if (CONSP (mask
)
6002 && EQ (XCAR (mask
), Qheuristic
))
6004 if (CONSP (XCDR (mask
)))
6005 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
6007 x_build_heuristic_mask (f
, img
, XCDR (mask
));
6009 else if (NILP (mask
) && found_p
&& img
->mask
)
6011 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
6017 /* Should we apply an image transformation algorithm? */
6020 Lisp_Object algorithm
;
6022 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
6023 if (EQ (algorithm
, Qdisabled
))
6024 x_disable_image (f
, img
);
6025 else if (EQ (algorithm
, Qlaplace
))
6027 else if (EQ (algorithm
, Qemboss
))
6029 else if (CONSP (algorithm
)
6030 && EQ (XCAR (algorithm
), Qedge_detection
))
6033 tem
= XCDR (algorithm
);
6035 x_edge_detection (f
, img
,
6036 Fplist_get (tem
, QCmatrix
),
6037 Fplist_get (tem
, QCcolor_adjustment
));
6043 xassert (!interrupt_input_blocked
);
6046 /* We're using IMG, so set its timestamp to `now'. */
6047 EMACS_GET_TIME (now
);
6048 img
->timestamp
= EMACS_SECS (now
);
6052 /* Value is the image id. */
6057 /* Cache image IMG in the image cache of frame F. */
6060 cache_image (f
, img
)
6064 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6067 /* Find a free slot in c->images. */
6068 for (i
= 0; i
< c
->used
; ++i
)
6069 if (c
->images
[i
] == NULL
)
6072 /* If no free slot found, maybe enlarge c->images. */
6073 if (i
== c
->used
&& c
->used
== c
->size
)
6076 c
->images
= (struct image
**) xrealloc (c
->images
,
6077 c
->size
* sizeof *c
->images
);
6080 /* Add IMG to c->images, and assign IMG an id. */
6086 /* Add IMG to the cache's hash table. */
6087 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6088 img
->next
= c
->buckets
[i
];
6090 img
->next
->prev
= img
;
6092 c
->buckets
[i
] = img
;
6096 /* Call FN on every image in the image cache of frame F. Used to mark
6097 Lisp Objects in the image cache. */
6100 forall_images_in_image_cache (f
, fn
)
6102 void (*fn
) P_ ((struct image
*img
));
6104 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6106 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6110 for (i
= 0; i
< c
->used
; ++i
)
6119 /***********************************************************************
6121 ***********************************************************************/
6123 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6124 XImage
**, Pixmap
*));
6125 static void x_destroy_x_image
P_ ((XImage
*));
6126 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6129 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6130 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6131 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6132 via xmalloc. Print error messages via image_error if an error
6133 occurs. Value is non-zero if successful. */
6136 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6138 int width
, height
, depth
;
6142 Display
*display
= FRAME_X_DISPLAY (f
);
6143 Screen
*screen
= FRAME_X_SCREEN (f
);
6144 Window window
= FRAME_X_WINDOW (f
);
6146 xassert (interrupt_input_blocked
);
6149 depth
= DefaultDepthOfScreen (screen
);
6150 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6151 depth
, ZPixmap
, 0, NULL
, width
, height
,
6152 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6155 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6159 /* Allocate image raster. */
6160 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6162 /* Allocate a pixmap of the same size. */
6163 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6164 if (*pixmap
== None
)
6166 x_destroy_x_image (*ximg
);
6168 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6176 /* Destroy XImage XIMG. Free XIMG->data. */
6179 x_destroy_x_image (ximg
)
6182 xassert (interrupt_input_blocked
);
6187 XDestroyImage (ximg
);
6192 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6193 are width and height of both the image and pixmap. */
6196 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6203 xassert (interrupt_input_blocked
);
6204 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6205 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6206 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6211 /***********************************************************************
6213 ***********************************************************************/
6215 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6216 static char *slurp_file
P_ ((char *, int *));
6219 /* Find image file FILE. Look in data-directory, then
6220 x-bitmap-file-path. Value is the full name of the file found, or
6221 nil if not found. */
6224 x_find_image_file (file
)
6227 Lisp_Object file_found
, search_path
;
6228 struct gcpro gcpro1
, gcpro2
;
6232 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6233 GCPRO2 (file_found
, search_path
);
6235 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6236 fd
= openp (search_path
, file
, "", &file_found
, 0);
6248 /* Read FILE into memory. Value is a pointer to a buffer allocated
6249 with xmalloc holding FILE's contents. Value is null if an error
6250 occurred. *SIZE is set to the size of the file. */
6253 slurp_file (file
, size
)
6261 if (stat (file
, &st
) == 0
6262 && (fp
= fopen (file
, "r")) != NULL
6263 && (buf
= (char *) xmalloc (st
.st_size
),
6264 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6285 /***********************************************************************
6287 ***********************************************************************/
6289 static int xbm_scan
P_ ((char **, char *, char *, int *));
6290 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6291 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6293 static int xbm_image_p
P_ ((Lisp_Object object
));
6294 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6296 static int xbm_file_p
P_ ((Lisp_Object
));
6299 /* Indices of image specification fields in xbm_format, below. */
6301 enum xbm_keyword_index
6319 /* Vector of image_keyword structures describing the format
6320 of valid XBM image specifications. */
6322 static struct image_keyword xbm_format
[XBM_LAST
] =
6324 {":type", IMAGE_SYMBOL_VALUE
, 1},
6325 {":file", IMAGE_STRING_VALUE
, 0},
6326 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6327 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6328 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6329 {":foreground", IMAGE_STRING_VALUE
, 0},
6330 {":background", IMAGE_STRING_VALUE
, 0},
6331 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6332 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6333 {":relief", IMAGE_INTEGER_VALUE
, 0},
6334 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6335 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6336 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6339 /* Structure describing the image type XBM. */
6341 static struct image_type xbm_type
=
6350 /* Tokens returned from xbm_scan. */
6359 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6360 A valid specification is a list starting with the symbol `image'
6361 The rest of the list is a property list which must contain an
6364 If the specification specifies a file to load, it must contain
6365 an entry `:file FILENAME' where FILENAME is a string.
6367 If the specification is for a bitmap loaded from memory it must
6368 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6369 WIDTH and HEIGHT are integers > 0. DATA may be:
6371 1. a string large enough to hold the bitmap data, i.e. it must
6372 have a size >= (WIDTH + 7) / 8 * HEIGHT
6374 2. a bool-vector of size >= WIDTH * HEIGHT
6376 3. a vector of strings or bool-vectors, one for each line of the
6379 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6380 may not be specified in this case because they are defined in the
6383 Both the file and data forms may contain the additional entries
6384 `:background COLOR' and `:foreground COLOR'. If not present,
6385 foreground and background of the frame on which the image is
6386 displayed is used. */
6389 xbm_image_p (object
)
6392 struct image_keyword kw
[XBM_LAST
];
6394 bcopy (xbm_format
, kw
, sizeof kw
);
6395 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6398 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6400 if (kw
[XBM_FILE
].count
)
6402 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6405 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6407 /* In-memory XBM file. */
6408 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6416 /* Entries for `:width', `:height' and `:data' must be present. */
6417 if (!kw
[XBM_WIDTH
].count
6418 || !kw
[XBM_HEIGHT
].count
6419 || !kw
[XBM_DATA
].count
)
6422 data
= kw
[XBM_DATA
].value
;
6423 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6424 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6426 /* Check type of data, and width and height against contents of
6432 /* Number of elements of the vector must be >= height. */
6433 if (XVECTOR (data
)->size
< height
)
6436 /* Each string or bool-vector in data must be large enough
6437 for one line of the image. */
6438 for (i
= 0; i
< height
; ++i
)
6440 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6444 if (XSTRING (elt
)->size
6445 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6448 else if (BOOL_VECTOR_P (elt
))
6450 if (XBOOL_VECTOR (elt
)->size
< width
)
6457 else if (STRINGP (data
))
6459 if (XSTRING (data
)->size
6460 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6463 else if (BOOL_VECTOR_P (data
))
6465 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6476 /* Scan a bitmap file. FP is the stream to read from. Value is
6477 either an enumerator from enum xbm_token, or a character for a
6478 single-character token, or 0 at end of file. If scanning an
6479 identifier, store the lexeme of the identifier in SVAL. If
6480 scanning a number, store its value in *IVAL. */
6483 xbm_scan (s
, end
, sval
, ival
)
6492 /* Skip white space. */
6493 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6498 else if (isdigit (c
))
6500 int value
= 0, digit
;
6502 if (c
== '0' && *s
< end
)
6505 if (c
== 'x' || c
== 'X')
6512 else if (c
>= 'a' && c
<= 'f')
6513 digit
= c
- 'a' + 10;
6514 else if (c
>= 'A' && c
<= 'F')
6515 digit
= c
- 'A' + 10;
6518 value
= 16 * value
+ digit
;
6521 else if (isdigit (c
))
6525 && (c
= *(*s
)++, isdigit (c
)))
6526 value
= 8 * value
+ c
- '0';
6533 && (c
= *(*s
)++, isdigit (c
)))
6534 value
= 10 * value
+ c
- '0';
6542 else if (isalpha (c
) || c
== '_')
6546 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6553 else if (c
== '/' && **s
== '*')
6555 /* C-style comment. */
6557 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6570 /* Replacement for XReadBitmapFileData which isn't available under old
6571 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6572 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6573 the image. Return in *DATA the bitmap data allocated with xmalloc.
6574 Value is non-zero if successful. DATA null means just test if
6575 CONTENTS looks like an in-memory XBM file. */
6578 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6579 char *contents
, *end
;
6580 int *width
, *height
;
6581 unsigned char **data
;
6584 char buffer
[BUFSIZ
];
6587 int bytes_per_line
, i
, nbytes
;
6593 LA1 = xbm_scan (&s, end, buffer, &value)
6595 #define expect(TOKEN) \
6596 if (LA1 != (TOKEN)) \
6601 #define expect_ident(IDENT) \
6602 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6607 *width
= *height
= -1;
6610 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6612 /* Parse defines for width, height and hot-spots. */
6616 expect_ident ("define");
6617 expect (XBM_TK_IDENT
);
6619 if (LA1
== XBM_TK_NUMBER
);
6621 char *p
= strrchr (buffer
, '_');
6622 p
= p
? p
+ 1 : buffer
;
6623 if (strcmp (p
, "width") == 0)
6625 else if (strcmp (p
, "height") == 0)
6628 expect (XBM_TK_NUMBER
);
6631 if (*width
< 0 || *height
< 0)
6633 else if (data
== NULL
)
6636 /* Parse bits. Must start with `static'. */
6637 expect_ident ("static");
6638 if (LA1
== XBM_TK_IDENT
)
6640 if (strcmp (buffer
, "unsigned") == 0)
6643 expect_ident ("char");
6645 else if (strcmp (buffer
, "short") == 0)
6649 if (*width
% 16 && *width
% 16 < 9)
6652 else if (strcmp (buffer
, "char") == 0)
6660 expect (XBM_TK_IDENT
);
6666 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6667 nbytes
= bytes_per_line
* *height
;
6668 p
= *data
= (char *) xmalloc (nbytes
);
6672 for (i
= 0; i
< nbytes
; i
+= 2)
6675 expect (XBM_TK_NUMBER
);
6678 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6681 if (LA1
== ',' || LA1
== '}')
6689 for (i
= 0; i
< nbytes
; ++i
)
6692 expect (XBM_TK_NUMBER
);
6696 if (LA1
== ',' || LA1
== '}')
6721 /* Load XBM image IMG which will be displayed on frame F from buffer
6722 CONTENTS. END is the end of the buffer. Value is non-zero if
6726 xbm_load_image (f
, img
, contents
, end
)
6729 char *contents
, *end
;
6732 unsigned char *data
;
6735 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6738 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6739 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6740 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6743 xassert (img
->width
> 0 && img
->height
> 0);
6745 /* Get foreground and background colors, maybe allocate colors. */
6746 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6748 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6750 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6752 background
= x_alloc_image_color (f
, img
, value
, background
);
6755 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6758 img
->width
, img
->height
,
6759 foreground
, background
,
6763 if (img
->pixmap
== None
)
6765 x_clear_image (f
, img
);
6766 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6772 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6778 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6785 return (STRINGP (data
)
6786 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6787 (XSTRING (data
)->data
6788 + STRING_BYTES (XSTRING (data
))),
6793 /* Fill image IMG which is used on frame F with pixmap data. Value is
6794 non-zero if successful. */
6802 Lisp_Object file_name
;
6804 xassert (xbm_image_p (img
->spec
));
6806 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6807 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6808 if (STRINGP (file_name
))
6813 struct gcpro gcpro1
;
6815 file
= x_find_image_file (file_name
);
6817 if (!STRINGP (file
))
6819 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6824 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6825 if (contents
== NULL
)
6827 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6832 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6837 struct image_keyword fmt
[XBM_LAST
];
6840 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6841 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6844 int in_memory_file_p
= 0;
6846 /* See if data looks like an in-memory XBM file. */
6847 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6848 in_memory_file_p
= xbm_file_p (data
);
6850 /* Parse the image specification. */
6851 bcopy (xbm_format
, fmt
, sizeof fmt
);
6852 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6855 /* Get specified width, and height. */
6856 if (!in_memory_file_p
)
6858 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6859 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6860 xassert (img
->width
> 0 && img
->height
> 0);
6863 /* Get foreground and background colors, maybe allocate colors. */
6864 if (fmt
[XBM_FOREGROUND
].count
)
6865 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6867 if (fmt
[XBM_BACKGROUND
].count
)
6868 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6871 if (in_memory_file_p
)
6872 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6873 (XSTRING (data
)->data
6874 + STRING_BYTES (XSTRING (data
))));
6881 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6883 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6884 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6886 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6888 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6890 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6893 else if (STRINGP (data
))
6894 bits
= XSTRING (data
)->data
;
6896 bits
= XBOOL_VECTOR (data
)->data
;
6898 /* Create the pixmap. */
6899 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6901 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6904 img
->width
, img
->height
,
6905 foreground
, background
,
6911 image_error ("Unable to create pixmap for XBM image `%s'",
6913 x_clear_image (f
, img
);
6923 /***********************************************************************
6925 ***********************************************************************/
6929 static int xpm_image_p
P_ ((Lisp_Object object
));
6930 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6931 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6933 #include "X11/xpm.h"
6935 /* The symbol `xpm' identifying XPM-format images. */
6939 /* Indices of image specification fields in xpm_format, below. */
6941 enum xpm_keyword_index
6956 /* Vector of image_keyword structures describing the format
6957 of valid XPM image specifications. */
6959 static struct image_keyword xpm_format
[XPM_LAST
] =
6961 {":type", IMAGE_SYMBOL_VALUE
, 1},
6962 {":file", IMAGE_STRING_VALUE
, 0},
6963 {":data", IMAGE_STRING_VALUE
, 0},
6964 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6965 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6966 {":relief", IMAGE_INTEGER_VALUE
, 0},
6967 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6968 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6969 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6970 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6973 /* Structure describing the image type XBM. */
6975 static struct image_type xpm_type
=
6985 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
6986 functions for allocating image colors. Our own functions handle
6987 color allocation failures more gracefully than the ones on the XPM
6990 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
6991 #define ALLOC_XPM_COLORS
6994 #ifdef ALLOC_XPM_COLORS
6996 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
6997 static void xpm_free_color_cache
P_ ((void));
6998 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
6999 static int xpm_color_bucket
P_ ((char *));
7000 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
7003 /* An entry in a hash table used to cache color definitions of named
7004 colors. This cache is necessary to speed up XPM image loading in
7005 case we do color allocations ourselves. Without it, we would need
7006 a call to XParseColor per pixel in the image. */
7008 struct xpm_cached_color
7010 /* Next in collision chain. */
7011 struct xpm_cached_color
*next
;
7013 /* Color definition (RGB and pixel color). */
7020 /* The hash table used for the color cache, and its bucket vector
7023 #define XPM_COLOR_CACHE_BUCKETS 1001
7024 struct xpm_cached_color
**xpm_color_cache
;
7026 /* Initialize the color cache. */
7029 xpm_init_color_cache (f
, attrs
)
7031 XpmAttributes
*attrs
;
7033 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
7034 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
7035 memset (xpm_color_cache
, 0, nbytes
);
7036 init_color_table ();
7038 if (attrs
->valuemask
& XpmColorSymbols
)
7043 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
7044 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7045 attrs
->colorsymbols
[i
].value
, &color
))
7047 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
7049 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
7055 /* Free the color cache. */
7058 xpm_free_color_cache ()
7060 struct xpm_cached_color
*p
, *next
;
7063 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
7064 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
7070 xfree (xpm_color_cache
);
7071 xpm_color_cache
= NULL
;
7072 free_color_table ();
7076 /* Return the bucket index for color named COLOR_NAME in the color
7080 xpm_color_bucket (color_name
)
7086 for (s
= color_name
; *s
; ++s
)
7088 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7092 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7093 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7096 static struct xpm_cached_color
*
7097 xpm_cache_color (f
, color_name
, color
, bucket
)
7104 struct xpm_cached_color
*p
;
7107 bucket
= xpm_color_bucket (color_name
);
7109 nbytes
= sizeof *p
+ strlen (color_name
);
7110 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7111 strcpy (p
->name
, color_name
);
7113 p
->next
= xpm_color_cache
[bucket
];
7114 xpm_color_cache
[bucket
] = p
;
7119 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7120 return the cached definition in *COLOR. Otherwise, make a new
7121 entry in the cache and allocate the color. Value is zero if color
7122 allocation failed. */
7125 xpm_lookup_color (f
, color_name
, color
)
7130 struct xpm_cached_color
*p
;
7131 int h
= xpm_color_bucket (color_name
);
7133 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7134 if (strcmp (p
->name
, color_name
) == 0)
7139 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7142 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7144 p
= xpm_cache_color (f
, color_name
, color
, h
);
7151 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7152 CLOSURE is a pointer to the frame on which we allocate the
7153 color. Return in *COLOR the allocated color. Value is non-zero
7157 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7164 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7168 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7169 is a pointer to the frame on which we allocate the color. Value is
7170 non-zero if successful. */
7173 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7183 #endif /* ALLOC_XPM_COLORS */
7186 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7187 for XPM images. Such a list must consist of conses whose car and
7191 xpm_valid_color_symbols_p (color_symbols
)
7192 Lisp_Object color_symbols
;
7194 while (CONSP (color_symbols
))
7196 Lisp_Object sym
= XCAR (color_symbols
);
7198 || !STRINGP (XCAR (sym
))
7199 || !STRINGP (XCDR (sym
)))
7201 color_symbols
= XCDR (color_symbols
);
7204 return NILP (color_symbols
);
7208 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7211 xpm_image_p (object
)
7214 struct image_keyword fmt
[XPM_LAST
];
7215 bcopy (xpm_format
, fmt
, sizeof fmt
);
7216 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7217 /* Either `:file' or `:data' must be present. */
7218 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7219 /* Either no `:color-symbols' or it's a list of conses
7220 whose car and cdr are strings. */
7221 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7222 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7226 /* Load image IMG which will be displayed on frame F. Value is
7227 non-zero if successful. */
7235 XpmAttributes attrs
;
7236 Lisp_Object specified_file
, color_symbols
;
7238 /* Configure the XPM lib. Use the visual of frame F. Allocate
7239 close colors. Return colors allocated. */
7240 bzero (&attrs
, sizeof attrs
);
7241 attrs
.visual
= FRAME_X_VISUAL (f
);
7242 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7243 attrs
.valuemask
|= XpmVisual
;
7244 attrs
.valuemask
|= XpmColormap
;
7246 #ifdef ALLOC_XPM_COLORS
7247 /* Allocate colors with our own functions which handle
7248 failing color allocation more gracefully. */
7249 attrs
.color_closure
= f
;
7250 attrs
.alloc_color
= xpm_alloc_color
;
7251 attrs
.free_colors
= xpm_free_colors
;
7252 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7253 #else /* not ALLOC_XPM_COLORS */
7254 /* Let the XPM lib allocate colors. */
7255 attrs
.valuemask
|= XpmReturnAllocPixels
;
7256 #ifdef XpmAllocCloseColors
7257 attrs
.alloc_close_colors
= 1;
7258 attrs
.valuemask
|= XpmAllocCloseColors
;
7259 #else /* not XpmAllocCloseColors */
7260 attrs
.closeness
= 600;
7261 attrs
.valuemask
|= XpmCloseness
;
7262 #endif /* not XpmAllocCloseColors */
7263 #endif /* ALLOC_XPM_COLORS */
7265 /* If image specification contains symbolic color definitions, add
7266 these to `attrs'. */
7267 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7268 if (CONSP (color_symbols
))
7271 XpmColorSymbol
*xpm_syms
;
7274 attrs
.valuemask
|= XpmColorSymbols
;
7276 /* Count number of symbols. */
7277 attrs
.numsymbols
= 0;
7278 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7281 /* Allocate an XpmColorSymbol array. */
7282 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7283 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7284 bzero (xpm_syms
, size
);
7285 attrs
.colorsymbols
= xpm_syms
;
7287 /* Fill the color symbol array. */
7288 for (tail
= color_symbols
, i
= 0;
7290 ++i
, tail
= XCDR (tail
))
7292 Lisp_Object name
= XCAR (XCAR (tail
));
7293 Lisp_Object color
= XCDR (XCAR (tail
));
7294 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7295 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7296 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7297 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7301 /* Create a pixmap for the image, either from a file, or from a
7302 string buffer containing data in the same format as an XPM file. */
7303 #ifdef ALLOC_XPM_COLORS
7304 xpm_init_color_cache (f
, &attrs
);
7307 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7308 if (STRINGP (specified_file
))
7310 Lisp_Object file
= x_find_image_file (specified_file
);
7311 if (!STRINGP (file
))
7313 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7317 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7318 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7323 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7324 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7325 XSTRING (buffer
)->data
,
7326 &img
->pixmap
, &img
->mask
,
7330 if (rc
== XpmSuccess
)
7332 #ifdef ALLOC_XPM_COLORS
7333 img
->colors
= colors_in_color_table (&img
->ncolors
);
7334 #else /* not ALLOC_XPM_COLORS */
7337 img
->ncolors
= attrs
.nalloc_pixels
;
7338 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7339 * sizeof *img
->colors
);
7340 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7342 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7343 #ifdef DEBUG_X_COLORS
7344 register_color (img
->colors
[i
]);
7347 #endif /* not ALLOC_XPM_COLORS */
7349 img
->width
= attrs
.width
;
7350 img
->height
= attrs
.height
;
7351 xassert (img
->width
> 0 && img
->height
> 0);
7353 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7354 XpmFreeAttributes (&attrs
);
7361 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7364 case XpmFileInvalid
:
7365 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7369 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7372 case XpmColorFailed
:
7373 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7377 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7382 #ifdef ALLOC_XPM_COLORS
7383 xpm_free_color_cache ();
7385 return rc
== XpmSuccess
;
7388 #endif /* HAVE_XPM != 0 */
7391 /***********************************************************************
7393 ***********************************************************************/
7395 /* An entry in the color table mapping an RGB color to a pixel color. */
7400 unsigned long pixel
;
7402 /* Next in color table collision list. */
7403 struct ct_color
*next
;
7406 /* The bucket vector size to use. Must be prime. */
7410 /* Value is a hash of the RGB color given by R, G, and B. */
7412 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7414 /* The color hash table. */
7416 struct ct_color
**ct_table
;
7418 /* Number of entries in the color table. */
7420 int ct_colors_allocated
;
7422 /* Initialize the color table. */
7427 int size
= CT_SIZE
* sizeof (*ct_table
);
7428 ct_table
= (struct ct_color
**) xmalloc (size
);
7429 bzero (ct_table
, size
);
7430 ct_colors_allocated
= 0;
7434 /* Free memory associated with the color table. */
7440 struct ct_color
*p
, *next
;
7442 for (i
= 0; i
< CT_SIZE
; ++i
)
7443 for (p
= ct_table
[i
]; p
; p
= next
)
7454 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7455 entry for that color already is in the color table, return the
7456 pixel color of that entry. Otherwise, allocate a new color for R,
7457 G, B, and make an entry in the color table. */
7459 static unsigned long
7460 lookup_rgb_color (f
, r
, g
, b
)
7464 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7465 int i
= hash
% CT_SIZE
;
7468 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7469 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7482 cmap
= FRAME_X_COLORMAP (f
);
7483 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7487 ++ct_colors_allocated
;
7489 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7493 p
->pixel
= color
.pixel
;
7494 p
->next
= ct_table
[i
];
7498 return FRAME_FOREGROUND_PIXEL (f
);
7505 /* Look up pixel color PIXEL which is used on frame F in the color
7506 table. If not already present, allocate it. Value is PIXEL. */
7508 static unsigned long
7509 lookup_pixel_color (f
, pixel
)
7511 unsigned long pixel
;
7513 int i
= pixel
% CT_SIZE
;
7516 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7517 if (p
->pixel
== pixel
)
7526 cmap
= FRAME_X_COLORMAP (f
);
7527 color
.pixel
= pixel
;
7528 x_query_color (f
, &color
);
7529 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7533 ++ct_colors_allocated
;
7535 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7540 p
->next
= ct_table
[i
];
7544 return FRAME_FOREGROUND_PIXEL (f
);
7551 /* Value is a vector of all pixel colors contained in the color table,
7552 allocated via xmalloc. Set *N to the number of colors. */
7554 static unsigned long *
7555 colors_in_color_table (n
)
7560 unsigned long *colors
;
7562 if (ct_colors_allocated
== 0)
7569 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7571 *n
= ct_colors_allocated
;
7573 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7574 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7575 colors
[j
++] = p
->pixel
;
7583 /***********************************************************************
7585 ***********************************************************************/
7587 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7588 int, XImage
*, int));
7589 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7590 XColor
*, int, XImage
*, int));
7591 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7592 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7593 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7595 /* Non-zero means draw a cross on images having `:algorithm
7598 int cross_disabled_images
;
7600 /* Edge detection matrices for different edge-detection
7603 static int emboss_matrix
[9] = {
7605 2, -1, 0, /* y - 1 */
7607 0, 1, -2 /* y + 1 */
7610 static int laplace_matrix
[9] = {
7612 1, 0, 0, /* y - 1 */
7614 0, 0, -1 /* y + 1 */
7617 /* Value is the intensity of the color whose red/green/blue values
7620 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7623 /* On frame F, return an array of XColor structures describing image
7624 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7625 non-zero means also fill the red/green/blue members of the XColor
7626 structures. Value is a pointer to the array of XColors structures,
7627 allocated with xmalloc; it must be freed by the caller. */
7630 x_to_xcolors (f
, img
, rgb_p
)
7639 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7641 /* Get the X image IMG->pixmap. */
7642 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7643 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7645 /* Fill the `pixel' members of the XColor array. I wished there
7646 were an easy and portable way to circumvent XGetPixel. */
7648 for (y
= 0; y
< img
->height
; ++y
)
7652 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7653 p
->pixel
= XGetPixel (ximg
, x
, y
);
7656 x_query_colors (f
, row
, img
->width
);
7659 XDestroyImage (ximg
);
7664 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7665 RGB members are set. F is the frame on which this all happens.
7666 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7669 x_from_xcolors (f
, img
, colors
)
7679 init_color_table ();
7681 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7684 for (y
= 0; y
< img
->height
; ++y
)
7685 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7687 unsigned long pixel
;
7688 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7689 XPutPixel (oimg
, x
, y
, pixel
);
7693 x_clear_image_1 (f
, img
, 1, 0, 1);
7695 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7696 x_destroy_x_image (oimg
);
7697 img
->pixmap
= pixmap
;
7698 img
->colors
= colors_in_color_table (&img
->ncolors
);
7699 free_color_table ();
7703 /* On frame F, perform edge-detection on image IMG.
7705 MATRIX is a nine-element array specifying the transformation
7706 matrix. See emboss_matrix for an example.
7708 COLOR_ADJUST is a color adjustment added to each pixel of the
7712 x_detect_edges (f
, img
, matrix
, color_adjust
)
7715 int matrix
[9], color_adjust
;
7717 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7721 for (i
= sum
= 0; i
< 9; ++i
)
7722 sum
+= abs (matrix
[i
]);
7724 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7726 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7728 for (y
= 0; y
< img
->height
; ++y
)
7730 p
= COLOR (new, 0, y
);
7731 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7732 p
= COLOR (new, img
->width
- 1, y
);
7733 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7736 for (x
= 1; x
< img
->width
- 1; ++x
)
7738 p
= COLOR (new, x
, 0);
7739 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7740 p
= COLOR (new, x
, img
->height
- 1);
7741 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7744 for (y
= 1; y
< img
->height
- 1; ++y
)
7746 p
= COLOR (new, 1, y
);
7748 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7750 int r
, g
, b
, y1
, x1
;
7753 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7754 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7757 XColor
*t
= COLOR (colors
, x1
, y1
);
7758 r
+= matrix
[i
] * t
->red
;
7759 g
+= matrix
[i
] * t
->green
;
7760 b
+= matrix
[i
] * t
->blue
;
7763 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7764 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7765 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7766 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7771 x_from_xcolors (f
, img
, new);
7777 /* Perform the pre-defined `emboss' edge-detection on image IMG
7785 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7789 /* Perform the pre-defined `laplace' edge-detection on image IMG
7797 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7801 /* Perform edge-detection on image IMG on frame F, with specified
7802 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7804 MATRIX must be either
7806 - a list of at least 9 numbers in row-major form
7807 - a vector of at least 9 numbers
7809 COLOR_ADJUST nil means use a default; otherwise it must be a
7813 x_edge_detection (f
, img
, matrix
, color_adjust
)
7816 Lisp_Object matrix
, color_adjust
;
7824 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7825 ++i
, matrix
= XCDR (matrix
))
7826 trans
[i
] = XFLOATINT (XCAR (matrix
));
7828 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7830 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7831 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7834 if (NILP (color_adjust
))
7835 color_adjust
= make_number (0xffff / 2);
7837 if (i
== 9 && NUMBERP (color_adjust
))
7838 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7842 /* Transform image IMG on frame F so that it looks disabled. */
7845 x_disable_image (f
, img
)
7849 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7851 if (dpyinfo
->n_planes
>= 2)
7853 /* Color (or grayscale). Convert to gray, and equalize. Just
7854 drawing such images with a stipple can look very odd, so
7855 we're using this method instead. */
7856 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7858 const int h
= 15000;
7859 const int l
= 30000;
7861 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7865 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7866 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7867 p
->red
= p
->green
= p
->blue
= i2
;
7870 x_from_xcolors (f
, img
, colors
);
7873 /* Draw a cross over the disabled image, if we must or if we
7875 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
7877 Display
*dpy
= FRAME_X_DISPLAY (f
);
7880 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
7881 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
7882 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
7883 img
->width
- 1, img
->height
- 1);
7884 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
7890 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
7891 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
7892 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
7893 img
->width
- 1, img
->height
- 1);
7894 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
7902 /* Build a mask for image IMG which is used on frame F. FILE is the
7903 name of an image file, for error messages. HOW determines how to
7904 determine the background color of IMG. If it is a list '(R G B)',
7905 with R, G, and B being integers >= 0, take that as the color of the
7906 background. Otherwise, determine the background color of IMG
7907 heuristically. Value is non-zero if successful. */
7910 x_build_heuristic_mask (f
, img
, how
)
7915 Display
*dpy
= FRAME_X_DISPLAY (f
);
7916 XImage
*ximg
, *mask_img
;
7917 int x
, y
, rc
, look_at_corners_p
;
7918 unsigned long bg
= 0;
7922 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
7926 /* Create an image and pixmap serving as mask. */
7927 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7928 &mask_img
, &img
->mask
);
7932 /* Get the X image of IMG->pixmap. */
7933 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7936 /* Determine the background color of ximg. If HOW is `(R G B)'
7937 take that as color. Otherwise, try to determine the color
7939 look_at_corners_p
= 1;
7947 && NATNUMP (XCAR (how
)))
7949 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7953 if (i
== 3 && NILP (how
))
7955 char color_name
[30];
7956 XColor exact
, color
;
7959 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7961 cmap
= FRAME_X_COLORMAP (f
);
7962 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7965 look_at_corners_p
= 0;
7970 if (look_at_corners_p
)
7972 unsigned long corners
[4];
7975 /* Get the colors at the corners of ximg. */
7976 corners
[0] = XGetPixel (ximg
, 0, 0);
7977 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7978 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7979 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7981 /* Choose the most frequently found color as background. */
7982 for (i
= best_count
= 0; i
< 4; ++i
)
7986 for (j
= n
= 0; j
< 4; ++j
)
7987 if (corners
[i
] == corners
[j
])
7991 bg
= corners
[i
], best_count
= n
;
7995 /* Set all bits in mask_img to 1 whose color in ximg is different
7996 from the background color bg. */
7997 for (y
= 0; y
< img
->height
; ++y
)
7998 for (x
= 0; x
< img
->width
; ++x
)
7999 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
8001 /* Put mask_img into img->mask. */
8002 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8003 x_destroy_x_image (mask_img
);
8004 XDestroyImage (ximg
);
8011 /***********************************************************************
8012 PBM (mono, gray, color)
8013 ***********************************************************************/
8015 static int pbm_image_p
P_ ((Lisp_Object object
));
8016 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
8017 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
8019 /* The symbol `pbm' identifying images of this type. */
8023 /* Indices of image specification fields in gs_format, below. */
8025 enum pbm_keyword_index
8041 /* Vector of image_keyword structures describing the format
8042 of valid user-defined image specifications. */
8044 static struct image_keyword pbm_format
[PBM_LAST
] =
8046 {":type", IMAGE_SYMBOL_VALUE
, 1},
8047 {":file", IMAGE_STRING_VALUE
, 0},
8048 {":data", IMAGE_STRING_VALUE
, 0},
8049 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8050 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8051 {":relief", IMAGE_INTEGER_VALUE
, 0},
8052 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8053 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8054 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8055 {":foreground", IMAGE_STRING_VALUE
, 0},
8056 {":background", IMAGE_STRING_VALUE
, 0}
8059 /* Structure describing the image type `pbm'. */
8061 static struct image_type pbm_type
=
8071 /* Return non-zero if OBJECT is a valid PBM image specification. */
8074 pbm_image_p (object
)
8077 struct image_keyword fmt
[PBM_LAST
];
8079 bcopy (pbm_format
, fmt
, sizeof fmt
);
8081 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8084 /* Must specify either :data or :file. */
8085 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8089 /* Scan a decimal number from *S and return it. Advance *S while
8090 reading the number. END is the end of the string. Value is -1 at
8094 pbm_scan_number (s
, end
)
8095 unsigned char **s
, *end
;
8097 int c
= 0, val
= -1;
8101 /* Skip white-space. */
8102 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8107 /* Skip comment to end of line. */
8108 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8111 else if (isdigit (c
))
8113 /* Read decimal number. */
8115 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8116 val
= 10 * val
+ c
- '0';
8127 /* Load PBM image IMG for use on frame F. */
8135 int width
, height
, max_color_idx
= 0;
8137 Lisp_Object file
, specified_file
;
8138 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8139 struct gcpro gcpro1
;
8140 unsigned char *contents
= NULL
;
8141 unsigned char *end
, *p
;
8144 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8148 if (STRINGP (specified_file
))
8150 file
= x_find_image_file (specified_file
);
8151 if (!STRINGP (file
))
8153 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8158 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8159 if (contents
== NULL
)
8161 image_error ("Error reading `%s'", file
, Qnil
);
8167 end
= contents
+ size
;
8172 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8173 p
= XSTRING (data
)->data
;
8174 end
= p
+ STRING_BYTES (XSTRING (data
));
8177 /* Check magic number. */
8178 if (end
- p
< 2 || *p
++ != 'P')
8180 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8190 raw_p
= 0, type
= PBM_MONO
;
8194 raw_p
= 0, type
= PBM_GRAY
;
8198 raw_p
= 0, type
= PBM_COLOR
;
8202 raw_p
= 1, type
= PBM_MONO
;
8206 raw_p
= 1, type
= PBM_GRAY
;
8210 raw_p
= 1, type
= PBM_COLOR
;
8214 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8218 /* Read width, height, maximum color-component. Characters
8219 starting with `#' up to the end of a line are ignored. */
8220 width
= pbm_scan_number (&p
, end
);
8221 height
= pbm_scan_number (&p
, end
);
8223 if (type
!= PBM_MONO
)
8225 max_color_idx
= pbm_scan_number (&p
, end
);
8226 if (raw_p
&& max_color_idx
> 255)
8227 max_color_idx
= 255;
8232 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8235 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8236 &ximg
, &img
->pixmap
))
8239 /* Initialize the color hash table. */
8240 init_color_table ();
8242 if (type
== PBM_MONO
)
8245 struct image_keyword fmt
[PBM_LAST
];
8246 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8247 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8249 /* Parse the image specification. */
8250 bcopy (pbm_format
, fmt
, sizeof fmt
);
8251 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8253 /* Get foreground and background colors, maybe allocate colors. */
8254 if (fmt
[PBM_FOREGROUND
].count
)
8255 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8256 if (fmt
[PBM_BACKGROUND
].count
)
8257 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8259 for (y
= 0; y
< height
; ++y
)
8260 for (x
= 0; x
< width
; ++x
)
8270 g
= pbm_scan_number (&p
, end
);
8272 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8277 for (y
= 0; y
< height
; ++y
)
8278 for (x
= 0; x
< width
; ++x
)
8282 if (type
== PBM_GRAY
)
8283 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8292 r
= pbm_scan_number (&p
, end
);
8293 g
= pbm_scan_number (&p
, end
);
8294 b
= pbm_scan_number (&p
, end
);
8297 if (r
< 0 || g
< 0 || b
< 0)
8301 XDestroyImage (ximg
);
8302 image_error ("Invalid pixel value in image `%s'",
8307 /* RGB values are now in the range 0..max_color_idx.
8308 Scale this to the range 0..0xffff supported by X. */
8309 r
= (double) r
* 65535 / max_color_idx
;
8310 g
= (double) g
* 65535 / max_color_idx
;
8311 b
= (double) b
* 65535 / max_color_idx
;
8312 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8316 /* Store in IMG->colors the colors allocated for the image, and
8317 free the color table. */
8318 img
->colors
= colors_in_color_table (&img
->ncolors
);
8319 free_color_table ();
8321 /* Put the image into a pixmap. */
8322 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8323 x_destroy_x_image (ximg
);
8326 img
->height
= height
;
8335 /***********************************************************************
8337 ***********************************************************************/
8343 /* Function prototypes. */
8345 static int png_image_p
P_ ((Lisp_Object object
));
8346 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8348 /* The symbol `png' identifying images of this type. */
8352 /* Indices of image specification fields in png_format, below. */
8354 enum png_keyword_index
8368 /* Vector of image_keyword structures describing the format
8369 of valid user-defined image specifications. */
8371 static struct image_keyword png_format
[PNG_LAST
] =
8373 {":type", IMAGE_SYMBOL_VALUE
, 1},
8374 {":data", IMAGE_STRING_VALUE
, 0},
8375 {":file", IMAGE_STRING_VALUE
, 0},
8376 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8377 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8378 {":relief", IMAGE_INTEGER_VALUE
, 0},
8379 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8380 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8381 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8384 /* Structure describing the image type `png'. */
8386 static struct image_type png_type
=
8396 /* Return non-zero if OBJECT is a valid PNG image specification. */
8399 png_image_p (object
)
8402 struct image_keyword fmt
[PNG_LAST
];
8403 bcopy (png_format
, fmt
, sizeof fmt
);
8405 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8408 /* Must specify either the :data or :file keyword. */
8409 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8413 /* Error and warning handlers installed when the PNG library
8417 my_png_error (png_ptr
, msg
)
8418 png_struct
*png_ptr
;
8421 xassert (png_ptr
!= NULL
);
8422 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8423 longjmp (png_ptr
->jmpbuf
, 1);
8428 my_png_warning (png_ptr
, msg
)
8429 png_struct
*png_ptr
;
8432 xassert (png_ptr
!= NULL
);
8433 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8436 /* Memory source for PNG decoding. */
8438 struct png_memory_storage
8440 unsigned char *bytes
; /* The data */
8441 size_t len
; /* How big is it? */
8442 int index
; /* Where are we? */
8446 /* Function set as reader function when reading PNG image from memory.
8447 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8448 bytes from the input to DATA. */
8451 png_read_from_memory (png_ptr
, data
, length
)
8452 png_structp png_ptr
;
8456 struct png_memory_storage
*tbr
8457 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8459 if (length
> tbr
->len
- tbr
->index
)
8460 png_error (png_ptr
, "Read error");
8462 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8463 tbr
->index
= tbr
->index
+ length
;
8466 /* Load PNG image IMG for use on frame F. Value is non-zero if
8474 Lisp_Object file
, specified_file
;
8475 Lisp_Object specified_data
;
8477 XImage
*ximg
, *mask_img
= NULL
;
8478 struct gcpro gcpro1
;
8479 png_struct
*png_ptr
= NULL
;
8480 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8481 FILE *volatile fp
= NULL
;
8483 png_byte
* volatile pixels
= NULL
;
8484 png_byte
** volatile rows
= NULL
;
8485 png_uint_32 width
, height
;
8486 int bit_depth
, color_type
, interlace_type
;
8488 png_uint_32 row_bytes
;
8491 double screen_gamma
, image_gamma
;
8493 struct png_memory_storage tbr
; /* Data to be read */
8495 /* Find out what file to load. */
8496 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8497 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8501 if (NILP (specified_data
))
8503 file
= x_find_image_file (specified_file
);
8504 if (!STRINGP (file
))
8506 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8511 /* Open the image file. */
8512 fp
= fopen (XSTRING (file
)->data
, "rb");
8515 image_error ("Cannot open image file `%s'", file
, Qnil
);
8521 /* Check PNG signature. */
8522 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8523 || !png_check_sig (sig
, sizeof sig
))
8525 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8533 /* Read from memory. */
8534 tbr
.bytes
= XSTRING (specified_data
)->data
;
8535 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8538 /* Check PNG signature. */
8539 if (tbr
.len
< sizeof sig
8540 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8542 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8547 /* Need to skip past the signature. */
8548 tbr
.bytes
+= sizeof (sig
);
8551 /* Initialize read and info structs for PNG lib. */
8552 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8553 my_png_error
, my_png_warning
);
8556 if (fp
) fclose (fp
);
8561 info_ptr
= png_create_info_struct (png_ptr
);
8564 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8565 if (fp
) fclose (fp
);
8570 end_info
= png_create_info_struct (png_ptr
);
8573 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8574 if (fp
) fclose (fp
);
8579 /* Set error jump-back. We come back here when the PNG library
8580 detects an error. */
8581 if (setjmp (png_ptr
->jmpbuf
))
8585 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8588 if (fp
) fclose (fp
);
8593 /* Read image info. */
8594 if (!NILP (specified_data
))
8595 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8597 png_init_io (png_ptr
, fp
);
8599 png_set_sig_bytes (png_ptr
, sizeof sig
);
8600 png_read_info (png_ptr
, info_ptr
);
8601 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8602 &interlace_type
, NULL
, NULL
);
8604 /* If image contains simply transparency data, we prefer to
8605 construct a clipping mask. */
8606 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8611 /* This function is easier to write if we only have to handle
8612 one data format: RGB or RGBA with 8 bits per channel. Let's
8613 transform other formats into that format. */
8615 /* Strip more than 8 bits per channel. */
8616 if (bit_depth
== 16)
8617 png_set_strip_16 (png_ptr
);
8619 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8621 png_set_expand (png_ptr
);
8623 /* Convert grayscale images to RGB. */
8624 if (color_type
== PNG_COLOR_TYPE_GRAY
8625 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8626 png_set_gray_to_rgb (png_ptr
);
8628 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8629 gamma_str
= getenv ("SCREEN_GAMMA");
8630 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8632 /* Tell the PNG lib to handle gamma correction for us. */
8634 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8635 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8636 /* There is a special chunk in the image specifying the gamma. */
8637 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8640 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8641 /* Image contains gamma information. */
8642 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8644 /* Use a default of 0.5 for the image gamma. */
8645 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8647 /* Handle alpha channel by combining the image with a background
8648 color. Do this only if a real alpha channel is supplied. For
8649 simple transparency, we prefer a clipping mask. */
8652 png_color_16
*image_background
;
8654 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8655 /* Image contains a background color with which to
8656 combine the image. */
8657 png_set_background (png_ptr
, image_background
,
8658 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8661 /* Image does not contain a background color with which
8662 to combine the image data via an alpha channel. Use
8663 the frame's background instead. */
8666 png_color_16 frame_background
;
8668 cmap
= FRAME_X_COLORMAP (f
);
8669 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8670 x_query_color (f
, &color
);
8672 bzero (&frame_background
, sizeof frame_background
);
8673 frame_background
.red
= color
.red
;
8674 frame_background
.green
= color
.green
;
8675 frame_background
.blue
= color
.blue
;
8677 png_set_background (png_ptr
, &frame_background
,
8678 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8682 /* Update info structure. */
8683 png_read_update_info (png_ptr
, info_ptr
);
8685 /* Get number of channels. Valid values are 1 for grayscale images
8686 and images with a palette, 2 for grayscale images with transparency
8687 information (alpha channel), 3 for RGB images, and 4 for RGB
8688 images with alpha channel, i.e. RGBA. If conversions above were
8689 sufficient we should only have 3 or 4 channels here. */
8690 channels
= png_get_channels (png_ptr
, info_ptr
);
8691 xassert (channels
== 3 || channels
== 4);
8693 /* Number of bytes needed for one row of the image. */
8694 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8696 /* Allocate memory for the image. */
8697 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8698 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8699 for (i
= 0; i
< height
; ++i
)
8700 rows
[i
] = pixels
+ i
* row_bytes
;
8702 /* Read the entire image. */
8703 png_read_image (png_ptr
, rows
);
8704 png_read_end (png_ptr
, info_ptr
);
8711 /* Create the X image and pixmap. */
8712 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8716 /* Create an image and pixmap serving as mask if the PNG image
8717 contains an alpha channel. */
8720 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8721 &mask_img
, &img
->mask
))
8723 x_destroy_x_image (ximg
);
8724 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8729 /* Fill the X image and mask from PNG data. */
8730 init_color_table ();
8732 for (y
= 0; y
< height
; ++y
)
8734 png_byte
*p
= rows
[y
];
8736 for (x
= 0; x
< width
; ++x
)
8743 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8745 /* An alpha channel, aka mask channel, associates variable
8746 transparency with an image. Where other image formats
8747 support binary transparency---fully transparent or fully
8748 opaque---PNG allows up to 254 levels of partial transparency.
8749 The PNG library implements partial transparency by combining
8750 the image with a specified background color.
8752 I'm not sure how to handle this here nicely: because the
8753 background on which the image is displayed may change, for
8754 real alpha channel support, it would be necessary to create
8755 a new image for each possible background.
8757 What I'm doing now is that a mask is created if we have
8758 boolean transparency information. Otherwise I'm using
8759 the frame's background color to combine the image with. */
8764 XPutPixel (mask_img
, x
, y
, *p
> 0);
8770 /* Remember colors allocated for this image. */
8771 img
->colors
= colors_in_color_table (&img
->ncolors
);
8772 free_color_table ();
8775 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8780 img
->height
= height
;
8782 /* Put the image into the pixmap, then free the X image and its buffer. */
8783 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8784 x_destroy_x_image (ximg
);
8786 /* Same for the mask. */
8789 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8790 x_destroy_x_image (mask_img
);
8797 #endif /* HAVE_PNG != 0 */
8801 /***********************************************************************
8803 ***********************************************************************/
8807 /* Work around a warning about HAVE_STDLIB_H being redefined in
8809 #ifdef HAVE_STDLIB_H
8810 #define HAVE_STDLIB_H_1
8811 #undef HAVE_STDLIB_H
8812 #endif /* HAVE_STLIB_H */
8814 #include <jpeglib.h>
8818 #ifdef HAVE_STLIB_H_1
8819 #define HAVE_STDLIB_H 1
8822 static int jpeg_image_p
P_ ((Lisp_Object object
));
8823 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8825 /* The symbol `jpeg' identifying images of this type. */
8829 /* Indices of image specification fields in gs_format, below. */
8831 enum jpeg_keyword_index
8840 JPEG_HEURISTIC_MASK
,
8845 /* Vector of image_keyword structures describing the format
8846 of valid user-defined image specifications. */
8848 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8850 {":type", IMAGE_SYMBOL_VALUE
, 1},
8851 {":data", IMAGE_STRING_VALUE
, 0},
8852 {":file", IMAGE_STRING_VALUE
, 0},
8853 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8854 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8855 {":relief", IMAGE_INTEGER_VALUE
, 0},
8856 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8857 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8858 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8861 /* Structure describing the image type `jpeg'. */
8863 static struct image_type jpeg_type
=
8873 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8876 jpeg_image_p (object
)
8879 struct image_keyword fmt
[JPEG_LAST
];
8881 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8883 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8886 /* Must specify either the :data or :file keyword. */
8887 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8891 struct my_jpeg_error_mgr
8893 struct jpeg_error_mgr pub
;
8894 jmp_buf setjmp_buffer
;
8899 my_error_exit (cinfo
)
8902 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8903 longjmp (mgr
->setjmp_buffer
, 1);
8907 /* Init source method for JPEG data source manager. Called by
8908 jpeg_read_header() before any data is actually read. See
8909 libjpeg.doc from the JPEG lib distribution. */
8912 our_init_source (cinfo
)
8913 j_decompress_ptr cinfo
;
8918 /* Fill input buffer method for JPEG data source manager. Called
8919 whenever more data is needed. We read the whole image in one step,
8920 so this only adds a fake end of input marker at the end. */
8923 our_fill_input_buffer (cinfo
)
8924 j_decompress_ptr cinfo
;
8926 /* Insert a fake EOI marker. */
8927 struct jpeg_source_mgr
*src
= cinfo
->src
;
8928 static JOCTET buffer
[2];
8930 buffer
[0] = (JOCTET
) 0xFF;
8931 buffer
[1] = (JOCTET
) JPEG_EOI
;
8933 src
->next_input_byte
= buffer
;
8934 src
->bytes_in_buffer
= 2;
8939 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8940 is the JPEG data source manager. */
8943 our_skip_input_data (cinfo
, num_bytes
)
8944 j_decompress_ptr cinfo
;
8947 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8951 if (num_bytes
> src
->bytes_in_buffer
)
8952 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8954 src
->bytes_in_buffer
-= num_bytes
;
8955 src
->next_input_byte
+= num_bytes
;
8960 /* Method to terminate data source. Called by
8961 jpeg_finish_decompress() after all data has been processed. */
8964 our_term_source (cinfo
)
8965 j_decompress_ptr cinfo
;
8970 /* Set up the JPEG lib for reading an image from DATA which contains
8971 LEN bytes. CINFO is the decompression info structure created for
8972 reading the image. */
8975 jpeg_memory_src (cinfo
, data
, len
)
8976 j_decompress_ptr cinfo
;
8980 struct jpeg_source_mgr
*src
;
8982 if (cinfo
->src
== NULL
)
8984 /* First time for this JPEG object? */
8985 cinfo
->src
= (struct jpeg_source_mgr
*)
8986 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8987 sizeof (struct jpeg_source_mgr
));
8988 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8989 src
->next_input_byte
= data
;
8992 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8993 src
->init_source
= our_init_source
;
8994 src
->fill_input_buffer
= our_fill_input_buffer
;
8995 src
->skip_input_data
= our_skip_input_data
;
8996 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
8997 src
->term_source
= our_term_source
;
8998 src
->bytes_in_buffer
= len
;
8999 src
->next_input_byte
= data
;
9003 /* Load image IMG for use on frame F. Patterned after example.c
9004 from the JPEG lib. */
9011 struct jpeg_decompress_struct cinfo
;
9012 struct my_jpeg_error_mgr mgr
;
9013 Lisp_Object file
, specified_file
;
9014 Lisp_Object specified_data
;
9015 FILE * volatile fp
= NULL
;
9017 int row_stride
, x
, y
;
9018 XImage
*ximg
= NULL
;
9020 unsigned long *colors
;
9022 struct gcpro gcpro1
;
9024 /* Open the JPEG file. */
9025 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9026 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9030 if (NILP (specified_data
))
9032 file
= x_find_image_file (specified_file
);
9033 if (!STRINGP (file
))
9035 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9040 fp
= fopen (XSTRING (file
)->data
, "r");
9043 image_error ("Cannot open `%s'", file
, Qnil
);
9049 /* Customize libjpeg's error handling to call my_error_exit when an
9050 error is detected. This function will perform a longjmp. */
9051 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
9052 mgr
.pub
.error_exit
= my_error_exit
;
9054 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
9058 /* Called from my_error_exit. Display a JPEG error. */
9059 char buffer
[JMSG_LENGTH_MAX
];
9060 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
9061 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
9062 build_string (buffer
));
9065 /* Close the input file and destroy the JPEG object. */
9067 fclose ((FILE *) fp
);
9068 jpeg_destroy_decompress (&cinfo
);
9070 /* If we already have an XImage, free that. */
9071 x_destroy_x_image (ximg
);
9073 /* Free pixmap and colors. */
9074 x_clear_image (f
, img
);
9080 /* Create the JPEG decompression object. Let it read from fp.
9081 Read the JPEG image header. */
9082 jpeg_create_decompress (&cinfo
);
9084 if (NILP (specified_data
))
9085 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9087 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9088 STRING_BYTES (XSTRING (specified_data
)));
9090 jpeg_read_header (&cinfo
, TRUE
);
9092 /* Customize decompression so that color quantization will be used.
9093 Start decompression. */
9094 cinfo
.quantize_colors
= TRUE
;
9095 jpeg_start_decompress (&cinfo
);
9096 width
= img
->width
= cinfo
.output_width
;
9097 height
= img
->height
= cinfo
.output_height
;
9099 /* Create X image and pixmap. */
9100 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9101 longjmp (mgr
.setjmp_buffer
, 2);
9103 /* Allocate colors. When color quantization is used,
9104 cinfo.actual_number_of_colors has been set with the number of
9105 colors generated, and cinfo.colormap is a two-dimensional array
9106 of color indices in the range 0..cinfo.actual_number_of_colors.
9107 No more than 255 colors will be generated. */
9111 if (cinfo
.out_color_components
> 2)
9112 ir
= 0, ig
= 1, ib
= 2;
9113 else if (cinfo
.out_color_components
> 1)
9114 ir
= 0, ig
= 1, ib
= 0;
9116 ir
= 0, ig
= 0, ib
= 0;
9118 /* Use the color table mechanism because it handles colors that
9119 cannot be allocated nicely. Such colors will be replaced with
9120 a default color, and we don't have to care about which colors
9121 can be freed safely, and which can't. */
9122 init_color_table ();
9123 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9126 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9128 /* Multiply RGB values with 255 because X expects RGB values
9129 in the range 0..0xffff. */
9130 int r
= cinfo
.colormap
[ir
][i
] << 8;
9131 int g
= cinfo
.colormap
[ig
][i
] << 8;
9132 int b
= cinfo
.colormap
[ib
][i
] << 8;
9133 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9136 /* Remember those colors actually allocated. */
9137 img
->colors
= colors_in_color_table (&img
->ncolors
);
9138 free_color_table ();
9142 row_stride
= width
* cinfo
.output_components
;
9143 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9145 for (y
= 0; y
< height
; ++y
)
9147 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9148 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9149 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9153 jpeg_finish_decompress (&cinfo
);
9154 jpeg_destroy_decompress (&cinfo
);
9156 fclose ((FILE *) fp
);
9158 /* Put the image into the pixmap. */
9159 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9160 x_destroy_x_image (ximg
);
9165 #endif /* HAVE_JPEG */
9169 /***********************************************************************
9171 ***********************************************************************/
9177 static int tiff_image_p
P_ ((Lisp_Object object
));
9178 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9180 /* The symbol `tiff' identifying images of this type. */
9184 /* Indices of image specification fields in tiff_format, below. */
9186 enum tiff_keyword_index
9195 TIFF_HEURISTIC_MASK
,
9200 /* Vector of image_keyword structures describing the format
9201 of valid user-defined image specifications. */
9203 static struct image_keyword tiff_format
[TIFF_LAST
] =
9205 {":type", IMAGE_SYMBOL_VALUE
, 1},
9206 {":data", IMAGE_STRING_VALUE
, 0},
9207 {":file", IMAGE_STRING_VALUE
, 0},
9208 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9209 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9210 {":relief", IMAGE_INTEGER_VALUE
, 0},
9211 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9212 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9213 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9216 /* Structure describing the image type `tiff'. */
9218 static struct image_type tiff_type
=
9228 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9231 tiff_image_p (object
)
9234 struct image_keyword fmt
[TIFF_LAST
];
9235 bcopy (tiff_format
, fmt
, sizeof fmt
);
9237 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9240 /* Must specify either the :data or :file keyword. */
9241 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9245 /* Reading from a memory buffer for TIFF images Based on the PNG
9246 memory source, but we have to provide a lot of extra functions.
9249 We really only need to implement read and seek, but I am not
9250 convinced that the TIFF library is smart enough not to destroy
9251 itself if we only hand it the function pointers we need to
9256 unsigned char *bytes
;
9264 tiff_read_from_memory (data
, buf
, size
)
9269 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9271 if (size
> src
->len
- src
->index
)
9273 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9280 tiff_write_from_memory (data
, buf
, size
)
9290 tiff_seek_in_memory (data
, off
, whence
)
9295 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9300 case SEEK_SET
: /* Go from beginning of source. */
9304 case SEEK_END
: /* Go from end of source. */
9305 idx
= src
->len
+ off
;
9308 case SEEK_CUR
: /* Go from current position. */
9309 idx
= src
->index
+ off
;
9312 default: /* Invalid `whence'. */
9316 if (idx
> src
->len
|| idx
< 0)
9325 tiff_close_memory (data
)
9334 tiff_mmap_memory (data
, pbase
, psize
)
9339 /* It is already _IN_ memory. */
9345 tiff_unmap_memory (data
, base
, size
)
9350 /* We don't need to do this. */
9355 tiff_size_of_memory (data
)
9358 return ((tiff_memory_source
*) data
)->len
;
9362 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9370 Lisp_Object file
, specified_file
;
9371 Lisp_Object specified_data
;
9373 int width
, height
, x
, y
;
9377 struct gcpro gcpro1
;
9378 tiff_memory_source memsrc
;
9380 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9381 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9385 if (NILP (specified_data
))
9387 /* Read from a file */
9388 file
= x_find_image_file (specified_file
);
9389 if (!STRINGP (file
))
9391 image_error ("Cannot find image file `%s'", file
, Qnil
);
9396 /* Try to open the image file. */
9397 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9400 image_error ("Cannot open `%s'", file
, Qnil
);
9407 /* Memory source! */
9408 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9409 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9412 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9413 (TIFFReadWriteProc
) tiff_read_from_memory
,
9414 (TIFFReadWriteProc
) tiff_write_from_memory
,
9415 tiff_seek_in_memory
,
9417 tiff_size_of_memory
,
9423 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9429 /* Get width and height of the image, and allocate a raster buffer
9430 of width x height 32-bit values. */
9431 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9432 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9433 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9435 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9439 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9445 /* Create the X image and pixmap. */
9446 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9453 /* Initialize the color table. */
9454 init_color_table ();
9456 /* Process the pixel raster. Origin is in the lower-left corner. */
9457 for (y
= 0; y
< height
; ++y
)
9459 uint32
*row
= buf
+ y
* width
;
9461 for (x
= 0; x
< width
; ++x
)
9463 uint32 abgr
= row
[x
];
9464 int r
= TIFFGetR (abgr
) << 8;
9465 int g
= TIFFGetG (abgr
) << 8;
9466 int b
= TIFFGetB (abgr
) << 8;
9467 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9471 /* Remember the colors allocated for the image. Free the color table. */
9472 img
->colors
= colors_in_color_table (&img
->ncolors
);
9473 free_color_table ();
9475 /* Put the image into the pixmap, then free the X image and its buffer. */
9476 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9477 x_destroy_x_image (ximg
);
9481 img
->height
= height
;
9487 #endif /* HAVE_TIFF != 0 */
9491 /***********************************************************************
9493 ***********************************************************************/
9497 #include <gif_lib.h>
9499 static int gif_image_p
P_ ((Lisp_Object object
));
9500 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9502 /* The symbol `gif' identifying images of this type. */
9506 /* Indices of image specification fields in gif_format, below. */
9508 enum gif_keyword_index
9523 /* Vector of image_keyword structures describing the format
9524 of valid user-defined image specifications. */
9526 static struct image_keyword gif_format
[GIF_LAST
] =
9528 {":type", IMAGE_SYMBOL_VALUE
, 1},
9529 {":data", IMAGE_STRING_VALUE
, 0},
9530 {":file", IMAGE_STRING_VALUE
, 0},
9531 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9532 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9533 {":relief", IMAGE_INTEGER_VALUE
, 0},
9534 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9535 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9536 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9537 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9540 /* Structure describing the image type `gif'. */
9542 static struct image_type gif_type
=
9552 /* Return non-zero if OBJECT is a valid GIF image specification. */
9555 gif_image_p (object
)
9558 struct image_keyword fmt
[GIF_LAST
];
9559 bcopy (gif_format
, fmt
, sizeof fmt
);
9561 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9564 /* Must specify either the :data or :file keyword. */
9565 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9569 /* Reading a GIF image from memory
9570 Based on the PNG memory stuff to a certain extent. */
9574 unsigned char *bytes
;
9581 /* Make the current memory source available to gif_read_from_memory.
9582 It's done this way because not all versions of libungif support
9583 a UserData field in the GifFileType structure. */
9584 static gif_memory_source
*current_gif_memory_src
;
9587 gif_read_from_memory (file
, buf
, len
)
9592 gif_memory_source
*src
= current_gif_memory_src
;
9594 if (len
> src
->len
- src
->index
)
9597 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9603 /* Load GIF image IMG for use on frame F. Value is non-zero if
9611 Lisp_Object file
, specified_file
;
9612 Lisp_Object specified_data
;
9613 int rc
, width
, height
, x
, y
, i
;
9615 ColorMapObject
*gif_color_map
;
9616 unsigned long pixel_colors
[256];
9618 struct gcpro gcpro1
;
9620 int ino
, image_left
, image_top
, image_width
, image_height
;
9621 gif_memory_source memsrc
;
9622 unsigned char *raster
;
9624 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9625 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9629 if (NILP (specified_data
))
9631 file
= x_find_image_file (specified_file
);
9632 if (!STRINGP (file
))
9634 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9639 /* Open the GIF file. */
9640 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9643 image_error ("Cannot open `%s'", file
, Qnil
);
9650 /* Read from memory! */
9651 current_gif_memory_src
= &memsrc
;
9652 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9653 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9656 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9659 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9665 /* Read entire contents. */
9666 rc
= DGifSlurp (gif
);
9667 if (rc
== GIF_ERROR
)
9669 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9670 DGifCloseFile (gif
);
9675 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9676 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9677 if (ino
>= gif
->ImageCount
)
9679 image_error ("Invalid image number `%s' in image `%s'",
9681 DGifCloseFile (gif
);
9686 width
= img
->width
= gif
->SWidth
;
9687 height
= img
->height
= gif
->SHeight
;
9689 /* Create the X image and pixmap. */
9690 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9692 DGifCloseFile (gif
);
9697 /* Allocate colors. */
9698 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9700 gif_color_map
= gif
->SColorMap
;
9701 init_color_table ();
9702 bzero (pixel_colors
, sizeof pixel_colors
);
9704 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9706 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9707 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9708 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9709 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9712 img
->colors
= colors_in_color_table (&img
->ncolors
);
9713 free_color_table ();
9715 /* Clear the part of the screen image that are not covered by
9716 the image from the GIF file. Full animated GIF support
9717 requires more than can be done here (see the gif89 spec,
9718 disposal methods). Let's simply assume that the part
9719 not covered by a sub-image is in the frame's background color. */
9720 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9721 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9722 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9723 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9725 for (y
= 0; y
< image_top
; ++y
)
9726 for (x
= 0; x
< width
; ++x
)
9727 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9729 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9730 for (x
= 0; x
< width
; ++x
)
9731 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9733 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9735 for (x
= 0; x
< image_left
; ++x
)
9736 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9737 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9738 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9741 /* Read the GIF image into the X image. We use a local variable
9742 `raster' here because RasterBits below is a char *, and invites
9743 problems with bytes >= 0x80. */
9744 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9746 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9748 static int interlace_start
[] = {0, 4, 2, 1};
9749 static int interlace_increment
[] = {8, 8, 4, 2};
9751 int row
= interlace_start
[0];
9755 for (y
= 0; y
< image_height
; y
++)
9757 if (row
>= image_height
)
9759 row
= interlace_start
[++pass
];
9760 while (row
>= image_height
)
9761 row
= interlace_start
[++pass
];
9764 for (x
= 0; x
< image_width
; x
++)
9766 int i
= raster
[(y
* image_width
) + x
];
9767 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9771 row
+= interlace_increment
[pass
];
9776 for (y
= 0; y
< image_height
; ++y
)
9777 for (x
= 0; x
< image_width
; ++x
)
9779 int i
= raster
[y
* image_width
+ x
];
9780 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9784 DGifCloseFile (gif
);
9786 /* Put the image into the pixmap, then free the X image and its buffer. */
9787 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9788 x_destroy_x_image (ximg
);
9794 #endif /* HAVE_GIF != 0 */
9798 /***********************************************************************
9800 ***********************************************************************/
9802 static int gs_image_p
P_ ((Lisp_Object object
));
9803 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9804 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9806 /* The symbol `postscript' identifying images of this type. */
9808 Lisp_Object Qpostscript
;
9810 /* Keyword symbols. */
9812 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9814 /* Indices of image specification fields in gs_format, below. */
9816 enum gs_keyword_index
9833 /* Vector of image_keyword structures describing the format
9834 of valid user-defined image specifications. */
9836 static struct image_keyword gs_format
[GS_LAST
] =
9838 {":type", IMAGE_SYMBOL_VALUE
, 1},
9839 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9840 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9841 {":file", IMAGE_STRING_VALUE
, 1},
9842 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9843 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9844 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9845 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9846 {":relief", IMAGE_INTEGER_VALUE
, 0},
9847 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9848 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9849 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9852 /* Structure describing the image type `ghostscript'. */
9854 static struct image_type gs_type
=
9864 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9867 gs_clear_image (f
, img
)
9871 /* IMG->data.ptr_val may contain a recorded colormap. */
9872 xfree (img
->data
.ptr_val
);
9873 x_clear_image (f
, img
);
9877 /* Return non-zero if OBJECT is a valid Ghostscript image
9884 struct image_keyword fmt
[GS_LAST
];
9888 bcopy (gs_format
, fmt
, sizeof fmt
);
9890 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
9893 /* Bounding box must be a list or vector containing 4 integers. */
9894 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9897 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9898 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9903 else if (VECTORP (tem
))
9905 if (XVECTOR (tem
)->size
!= 4)
9907 for (i
= 0; i
< 4; ++i
)
9908 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9918 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9927 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9928 struct gcpro gcpro1
, gcpro2
;
9930 double in_width
, in_height
;
9931 Lisp_Object pixel_colors
= Qnil
;
9933 /* Compute pixel size of pixmap needed from the given size in the
9934 image specification. Sizes in the specification are in pt. 1 pt
9935 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9937 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9938 in_width
= XFASTINT (pt_width
) / 72.0;
9939 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9940 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9941 in_height
= XFASTINT (pt_height
) / 72.0;
9942 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9944 /* Create the pixmap. */
9945 xassert (img
->pixmap
== None
);
9946 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9947 img
->width
, img
->height
,
9948 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9952 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9956 /* Call the loader to fill the pixmap. It returns a process object
9957 if successful. We do not record_unwind_protect here because
9958 other places in redisplay like calling window scroll functions
9959 don't either. Let the Lisp loader use `unwind-protect' instead. */
9960 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9962 sprintf (buffer
, "%lu %lu",
9963 (unsigned long) FRAME_X_WINDOW (f
),
9964 (unsigned long) img
->pixmap
);
9965 window_and_pixmap_id
= build_string (buffer
);
9967 sprintf (buffer
, "%lu %lu",
9968 FRAME_FOREGROUND_PIXEL (f
),
9969 FRAME_BACKGROUND_PIXEL (f
));
9970 pixel_colors
= build_string (buffer
);
9972 XSETFRAME (frame
, f
);
9973 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9975 loader
= intern ("gs-load-image");
9977 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9978 make_number (img
->width
),
9979 make_number (img
->height
),
9980 window_and_pixmap_id
,
9983 return PROCESSP (img
->data
.lisp_val
);
9987 /* Kill the Ghostscript process that was started to fill PIXMAP on
9988 frame F. Called from XTread_socket when receiving an event
9989 telling Emacs that Ghostscript has finished drawing. */
9992 x_kill_gs_process (pixmap
, f
)
9996 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
10000 /* Find the image containing PIXMAP. */
10001 for (i
= 0; i
< c
->used
; ++i
)
10002 if (c
->images
[i
]->pixmap
== pixmap
)
10005 /* Kill the GS process. We should have found PIXMAP in the image
10006 cache and its image should contain a process object. */
10007 xassert (i
< c
->used
);
10008 img
= c
->images
[i
];
10009 xassert (PROCESSP (img
->data
.lisp_val
));
10010 Fkill_process (img
->data
.lisp_val
, Qnil
);
10011 img
->data
.lisp_val
= Qnil
;
10013 /* On displays with a mutable colormap, figure out the colors
10014 allocated for the image by looking at the pixels of an XImage for
10016 class = FRAME_X_VISUAL (f
)->class;
10017 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
10023 /* Try to get an XImage for img->pixmep. */
10024 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10025 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10030 /* Initialize the color table. */
10031 init_color_table ();
10033 /* For each pixel of the image, look its color up in the
10034 color table. After having done so, the color table will
10035 contain an entry for each color used by the image. */
10036 for (y
= 0; y
< img
->height
; ++y
)
10037 for (x
= 0; x
< img
->width
; ++x
)
10039 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
10040 lookup_pixel_color (f
, pixel
);
10043 /* Record colors in the image. Free color table and XImage. */
10044 img
->colors
= colors_in_color_table (&img
->ncolors
);
10045 free_color_table ();
10046 XDestroyImage (ximg
);
10048 #if 0 /* This doesn't seem to be the case. If we free the colors
10049 here, we get a BadAccess later in x_clear_image when
10050 freeing the colors. */
10051 /* We have allocated colors once, but Ghostscript has also
10052 allocated colors on behalf of us. So, to get the
10053 reference counts right, free them once. */
10055 x_free_colors (f
, img
->colors
, img
->ncolors
);
10059 image_error ("Cannot get X image of `%s'; colors will not be freed",
10068 /***********************************************************************
10070 ***********************************************************************/
10072 DEFUN ("x-change-window-property", Fx_change_window_property
,
10073 Sx_change_window_property
, 2, 3, 0,
10074 "Change window property PROP to VALUE on the X window of FRAME.\n\
10075 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
10076 selected frame. Value is VALUE.")
10077 (prop
, value
, frame
)
10078 Lisp_Object frame
, prop
, value
;
10080 struct frame
*f
= check_x_frame (frame
);
10083 CHECK_STRING (prop
, 1);
10084 CHECK_STRING (value
, 2);
10087 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10088 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10089 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10090 XSTRING (value
)->data
, XSTRING (value
)->size
);
10092 /* Make sure the property is set when we return. */
10093 XFlush (FRAME_X_DISPLAY (f
));
10100 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10101 Sx_delete_window_property
, 1, 2, 0,
10102 "Remove window property PROP from X window of FRAME.\n\
10103 FRAME nil or omitted means use the selected frame. Value is PROP.")
10105 Lisp_Object prop
, frame
;
10107 struct frame
*f
= check_x_frame (frame
);
10110 CHECK_STRING (prop
, 1);
10112 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10113 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10115 /* Make sure the property is removed when we return. */
10116 XFlush (FRAME_X_DISPLAY (f
));
10123 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10125 "Value is the value of window property PROP on FRAME.\n\
10126 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10127 if FRAME hasn't a property with name PROP or if PROP has no string\n\
10130 Lisp_Object prop
, frame
;
10132 struct frame
*f
= check_x_frame (frame
);
10135 Lisp_Object prop_value
= Qnil
;
10136 char *tmp_data
= NULL
;
10139 unsigned long actual_size
, bytes_remaining
;
10141 CHECK_STRING (prop
, 1);
10143 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10144 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10145 prop_atom
, 0, 0, False
, XA_STRING
,
10146 &actual_type
, &actual_format
, &actual_size
,
10147 &bytes_remaining
, (unsigned char **) &tmp_data
);
10150 int size
= bytes_remaining
;
10155 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10156 prop_atom
, 0, bytes_remaining
,
10158 &actual_type
, &actual_format
,
10159 &actual_size
, &bytes_remaining
,
10160 (unsigned char **) &tmp_data
);
10162 prop_value
= make_string (tmp_data
, size
);
10173 /***********************************************************************
10175 ***********************************************************************/
10177 /* If non-null, an asynchronous timer that, when it expires, displays
10178 a busy cursor on all frames. */
10180 static struct atimer
*busy_cursor_atimer
;
10182 /* Non-zero means a busy cursor is currently shown. */
10184 static int busy_cursor_shown_p
;
10186 /* Number of seconds to wait before displaying a busy cursor. */
10188 static Lisp_Object Vbusy_cursor_delay
;
10190 /* Default number of seconds to wait before displaying a busy
10193 #define DEFAULT_BUSY_CURSOR_DELAY 1
10195 /* Function prototypes. */
10197 static void show_busy_cursor
P_ ((struct atimer
*));
10198 static void hide_busy_cursor
P_ ((void));
10201 /* Cancel a currently active busy-cursor timer, and start a new one. */
10204 start_busy_cursor ()
10207 int secs
, usecs
= 0;
10209 cancel_busy_cursor ();
10211 if (INTEGERP (Vbusy_cursor_delay
)
10212 && XINT (Vbusy_cursor_delay
) > 0)
10213 secs
= XFASTINT (Vbusy_cursor_delay
);
10214 else if (FLOATP (Vbusy_cursor_delay
)
10215 && XFLOAT_DATA (Vbusy_cursor_delay
) > 0)
10218 tem
= Ftruncate (Vbusy_cursor_delay
, Qnil
);
10219 secs
= XFASTINT (tem
);
10220 usecs
= (XFLOAT_DATA (Vbusy_cursor_delay
) - secs
) * 1000000;
10223 secs
= DEFAULT_BUSY_CURSOR_DELAY
;
10225 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10226 busy_cursor_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10227 show_busy_cursor
, NULL
);
10231 /* Cancel the busy cursor timer if active, hide a busy cursor if
10235 cancel_busy_cursor ()
10237 if (busy_cursor_atimer
)
10239 cancel_atimer (busy_cursor_atimer
);
10240 busy_cursor_atimer
= NULL
;
10243 if (busy_cursor_shown_p
)
10244 hide_busy_cursor ();
10248 /* Timer function of busy_cursor_atimer. TIMER is equal to
10249 busy_cursor_atimer.
10251 Display a busy cursor on all frames by mapping the frames'
10252 busy_window. Set the busy_p flag in the frames' output_data.x
10253 structure to indicate that a busy cursor is shown on the
10257 show_busy_cursor (timer
)
10258 struct atimer
*timer
;
10260 /* The timer implementation will cancel this timer automatically
10261 after this function has run. Set busy_cursor_atimer to null
10262 so that we know the timer doesn't have to be canceled. */
10263 busy_cursor_atimer
= NULL
;
10265 if (!busy_cursor_shown_p
)
10267 Lisp_Object rest
, frame
;
10271 FOR_EACH_FRAME (rest
, frame
)
10273 struct frame
*f
= XFRAME (frame
);
10275 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
) && FRAME_X_DISPLAY (f
))
10277 Display
*dpy
= FRAME_X_DISPLAY (f
);
10279 #ifdef USE_X_TOOLKIT
10280 if (f
->output_data
.x
->widget
)
10282 if (FRAME_OUTER_WINDOW (f
))
10285 f
->output_data
.x
->busy_p
= 1;
10287 if (!f
->output_data
.x
->busy_window
)
10289 unsigned long mask
= CWCursor
;
10290 XSetWindowAttributes attrs
;
10292 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
10294 f
->output_data
.x
->busy_window
10295 = XCreateWindow (dpy
, FRAME_OUTER_WINDOW (f
),
10296 0, 0, 32000, 32000, 0, 0,
10302 XMapRaised (dpy
, f
->output_data
.x
->busy_window
);
10308 busy_cursor_shown_p
= 1;
10314 /* Hide the busy cursor on all frames, if it is currently shown. */
10317 hide_busy_cursor ()
10319 if (busy_cursor_shown_p
)
10321 Lisp_Object rest
, frame
;
10324 FOR_EACH_FRAME (rest
, frame
)
10326 struct frame
*f
= XFRAME (frame
);
10329 /* Watch out for newly created frames. */
10330 && f
->output_data
.x
->busy_window
)
10332 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10333 /* Sync here because XTread_socket looks at the busy_p flag
10334 that is reset to zero below. */
10335 XSync (FRAME_X_DISPLAY (f
), False
);
10336 f
->output_data
.x
->busy_p
= 0;
10340 busy_cursor_shown_p
= 0;
10347 /***********************************************************************
10349 ***********************************************************************/
10351 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10353 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
10354 Lisp_Object
, int *, int *));
10356 /* The frame of a currently visible tooltip. */
10358 Lisp_Object tip_frame
;
10360 /* If non-nil, a timer started that hides the last tooltip when it
10363 Lisp_Object tip_timer
;
10366 /* If non-nil, a vector of 3 elements containing the last args
10367 with which x-show-tip was called. See there. */
10369 Lisp_Object last_show_tip_args
;
10373 unwind_create_tip_frame (frame
)
10376 Lisp_Object deleted
;
10378 deleted
= unwind_create_frame (frame
);
10379 if (EQ (deleted
, Qt
))
10389 /* Create a frame for a tooltip on the display described by DPYINFO.
10390 PARMS is a list of frame parameters. Value is the frame.
10392 Note that functions called here, esp. x_default_parameter can
10393 signal errors, for instance when a specified color name is
10394 undefined. We have to make sure that we're in a consistent state
10395 when this happens. */
10398 x_create_tip_frame (dpyinfo
, parms
)
10399 struct x_display_info
*dpyinfo
;
10403 Lisp_Object frame
, tem
;
10405 long window_prompting
= 0;
10407 int count
= BINDING_STACK_SIZE ();
10408 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10410 int face_change_count_before
= face_change_count
;
10414 /* Use this general default value to start with until we know if
10415 this frame has a specified name. */
10416 Vx_resource_name
= Vinvocation_name
;
10418 #ifdef MULTI_KBOARD
10419 kb
= dpyinfo
->kboard
;
10421 kb
= &the_only_kboard
;
10424 /* Get the name of the frame to use for resource lookup. */
10425 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10426 if (!STRINGP (name
)
10427 && !EQ (name
, Qunbound
)
10429 error ("Invalid frame name--not a string or nil");
10430 Vx_resource_name
= name
;
10433 GCPRO3 (parms
, name
, frame
);
10434 f
= make_frame (1);
10435 XSETFRAME (frame
, f
);
10436 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10437 record_unwind_protect (unwind_create_tip_frame
, frame
);
10439 /* By setting the output method, we're essentially saying that
10440 the frame is live, as per FRAME_LIVE_P. If we get a signal
10441 from this point on, x_destroy_window might screw up reference
10443 f
->output_method
= output_x_window
;
10444 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10445 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10446 f
->output_data
.x
->icon_bitmap
= -1;
10447 f
->output_data
.x
->fontset
= -1;
10448 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10449 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10450 f
->icon_name
= Qnil
;
10451 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10453 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
10454 dpyinfo_refcount
= dpyinfo
->reference_count
;
10455 #endif /* GLYPH_DEBUG */
10456 #ifdef MULTI_KBOARD
10457 FRAME_KBOARD (f
) = kb
;
10459 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10460 f
->output_data
.x
->explicit_parent
= 0;
10462 /* These colors will be set anyway later, but it's important
10463 to get the color reference counts right, so initialize them! */
10466 struct gcpro gcpro1
;
10468 black
= build_string ("black");
10470 f
->output_data
.x
->foreground_pixel
10471 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10472 f
->output_data
.x
->background_pixel
10473 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10474 f
->output_data
.x
->cursor_pixel
10475 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10476 f
->output_data
.x
->cursor_foreground_pixel
10477 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10478 f
->output_data
.x
->border_pixel
10479 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10480 f
->output_data
.x
->mouse_pixel
10481 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10485 /* Set the name; the functions to which we pass f expect the name to
10487 if (EQ (name
, Qunbound
) || NILP (name
))
10489 f
->name
= build_string (dpyinfo
->x_id_name
);
10490 f
->explicit_name
= 0;
10495 f
->explicit_name
= 1;
10496 /* use the frame's title when getting resources for this frame. */
10497 specbind (Qx_resource_name
, name
);
10500 /* Extract the window parameters from the supplied values that are
10501 needed to determine window geometry. */
10505 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10508 /* First, try whatever font the caller has specified. */
10509 if (STRINGP (font
))
10511 tem
= Fquery_fontset (font
, Qnil
);
10513 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10515 font
= x_new_font (f
, XSTRING (font
)->data
);
10518 /* Try out a font which we hope has bold and italic variations. */
10519 if (!STRINGP (font
))
10520 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10521 if (!STRINGP (font
))
10522 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10523 if (! STRINGP (font
))
10524 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10525 if (! STRINGP (font
))
10526 /* This was formerly the first thing tried, but it finds too many fonts
10527 and takes too long. */
10528 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10529 /* If those didn't work, look for something which will at least work. */
10530 if (! STRINGP (font
))
10531 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10533 if (! STRINGP (font
))
10534 font
= build_string ("fixed");
10536 x_default_parameter (f
, parms
, Qfont
, font
,
10537 "font", "Font", RES_TYPE_STRING
);
10540 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10541 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10543 /* This defaults to 2 in order to match xterm. We recognize either
10544 internalBorderWidth or internalBorder (which is what xterm calls
10546 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10550 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10551 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10552 if (! EQ (value
, Qunbound
))
10553 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10557 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10558 "internalBorderWidth", "internalBorderWidth",
10561 /* Also do the stuff which must be set before the window exists. */
10562 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10563 "foreground", "Foreground", RES_TYPE_STRING
);
10564 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10565 "background", "Background", RES_TYPE_STRING
);
10566 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10567 "pointerColor", "Foreground", RES_TYPE_STRING
);
10568 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10569 "cursorColor", "Foreground", RES_TYPE_STRING
);
10570 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10571 "borderColor", "BorderColor", RES_TYPE_STRING
);
10573 /* Init faces before x_default_parameter is called for scroll-bar
10574 parameters because that function calls x_set_scroll_bar_width,
10575 which calls change_frame_size, which calls Fset_window_buffer,
10576 which runs hooks, which call Fvertical_motion. At the end, we
10577 end up in init_iterator with a null face cache, which should not
10579 init_frame_faces (f
);
10581 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10582 window_prompting
= x_figure_window_size (f
, parms
);
10584 if (window_prompting
& XNegative
)
10586 if (window_prompting
& YNegative
)
10587 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10589 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10593 if (window_prompting
& YNegative
)
10594 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10596 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10599 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10601 XSetWindowAttributes attrs
;
10602 unsigned long mask
;
10605 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10606 if (DoesSaveUnders (dpyinfo
->screen
))
10607 mask
|= CWSaveUnder
;
10609 /* Window managers look at the override-redirect flag to determine
10610 whether or net to give windows a decoration (Xlib spec, chapter
10612 attrs
.override_redirect
= True
;
10613 attrs
.save_under
= True
;
10614 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10615 /* Arrange for getting MapNotify and UnmapNotify events. */
10616 attrs
.event_mask
= StructureNotifyMask
;
10618 = FRAME_X_WINDOW (f
)
10619 = XCreateWindow (FRAME_X_DISPLAY (f
),
10620 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10621 /* x, y, width, height */
10625 CopyFromParent
, InputOutput
, CopyFromParent
,
10632 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10633 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10634 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10635 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10636 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10637 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10639 /* Dimensions, especially f->height, must be done via change_frame_size.
10640 Change will not be effected unless different from the current
10643 height
= f
->height
;
10645 SET_FRAME_WIDTH (f
, 0);
10646 change_frame_size (f
, height
, width
, 1, 0, 0);
10648 /* Set up faces after all frame parameters are known. This call
10649 also merges in face attributes specified for new frames. If we
10650 don't do this, the `menu' face for instance won't have the right
10651 colors, and the menu bar won't appear in the specified colors for
10653 call1 (Qface_set_after_frame_default
, frame
);
10659 /* It is now ok to make the frame official even if we get an error
10660 below. And the frame needs to be on Vframe_list or making it
10661 visible won't work. */
10662 Vframe_list
= Fcons (frame
, Vframe_list
);
10665 /* Now that the frame is official, it counts as a reference to
10667 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10669 /* Setting attributes of faces of the tooltip frame from resources
10670 and similar will increment face_change_count, which leads to the
10671 clearing of all current matrices. Since this isn't necessary
10672 here, avoid it by resetting face_change_count to the value it
10673 had before we created the tip frame. */
10674 face_change_count
= face_change_count_before
;
10676 /* Discard the unwind_protect. */
10677 return unbind_to (count
, frame
);
10681 /* Compute where to display tip frame F. PARMS is the list of frame
10682 parameters for F. DX and DY are specified offsets from the current
10683 location of the mouse. Return coordinates relative to the root
10684 window of the display in *ROOT_X, and *ROOT_Y. */
10687 compute_tip_xy (f
, parms
, dx
, dy
, root_x
, root_y
)
10689 Lisp_Object parms
, dx
, dy
;
10690 int *root_x
, *root_y
;
10692 Lisp_Object left
, top
;
10694 Window root
, child
;
10697 /* User-specified position? */
10698 left
= Fcdr (Fassq (Qleft
, parms
));
10699 top
= Fcdr (Fassq (Qtop
, parms
));
10701 /* Move the tooltip window where the mouse pointer is. Resize and
10704 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10705 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
10708 *root_x
+= XINT (dx
);
10709 *root_y
+= XINT (dy
);
10711 if (INTEGERP (left
))
10712 *root_x
= XINT (left
);
10713 if (INTEGERP (top
))
10714 *root_y
= XINT (top
);
10718 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10719 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10720 A tooltip window is a small X window displaying a string.\n\
10722 FRAME nil or omitted means use the selected frame.\n\
10724 PARMS is an optional list of frame parameters which can be\n\
10725 used to change the tooltip's appearance.\n\
10727 Automatically hide the tooltip after TIMEOUT seconds.\n\
10728 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10730 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10731 the tooltip is displayed at that x-position. Otherwise it is\n\
10732 displayed at the mouse position, with offset DX added (default is 5 if\n\
10733 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10734 parameter is specified, it determines the y-position of the tooltip\n\
10735 window, otherwise it is displayed at the mouse position, with offset\n\
10736 DY added (default is -10).")
10737 (string
, frame
, parms
, timeout
, dx
, dy
)
10738 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10742 Lisp_Object buffer
, top
, left
;
10743 int root_x
, root_y
;
10744 struct buffer
*old_buffer
;
10745 struct text_pos pos
;
10746 int i
, width
, height
;
10747 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10748 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10749 int count
= BINDING_STACK_SIZE ();
10751 specbind (Qinhibit_redisplay
, Qt
);
10753 GCPRO4 (string
, parms
, frame
, timeout
);
10755 CHECK_STRING (string
, 0);
10756 f
= check_x_frame (frame
);
10757 if (NILP (timeout
))
10758 timeout
= make_number (5);
10760 CHECK_NATNUM (timeout
, 2);
10763 dx
= make_number (5);
10765 CHECK_NUMBER (dx
, 5);
10768 dy
= make_number (-10);
10770 CHECK_NUMBER (dy
, 6);
10772 if (NILP (last_show_tip_args
))
10773 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
10775 if (!NILP (tip_frame
))
10777 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
10778 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
10779 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
10781 if (EQ (frame
, last_frame
)
10782 && !NILP (Fequal (last_string
, string
))
10783 && !NILP (Fequal (last_parms
, parms
)))
10785 struct frame
*f
= XFRAME (tip_frame
);
10787 /* Only DX and DY have changed. */
10788 if (!NILP (tip_timer
))
10789 call1 (intern ("cancel-timer"), tip_timer
);
10792 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
10793 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10794 root_x
, root_y
- PIXEL_HEIGHT (f
));
10800 /* Hide a previous tip, if any. */
10803 ASET (last_show_tip_args
, 0, string
);
10804 ASET (last_show_tip_args
, 1, frame
);
10805 ASET (last_show_tip_args
, 2, parms
);
10807 /* Add default values to frame parameters. */
10808 if (NILP (Fassq (Qname
, parms
)))
10809 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10810 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10811 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10812 if (NILP (Fassq (Qborder_width
, parms
)))
10813 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10814 if (NILP (Fassq (Qborder_color
, parms
)))
10815 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10816 if (NILP (Fassq (Qbackground_color
, parms
)))
10817 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10820 /* Create a frame for the tooltip, and record it in the global
10821 variable tip_frame. */
10822 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
10823 f
= XFRAME (frame
);
10825 /* Set up the frame's root window. Currently we use a size of 80
10826 columns x 40 lines. If someone wants to show a larger tip, he
10827 will loose. I don't think this is a realistic case. */
10828 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10829 w
->left
= w
->top
= make_number (0);
10830 w
->width
= make_number (80);
10831 w
->height
= make_number (40);
10833 w
->pseudo_window_p
= 1;
10835 /* Display the tooltip text in a temporary buffer. */
10836 buffer
= Fget_buffer_create (build_string (" *tip*"));
10837 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10838 old_buffer
= current_buffer
;
10839 set_buffer_internal_1 (XBUFFER (buffer
));
10841 Finsert (1, &string
);
10842 clear_glyph_matrix (w
->desired_matrix
);
10843 clear_glyph_matrix (w
->current_matrix
);
10844 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10845 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10847 /* Compute width and height of the tooltip. */
10848 width
= height
= 0;
10849 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10851 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10852 struct glyph
*last
;
10855 /* Stop at the first empty row at the end. */
10856 if (!row
->enabled_p
|| !row
->displays_text_p
)
10859 /* Let the row go over the full width of the frame. */
10860 row
->full_width_p
= 1;
10862 /* There's a glyph at the end of rows that is used to place
10863 the cursor there. Don't include the width of this glyph. */
10864 if (row
->used
[TEXT_AREA
])
10866 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10867 row_width
= row
->pixel_width
- last
->pixel_width
;
10870 row_width
= row
->pixel_width
;
10872 height
+= row
->height
;
10873 width
= max (width
, row_width
);
10876 /* Add the frame's internal border to the width and height the X
10877 window should have. */
10878 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10879 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10881 /* Move the tooltip window where the mouse pointer is. Resize and
10883 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
10886 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10887 root_x
, root_y
- height
, width
, height
);
10888 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10891 /* Draw into the window. */
10892 w
->must_be_updated_p
= 1;
10893 update_single_window (w
, 1);
10895 /* Restore original current buffer. */
10896 set_buffer_internal_1 (old_buffer
);
10897 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
10900 /* Let the tip disappear after timeout seconds. */
10901 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
10902 intern ("x-hide-tip"));
10905 return unbind_to (count
, Qnil
);
10909 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
10910 "Hide the current tooltip window, if there is any.\n\
10911 Value is t is tooltip was open, nil otherwise.")
10915 Lisp_Object deleted
, frame
, timer
;
10916 struct gcpro gcpro1
, gcpro2
;
10918 /* Return quickly if nothing to do. */
10919 if (NILP (tip_timer
) && NILP (tip_frame
))
10924 GCPRO2 (frame
, timer
);
10925 tip_frame
= tip_timer
= deleted
= Qnil
;
10927 count
= BINDING_STACK_SIZE ();
10928 specbind (Qinhibit_redisplay
, Qt
);
10929 specbind (Qinhibit_quit
, Qt
);
10932 call1 (intern ("cancel-timer"), timer
);
10934 if (FRAMEP (frame
))
10936 Fdelete_frame (frame
, Qnil
);
10940 /* Bloodcurdling hack alert: The Lucid menu bar widget's
10941 redisplay procedure is not called when a tip frame over menu
10942 items is unmapped. Redisplay the menu manually... */
10944 struct frame
*f
= SELECTED_FRAME ();
10945 Widget w
= f
->output_data
.x
->menubar_widget
;
10946 extern void xlwmenu_redisplay
P_ ((Widget
));
10948 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
10952 xlwmenu_redisplay (w
);
10956 #endif /* USE_LUCID */
10960 return unbind_to (count
, deleted
);
10965 /***********************************************************************
10966 File selection dialog
10967 ***********************************************************************/
10971 /* Callback for "OK" and "Cancel" on file selection dialog. */
10974 file_dialog_cb (widget
, client_data
, call_data
)
10976 XtPointer call_data
, client_data
;
10978 int *result
= (int *) client_data
;
10979 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
10980 *result
= cb
->reason
;
10984 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
10985 "Read file name, prompting with PROMPT in directory DIR.\n\
10986 Use a file selection dialog.\n\
10987 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10988 specified. Don't let the user enter a file name in the file\n\
10989 selection dialog's entry field, if MUSTMATCH is non-nil.")
10990 (prompt
, dir
, default_filename
, mustmatch
)
10991 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
10994 struct frame
*f
= SELECTED_FRAME ();
10995 Lisp_Object file
= Qnil
;
10996 Widget dialog
, text
, list
, help
;
10999 extern XtAppContext Xt_app_con
;
11001 XmString dir_xmstring
, pattern_xmstring
;
11002 int popup_activated_flag
;
11003 int count
= specpdl_ptr
- specpdl
;
11004 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
11006 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
11007 CHECK_STRING (prompt
, 0);
11008 CHECK_STRING (dir
, 1);
11010 /* Prevent redisplay. */
11011 specbind (Qinhibit_redisplay
, Qt
);
11015 /* Create the dialog with PROMPT as title, using DIR as initial
11016 directory and using "*" as pattern. */
11017 dir
= Fexpand_file_name (dir
, Qnil
);
11018 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
11019 pattern_xmstring
= XmStringCreateLocalized ("*");
11021 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
11022 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
11023 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
11024 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
11025 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
11026 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
11028 XmStringFree (dir_xmstring
);
11029 XmStringFree (pattern_xmstring
);
11031 /* Add callbacks for OK and Cancel. */
11032 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
11033 (XtPointer
) &result
);
11034 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
11035 (XtPointer
) &result
);
11037 /* Disable the help button since we can't display help. */
11038 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
11039 XtSetSensitive (help
, False
);
11041 /* Mark OK button as default. */
11042 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
11043 XmNshowAsDefault
, True
, NULL
);
11045 /* If MUSTMATCH is non-nil, disable the file entry field of the
11046 dialog, so that the user must select a file from the files list
11047 box. We can't remove it because we wouldn't have a way to get at
11048 the result file name, then. */
11049 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
11050 if (!NILP (mustmatch
))
11053 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
11054 XtSetSensitive (text
, False
);
11055 XtSetSensitive (label
, False
);
11058 /* Manage the dialog, so that list boxes get filled. */
11059 XtManageChild (dialog
);
11061 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11062 must include the path for this to work. */
11063 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
11064 if (STRINGP (default_filename
))
11066 XmString default_xmstring
;
11070 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
11072 if (!XmListItemExists (list
, default_xmstring
))
11074 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11075 XmListAddItem (list
, default_xmstring
, 0);
11079 item_pos
= XmListItemPos (list
, default_xmstring
);
11080 XmStringFree (default_xmstring
);
11082 /* Select the item and scroll it into view. */
11083 XmListSelectPos (list
, item_pos
, True
);
11084 XmListSetPos (list
, item_pos
);
11087 #ifdef HAVE_MOTIF_2_1
11089 /* Process events until the user presses Cancel or OK. */
11091 while (result
== 0 || XtAppPending (Xt_app_con
))
11092 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
11094 #else /* not HAVE_MOTIF_2_1 */
11096 /* Process all events until the user presses Cancel or OK. */
11097 for (result
= 0; result
== 0;)
11100 Widget widget
, parent
;
11102 XtAppNextEvent (Xt_app_con
, &event
);
11104 /* See if the receiver of the event is one of the widgets of
11105 the file selection dialog. If so, dispatch it. If not,
11107 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
11109 while (parent
&& parent
!= dialog
)
11110 parent
= XtParent (parent
);
11112 if (parent
== dialog
11113 || (event
.type
== Expose
11114 && !process_expose_from_menu (event
)))
11115 XtDispatchEvent (&event
);
11118 #endif /* not HAVE_MOTIF_2_1 */
11120 /* Get the result. */
11121 if (result
== XmCR_OK
)
11126 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
11127 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
11128 XmStringFree (text
);
11129 file
= build_string (data
);
11136 XtUnmanageChild (dialog
);
11137 XtDestroyWidget (dialog
);
11141 /* Make "Cancel" equivalent to C-g. */
11143 Fsignal (Qquit
, Qnil
);
11145 return unbind_to (count
, file
);
11148 #endif /* USE_MOTIF */
11152 /***********************************************************************
11154 ***********************************************************************/
11156 #ifdef HAVE_XKBGETKEYBOARD
11157 #include <X11/XKBlib.h>
11158 #include <X11/keysym.h>
11161 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p
,
11162 Sx_backspace_delete_keys_p
, 0, 1, 0,
11163 "Check if both Backspace and Delete keys are on the keyboard of FRAME.\n\
11164 FRAME nil means use the selected frame.\n\
11165 Value is t if we know that both keys are present, and are mapped to the\n\
11170 #ifdef HAVE_XKBGETKEYBOARD
11172 struct frame
*f
= check_x_frame (frame
);
11173 Display
*dpy
= FRAME_X_DISPLAY (f
);
11174 Lisp_Object have_keys
;
11175 int major
, minor
, op
, event
, error
;
11179 /* Check library version in case we're dynamically linked. */
11180 major
= XkbMajorVersion
;
11181 minor
= XkbMinorVersion
;
11182 if (!XkbLibraryVersion (&major
, &minor
))
11188 /* Check that the server supports XKB. */
11189 major
= XkbMajorVersion
;
11190 minor
= XkbMinorVersion
;
11191 if (!XkbQueryExtension (dpy
, &op
, &event
, &error
, &major
, &minor
))
11198 kb
= XkbGetMap (dpy
, XkbAllMapComponentsMask
, XkbUseCoreKbd
);
11201 int delete_keycode
= 0, backspace_keycode
= 0, i
;
11203 if (XkbGetNames (dpy
, XkbAllNamesMask
, kb
) == Success
)
11205 for (i
= kb
->min_key_code
;
11206 (i
< kb
->max_key_code
11207 && (delete_keycode
== 0 || backspace_keycode
== 0));
11210 /* The XKB symbolic key names can be seen most easily
11211 in the PS file generated by `xkbprint -label name $DISPLAY'. */
11212 if (bcmp ("DELE", kb
->names
->keys
[i
].name
, 4) == 0)
11213 delete_keycode
= i
;
11214 else if (bcmp ("BKSP", kb
->names
->keys
[i
].name
, 4) == 0)
11215 backspace_keycode
= i
;
11218 XkbFreeNames (kb
, 0, True
);
11221 XkbFreeClientMap (kb
, 0, True
);
11224 && backspace_keycode
11225 && XKeysymToKeycode (dpy
, XK_Delete
) == delete_keycode
11226 && XKeysymToKeycode (dpy
, XK_BackSpace
) == backspace_keycode
)
11231 #else /* not HAVE_XKBGETKEYBOARD */
11233 #endif /* not HAVE_XKBGETKEYBOARD */
11238 /***********************************************************************
11240 ***********************************************************************/
11245 /* This is zero if not using X windows. */
11248 /* The section below is built by the lisp expression at the top of the file,
11249 just above where these variables are declared. */
11250 /*&&& init symbols here &&&*/
11251 Qauto_raise
= intern ("auto-raise");
11252 staticpro (&Qauto_raise
);
11253 Qauto_lower
= intern ("auto-lower");
11254 staticpro (&Qauto_lower
);
11255 Qbar
= intern ("bar");
11257 Qborder_color
= intern ("border-color");
11258 staticpro (&Qborder_color
);
11259 Qborder_width
= intern ("border-width");
11260 staticpro (&Qborder_width
);
11261 Qbox
= intern ("box");
11263 Qcursor_color
= intern ("cursor-color");
11264 staticpro (&Qcursor_color
);
11265 Qcursor_type
= intern ("cursor-type");
11266 staticpro (&Qcursor_type
);
11267 Qgeometry
= intern ("geometry");
11268 staticpro (&Qgeometry
);
11269 Qicon_left
= intern ("icon-left");
11270 staticpro (&Qicon_left
);
11271 Qicon_top
= intern ("icon-top");
11272 staticpro (&Qicon_top
);
11273 Qicon_type
= intern ("icon-type");
11274 staticpro (&Qicon_type
);
11275 Qicon_name
= intern ("icon-name");
11276 staticpro (&Qicon_name
);
11277 Qinternal_border_width
= intern ("internal-border-width");
11278 staticpro (&Qinternal_border_width
);
11279 Qleft
= intern ("left");
11280 staticpro (&Qleft
);
11281 Qright
= intern ("right");
11282 staticpro (&Qright
);
11283 Qmouse_color
= intern ("mouse-color");
11284 staticpro (&Qmouse_color
);
11285 Qnone
= intern ("none");
11286 staticpro (&Qnone
);
11287 Qparent_id
= intern ("parent-id");
11288 staticpro (&Qparent_id
);
11289 Qscroll_bar_width
= intern ("scroll-bar-width");
11290 staticpro (&Qscroll_bar_width
);
11291 Qsuppress_icon
= intern ("suppress-icon");
11292 staticpro (&Qsuppress_icon
);
11293 Qundefined_color
= intern ("undefined-color");
11294 staticpro (&Qundefined_color
);
11295 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11296 staticpro (&Qvertical_scroll_bars
);
11297 Qvisibility
= intern ("visibility");
11298 staticpro (&Qvisibility
);
11299 Qwindow_id
= intern ("window-id");
11300 staticpro (&Qwindow_id
);
11301 Qouter_window_id
= intern ("outer-window-id");
11302 staticpro (&Qouter_window_id
);
11303 Qx_frame_parameter
= intern ("x-frame-parameter");
11304 staticpro (&Qx_frame_parameter
);
11305 Qx_resource_name
= intern ("x-resource-name");
11306 staticpro (&Qx_resource_name
);
11307 Quser_position
= intern ("user-position");
11308 staticpro (&Quser_position
);
11309 Quser_size
= intern ("user-size");
11310 staticpro (&Quser_size
);
11311 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11312 staticpro (&Qscroll_bar_foreground
);
11313 Qscroll_bar_background
= intern ("scroll-bar-background");
11314 staticpro (&Qscroll_bar_background
);
11315 Qscreen_gamma
= intern ("screen-gamma");
11316 staticpro (&Qscreen_gamma
);
11317 Qline_spacing
= intern ("line-spacing");
11318 staticpro (&Qline_spacing
);
11319 Qcenter
= intern ("center");
11320 staticpro (&Qcenter
);
11321 Qcompound_text
= intern ("compound-text");
11322 staticpro (&Qcompound_text
);
11323 /* This is the end of symbol initialization. */
11325 /* Text property `display' should be nonsticky by default. */
11326 Vtext_property_default_nonsticky
11327 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11330 Qlaplace
= intern ("laplace");
11331 staticpro (&Qlaplace
);
11332 Qemboss
= intern ("emboss");
11333 staticpro (&Qemboss
);
11334 Qedge_detection
= intern ("edge-detection");
11335 staticpro (&Qedge_detection
);
11336 Qheuristic
= intern ("heuristic");
11337 staticpro (&Qheuristic
);
11338 QCmatrix
= intern (":matrix");
11339 staticpro (&QCmatrix
);
11340 QCcolor_adjustment
= intern (":color-adjustment");
11341 staticpro (&QCcolor_adjustment
);
11342 QCmask
= intern (":mask");
11343 staticpro (&QCmask
);
11345 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11346 staticpro (&Qface_set_after_frame_default
);
11348 Fput (Qundefined_color
, Qerror_conditions
,
11349 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11350 Fput (Qundefined_color
, Qerror_message
,
11351 build_string ("Undefined color"));
11353 init_x_parm_symbols ();
11355 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11356 "Non-nil means always draw a cross over disabled images.\n\
11357 Disabled images are those having an `:algorithm disabled' property.\n\
11358 A cross is always drawn on black & white displays.");
11359 cross_disabled_images
= 0;
11361 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11362 "List of directories to search for bitmap files for X.");
11363 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11365 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11366 "The shape of the pointer when over text.\n\
11367 Changing the value does not affect existing frames\n\
11368 unless you set the mouse color.");
11369 Vx_pointer_shape
= Qnil
;
11371 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11372 "The name Emacs uses to look up X resources.\n\
11373 `x-get-resource' uses this as the first component of the instance name\n\
11374 when requesting resource values.\n\
11375 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
11376 was invoked, or to the value specified with the `-name' or `-rn'\n\
11377 switches, if present.\n\
11379 It may be useful to bind this variable locally around a call\n\
11380 to `x-get-resource'. See also the variable `x-resource-class'.");
11381 Vx_resource_name
= Qnil
;
11383 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11384 "The class Emacs uses to look up X resources.\n\
11385 `x-get-resource' uses this as the first component of the instance class\n\
11386 when requesting resource values.\n\
11387 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
11389 Setting this variable permanently is not a reasonable thing to do,\n\
11390 but binding this variable locally around a call to `x-get-resource'\n\
11391 is a reasonable practice. See also the variable `x-resource-name'.");
11392 Vx_resource_class
= build_string (EMACS_CLASS
);
11394 #if 0 /* This doesn't really do anything. */
11395 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11396 "The shape of the pointer when not over text.\n\
11397 This variable takes effect when you create a new frame\n\
11398 or when you set the mouse color.");
11400 Vx_nontext_pointer_shape
= Qnil
;
11402 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
11403 "The shape of the pointer when Emacs is busy.\n\
11404 This variable takes effect when you create a new frame\n\
11405 or when you set the mouse color.");
11406 Vx_busy_pointer_shape
= Qnil
;
11408 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
11409 "Non-zero means Emacs displays a busy cursor on window systems.");
11410 display_busy_cursor_p
= 1;
11412 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay
,
11413 "*Seconds to wait before displaying a busy-cursor.\n\
11414 Value must be an integer or float.");
11415 Vbusy_cursor_delay
= make_number (DEFAULT_BUSY_CURSOR_DELAY
);
11417 #if 0 /* This doesn't really do anything. */
11418 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11419 "The shape of the pointer when over the mode line.\n\
11420 This variable takes effect when you create a new frame\n\
11421 or when you set the mouse color.");
11423 Vx_mode_pointer_shape
= Qnil
;
11425 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11426 &Vx_sensitive_text_pointer_shape
,
11427 "The shape of the pointer when over mouse-sensitive text.\n\
11428 This variable takes effect when you create a new frame\n\
11429 or when you set the mouse color.");
11430 Vx_sensitive_text_pointer_shape
= Qnil
;
11432 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11433 &Vx_window_horizontal_drag_shape
,
11434 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
11435 This variable takes effect when you create a new frame\n\
11436 or when you set the mouse color.");
11437 Vx_window_horizontal_drag_shape
= Qnil
;
11439 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11440 "A string indicating the foreground color of the cursor box.");
11441 Vx_cursor_fore_pixel
= Qnil
;
11443 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11444 "Non-nil if no X window manager is in use.\n\
11445 Emacs doesn't try to figure this out; this is always nil\n\
11446 unless you set it to something else.");
11447 /* We don't have any way to find this out, so set it to nil
11448 and maybe the user would like to set it to t. */
11449 Vx_no_window_manager
= Qnil
;
11451 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11452 &Vx_pixel_size_width_font_regexp
,
11453 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11455 Since Emacs gets width of a font matching with this regexp from\n\
11456 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11457 such a font. This is especially effective for such large fonts as\n\
11458 Chinese, Japanese, and Korean.");
11459 Vx_pixel_size_width_font_regexp
= Qnil
;
11461 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11462 "Time after which cached images are removed from the cache.\n\
11463 When an image has not been displayed this many seconds, remove it\n\
11464 from the image cache. Value must be an integer or nil with nil\n\
11465 meaning don't clear the cache.");
11466 Vimage_cache_eviction_delay
= make_number (30 * 60);
11468 #ifdef USE_X_TOOLKIT
11469 Fprovide (intern ("x-toolkit"));
11472 Fprovide (intern ("motif"));
11475 defsubr (&Sx_get_resource
);
11477 /* X window properties. */
11478 defsubr (&Sx_change_window_property
);
11479 defsubr (&Sx_delete_window_property
);
11480 defsubr (&Sx_window_property
);
11482 defsubr (&Sxw_display_color_p
);
11483 defsubr (&Sx_display_grayscale_p
);
11484 defsubr (&Sxw_color_defined_p
);
11485 defsubr (&Sxw_color_values
);
11486 defsubr (&Sx_server_max_request_size
);
11487 defsubr (&Sx_server_vendor
);
11488 defsubr (&Sx_server_version
);
11489 defsubr (&Sx_display_pixel_width
);
11490 defsubr (&Sx_display_pixel_height
);
11491 defsubr (&Sx_display_mm_width
);
11492 defsubr (&Sx_display_mm_height
);
11493 defsubr (&Sx_display_screens
);
11494 defsubr (&Sx_display_planes
);
11495 defsubr (&Sx_display_color_cells
);
11496 defsubr (&Sx_display_visual_class
);
11497 defsubr (&Sx_display_backing_store
);
11498 defsubr (&Sx_display_save_under
);
11499 defsubr (&Sx_parse_geometry
);
11500 defsubr (&Sx_create_frame
);
11501 defsubr (&Sx_open_connection
);
11502 defsubr (&Sx_close_connection
);
11503 defsubr (&Sx_display_list
);
11504 defsubr (&Sx_synchronize
);
11505 defsubr (&Sx_focus_frame
);
11506 defsubr (&Sx_backspace_delete_keys_p
);
11508 /* Setting callback functions for fontset handler. */
11509 get_font_info_func
= x_get_font_info
;
11511 #if 0 /* This function pointer doesn't seem to be used anywhere.
11512 And the pointer assigned has the wrong type, anyway. */
11513 list_fonts_func
= x_list_fonts
;
11516 load_font_func
= x_load_font
;
11517 find_ccl_program_func
= x_find_ccl_program
;
11518 query_font_func
= x_query_font
;
11519 set_frame_fontset_func
= x_set_font
;
11520 check_window_system_func
= check_x
;
11523 Qxbm
= intern ("xbm");
11525 QCtype
= intern (":type");
11526 staticpro (&QCtype
);
11527 QCalgorithm
= intern (":algorithm");
11528 staticpro (&QCalgorithm
);
11529 QCheuristic_mask
= intern (":heuristic-mask");
11530 staticpro (&QCheuristic_mask
);
11531 QCcolor_symbols
= intern (":color-symbols");
11532 staticpro (&QCcolor_symbols
);
11533 QCascent
= intern (":ascent");
11534 staticpro (&QCascent
);
11535 QCmargin
= intern (":margin");
11536 staticpro (&QCmargin
);
11537 QCrelief
= intern (":relief");
11538 staticpro (&QCrelief
);
11539 Qpostscript
= intern ("postscript");
11540 staticpro (&Qpostscript
);
11541 QCloader
= intern (":loader");
11542 staticpro (&QCloader
);
11543 QCbounding_box
= intern (":bounding-box");
11544 staticpro (&QCbounding_box
);
11545 QCpt_width
= intern (":pt-width");
11546 staticpro (&QCpt_width
);
11547 QCpt_height
= intern (":pt-height");
11548 staticpro (&QCpt_height
);
11549 QCindex
= intern (":index");
11550 staticpro (&QCindex
);
11551 Qpbm
= intern ("pbm");
11555 Qxpm
= intern ("xpm");
11560 Qjpeg
= intern ("jpeg");
11561 staticpro (&Qjpeg
);
11565 Qtiff
= intern ("tiff");
11566 staticpro (&Qtiff
);
11570 Qgif
= intern ("gif");
11575 Qpng
= intern ("png");
11579 defsubr (&Sclear_image_cache
);
11580 defsubr (&Simage_size
);
11581 defsubr (&Simage_mask_p
);
11583 busy_cursor_atimer
= NULL
;
11584 busy_cursor_shown_p
= 0;
11586 defsubr (&Sx_show_tip
);
11587 defsubr (&Sx_hide_tip
);
11589 staticpro (&tip_timer
);
11591 staticpro (&tip_frame
);
11593 last_show_tip_args
= Qnil
;
11594 staticpro (&last_show_tip_args
);
11597 defsubr (&Sx_file_dialog
);
11605 image_types
= NULL
;
11606 Vimage_types
= Qnil
;
11608 define_image_type (&xbm_type
);
11609 define_image_type (&gs_type
);
11610 define_image_type (&pbm_type
);
11613 define_image_type (&xpm_type
);
11617 define_image_type (&jpeg_type
);
11621 define_image_type (&tiff_type
);
11625 define_image_type (&gif_type
);
11629 define_image_type (&png_type
);
11633 #endif /* HAVE_X_WINDOWS */