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