1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
27 /* This makes the fields of a Display accessible, in Xlib header files. */
29 #define XLIB_ILLEGAL_ACCESS
36 #include "intervals.h"
37 #include "dispextern.h"
39 #include "blockinput.h"
44 #include "termhooks.h"
50 #include <sys/types.h>
53 /* On some systems, the character-composition stuff is broken in X11R5. */
55 #if defined (HAVE_X11R5) && ! defined (HAVE_X11R6)
56 #ifdef X11R5_INHIBIT_I18N
57 #define X_I18N_INHIBITED
62 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
63 #include "bitmaps/gray.xbm"
65 #include <X11/bitmaps/gray>
68 #include "[.bitmaps]gray.xbm"
72 #include <X11/Shell.h>
75 #include <X11/Xaw/Paned.h>
76 #include <X11/Xaw/Label.h>
77 #endif /* USE_MOTIF */
80 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
89 #include "../lwlib/lwlib.h"
93 #include <Xm/DialogS.h>
94 #include <Xm/FileSB.h>
97 /* Do the EDITRES protocol if running X11R5
98 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
100 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
102 extern void _XEditResCheckMessages ();
103 #endif /* R5 + Athena */
105 /* Unique id counter for widgets created by the Lucid Widget Library. */
107 extern LWLIB_ID widget_id_tick
;
110 /* This is part of a kludge--see lwlib/xlwmenu.c. */
111 extern XFontStruct
*xlwmenu_default_font
;
114 extern void free_frame_menubar ();
115 extern double atof ();
117 #endif /* USE_X_TOOLKIT */
119 #define min(a,b) ((a) < (b) ? (a) : (b))
120 #define max(a,b) ((a) > (b) ? (a) : (b))
123 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
125 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
128 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
129 it, and including `bitmaps/gray' more than once is a problem when
130 config.h defines `static' as an empty replacement string. */
132 int gray_bitmap_width
= gray_width
;
133 int gray_bitmap_height
= gray_height
;
134 unsigned char *gray_bitmap_bits
= gray_bits
;
136 /* The name we're using in resource queries. Most often "emacs". */
138 Lisp_Object Vx_resource_name
;
140 /* The application class we're using in resource queries.
143 Lisp_Object Vx_resource_class
;
145 /* Non-zero means we're allowed to display a busy cursor. */
147 int display_busy_cursor_p
;
149 /* The background and shape of the mouse pointer, and shape when not
150 over text or in the modeline. */
152 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
153 Lisp_Object Vx_busy_pointer_shape
;
155 /* The shape when over mouse-sensitive text. */
157 Lisp_Object Vx_sensitive_text_pointer_shape
;
159 /* Color of chars displayed in cursor box. */
161 Lisp_Object Vx_cursor_fore_pixel
;
163 /* Nonzero if using X. */
167 /* Non nil if no window manager is in use. */
169 Lisp_Object Vx_no_window_manager
;
171 /* Search path for bitmap files. */
173 Lisp_Object Vx_bitmap_file_path
;
175 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
177 Lisp_Object Vx_pixel_size_width_font_regexp
;
179 /* Evaluate this expression to rebuild the section of syms_of_xfns
180 that initializes and staticpros the symbols declared below. Note
181 that Emacs 18 has a bug that keeps C-x C-e from being able to
182 evaluate this expression.
185 ;; Accumulate a list of the symbols we want to initialize from the
186 ;; declarations at the top of the file.
187 (goto-char (point-min))
188 (search-forward "/\*&&& symbols declared here &&&*\/\n")
190 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
192 (cons (buffer-substring (match-beginning 1) (match-end 1))
195 (setq symbol-list (nreverse symbol-list))
196 ;; Delete the section of syms_of_... where we initialize the symbols.
197 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
198 (let ((start (point)))
199 (while (looking-at "^ Q")
201 (kill-region start (point)))
202 ;; Write a new symbol initialization section.
204 (insert (format " %s = intern (\"" (car symbol-list)))
205 (let ((start (point)))
206 (insert (substring (car symbol-list) 1))
207 (subst-char-in-region start (point) ?_ ?-))
208 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
209 (setq symbol-list (cdr symbol-list)))))
213 /*&&& symbols declared here &&&*/
214 Lisp_Object Qauto_raise
;
215 Lisp_Object Qauto_lower
;
217 Lisp_Object Qborder_color
;
218 Lisp_Object Qborder_width
;
220 Lisp_Object Qcursor_color
;
221 Lisp_Object Qcursor_type
;
222 Lisp_Object Qgeometry
;
223 Lisp_Object Qicon_left
;
224 Lisp_Object Qicon_top
;
225 Lisp_Object Qicon_type
;
226 Lisp_Object Qicon_name
;
227 Lisp_Object Qinternal_border_width
;
230 Lisp_Object Qmouse_color
;
232 Lisp_Object Qouter_window_id
;
233 Lisp_Object Qparent_id
;
234 Lisp_Object Qscroll_bar_width
;
235 Lisp_Object Qsuppress_icon
;
236 extern Lisp_Object Qtop
;
237 Lisp_Object Qundefined_color
;
238 Lisp_Object Qvertical_scroll_bars
;
239 Lisp_Object Qvisibility
;
240 Lisp_Object Qwindow_id
;
241 Lisp_Object Qx_frame_parameter
;
242 Lisp_Object Qx_resource_name
;
243 Lisp_Object Quser_position
;
244 Lisp_Object Quser_size
;
245 extern Lisp_Object Qdisplay
;
246 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
247 Lisp_Object Qscreen_gamma
;
249 /* The below are defined in frame.c. */
251 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
252 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
253 extern Lisp_Object Qtool_bar_lines
;
255 extern Lisp_Object Vwindow_system_version
;
257 Lisp_Object Qface_set_after_frame_default
;
260 /* Error if we are not connected to X. */
266 error ("X windows are not in use or not initialized");
269 /* Nonzero if we can use mouse menus.
270 You should not call this unless HAVE_MENUS is defined. */
278 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
279 and checking validity for X. */
282 check_x_frame (frame
)
288 frame
= selected_frame
;
289 CHECK_LIVE_FRAME (frame
, 0);
292 error ("Non-X frame used");
296 /* Let the user specify an X display with a frame.
297 nil stands for the selected frame--or, if that is not an X frame,
298 the first X display on the list. */
300 static struct x_display_info
*
301 check_x_display_info (frame
)
306 struct frame
*sf
= XFRAME (selected_frame
);
308 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
309 return FRAME_X_DISPLAY_INFO (sf
);
310 else if (x_display_list
!= 0)
311 return x_display_list
;
313 error ("X windows are not in use or not initialized");
315 else if (STRINGP (frame
))
316 return x_display_info_for_name (frame
);
321 CHECK_LIVE_FRAME (frame
, 0);
324 error ("Non-X frame used");
325 return FRAME_X_DISPLAY_INFO (f
);
330 /* Return the Emacs frame-object corresponding to an X window.
331 It could be the frame's main window or an icon window. */
333 /* This function can be called during GC, so use GC_xxx type test macros. */
336 x_window_to_frame (dpyinfo
, wdesc
)
337 struct x_display_info
*dpyinfo
;
340 Lisp_Object tail
, frame
;
343 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
346 if (!GC_FRAMEP (frame
))
349 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
351 if (f
->output_data
.x
->busy_window
== wdesc
)
354 if ((f
->output_data
.x
->edit_widget
355 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
356 /* A tooltip frame? */
357 || (!f
->output_data
.x
->edit_widget
358 && FRAME_X_WINDOW (f
) == wdesc
)
359 || f
->output_data
.x
->icon_desc
== wdesc
)
361 #else /* not USE_X_TOOLKIT */
362 if (FRAME_X_WINDOW (f
) == wdesc
363 || f
->output_data
.x
->icon_desc
== wdesc
)
365 #endif /* not USE_X_TOOLKIT */
371 /* Like x_window_to_frame but also compares the window with the widget's
375 x_any_window_to_frame (dpyinfo
, wdesc
)
376 struct x_display_info
*dpyinfo
;
379 Lisp_Object tail
, frame
;
380 struct frame
*f
, *found
;
384 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
387 if (!GC_FRAMEP (frame
))
391 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
393 /* This frame matches if the window is any of its widgets. */
394 x
= f
->output_data
.x
;
395 if (x
->busy_window
== wdesc
)
399 if (wdesc
== XtWindow (x
->widget
)
400 || wdesc
== XtWindow (x
->column_widget
)
401 || wdesc
== XtWindow (x
->edit_widget
))
403 /* Match if the window is this frame's menubar. */
404 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
407 else if (FRAME_X_WINDOW (f
) == wdesc
)
408 /* A tooltip frame. */
416 /* Likewise, but exclude the menu bar widget. */
419 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
420 struct x_display_info
*dpyinfo
;
423 Lisp_Object tail
, frame
;
427 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
430 if (!GC_FRAMEP (frame
))
433 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
435 x
= f
->output_data
.x
;
436 /* This frame matches if the window is any of its widgets. */
437 if (x
->busy_window
== wdesc
)
441 if (wdesc
== XtWindow (x
->widget
)
442 || wdesc
== XtWindow (x
->column_widget
)
443 || wdesc
== XtWindow (x
->edit_widget
))
446 else if (FRAME_X_WINDOW (f
) == wdesc
)
447 /* A tooltip frame. */
453 /* Likewise, but consider only the menu bar widget. */
456 x_menubar_window_to_frame (dpyinfo
, wdesc
)
457 struct x_display_info
*dpyinfo
;
460 Lisp_Object tail
, frame
;
464 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
467 if (!GC_FRAMEP (frame
))
470 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
472 x
= f
->output_data
.x
;
473 /* Match if the window is this frame's menubar. */
474 if (x
->menubar_widget
475 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
481 /* Return the frame whose principal (outermost) window is WDESC.
482 If WDESC is some other (smaller) window, we return 0. */
485 x_top_window_to_frame (dpyinfo
, wdesc
)
486 struct x_display_info
*dpyinfo
;
489 Lisp_Object tail
, frame
;
493 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
496 if (!GC_FRAMEP (frame
))
499 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
501 x
= f
->output_data
.x
;
505 /* This frame matches if the window is its topmost widget. */
506 if (wdesc
== XtWindow (x
->widget
))
508 #if 0 /* I don't know why it did this,
509 but it seems logically wrong,
510 and it causes trouble for MapNotify events. */
511 /* Match if the window is this frame's menubar. */
512 if (x
->menubar_widget
513 && wdesc
== XtWindow (x
->menubar_widget
))
517 else if (FRAME_X_WINDOW (f
) == wdesc
)
523 #endif /* USE_X_TOOLKIT */
527 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
528 id, which is just an int that this section returns. Bitmaps are
529 reference counted so they can be shared among frames.
531 Bitmap indices are guaranteed to be > 0, so a negative number can
532 be used to indicate no bitmap.
534 If you use x_create_bitmap_from_data, then you must keep track of
535 the bitmaps yourself. That is, creating a bitmap from the same
536 data more than once will not be caught. */
539 /* Functions to access the contents of a bitmap, given an id. */
542 x_bitmap_height (f
, id
)
546 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
550 x_bitmap_width (f
, id
)
554 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
558 x_bitmap_pixmap (f
, id
)
562 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
566 /* Allocate a new bitmap record. Returns index of new record. */
569 x_allocate_bitmap_record (f
)
572 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
575 if (dpyinfo
->bitmaps
== NULL
)
577 dpyinfo
->bitmaps_size
= 10;
579 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
580 dpyinfo
->bitmaps_last
= 1;
584 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
585 return ++dpyinfo
->bitmaps_last
;
587 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
588 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
591 dpyinfo
->bitmaps_size
*= 2;
593 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
594 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
595 return ++dpyinfo
->bitmaps_last
;
598 /* Add one reference to the reference count of the bitmap with id ID. */
601 x_reference_bitmap (f
, id
)
605 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
608 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
611 x_create_bitmap_from_data (f
, bits
, width
, height
)
614 unsigned int width
, height
;
616 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
620 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
621 bits
, width
, height
);
626 id
= x_allocate_bitmap_record (f
);
627 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
628 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
629 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
630 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
631 dpyinfo
->bitmaps
[id
- 1].height
= height
;
632 dpyinfo
->bitmaps
[id
- 1].width
= width
;
637 /* Create bitmap from file FILE for frame F. */
640 x_create_bitmap_from_file (f
, file
)
644 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
645 unsigned int width
, height
;
647 int xhot
, yhot
, result
, id
;
652 /* Look for an existing bitmap with the same name. */
653 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
655 if (dpyinfo
->bitmaps
[id
].refcount
656 && dpyinfo
->bitmaps
[id
].file
657 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
659 ++dpyinfo
->bitmaps
[id
].refcount
;
664 /* Search bitmap-file-path for the file, if appropriate. */
665 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
668 /* XReadBitmapFile won't handle magic file names. */
673 filename
= (char *) XSTRING (found
)->data
;
675 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
676 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
677 if (result
!= BitmapSuccess
)
680 id
= x_allocate_bitmap_record (f
);
681 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
682 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
683 dpyinfo
->bitmaps
[id
- 1].file
684 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
685 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
686 dpyinfo
->bitmaps
[id
- 1].height
= height
;
687 dpyinfo
->bitmaps
[id
- 1].width
= width
;
688 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
693 /* Remove reference to bitmap with id number ID. */
696 x_destroy_bitmap (f
, id
)
700 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
704 --dpyinfo
->bitmaps
[id
- 1].refcount
;
705 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
708 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
709 if (dpyinfo
->bitmaps
[id
- 1].file
)
711 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
712 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
719 /* Free all the bitmaps for the display specified by DPYINFO. */
722 x_destroy_all_bitmaps (dpyinfo
)
723 struct x_display_info
*dpyinfo
;
726 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
727 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
729 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
730 if (dpyinfo
->bitmaps
[i
].file
)
731 xfree (dpyinfo
->bitmaps
[i
].file
);
733 dpyinfo
->bitmaps_last
= 0;
736 /* Connect the frame-parameter names for X frames
737 to the ways of passing the parameter values to the window system.
739 The name of a parameter, as a Lisp symbol,
740 has an `x-frame-parameter' property which is an integer in Lisp
741 that is an index in this table. */
743 struct x_frame_parm_table
746 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 static void x_create_im
P_ ((struct frame
*));
750 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
755 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
759 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
760 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
762 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
763 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
764 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
765 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
767 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
768 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
769 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
770 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
771 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
772 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
773 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
775 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
777 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
782 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
784 static struct x_frame_parm_table x_frame_parms
[] =
786 "auto-raise", x_set_autoraise
,
787 "auto-lower", x_set_autolower
,
788 "background-color", x_set_background_color
,
789 "border-color", x_set_border_color
,
790 "border-width", x_set_border_width
,
791 "cursor-color", x_set_cursor_color
,
792 "cursor-type", x_set_cursor_type
,
794 "foreground-color", x_set_foreground_color
,
795 "icon-name", x_set_icon_name
,
796 "icon-type", x_set_icon_type
,
797 "internal-border-width", x_set_internal_border_width
,
798 "menu-bar-lines", x_set_menu_bar_lines
,
799 "mouse-color", x_set_mouse_color
,
800 "name", x_explicitly_set_name
,
801 "scroll-bar-width", x_set_scroll_bar_width
,
802 "title", x_set_title
,
803 "unsplittable", x_set_unsplittable
,
804 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
805 "visibility", x_set_visibility
,
806 "tool-bar-lines", x_set_tool_bar_lines
,
807 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
808 "scroll-bar-background", x_set_scroll_bar_background
,
809 "screen-gamma", x_set_screen_gamma
812 /* Attach the `x-frame-parameter' properties to
813 the Lisp symbol names of parameters relevant to X. */
816 init_x_parm_symbols ()
820 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
821 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
825 /* Change the parameters of frame F as specified by ALIST.
826 If a parameter is not specially recognized, do nothing;
827 otherwise call the `x_set_...' function for that parameter. */
830 x_set_frame_parameters (f
, alist
)
836 /* If both of these parameters are present, it's more efficient to
837 set them both at once. So we wait until we've looked at the
838 entire list before we set them. */
842 Lisp_Object left
, top
;
844 /* Same with these. */
845 Lisp_Object icon_left
, icon_top
;
847 /* Record in these vectors all the parms specified. */
851 int left_no_change
= 0, top_no_change
= 0;
852 int icon_left_no_change
= 0, icon_top_no_change
= 0;
854 struct gcpro gcpro1
, gcpro2
;
857 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
860 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
861 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
863 /* Extract parm names and values into those vectors. */
866 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
871 parms
[i
] = Fcar (elt
);
872 values
[i
] = Fcdr (elt
);
875 /* TAIL and ALIST are not used again below here. */
878 GCPRO2 (*parms
, *values
);
882 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
883 because their values appear in VALUES and strings are not valid. */
884 top
= left
= Qunbound
;
885 icon_left
= icon_top
= Qunbound
;
887 /* Provide default values for HEIGHT and WIDTH. */
888 if (FRAME_NEW_WIDTH (f
))
889 width
= FRAME_NEW_WIDTH (f
);
891 width
= FRAME_WIDTH (f
);
893 if (FRAME_NEW_HEIGHT (f
))
894 height
= FRAME_NEW_HEIGHT (f
);
896 height
= FRAME_HEIGHT (f
);
898 /* Process foreground_color and background_color before anything else.
899 They are independent of other properties, but other properties (e.g.,
900 cursor_color) are dependent upon them. */
901 for (p
= 0; p
< i
; p
++)
903 Lisp_Object prop
, val
;
907 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
909 register Lisp_Object param_index
, old_value
;
911 param_index
= Fget (prop
, Qx_frame_parameter
);
912 old_value
= get_frame_param (f
, prop
);
913 store_frame_param (f
, prop
, val
);
914 if (NATNUMP (param_index
)
915 && (XFASTINT (param_index
)
916 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
917 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
921 /* Now process them in reverse of specified order. */
922 for (i
--; i
>= 0; i
--)
924 Lisp_Object prop
, val
;
929 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
930 width
= XFASTINT (val
);
931 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
932 height
= XFASTINT (val
);
933 else if (EQ (prop
, Qtop
))
935 else if (EQ (prop
, Qleft
))
937 else if (EQ (prop
, Qicon_top
))
939 else if (EQ (prop
, Qicon_left
))
941 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
942 /* Processed above. */
946 register Lisp_Object param_index
, old_value
;
948 param_index
= Fget (prop
, Qx_frame_parameter
);
949 old_value
= get_frame_param (f
, prop
);
950 store_frame_param (f
, prop
, val
);
951 if (NATNUMP (param_index
)
952 && (XFASTINT (param_index
)
953 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
954 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
958 /* Don't die if just one of these was set. */
959 if (EQ (left
, Qunbound
))
962 if (f
->output_data
.x
->left_pos
< 0)
963 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
965 XSETINT (left
, f
->output_data
.x
->left_pos
);
967 if (EQ (top
, Qunbound
))
970 if (f
->output_data
.x
->top_pos
< 0)
971 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
973 XSETINT (top
, f
->output_data
.x
->top_pos
);
976 /* If one of the icon positions was not set, preserve or default it. */
977 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
979 icon_left_no_change
= 1;
980 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
981 if (NILP (icon_left
))
982 XSETINT (icon_left
, 0);
984 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
986 icon_top_no_change
= 1;
987 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
989 XSETINT (icon_top
, 0);
992 /* Don't set these parameters unless they've been explicitly
993 specified. The window might be mapped or resized while we're in
994 this function, and we don't want to override that unless the lisp
995 code has asked for it.
997 Don't set these parameters unless they actually differ from the
998 window's current parameters; the window may not actually exist
1003 check_frame_size (f
, &height
, &width
);
1005 XSETFRAME (frame
, f
);
1007 if (width
!= FRAME_WIDTH (f
)
1008 || height
!= FRAME_HEIGHT (f
)
1009 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1010 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1012 if ((!NILP (left
) || !NILP (top
))
1013 && ! (left_no_change
&& top_no_change
)
1014 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1015 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1020 /* Record the signs. */
1021 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1022 if (EQ (left
, Qminus
))
1023 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1024 else if (INTEGERP (left
))
1026 leftpos
= XINT (left
);
1028 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1030 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1031 && CONSP (XCDR (left
))
1032 && INTEGERP (XCAR (XCDR (left
))))
1034 leftpos
= - XINT (XCAR (XCDR (left
)));
1035 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1037 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1038 && CONSP (XCDR (left
))
1039 && INTEGERP (XCAR (XCDR (left
))))
1041 leftpos
= XINT (XCAR (XCDR (left
)));
1044 if (EQ (top
, Qminus
))
1045 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1046 else if (INTEGERP (top
))
1048 toppos
= XINT (top
);
1050 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1052 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1053 && CONSP (XCDR (top
))
1054 && INTEGERP (XCAR (XCDR (top
))))
1056 toppos
= - XINT (XCAR (XCDR (top
)));
1057 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1059 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1060 && CONSP (XCDR (top
))
1061 && INTEGERP (XCAR (XCDR (top
))))
1063 toppos
= XINT (XCAR (XCDR (top
)));
1067 /* Store the numeric value of the position. */
1068 f
->output_data
.x
->top_pos
= toppos
;
1069 f
->output_data
.x
->left_pos
= leftpos
;
1071 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1073 /* Actually set that position, and convert to absolute. */
1074 x_set_offset (f
, leftpos
, toppos
, -1);
1077 if ((!NILP (icon_left
) || !NILP (icon_top
))
1078 && ! (icon_left_no_change
&& icon_top_no_change
))
1079 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1085 /* Store the screen positions of frame F into XPTR and YPTR.
1086 These are the positions of the containing window manager window,
1087 not Emacs's own window. */
1090 x_real_positions (f
, xptr
, yptr
)
1097 /* This is pretty gross, but seems to be the easiest way out of
1098 the problem that arises when restarting window-managers. */
1100 #ifdef USE_X_TOOLKIT
1101 Window outer
= (f
->output_data
.x
->widget
1102 ? XtWindow (f
->output_data
.x
->widget
)
1103 : FRAME_X_WINDOW (f
));
1105 Window outer
= f
->output_data
.x
->window_desc
;
1107 Window tmp_root_window
;
1108 Window
*tmp_children
;
1113 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1114 Window outer_window
;
1116 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1117 &f
->output_data
.x
->parent_desc
,
1118 &tmp_children
, &tmp_nchildren
);
1119 XFree ((char *) tmp_children
);
1123 /* Find the position of the outside upper-left corner of
1124 the inner window, with respect to the outer window. */
1125 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1126 outer_window
= f
->output_data
.x
->parent_desc
;
1128 outer_window
= outer
;
1130 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1132 /* From-window, to-window. */
1134 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1136 /* From-position, to-position. */
1137 0, 0, &win_x
, &win_y
,
1142 /* It is possible for the window returned by the XQueryNotify
1143 to become invalid by the time we call XTranslateCoordinates.
1144 That can happen when you restart some window managers.
1145 If so, we get an error in XTranslateCoordinates.
1146 Detect that and try the whole thing over. */
1147 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1149 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1153 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1160 /* Insert a description of internally-recorded parameters of frame X
1161 into the parameter alist *ALISTPTR that is to be given to the user.
1162 Only parameters that are specific to the X window system
1163 and whose values are not correctly recorded in the frame's
1164 param_alist need to be considered here. */
1167 x_report_frame_params (f
, alistptr
)
1169 Lisp_Object
*alistptr
;
1174 /* Represent negative positions (off the top or left screen edge)
1175 in a way that Fmodify_frame_parameters will understand correctly. */
1176 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1177 if (f
->output_data
.x
->left_pos
>= 0)
1178 store_in_alist (alistptr
, Qleft
, tem
);
1180 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1182 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1183 if (f
->output_data
.x
->top_pos
>= 0)
1184 store_in_alist (alistptr
, Qtop
, tem
);
1186 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1188 store_in_alist (alistptr
, Qborder_width
,
1189 make_number (f
->output_data
.x
->border_width
));
1190 store_in_alist (alistptr
, Qinternal_border_width
,
1191 make_number (f
->output_data
.x
->internal_border_width
));
1192 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1193 store_in_alist (alistptr
, Qwindow_id
,
1194 build_string (buf
));
1195 #ifdef USE_X_TOOLKIT
1196 /* Tooltip frame may not have this widget. */
1197 if (f
->output_data
.x
->widget
)
1199 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1200 store_in_alist (alistptr
, Qouter_window_id
,
1201 build_string (buf
));
1202 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1203 FRAME_SAMPLE_VISIBILITY (f
);
1204 store_in_alist (alistptr
, Qvisibility
,
1205 (FRAME_VISIBLE_P (f
) ? Qt
1206 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1207 store_in_alist (alistptr
, Qdisplay
,
1208 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1210 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1213 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1214 store_in_alist (alistptr
, Qparent_id
, tem
);
1219 /* Gamma-correct COLOR on frame F. */
1222 gamma_correct (f
, color
)
1228 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1229 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1230 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1235 /* Decide if color named COLOR is valid for the display associated with
1236 the selected frame; if so, return the rgb values in COLOR_DEF.
1237 If ALLOC is nonzero, allocate a new colormap cell. */
1240 x_defined_color (f
, color
, color_def
, alloc
)
1246 register int status
;
1247 Colormap screen_colormap
;
1248 Display
*display
= FRAME_X_DISPLAY (f
);
1251 screen_colormap
= DefaultColormap (display
, XDefaultScreen (display
));
1253 status
= XParseColor (display
, screen_colormap
, color
, color_def
);
1254 if (status
&& alloc
)
1256 /* Apply gamma correction. */
1257 gamma_correct (f
, color_def
);
1259 status
= XAllocColor (display
, screen_colormap
, color_def
);
1262 /* If we got to this point, the colormap is full, so we're
1263 going to try and get the next closest color.
1264 The algorithm used is a least-squares matching, which is
1265 what X uses for closest color matching with StaticColor visuals. */
1270 long nearest_delta
, trial_delta
;
1273 no_cells
= XDisplayCells (display
, XDefaultScreen (display
));
1274 cells
= (XColor
*) alloca (sizeof (XColor
) * no_cells
);
1276 for (x
= 0; x
< no_cells
; x
++)
1279 XQueryColors (display
, screen_colormap
, cells
, no_cells
);
1281 /* I'm assuming CSE so I'm not going to condense this. */
1282 nearest_delta
= ((((color_def
->red
>> 8) - (cells
[0].red
>> 8))
1283 * ((color_def
->red
>> 8) - (cells
[0].red
>> 8)))
1285 (((color_def
->green
>> 8) - (cells
[0].green
>> 8))
1286 * ((color_def
->green
>> 8) - (cells
[0].green
>> 8)))
1288 (((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))
1289 * ((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))));
1290 for (x
= 1; x
< no_cells
; x
++)
1292 trial_delta
= ((((color_def
->red
>> 8) - (cells
[x
].red
>> 8))
1293 * ((color_def
->red
>> 8) - (cells
[x
].red
>> 8)))
1295 (((color_def
->green
>> 8) - (cells
[x
].green
>> 8))
1296 * ((color_def
->green
>> 8) - (cells
[x
].green
>> 8)))
1298 (((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))
1299 * ((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))));
1300 if (trial_delta
< nearest_delta
)
1303 temp
.red
= cells
[x
].red
;
1304 temp
.green
= cells
[x
].green
;
1305 temp
.blue
= cells
[x
].blue
;
1306 status
= XAllocColor (display
, screen_colormap
, &temp
);
1310 nearest_delta
= trial_delta
;
1314 color_def
->red
= cells
[nearest
].red
;
1315 color_def
->green
= cells
[nearest
].green
;
1316 color_def
->blue
= cells
[nearest
].blue
;
1317 status
= XAllocColor (display
, screen_colormap
, color_def
);
1328 /* Given a string ARG naming a color, compute a pixel value from it
1329 suitable for screen F.
1330 If F is not a color screen, return DEF (default) regardless of what
1334 x_decode_color (f
, arg
, def
)
1341 CHECK_STRING (arg
, 0);
1343 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1344 return BLACK_PIX_DEFAULT (f
);
1345 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1346 return WHITE_PIX_DEFAULT (f
);
1348 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1351 /* x_defined_color is responsible for coping with failures
1352 by looking for a near-miss. */
1353 if (x_defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1356 Fsignal (Qerror
, Fcons (build_string ("undefined color"),
1357 Fcons (arg
, Qnil
)));
1360 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1361 the previous value of that parameter, NEW_VALUE is the new value. */
1364 x_set_screen_gamma (f
, new_value
, old_value
)
1366 Lisp_Object new_value
, old_value
;
1368 if (NILP (new_value
))
1370 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1371 /* The value 0.4545 is the normal viewing gamma. */
1372 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1374 Fsignal (Qerror
, Fcons (build_string ("Illegal screen-gamma"),
1375 Fcons (new_value
, Qnil
)));
1377 clear_face_cache (0);
1381 /* Functions called only from `x_set_frame_param'
1382 to set individual parameters.
1384 If FRAME_X_WINDOW (f) is 0,
1385 the frame is being created and its X-window does not exist yet.
1386 In that case, just record the parameter's new value
1387 in the standard place; do not attempt to change the window. */
1390 x_set_foreground_color (f
, arg
, oldval
)
1392 Lisp_Object arg
, oldval
;
1395 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1397 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1398 f
->output_data
.x
->foreground_pixel
= pixel
;
1400 if (FRAME_X_WINDOW (f
) != 0)
1403 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1404 f
->output_data
.x
->foreground_pixel
);
1405 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1406 f
->output_data
.x
->foreground_pixel
);
1408 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1409 if (FRAME_VISIBLE_P (f
))
1415 x_set_background_color (f
, arg
, oldval
)
1417 Lisp_Object arg
, oldval
;
1420 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1422 unload_color (f
, f
->output_data
.x
->background_pixel
);
1423 f
->output_data
.x
->background_pixel
= pixel
;
1425 if (FRAME_X_WINDOW (f
) != 0)
1428 /* The main frame area. */
1429 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1430 f
->output_data
.x
->background_pixel
);
1431 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1432 f
->output_data
.x
->background_pixel
);
1433 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1434 f
->output_data
.x
->background_pixel
);
1435 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1436 f
->output_data
.x
->background_pixel
);
1439 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1440 bar
= XSCROLL_BAR (bar
)->next
)
1441 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1442 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1443 f
->output_data
.x
->background_pixel
);
1447 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1449 if (FRAME_VISIBLE_P (f
))
1455 x_set_mouse_color (f
, arg
, oldval
)
1457 Lisp_Object arg
, oldval
;
1459 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1462 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1463 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1465 /* Don't let pointers be invisible. */
1466 if (mask_color
== pixel
1467 && mask_color
== f
->output_data
.x
->background_pixel
)
1468 pixel
= f
->output_data
.x
->foreground_pixel
;
1470 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1471 f
->output_data
.x
->mouse_pixel
= pixel
;
1475 /* It's not okay to crash if the user selects a screwy cursor. */
1476 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1478 if (!EQ (Qnil
, Vx_pointer_shape
))
1480 CHECK_NUMBER (Vx_pointer_shape
, 0);
1481 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1484 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1485 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1487 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1489 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1490 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1491 XINT (Vx_nontext_pointer_shape
));
1494 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1495 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1497 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1499 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1500 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1501 XINT (Vx_busy_pointer_shape
));
1504 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1505 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1507 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1508 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1510 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1511 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1512 XINT (Vx_mode_pointer_shape
));
1515 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1516 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1518 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1520 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1522 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1523 XINT (Vx_sensitive_text_pointer_shape
));
1526 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1528 /* Check and report errors with the above calls. */
1529 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1530 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1533 XColor fore_color
, back_color
;
1535 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1536 back_color
.pixel
= mask_color
;
1537 XQueryColor (FRAME_X_DISPLAY (f
),
1538 DefaultColormap (FRAME_X_DISPLAY (f
),
1539 DefaultScreen (FRAME_X_DISPLAY (f
))),
1541 XQueryColor (FRAME_X_DISPLAY (f
),
1542 DefaultColormap (FRAME_X_DISPLAY (f
),
1543 DefaultScreen (FRAME_X_DISPLAY (f
))),
1545 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1546 &fore_color
, &back_color
);
1547 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1548 &fore_color
, &back_color
);
1549 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1550 &fore_color
, &back_color
);
1551 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1552 &fore_color
, &back_color
);
1553 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1554 &fore_color
, &back_color
);
1557 if (FRAME_X_WINDOW (f
) != 0)
1558 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1560 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1561 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1562 f
->output_data
.x
->text_cursor
= cursor
;
1564 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1565 && f
->output_data
.x
->nontext_cursor
!= 0)
1566 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1567 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1569 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1570 && f
->output_data
.x
->busy_cursor
!= 0)
1571 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1572 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1574 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1575 && f
->output_data
.x
->modeline_cursor
!= 0)
1576 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1577 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1579 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1580 && f
->output_data
.x
->cross_cursor
!= 0)
1581 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1582 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1584 XFlush (FRAME_X_DISPLAY (f
));
1587 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1591 x_set_cursor_color (f
, arg
, oldval
)
1593 Lisp_Object arg
, oldval
;
1595 unsigned long fore_pixel
, pixel
;
1597 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1598 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1599 WHITE_PIX_DEFAULT (f
));
1601 fore_pixel
= f
->output_data
.x
->background_pixel
;
1602 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1604 /* Make sure that the cursor color differs from the background color. */
1605 if (pixel
== f
->output_data
.x
->background_pixel
)
1607 pixel
= f
->output_data
.x
->mouse_pixel
;
1608 if (pixel
== fore_pixel
)
1609 fore_pixel
= f
->output_data
.x
->background_pixel
;
1612 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1613 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1615 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1616 f
->output_data
.x
->cursor_pixel
= pixel
;
1618 if (FRAME_X_WINDOW (f
) != 0)
1621 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1622 f
->output_data
.x
->cursor_pixel
);
1623 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1627 if (FRAME_VISIBLE_P (f
))
1629 x_update_cursor (f
, 0);
1630 x_update_cursor (f
, 1);
1634 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1637 /* Set the border-color of frame F to value described by ARG.
1638 ARG can be a string naming a color.
1639 The border-color is used for the border that is drawn by the X server.
1640 Note that this does not fully take effect if done before
1641 F has an x-window; it must be redone when the window is created.
1643 Note: this is done in two routines because of the way X10 works.
1645 Note: under X11, this is normally the province of the window manager,
1646 and so emacs' border colors may be overridden. */
1649 x_set_border_color (f
, arg
, oldval
)
1651 Lisp_Object arg
, oldval
;
1655 CHECK_STRING (arg
, 0);
1656 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1657 x_set_border_pixel (f
, pix
);
1658 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1661 /* Set the border-color of frame F to pixel value PIX.
1662 Note that this does not fully take effect if done before
1663 F has an x-window. */
1666 x_set_border_pixel (f
, pix
)
1670 unload_color (f
, f
->output_data
.x
->border_pixel
);
1671 f
->output_data
.x
->border_pixel
= pix
;
1673 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1676 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1677 (unsigned long)pix
);
1680 if (FRAME_VISIBLE_P (f
))
1686 x_set_cursor_type (f
, arg
, oldval
)
1688 Lisp_Object arg
, oldval
;
1692 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1693 f
->output_data
.x
->cursor_width
= 2;
1695 else if (CONSP (arg
) && EQ (XCAR (arg
), Qbar
)
1696 && INTEGERP (XCDR (arg
)))
1698 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1699 f
->output_data
.x
->cursor_width
= XINT (XCDR (arg
));
1702 /* Treat anything unknown as "box cursor".
1703 It was bad to signal an error; people have trouble fixing
1704 .Xdefaults with Emacs, when it has something bad in it. */
1705 FRAME_DESIRED_CURSOR (f
) = FILLED_BOX_CURSOR
;
1707 /* Make sure the cursor gets redrawn. This is overkill, but how
1708 often do people change cursor types? */
1709 update_mode_lines
++;
1713 x_set_icon_type (f
, arg
, oldval
)
1715 Lisp_Object arg
, oldval
;
1721 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1724 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1729 result
= x_text_icon (f
,
1730 (char *) XSTRING ((!NILP (f
->icon_name
)
1734 result
= x_bitmap_icon (f
, arg
);
1739 error ("No icon window available");
1742 XFlush (FRAME_X_DISPLAY (f
));
1746 /* Return non-nil if frame F wants a bitmap icon. */
1754 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1762 x_set_icon_name (f
, arg
, oldval
)
1764 Lisp_Object arg
, oldval
;
1770 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1773 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1778 if (f
->output_data
.x
->icon_bitmap
!= 0)
1783 result
= x_text_icon (f
,
1784 (char *) XSTRING ((!NILP (f
->icon_name
)
1793 error ("No icon window available");
1796 XFlush (FRAME_X_DISPLAY (f
));
1801 x_set_font (f
, arg
, oldval
)
1803 Lisp_Object arg
, oldval
;
1806 Lisp_Object fontset_name
;
1809 CHECK_STRING (arg
, 1);
1811 fontset_name
= Fquery_fontset (arg
, Qnil
);
1814 result
= (STRINGP (fontset_name
)
1815 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1816 : x_new_font (f
, XSTRING (arg
)->data
));
1819 if (EQ (result
, Qnil
))
1820 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1821 else if (EQ (result
, Qt
))
1822 error ("The characters of the given font have varying widths");
1823 else if (STRINGP (result
))
1825 store_frame_param (f
, Qfont
, result
);
1826 recompute_basic_faces (f
);
1831 do_pending_window_change (0);
1833 /* Don't call `face-set-after-frame-default' when faces haven't been
1834 initialized yet. This is the case when called from
1835 Fx_create_frame. In that case, the X widget or window doesn't
1836 exist either, and we can end up in x_report_frame_params with a
1837 null widget which gives a segfault. */
1838 if (FRAME_FACE_CACHE (f
))
1840 XSETFRAME (frame
, f
);
1841 call1 (Qface_set_after_frame_default
, frame
);
1846 x_set_border_width (f
, arg
, oldval
)
1848 Lisp_Object arg
, oldval
;
1850 CHECK_NUMBER (arg
, 0);
1852 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1855 if (FRAME_X_WINDOW (f
) != 0)
1856 error ("Cannot change the border width of a window");
1858 f
->output_data
.x
->border_width
= XINT (arg
);
1862 x_set_internal_border_width (f
, arg
, oldval
)
1864 Lisp_Object arg
, oldval
;
1866 int old
= f
->output_data
.x
->internal_border_width
;
1868 CHECK_NUMBER (arg
, 0);
1869 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1870 if (f
->output_data
.x
->internal_border_width
< 0)
1871 f
->output_data
.x
->internal_border_width
= 0;
1873 #ifdef USE_X_TOOLKIT
1874 if (f
->output_data
.x
->edit_widget
)
1875 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1878 if (f
->output_data
.x
->internal_border_width
== old
)
1881 if (FRAME_X_WINDOW (f
) != 0)
1883 x_set_window_size (f
, 0, f
->width
, f
->height
);
1884 SET_FRAME_GARBAGED (f
);
1885 do_pending_window_change (0);
1890 x_set_visibility (f
, value
, oldval
)
1892 Lisp_Object value
, oldval
;
1895 XSETFRAME (frame
, f
);
1898 Fmake_frame_invisible (frame
, Qt
);
1899 else if (EQ (value
, Qicon
))
1900 Ficonify_frame (frame
);
1902 Fmake_frame_visible (frame
);
1906 x_set_menu_bar_lines_1 (window
, n
)
1910 struct window
*w
= XWINDOW (window
);
1912 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1913 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1915 /* Handle just the top child in a vertical split. */
1916 if (!NILP (w
->vchild
))
1917 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1919 /* Adjust all children in a horizontal split. */
1920 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1922 w
= XWINDOW (window
);
1923 x_set_menu_bar_lines_1 (window
, n
);
1928 x_set_menu_bar_lines (f
, value
, oldval
)
1930 Lisp_Object value
, oldval
;
1933 #ifndef USE_X_TOOLKIT
1934 int olines
= FRAME_MENU_BAR_LINES (f
);
1937 /* Right now, menu bars don't work properly in minibuf-only frames;
1938 most of the commands try to apply themselves to the minibuffer
1939 frame itself, and get an error because you can't switch buffers
1940 in or split the minibuffer window. */
1941 if (FRAME_MINIBUF_ONLY_P (f
))
1944 if (INTEGERP (value
))
1945 nlines
= XINT (value
);
1949 /* Make sure we redisplay all windows in this frame. */
1950 windows_or_buffers_changed
++;
1952 #ifdef USE_X_TOOLKIT
1953 FRAME_MENU_BAR_LINES (f
) = 0;
1956 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1957 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1958 /* Make sure next redisplay shows the menu bar. */
1959 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1963 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1964 free_frame_menubar (f
);
1965 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1967 f
->output_data
.x
->menubar_widget
= 0;
1969 #else /* not USE_X_TOOLKIT */
1970 FRAME_MENU_BAR_LINES (f
) = nlines
;
1971 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1972 #endif /* not USE_X_TOOLKIT */
1977 /* Set the number of lines used for the tool bar of frame F to VALUE.
1978 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1979 is the old number of tool bar lines. This function changes the
1980 height of all windows on frame F to match the new tool bar height.
1981 The frame's height doesn't change. */
1984 x_set_tool_bar_lines (f
, value
, oldval
)
1986 Lisp_Object value
, oldval
;
1990 /* Use VALUE only if an integer >= 0. */
1991 if (INTEGERP (value
) && XINT (value
) >= 0)
1992 nlines
= XFASTINT (value
);
1996 /* Make sure we redisplay all windows in this frame. */
1997 ++windows_or_buffers_changed
;
1999 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2000 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2001 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f
), delta
);
2006 /* Set the foreground color for scroll bars on frame F to VALUE.
2007 VALUE should be a string, a color name. If it isn't a string or
2008 isn't a valid color name, do nothing. OLDVAL is the old value of
2009 the frame parameter. */
2012 x_set_scroll_bar_foreground (f
, value
, oldval
)
2014 Lisp_Object value
, oldval
;
2016 unsigned long pixel
;
2018 if (STRINGP (value
))
2019 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2023 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2024 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2026 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2027 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2029 /* Remove all scroll bars because they have wrong colors. */
2030 if (condemn_scroll_bars_hook
)
2031 (*condemn_scroll_bars_hook
) (f
);
2032 if (judge_scroll_bars_hook
)
2033 (*judge_scroll_bars_hook
) (f
);
2035 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2041 /* Set the background color for scroll bars on frame F to VALUE VALUE
2042 should be a string, a color name. If it isn't a string or isn't a
2043 valid color name, do nothing. OLDVAL is the old value of the frame
2047 x_set_scroll_bar_background (f
, value
, oldval
)
2049 Lisp_Object value
, oldval
;
2051 unsigned long pixel
;
2053 if (STRINGP (value
))
2054 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2058 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2059 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2061 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2062 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2064 /* Remove all scroll bars because they have wrong colors. */
2065 if (condemn_scroll_bars_hook
)
2066 (*condemn_scroll_bars_hook
) (f
);
2067 if (judge_scroll_bars_hook
)
2068 (*judge_scroll_bars_hook
) (f
);
2070 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2076 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2079 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2080 name; if NAME is a string, set F's name to NAME and set
2081 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2083 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2084 suggesting a new name, which lisp code should override; if
2085 F->explicit_name is set, ignore the new name; otherwise, set it. */
2088 x_set_name (f
, name
, explicit)
2093 /* Make sure that requests from lisp code override requests from
2094 Emacs redisplay code. */
2097 /* If we're switching from explicit to implicit, we had better
2098 update the mode lines and thereby update the title. */
2099 if (f
->explicit_name
&& NILP (name
))
2100 update_mode_lines
= 1;
2102 f
->explicit_name
= ! NILP (name
);
2104 else if (f
->explicit_name
)
2107 /* If NAME is nil, set the name to the x_id_name. */
2110 /* Check for no change needed in this very common case
2111 before we do any consing. */
2112 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2113 XSTRING (f
->name
)->data
))
2115 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2118 CHECK_STRING (name
, 0);
2120 /* Don't change the name if it's already NAME. */
2121 if (! NILP (Fstring_equal (name
, f
->name
)))
2126 /* For setting the frame title, the title parameter should override
2127 the name parameter. */
2128 if (! NILP (f
->title
))
2131 if (FRAME_X_WINDOW (f
))
2136 XTextProperty text
, icon
;
2137 Lisp_Object icon_name
;
2139 text
.value
= XSTRING (name
)->data
;
2140 text
.encoding
= XA_STRING
;
2142 text
.nitems
= STRING_BYTES (XSTRING (name
));
2144 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2146 icon
.value
= XSTRING (icon_name
)->data
;
2147 icon
.encoding
= XA_STRING
;
2149 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2150 #ifdef USE_X_TOOLKIT
2151 XSetWMName (FRAME_X_DISPLAY (f
),
2152 XtWindow (f
->output_data
.x
->widget
), &text
);
2153 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2155 #else /* not USE_X_TOOLKIT */
2156 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2157 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2158 #endif /* not USE_X_TOOLKIT */
2160 #else /* not HAVE_X11R4 */
2161 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2162 XSTRING (name
)->data
);
2163 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2164 XSTRING (name
)->data
);
2165 #endif /* not HAVE_X11R4 */
2170 /* This function should be called when the user's lisp code has
2171 specified a name for the frame; the name will override any set by the
2174 x_explicitly_set_name (f
, arg
, oldval
)
2176 Lisp_Object arg
, oldval
;
2178 x_set_name (f
, arg
, 1);
2181 /* This function should be called by Emacs redisplay code to set the
2182 name; names set this way will never override names set by the user's
2185 x_implicitly_set_name (f
, arg
, oldval
)
2187 Lisp_Object arg
, oldval
;
2189 x_set_name (f
, arg
, 0);
2192 /* Change the title of frame F to NAME.
2193 If NAME is nil, use the frame name as the title.
2195 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2196 name; if NAME is a string, set F's name to NAME and set
2197 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2199 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2200 suggesting a new name, which lisp code should override; if
2201 F->explicit_name is set, ignore the new name; otherwise, set it. */
2204 x_set_title (f
, name
, old_name
)
2206 Lisp_Object name
, old_name
;
2208 /* Don't change the title if it's already NAME. */
2209 if (EQ (name
, f
->title
))
2212 update_mode_lines
= 1;
2219 CHECK_STRING (name
, 0);
2221 if (FRAME_X_WINDOW (f
))
2226 XTextProperty text
, icon
;
2227 Lisp_Object icon_name
;
2229 text
.value
= XSTRING (name
)->data
;
2230 text
.encoding
= XA_STRING
;
2232 text
.nitems
= STRING_BYTES (XSTRING (name
));
2234 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2236 icon
.value
= XSTRING (icon_name
)->data
;
2237 icon
.encoding
= XA_STRING
;
2239 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2240 #ifdef USE_X_TOOLKIT
2241 XSetWMName (FRAME_X_DISPLAY (f
),
2242 XtWindow (f
->output_data
.x
->widget
), &text
);
2243 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2245 #else /* not USE_X_TOOLKIT */
2246 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2247 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2248 #endif /* not USE_X_TOOLKIT */
2250 #else /* not HAVE_X11R4 */
2251 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2252 XSTRING (name
)->data
);
2253 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2254 XSTRING (name
)->data
);
2255 #endif /* not HAVE_X11R4 */
2261 x_set_autoraise (f
, arg
, oldval
)
2263 Lisp_Object arg
, oldval
;
2265 f
->auto_raise
= !EQ (Qnil
, arg
);
2269 x_set_autolower (f
, arg
, oldval
)
2271 Lisp_Object arg
, oldval
;
2273 f
->auto_lower
= !EQ (Qnil
, arg
);
2277 x_set_unsplittable (f
, arg
, oldval
)
2279 Lisp_Object arg
, oldval
;
2281 f
->no_split
= !NILP (arg
);
2285 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2287 Lisp_Object arg
, oldval
;
2289 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2290 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2291 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2292 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2294 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2296 ? vertical_scroll_bar_none
2298 ? vertical_scroll_bar_right
2299 : vertical_scroll_bar_left
);
2301 /* We set this parameter before creating the X window for the
2302 frame, so we can get the geometry right from the start.
2303 However, if the window hasn't been created yet, we shouldn't
2304 call x_set_window_size. */
2305 if (FRAME_X_WINDOW (f
))
2306 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2307 do_pending_window_change (0);
2312 x_set_scroll_bar_width (f
, arg
, oldval
)
2314 Lisp_Object arg
, oldval
;
2316 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2320 #ifdef USE_TOOLKIT_SCROLL_BARS
2321 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2322 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2323 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2324 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2326 /* Make the actual width at least 14 pixels and a multiple of a
2328 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2330 /* Use all of that space (aside from required margins) for the
2332 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2335 if (FRAME_X_WINDOW (f
))
2336 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2337 do_pending_window_change (0);
2339 else if (INTEGERP (arg
) && XINT (arg
) > 0
2340 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2342 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2343 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2345 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2346 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2347 if (FRAME_X_WINDOW (f
))
2348 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2351 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2352 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2353 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2358 /* Subroutines of creating an X frame. */
2360 /* Make sure that Vx_resource_name is set to a reasonable value.
2361 Fix it up, or set it to `emacs' if it is too hopeless. */
2364 validate_x_resource_name ()
2367 /* Number of valid characters in the resource name. */
2369 /* Number of invalid characters in the resource name. */
2374 if (!STRINGP (Vx_resource_class
))
2375 Vx_resource_class
= build_string (EMACS_CLASS
);
2377 if (STRINGP (Vx_resource_name
))
2379 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2382 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2384 /* Only letters, digits, - and _ are valid in resource names.
2385 Count the valid characters and count the invalid ones. */
2386 for (i
= 0; i
< len
; i
++)
2389 if (! ((c
>= 'a' && c
<= 'z')
2390 || (c
>= 'A' && c
<= 'Z')
2391 || (c
>= '0' && c
<= '9')
2392 || c
== '-' || c
== '_'))
2399 /* Not a string => completely invalid. */
2400 bad_count
= 5, good_count
= 0;
2402 /* If name is valid already, return. */
2406 /* If name is entirely invalid, or nearly so, use `emacs'. */
2408 || (good_count
== 1 && bad_count
> 0))
2410 Vx_resource_name
= build_string ("emacs");
2414 /* Name is partly valid. Copy it and replace the invalid characters
2415 with underscores. */
2417 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2419 for (i
= 0; i
< len
; i
++)
2421 int c
= XSTRING (new)->data
[i
];
2422 if (! ((c
>= 'a' && c
<= 'z')
2423 || (c
>= 'A' && c
<= 'Z')
2424 || (c
>= '0' && c
<= '9')
2425 || c
== '-' || c
== '_'))
2426 XSTRING (new)->data
[i
] = '_';
2431 extern char *x_get_string_resource ();
2433 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2434 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2435 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2436 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2437 the name specified by the `-name' or `-rn' command-line arguments.\n\
2439 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2440 class, respectively. You must specify both of them or neither.\n\
2441 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2442 and the class is `Emacs.CLASS.SUBCLASS'.")
2443 (attribute
, class, component
, subclass
)
2444 Lisp_Object attribute
, class, component
, subclass
;
2446 register char *value
;
2452 CHECK_STRING (attribute
, 0);
2453 CHECK_STRING (class, 0);
2455 if (!NILP (component
))
2456 CHECK_STRING (component
, 1);
2457 if (!NILP (subclass
))
2458 CHECK_STRING (subclass
, 2);
2459 if (NILP (component
) != NILP (subclass
))
2460 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2462 validate_x_resource_name ();
2464 /* Allocate space for the components, the dots which separate them,
2465 and the final '\0'. Make them big enough for the worst case. */
2466 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2467 + (STRINGP (component
)
2468 ? STRING_BYTES (XSTRING (component
)) : 0)
2469 + STRING_BYTES (XSTRING (attribute
))
2472 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2473 + STRING_BYTES (XSTRING (class))
2474 + (STRINGP (subclass
)
2475 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2478 /* Start with emacs.FRAMENAME for the name (the specific one)
2479 and with `Emacs' for the class key (the general one). */
2480 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2481 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2483 strcat (class_key
, ".");
2484 strcat (class_key
, XSTRING (class)->data
);
2486 if (!NILP (component
))
2488 strcat (class_key
, ".");
2489 strcat (class_key
, XSTRING (subclass
)->data
);
2491 strcat (name_key
, ".");
2492 strcat (name_key
, XSTRING (component
)->data
);
2495 strcat (name_key
, ".");
2496 strcat (name_key
, XSTRING (attribute
)->data
);
2498 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2499 name_key
, class_key
);
2501 if (value
!= (char *) 0)
2502 return build_string (value
);
2507 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2510 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2511 struct x_display_info
*dpyinfo
;
2512 Lisp_Object attribute
, class, component
, subclass
;
2514 register char *value
;
2520 CHECK_STRING (attribute
, 0);
2521 CHECK_STRING (class, 0);
2523 if (!NILP (component
))
2524 CHECK_STRING (component
, 1);
2525 if (!NILP (subclass
))
2526 CHECK_STRING (subclass
, 2);
2527 if (NILP (component
) != NILP (subclass
))
2528 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2530 validate_x_resource_name ();
2532 /* Allocate space for the components, the dots which separate them,
2533 and the final '\0'. Make them big enough for the worst case. */
2534 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2535 + (STRINGP (component
)
2536 ? STRING_BYTES (XSTRING (component
)) : 0)
2537 + STRING_BYTES (XSTRING (attribute
))
2540 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2541 + STRING_BYTES (XSTRING (class))
2542 + (STRINGP (subclass
)
2543 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2546 /* Start with emacs.FRAMENAME for the name (the specific one)
2547 and with `Emacs' for the class key (the general one). */
2548 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2549 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2551 strcat (class_key
, ".");
2552 strcat (class_key
, XSTRING (class)->data
);
2554 if (!NILP (component
))
2556 strcat (class_key
, ".");
2557 strcat (class_key
, XSTRING (subclass
)->data
);
2559 strcat (name_key
, ".");
2560 strcat (name_key
, XSTRING (component
)->data
);
2563 strcat (name_key
, ".");
2564 strcat (name_key
, XSTRING (attribute
)->data
);
2566 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2568 if (value
!= (char *) 0)
2569 return build_string (value
);
2574 /* Used when C code wants a resource value. */
2577 x_get_resource_string (attribute
, class)
2578 char *attribute
, *class;
2582 struct frame
*sf
= SELECTED_FRAME ();
2584 /* Allocate space for the components, the dots which separate them,
2585 and the final '\0'. */
2586 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2587 + strlen (attribute
) + 2);
2588 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2589 + strlen (class) + 2);
2591 sprintf (name_key
, "%s.%s",
2592 XSTRING (Vinvocation_name
)->data
,
2594 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2596 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2597 name_key
, class_key
);
2600 /* Types we might convert a resource string into. */
2610 /* Return the value of parameter PARAM.
2612 First search ALIST, then Vdefault_frame_alist, then the X defaults
2613 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2615 Convert the resource to the type specified by desired_type.
2617 If no default is specified, return Qunbound. If you call
2618 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2619 and don't let it get stored in any Lisp-visible variables! */
2622 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2623 struct x_display_info
*dpyinfo
;
2624 Lisp_Object alist
, param
;
2627 enum resource_types type
;
2629 register Lisp_Object tem
;
2631 tem
= Fassq (param
, alist
);
2633 tem
= Fassq (param
, Vdefault_frame_alist
);
2639 tem
= display_x_get_resource (dpyinfo
,
2640 build_string (attribute
),
2641 build_string (class),
2649 case RES_TYPE_NUMBER
:
2650 return make_number (atoi (XSTRING (tem
)->data
));
2652 case RES_TYPE_FLOAT
:
2653 return make_float (atof (XSTRING (tem
)->data
));
2655 case RES_TYPE_BOOLEAN
:
2656 tem
= Fdowncase (tem
);
2657 if (!strcmp (XSTRING (tem
)->data
, "on")
2658 || !strcmp (XSTRING (tem
)->data
, "true"))
2663 case RES_TYPE_STRING
:
2666 case RES_TYPE_SYMBOL
:
2667 /* As a special case, we map the values `true' and `on'
2668 to Qt, and `false' and `off' to Qnil. */
2671 lower
= Fdowncase (tem
);
2672 if (!strcmp (XSTRING (lower
)->data
, "on")
2673 || !strcmp (XSTRING (lower
)->data
, "true"))
2675 else if (!strcmp (XSTRING (lower
)->data
, "off")
2676 || !strcmp (XSTRING (lower
)->data
, "false"))
2679 return Fintern (tem
, Qnil
);
2692 /* Like x_get_arg, but also record the value in f->param_alist. */
2695 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2697 Lisp_Object alist
, param
;
2700 enum resource_types type
;
2704 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2705 attribute
, class, type
);
2707 store_frame_param (f
, param
, value
);
2712 /* Record in frame F the specified or default value according to ALIST
2713 of the parameter named PROP (a Lisp symbol).
2714 If no value is specified for PROP, look for an X default for XPROP
2715 on the frame named NAME.
2716 If that is not found either, use the value DEFLT. */
2719 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2726 enum resource_types type
;
2730 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2731 if (EQ (tem
, Qunbound
))
2733 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2738 /* Record in frame F the specified or default value according to ALIST
2739 of the parameter named PROP (a Lisp symbol). If no value is
2740 specified for PROP, look for an X default for XPROP on the frame
2741 named NAME. If that is not found either, use the value DEFLT. */
2744 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2753 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2756 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2757 if (EQ (tem
, Qunbound
))
2759 #ifdef USE_TOOLKIT_SCROLL_BARS
2761 /* See if an X resource for the scroll bar color has been
2763 tem
= display_x_get_resource (dpyinfo
,
2764 build_string (foreground_p
2768 build_string ("verticalScrollBar"),
2772 /* If nothing has been specified, scroll bars will use a
2773 toolkit-dependent default. Because these defaults are
2774 difficult to get at without actually creating a scroll
2775 bar, use nil to indicate that no color has been
2780 #else /* not USE_TOOLKIT_SCROLL_BARS */
2784 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2787 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2793 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2794 "Parse an X-style geometry string STRING.\n\
2795 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2796 The properties returned may include `top', `left', `height', and `width'.\n\
2797 The value of `left' or `top' may be an integer,\n\
2798 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2799 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2804 unsigned int width
, height
;
2807 CHECK_STRING (string
, 0);
2809 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2810 &x
, &y
, &width
, &height
);
2813 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2814 error ("Must specify both x and y position, or neither");
2818 if (geometry
& XValue
)
2820 Lisp_Object element
;
2822 if (x
>= 0 && (geometry
& XNegative
))
2823 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2824 else if (x
< 0 && ! (geometry
& XNegative
))
2825 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2827 element
= Fcons (Qleft
, make_number (x
));
2828 result
= Fcons (element
, result
);
2831 if (geometry
& YValue
)
2833 Lisp_Object element
;
2835 if (y
>= 0 && (geometry
& YNegative
))
2836 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2837 else if (y
< 0 && ! (geometry
& YNegative
))
2838 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2840 element
= Fcons (Qtop
, make_number (y
));
2841 result
= Fcons (element
, result
);
2844 if (geometry
& WidthValue
)
2845 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2846 if (geometry
& HeightValue
)
2847 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2852 /* Calculate the desired size and position of this window,
2853 and return the flags saying which aspects were specified.
2855 This function does not make the coordinates positive. */
2857 #define DEFAULT_ROWS 40
2858 #define DEFAULT_COLS 80
2861 x_figure_window_size (f
, parms
)
2865 register Lisp_Object tem0
, tem1
, tem2
;
2866 long window_prompting
= 0;
2867 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2869 /* Default values if we fall through.
2870 Actually, if that happens we should get
2871 window manager prompting. */
2872 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2873 f
->height
= DEFAULT_ROWS
;
2874 /* Window managers expect that if program-specified
2875 positions are not (0,0), they're intentional, not defaults. */
2876 f
->output_data
.x
->top_pos
= 0;
2877 f
->output_data
.x
->left_pos
= 0;
2879 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
2880 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
2881 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
2882 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2884 if (!EQ (tem0
, Qunbound
))
2886 CHECK_NUMBER (tem0
, 0);
2887 f
->height
= XINT (tem0
);
2889 if (!EQ (tem1
, Qunbound
))
2891 CHECK_NUMBER (tem1
, 0);
2892 SET_FRAME_WIDTH (f
, XINT (tem1
));
2894 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2895 window_prompting
|= USSize
;
2897 window_prompting
|= PSize
;
2900 f
->output_data
.x
->vertical_scroll_bar_extra
2901 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2903 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2904 f
->output_data
.x
->flags_areas_extra
2905 = FRAME_FLAGS_AREA_WIDTH (f
);
2906 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2907 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2909 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
2910 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
2911 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
2912 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2914 if (EQ (tem0
, Qminus
))
2916 f
->output_data
.x
->top_pos
= 0;
2917 window_prompting
|= YNegative
;
2919 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
2920 && CONSP (XCDR (tem0
))
2921 && INTEGERP (XCAR (XCDR (tem0
))))
2923 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
2924 window_prompting
|= YNegative
;
2926 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
2927 && CONSP (XCDR (tem0
))
2928 && INTEGERP (XCAR (XCDR (tem0
))))
2930 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
2932 else if (EQ (tem0
, Qunbound
))
2933 f
->output_data
.x
->top_pos
= 0;
2936 CHECK_NUMBER (tem0
, 0);
2937 f
->output_data
.x
->top_pos
= XINT (tem0
);
2938 if (f
->output_data
.x
->top_pos
< 0)
2939 window_prompting
|= YNegative
;
2942 if (EQ (tem1
, Qminus
))
2944 f
->output_data
.x
->left_pos
= 0;
2945 window_prompting
|= XNegative
;
2947 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
2948 && CONSP (XCDR (tem1
))
2949 && INTEGERP (XCAR (XCDR (tem1
))))
2951 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
2952 window_prompting
|= XNegative
;
2954 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
2955 && CONSP (XCDR (tem1
))
2956 && INTEGERP (XCAR (XCDR (tem1
))))
2958 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
2960 else if (EQ (tem1
, Qunbound
))
2961 f
->output_data
.x
->left_pos
= 0;
2964 CHECK_NUMBER (tem1
, 0);
2965 f
->output_data
.x
->left_pos
= XINT (tem1
);
2966 if (f
->output_data
.x
->left_pos
< 0)
2967 window_prompting
|= XNegative
;
2970 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2971 window_prompting
|= USPosition
;
2973 window_prompting
|= PPosition
;
2976 return window_prompting
;
2979 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2982 XSetWMProtocols (dpy
, w
, protocols
, count
)
2989 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
2990 if (prop
== None
) return False
;
2991 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
2992 (unsigned char *) protocols
, count
);
2995 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2997 #ifdef USE_X_TOOLKIT
2999 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3000 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3001 already be present because of the toolkit (Motif adds some of them,
3002 for example, but Xt doesn't). */
3005 hack_wm_protocols (f
, widget
)
3009 Display
*dpy
= XtDisplay (widget
);
3010 Window w
= XtWindow (widget
);
3011 int need_delete
= 1;
3017 Atom type
, *atoms
= 0;
3019 unsigned long nitems
= 0;
3020 unsigned long bytes_after
;
3022 if ((XGetWindowProperty (dpy
, w
,
3023 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3024 (long)0, (long)100, False
, XA_ATOM
,
3025 &type
, &format
, &nitems
, &bytes_after
,
3026 (unsigned char **) &atoms
)
3028 && format
== 32 && type
== XA_ATOM
)
3032 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3034 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3036 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3039 if (atoms
) XFree ((char *) atoms
);
3045 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3047 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3049 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3051 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3052 XA_ATOM
, 32, PropModeAppend
,
3053 (unsigned char *) props
, count
);
3061 /* Support routines for XIC (X Input Context). */
3065 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3066 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3069 /* Supported XIM styles, ordered by preferenc. */
3071 static XIMStyle supported_xim_styles
[] =
3073 XIMPreeditPosition
| XIMStatusArea
,
3074 XIMPreeditPosition
| XIMStatusNothing
,
3075 XIMPreeditPosition
| XIMStatusNone
,
3076 XIMPreeditNothing
| XIMStatusArea
,
3077 XIMPreeditNothing
| XIMStatusNothing
,
3078 XIMPreeditNothing
| XIMStatusNone
,
3079 XIMPreeditNone
| XIMStatusArea
,
3080 XIMPreeditNone
| XIMStatusNothing
,
3081 XIMPreeditNone
| XIMStatusNone
,
3086 /* Create an X fontset on frame F with base font name
3090 xic_create_xfontset (f
, base_fontname
)
3092 char *base_fontname
;
3095 char **missing_list
;
3099 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3100 base_fontname
, &missing_list
,
3101 &missing_count
, &def_string
);
3103 XFreeStringList (missing_list
);
3105 /* No need to free def_string. */
3110 /* Value is the best input style, given user preferences USER (already
3111 checked to be supported by Emacs), and styles supported by the
3112 input method XIM. */
3115 best_xim_style (user
, xim
)
3121 for (i
= 0; i
< user
->count_styles
; ++i
)
3122 for (j
= 0; j
< xim
->count_styles
; ++j
)
3123 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3124 return user
->supported_styles
[i
];
3126 /* Return the default style. */
3127 return XIMPreeditNothing
| XIMStatusNothing
;
3130 /* Create XIC for frame F. */
3133 create_frame_xic (f
)
3136 #ifndef X_I18N_INHIBITED
3139 XFontSet xfs
= NULL
;
3140 static XIMStyle xic_style
;
3145 xim
= FRAME_X_XIM (f
);
3150 XVaNestedList preedit_attr
;
3151 XVaNestedList status_attr
;
3152 char *base_fontname
;
3155 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3156 spot
.x
= 0; spot
.y
= 1;
3157 /* Create X fontset. */
3158 fontset
= FRAME_FONTSET (f
);
3160 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3163 struct fontset_info
*fontsetp
;
3167 fontsetp
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
3168 for (i
= 0; i
<= MAX_CHARSET
; i
++)
3169 if (fontsetp
->fontname
[i
])
3170 len
+= strlen (fontsetp
->fontname
[i
]) + 1;
3171 base_fontname
= alloca (len
);
3172 strcpy (base_fontname
, fontsetp
->fontname
[CHARSET_ASCII
]);
3173 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
<= MAX_CHARSET
; i
++)
3174 if (fontsetp
->fontname
[i
])
3176 strcat (base_fontname
, ",");
3177 strcat (base_fontname
, fontsetp
->fontname
[i
]);
3180 xfs
= xic_create_xfontset (f
, base_fontname
);
3182 /* Determine XIC style. */
3185 XIMStyles supported_list
;
3186 supported_list
.count_styles
= (sizeof supported_xim_styles
3187 / sizeof supported_xim_styles
[0]);
3188 supported_list
.supported_styles
= supported_xim_styles
;
3189 xic_style
= best_xim_style (&supported_list
,
3190 FRAME_X_XIM_STYLES (f
));
3193 preedit_attr
= XVaCreateNestedList (0,
3196 FRAME_FOREGROUND_PIXEL (f
),
3198 FRAME_BACKGROUND_PIXEL (f
),
3199 (xic_style
& XIMPreeditPosition
3204 status_attr
= XVaCreateNestedList (0,
3210 FRAME_FOREGROUND_PIXEL (f
),
3212 FRAME_BACKGROUND_PIXEL (f
),
3215 xic
= XCreateIC (xim
,
3216 XNInputStyle
, xic_style
,
3217 XNClientWindow
, FRAME_X_WINDOW(f
),
3218 XNFocusWindow
, FRAME_X_WINDOW(f
),
3219 XNStatusAttributes
, status_attr
,
3220 XNPreeditAttributes
, preedit_attr
,
3222 XFree (preedit_attr
);
3223 XFree (status_attr
);
3226 FRAME_XIC (f
) = xic
;
3227 FRAME_XIC_STYLE (f
) = xic_style
;
3228 FRAME_XIC_FONTSET (f
) = xfs
;
3229 #else /* X_I18N_INHIBITED */
3230 FRAME_XIC (f
) = NULL
;
3231 FRAME_XIC_STYLE (f
) = 0;
3232 FRAME_XIC_FONTSET (f
) = NULL
;
3233 #endif /* X_I18N_INHIBITED */
3237 /* Destroy XIC and free XIC fontset of frame F, if any. */
3243 if (FRAME_XIC (f
) == NULL
)
3246 XDestroyIC (FRAME_XIC (f
));
3247 if (FRAME_XIC_FONTSET (f
))
3248 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3250 FRAME_XIC (f
) = NULL
;
3251 FRAME_XIC_FONTSET (f
) = NULL
;
3255 /* Place preedit area for XIC of window W's frame to specified
3256 pixel position X/Y. X and Y are relative to window W. */
3259 xic_set_preeditarea (w
, x
, y
)
3263 struct frame
*f
= XFRAME (w
->frame
);
3267 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3268 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3269 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3270 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3275 /* Place status area for XIC in bottom right corner of frame F.. */
3278 xic_set_statusarea (f
)
3281 XIC xic
= FRAME_XIC (f
);
3286 /* Negotiate geometry of status area. If input method has existing
3287 status area, use its current size. */
3288 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3289 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3290 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3293 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3294 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3297 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3299 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3300 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3304 area
.width
= needed
->width
;
3305 area
.height
= needed
->height
;
3306 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3307 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3308 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3311 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3312 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3317 /* Set X fontset for XIC of frame F, using base font name
3318 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3321 xic_set_xfontset (f
, base_fontname
)
3323 char *base_fontname
;
3328 xfs
= xic_create_xfontset (f
, base_fontname
);
3330 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3331 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3332 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3333 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3334 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3337 if (FRAME_XIC_FONTSET (f
))
3338 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3339 FRAME_XIC_FONTSET (f
) = xfs
;
3342 #endif /* HAVE_X_I18N */
3346 #ifdef USE_X_TOOLKIT
3348 /* Create and set up the X widget for frame F. */
3351 x_window (f
, window_prompting
, minibuffer_only
)
3353 long window_prompting
;
3354 int minibuffer_only
;
3356 XClassHint class_hints
;
3357 XSetWindowAttributes attributes
;
3358 unsigned long attribute_mask
;
3360 Widget shell_widget
;
3362 Widget frame_widget
;
3368 /* Use the resource name as the top-level widget name
3369 for looking up resources. Make a non-Lisp copy
3370 for the window manager, so GC relocation won't bother it.
3372 Elsewhere we specify the window name for the window manager. */
3375 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3376 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3377 strcpy (f
->namebuf
, str
);
3381 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3382 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3383 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3384 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3385 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3386 applicationShellWidgetClass
,
3387 FRAME_X_DISPLAY (f
), al
, ac
);
3389 f
->output_data
.x
->widget
= shell_widget
;
3390 /* maybe_set_screen_title_format (shell_widget); */
3392 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3393 (widget_value
*) NULL
,
3394 shell_widget
, False
,
3398 (lw_callback
) NULL
);
3400 f
->output_data
.x
->column_widget
= pane_widget
;
3402 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3403 the emacs screen when changing menubar. This reduces flickering. */
3406 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3407 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3408 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3409 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3410 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3411 frame_widget
= XtCreateWidget (f
->namebuf
,
3413 pane_widget
, al
, ac
);
3415 f
->output_data
.x
->edit_widget
= frame_widget
;
3417 XtManageChild (frame_widget
);
3419 /* Do some needed geometry management. */
3422 char *tem
, shell_position
[32];
3425 int extra_borders
= 0;
3427 = (f
->output_data
.x
->menubar_widget
3428 ? (f
->output_data
.x
->menubar_widget
->core
.height
3429 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3432 #if 0 /* Experimentally, we now get the right results
3433 for -geometry -0-0 without this. 24 Aug 96, rms. */
3434 if (FRAME_EXTERNAL_MENU_BAR (f
))
3437 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3438 menubar_size
+= ibw
;
3442 f
->output_data
.x
->menubar_height
= menubar_size
;
3445 /* Motif seems to need this amount added to the sizes
3446 specified for the shell widget. The Athena/Lucid widgets don't.
3447 Both conclusions reached experimentally. -- rms. */
3448 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3449 &extra_borders
, NULL
);
3453 /* Convert our geometry parameters into a geometry string
3455 Note that we do not specify here whether the position
3456 is a user-specified or program-specified one.
3457 We pass that information later, in x_wm_set_size_hints. */
3459 int left
= f
->output_data
.x
->left_pos
;
3460 int xneg
= window_prompting
& XNegative
;
3461 int top
= f
->output_data
.x
->top_pos
;
3462 int yneg
= window_prompting
& YNegative
;
3468 if (window_prompting
& USPosition
)
3469 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3470 PIXEL_WIDTH (f
) + extra_borders
,
3471 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3472 (xneg
? '-' : '+'), left
,
3473 (yneg
? '-' : '+'), top
);
3475 sprintf (shell_position
, "=%dx%d",
3476 PIXEL_WIDTH (f
) + extra_borders
,
3477 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3480 len
= strlen (shell_position
) + 1;
3481 /* We don't free this because we don't know whether
3482 it is safe to free it while the frame exists.
3483 It isn't worth the trouble of arranging to free it
3484 when the frame is deleted. */
3485 tem
= (char *) xmalloc (len
);
3486 strncpy (tem
, shell_position
, len
);
3487 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3488 XtSetValues (shell_widget
, al
, ac
);
3491 XtManageChild (pane_widget
);
3492 XtRealizeWidget (shell_widget
);
3494 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3496 validate_x_resource_name ();
3498 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3499 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3500 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3503 FRAME_XIC (f
) = NULL
;
3504 create_frame_xic (f
);
3507 f
->output_data
.x
->wm_hints
.input
= True
;
3508 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3509 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3510 &f
->output_data
.x
->wm_hints
);
3512 hack_wm_protocols (f
, shell_widget
);
3515 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3518 /* Do a stupid property change to force the server to generate a
3519 PropertyNotify event so that the event_stream server timestamp will
3520 be initialized to something relevant to the time we created the window.
3522 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3523 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3524 XA_ATOM
, 32, PropModeAppend
,
3525 (unsigned char*) NULL
, 0);
3527 /* Make all the standard events reach the Emacs frame. */
3528 attributes
.event_mask
= STANDARD_EVENT_SET
;
3533 /* XIM server might require some X events. */
3534 unsigned long fevent
= NoEventMask
;
3535 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3536 attributes
.event_mask
|= fevent
;
3538 #endif /* HAVE_X_I18N */
3540 attribute_mask
= CWEventMask
;
3541 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3542 attribute_mask
, &attributes
);
3544 XtMapWidget (frame_widget
);
3546 /* x_set_name normally ignores requests to set the name if the
3547 requested name is the same as the current name. This is the one
3548 place where that assumption isn't correct; f->name is set, but
3549 the X server hasn't been told. */
3552 int explicit = f
->explicit_name
;
3554 f
->explicit_name
= 0;
3557 x_set_name (f
, name
, explicit);
3560 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3561 f
->output_data
.x
->text_cursor
);
3565 /* This is a no-op, except under Motif. Make sure main areas are
3566 set to something reasonable, in case we get an error later. */
3567 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3570 #else /* not USE_X_TOOLKIT */
3572 /* Create and set up the X window for frame F. */
3579 XClassHint class_hints
;
3580 XSetWindowAttributes attributes
;
3581 unsigned long attribute_mask
;
3583 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3584 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3585 attributes
.bit_gravity
= StaticGravity
;
3586 attributes
.backing_store
= NotUseful
;
3587 attributes
.save_under
= True
;
3588 attributes
.event_mask
= STANDARD_EVENT_SET
;
3589 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
3591 | CWBackingStore
| CWSaveUnder
3597 = XCreateWindow (FRAME_X_DISPLAY (f
),
3598 f
->output_data
.x
->parent_desc
,
3599 f
->output_data
.x
->left_pos
,
3600 f
->output_data
.x
->top_pos
,
3601 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3602 f
->output_data
.x
->border_width
,
3603 CopyFromParent
, /* depth */
3604 InputOutput
, /* class */
3605 FRAME_X_DISPLAY_INFO (f
)->visual
,
3606 attribute_mask
, &attributes
);
3609 create_frame_xic (f
);
3612 /* XIM server might require some X events. */
3613 unsigned long fevent
= NoEventMask
;
3614 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3615 attributes
.event_mask
|= fevent
;
3616 attribute_mask
= CWEventMask
;
3617 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3618 attribute_mask
, &attributes
);
3620 #endif /* HAVE_X_I18N */
3622 validate_x_resource_name ();
3624 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3625 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3626 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3628 /* The menubar is part of the ordinary display;
3629 it does not count in addition to the height of the window. */
3630 f
->output_data
.x
->menubar_height
= 0;
3632 /* This indicates that we use the "Passive Input" input model.
3633 Unless we do this, we don't get the Focus{In,Out} events that we
3634 need to draw the cursor correctly. Accursed bureaucrats.
3635 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3637 f
->output_data
.x
->wm_hints
.input
= True
;
3638 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3639 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3640 &f
->output_data
.x
->wm_hints
);
3641 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3643 /* Request "save yourself" and "delete window" commands from wm. */
3646 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3647 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3648 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3651 /* x_set_name normally ignores requests to set the name if the
3652 requested name is the same as the current name. This is the one
3653 place where that assumption isn't correct; f->name is set, but
3654 the X server hasn't been told. */
3657 int explicit = f
->explicit_name
;
3659 f
->explicit_name
= 0;
3662 x_set_name (f
, name
, explicit);
3665 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3666 f
->output_data
.x
->text_cursor
);
3670 if (FRAME_X_WINDOW (f
) == 0)
3671 error ("Unable to create window");
3674 #endif /* not USE_X_TOOLKIT */
3676 /* Handle the icon stuff for this window. Perhaps later we might
3677 want an x_set_icon_position which can be called interactively as
3685 Lisp_Object icon_x
, icon_y
;
3686 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3688 /* Set the position of the icon. Note that twm groups all
3689 icons in an icon window. */
3690 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3691 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3692 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3694 CHECK_NUMBER (icon_x
, 0);
3695 CHECK_NUMBER (icon_y
, 0);
3697 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3698 error ("Both left and top icon corners of icon must be specified");
3702 if (! EQ (icon_x
, Qunbound
))
3703 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3705 /* Start up iconic or window? */
3706 x_wm_set_window_state
3707 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3712 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3719 /* Make the GC's needed for this window, setting the
3720 background, border and mouse colors; also create the
3721 mouse cursor and the gray border tile. */
3723 static char cursor_bits
[] =
3725 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3726 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3727 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3728 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3735 XGCValues gc_values
;
3739 /* Create the GC's of this frame.
3740 Note that many default values are used. */
3743 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3744 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3745 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3746 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3747 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3749 GCLineWidth
| GCFont
3750 | GCForeground
| GCBackground
,
3753 /* Reverse video style. */
3754 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3755 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3756 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3758 GCFont
| GCForeground
| GCBackground
3762 /* Cursor has cursor-color background, background-color foreground. */
3763 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3764 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3765 gc_values
.fill_style
= FillOpaqueStippled
;
3767 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3768 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3769 cursor_bits
, 16, 16);
3770 f
->output_data
.x
->cursor_gc
3771 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3772 (GCFont
| GCForeground
| GCBackground
3773 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3777 f
->output_data
.x
->white_relief
.gc
= 0;
3778 f
->output_data
.x
->black_relief
.gc
= 0;
3780 /* Create the gray border tile used when the pointer is not in
3781 the frame. Since this depends on the frame's pixel values,
3782 this must be done on a per-frame basis. */
3783 f
->output_data
.x
->border_tile
3784 = (XCreatePixmapFromBitmapData
3785 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3786 gray_bits
, gray_width
, gray_height
,
3787 f
->output_data
.x
->foreground_pixel
,
3788 f
->output_data
.x
->background_pixel
,
3789 DefaultDepth (FRAME_X_DISPLAY (f
),
3790 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3795 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3797 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3798 Returns an Emacs frame object.\n\
3799 ALIST is an alist of frame parameters.\n\
3800 If the parameters specify that the frame should not have a minibuffer,\n\
3801 and do not specify a specific minibuffer window to use,\n\
3802 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3803 be shared by the new frame.\n\
3805 This function is an internal primitive--use `make-frame' instead.")
3810 Lisp_Object frame
, tem
;
3812 int minibuffer_only
= 0;
3813 long window_prompting
= 0;
3815 int count
= specpdl_ptr
- specpdl
;
3816 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3817 Lisp_Object display
;
3818 struct x_display_info
*dpyinfo
= NULL
;
3824 /* Use this general default value to start with
3825 until we know if this frame has a specified name. */
3826 Vx_resource_name
= Vinvocation_name
;
3828 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3829 if (EQ (display
, Qunbound
))
3831 dpyinfo
= check_x_display_info (display
);
3833 kb
= dpyinfo
->kboard
;
3835 kb
= &the_only_kboard
;
3838 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3840 && ! EQ (name
, Qunbound
)
3842 error ("Invalid frame name--not a string or nil");
3845 Vx_resource_name
= name
;
3847 /* See if parent window is specified. */
3848 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
3849 if (EQ (parent
, Qunbound
))
3851 if (! NILP (parent
))
3852 CHECK_NUMBER (parent
, 0);
3854 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3855 /* No need to protect DISPLAY because that's not used after passing
3856 it to make_frame_without_minibuffer. */
3858 GCPRO4 (parms
, parent
, name
, frame
);
3859 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
3861 if (EQ (tem
, Qnone
) || NILP (tem
))
3862 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3863 else if (EQ (tem
, Qonly
))
3865 f
= make_minibuffer_frame ();
3866 minibuffer_only
= 1;
3868 else if (WINDOWP (tem
))
3869 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3873 XSETFRAME (frame
, f
);
3875 /* Note that X Windows does support scroll bars. */
3876 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3878 f
->output_method
= output_x_window
;
3879 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
3880 bzero (f
->output_data
.x
, sizeof (struct x_output
));
3881 f
->output_data
.x
->icon_bitmap
= -1;
3882 f
->output_data
.x
->fontset
= -1;
3883 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
3884 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
3887 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
3889 if (! STRINGP (f
->icon_name
))
3890 f
->icon_name
= Qnil
;
3892 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
3894 FRAME_KBOARD (f
) = kb
;
3897 /* Specify the parent under which to make this X window. */
3901 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
3902 f
->output_data
.x
->explicit_parent
= 1;
3906 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3907 f
->output_data
.x
->explicit_parent
= 0;
3910 /* Set the name; the functions to which we pass f expect the name to
3912 if (EQ (name
, Qunbound
) || NILP (name
))
3914 f
->name
= build_string (dpyinfo
->x_id_name
);
3915 f
->explicit_name
= 0;
3920 f
->explicit_name
= 1;
3921 /* use the frame's title when getting resources for this frame. */
3922 specbind (Qx_resource_name
, name
);
3925 /* Create fontsets from `global_fontset_alist' before handling fonts. */
3926 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
3927 fs_register_fontset (f
, XCAR (tem
));
3929 /* Extract the window parameters from the supplied values
3930 that are needed to determine window geometry. */
3934 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
3937 /* First, try whatever font the caller has specified. */
3940 tem
= Fquery_fontset (font
, Qnil
);
3942 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
3944 font
= x_new_font (f
, XSTRING (font
)->data
);
3947 /* Try out a font which we hope has bold and italic variations. */
3948 if (!STRINGP (font
))
3949 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3950 if (!STRINGP (font
))
3951 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3952 if (! STRINGP (font
))
3953 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3954 if (! STRINGP (font
))
3955 /* This was formerly the first thing tried, but it finds too many fonts
3956 and takes too long. */
3957 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3958 /* If those didn't work, look for something which will at least work. */
3959 if (! STRINGP (font
))
3960 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3962 if (! STRINGP (font
))
3963 font
= build_string ("fixed");
3965 x_default_parameter (f
, parms
, Qfont
, font
,
3966 "font", "Font", RES_TYPE_STRING
);
3970 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3971 whereby it fails to get any font. */
3972 xlwmenu_default_font
= f
->output_data
.x
->font
;
3975 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3976 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
3978 /* This defaults to 2 in order to match xterm. We recognize either
3979 internalBorderWidth or internalBorder (which is what xterm calls
3981 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3985 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
3986 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
3987 if (! EQ (value
, Qunbound
))
3988 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3991 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
3992 "internalBorderWidth", "internalBorderWidth",
3994 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
3995 "verticalScrollBars", "ScrollBars",
3998 /* Also do the stuff which must be set before the window exists. */
3999 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4000 "foreground", "Foreground", RES_TYPE_STRING
);
4001 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4002 "background", "Background", RES_TYPE_STRING
);
4003 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4004 "pointerColor", "Foreground", RES_TYPE_STRING
);
4005 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4006 "cursorColor", "Foreground", RES_TYPE_STRING
);
4007 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4008 "borderColor", "BorderColor", RES_TYPE_STRING
);
4009 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4010 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4012 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4013 "scrollBarForeground",
4014 "ScrollBarForeground", 1);
4015 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4016 "scrollBarBackground",
4017 "ScrollBarBackground", 0);
4019 /* Init faces before x_default_parameter is called for scroll-bar
4020 parameters because that function calls x_set_scroll_bar_width,
4021 which calls change_frame_size, which calls Fset_window_buffer,
4022 which runs hooks, which call Fvertical_motion. At the end, we
4023 end up in init_iterator with a null face cache, which should not
4025 init_frame_faces (f
);
4027 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4028 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4029 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
4030 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4031 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4032 "bufferPredicate", "BufferPredicate",
4034 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4035 "title", "Title", RES_TYPE_STRING
);
4037 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4038 window_prompting
= x_figure_window_size (f
, parms
);
4040 if (window_prompting
& XNegative
)
4042 if (window_prompting
& YNegative
)
4043 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4045 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4049 if (window_prompting
& YNegative
)
4050 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4052 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4055 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4057 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4058 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4060 /* Create the X widget or window. Add the tool-bar height to the
4061 initial frame height so that the user gets a text display area of
4062 the size he specified with -g or via .Xdefaults. Later changes
4063 of the tool-bar height don't change the frame size. This is done
4064 so that users can create tall Emacs frames without having to
4065 guess how tall the tool-bar will get. */
4066 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
4068 #ifdef USE_X_TOOLKIT
4069 x_window (f
, window_prompting
, minibuffer_only
);
4077 /* Now consider the frame official. */
4078 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4079 Vframe_list
= Fcons (frame
, Vframe_list
);
4081 /* We need to do this after creating the X window, so that the
4082 icon-creation functions can say whose icon they're describing. */
4083 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4084 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4086 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4087 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4088 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4089 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4090 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4091 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4092 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4093 "scrollBarWidth", "ScrollBarWidth",
4096 /* Dimensions, especially f->height, must be done via change_frame_size.
4097 Change will not be effected unless different from the current
4102 SET_FRAME_WIDTH (f
, 0);
4103 change_frame_size (f
, height
, width
, 1, 0, 0);
4105 /* Set up faces after all frame parameters are known. */
4106 call1 (Qface_set_after_frame_default
, frame
);
4108 #ifdef USE_X_TOOLKIT
4109 /* Create the menu bar. */
4110 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4112 /* If this signals an error, we haven't set size hints for the
4113 frame and we didn't make it visible. */
4114 initialize_frame_menubar (f
);
4116 /* This is a no-op, except under Motif where it arranges the
4117 main window for the widgets on it. */
4118 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4119 f
->output_data
.x
->menubar_widget
,
4120 f
->output_data
.x
->edit_widget
);
4122 #endif /* USE_X_TOOLKIT */
4124 /* Tell the server what size and position, etc, we want, and how
4125 badly we want them. This should be done after we have the menu
4126 bar so that its size can be taken into account. */
4128 x_wm_set_size_hint (f
, window_prompting
, 0);
4131 /* Make the window appear on the frame and enable display, unless
4132 the caller says not to. However, with explicit parent, Emacs
4133 cannot control visibility, so don't try. */
4134 if (! f
->output_data
.x
->explicit_parent
)
4136 Lisp_Object visibility
;
4138 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4140 if (EQ (visibility
, Qunbound
))
4143 if (EQ (visibility
, Qicon
))
4144 x_iconify_frame (f
);
4145 else if (! NILP (visibility
))
4146 x_make_frame_visible (f
);
4148 /* Must have been Qnil. */
4153 return unbind_to (count
, frame
);
4156 /* FRAME is used only to get a handle on the X display. We don't pass the
4157 display info directly because we're called from frame.c, which doesn't
4158 know about that structure. */
4161 x_get_focus_frame (frame
)
4162 struct frame
*frame
;
4164 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4166 if (! dpyinfo
->x_focus_frame
)
4169 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4174 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4175 "Internal function called by `color-defined-p', which see.")
4177 Lisp_Object color
, frame
;
4180 FRAME_PTR f
= check_x_frame (frame
);
4182 CHECK_STRING (color
, 1);
4184 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4190 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4191 "Internal function called by `color-values', which see.")
4193 Lisp_Object color
, frame
;
4196 FRAME_PTR f
= check_x_frame (frame
);
4198 CHECK_STRING (color
, 1);
4200 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4204 rgb
[0] = make_number (foo
.red
);
4205 rgb
[1] = make_number (foo
.green
);
4206 rgb
[2] = make_number (foo
.blue
);
4207 return Flist (3, rgb
);
4213 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4214 "Internal function called by `display-color-p', which see.")
4216 Lisp_Object display
;
4218 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4220 if (dpyinfo
->n_planes
<= 2)
4223 switch (dpyinfo
->visual
->class)
4236 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4238 "Return t if the X display supports shades of gray.\n\
4239 Note that color displays do support shades of gray.\n\
4240 The optional argument DISPLAY specifies which display to ask about.\n\
4241 DISPLAY should be either a frame or a display name (a string).\n\
4242 If omitted or nil, that stands for the selected frame's display.")
4244 Lisp_Object display
;
4246 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4248 if (dpyinfo
->n_planes
<= 1)
4251 switch (dpyinfo
->visual
->class)
4266 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4268 "Returns the width in pixels of the X display DISPLAY.\n\
4269 The optional argument DISPLAY specifies which display to ask about.\n\
4270 DISPLAY should be either a frame or a display name (a string).\n\
4271 If omitted or nil, that stands for the selected frame's display.")
4273 Lisp_Object display
;
4275 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4277 return make_number (dpyinfo
->width
);
4280 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4281 Sx_display_pixel_height
, 0, 1, 0,
4282 "Returns the height in pixels of the X display DISPLAY.\n\
4283 The optional argument DISPLAY specifies which display to ask about.\n\
4284 DISPLAY should be either a frame or a display name (a string).\n\
4285 If omitted or nil, that stands for the selected frame's display.")
4287 Lisp_Object display
;
4289 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4291 return make_number (dpyinfo
->height
);
4294 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4296 "Returns the number of bitplanes of the X display DISPLAY.\n\
4297 The optional argument DISPLAY specifies which display to ask about.\n\
4298 DISPLAY should be either a frame or a display name (a string).\n\
4299 If omitted or nil, that stands for the selected frame's display.")
4301 Lisp_Object display
;
4303 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4305 return make_number (dpyinfo
->n_planes
);
4308 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4310 "Returns the number of color cells of the X display DISPLAY.\n\
4311 The optional argument DISPLAY specifies which display to ask about.\n\
4312 DISPLAY should be either a frame or a display name (a string).\n\
4313 If omitted or nil, that stands for the selected frame's display.")
4315 Lisp_Object display
;
4317 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4319 return make_number (DisplayCells (dpyinfo
->display
,
4320 XScreenNumberOfScreen (dpyinfo
->screen
)));
4323 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4324 Sx_server_max_request_size
,
4326 "Returns the maximum request size of the X server of display DISPLAY.\n\
4327 The optional argument DISPLAY specifies which display to ask about.\n\
4328 DISPLAY should be either a frame or a display name (a string).\n\
4329 If omitted or nil, that stands for the selected frame's display.")
4331 Lisp_Object display
;
4333 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4335 return make_number (MAXREQUEST (dpyinfo
->display
));
4338 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4339 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4340 The optional argument DISPLAY specifies which display to ask about.\n\
4341 DISPLAY should be either a frame or a display name (a string).\n\
4342 If omitted or nil, that stands for the selected frame's display.")
4344 Lisp_Object display
;
4346 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4347 char *vendor
= ServerVendor (dpyinfo
->display
);
4349 if (! vendor
) vendor
= "";
4350 return build_string (vendor
);
4353 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4354 "Returns the version numbers of the X server of display DISPLAY.\n\
4355 The value is a list of three integers: the major and minor\n\
4356 version numbers of the X Protocol in use, and the vendor-specific release\n\
4357 number. See also the function `x-server-vendor'.\n\n\
4358 The optional argument DISPLAY specifies which display to ask about.\n\
4359 DISPLAY should be either a frame or a display name (a string).\n\
4360 If omitted or nil, that stands for the selected frame's display.")
4362 Lisp_Object display
;
4364 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4365 Display
*dpy
= dpyinfo
->display
;
4367 return Fcons (make_number (ProtocolVersion (dpy
)),
4368 Fcons (make_number (ProtocolRevision (dpy
)),
4369 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4372 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4373 "Returns the number of screens on the X server of display DISPLAY.\n\
4374 The optional argument DISPLAY specifies which display to ask about.\n\
4375 DISPLAY should be either a frame or a display name (a string).\n\
4376 If omitted or nil, that stands for the selected frame's display.")
4378 Lisp_Object display
;
4380 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4382 return make_number (ScreenCount (dpyinfo
->display
));
4385 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4386 "Returns the height in millimeters of the X display DISPLAY.\n\
4387 The optional argument DISPLAY specifies which display to ask about.\n\
4388 DISPLAY should be either a frame or a display name (a string).\n\
4389 If omitted or nil, that stands for the selected frame's display.")
4391 Lisp_Object display
;
4393 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4395 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4398 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4399 "Returns the width in millimeters of the X display DISPLAY.\n\
4400 The optional argument DISPLAY specifies which display to ask about.\n\
4401 DISPLAY should be either a frame or a display name (a string).\n\
4402 If omitted or nil, that stands for the selected frame's display.")
4404 Lisp_Object display
;
4406 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4408 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4411 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4412 Sx_display_backing_store
, 0, 1, 0,
4413 "Returns an indication of whether X display DISPLAY does backing store.\n\
4414 The value may be `always', `when-mapped', or `not-useful'.\n\
4415 The optional argument DISPLAY specifies which display to ask about.\n\
4416 DISPLAY should be either a frame or a display name (a string).\n\
4417 If omitted or nil, that stands for the selected frame's display.")
4419 Lisp_Object display
;
4421 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4423 switch (DoesBackingStore (dpyinfo
->screen
))
4426 return intern ("always");
4429 return intern ("when-mapped");
4432 return intern ("not-useful");
4435 error ("Strange value for BackingStore parameter of screen");
4439 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4440 Sx_display_visual_class
, 0, 1, 0,
4441 "Returns the visual class of the X display DISPLAY.\n\
4442 The value is one of the symbols `static-gray', `gray-scale',\n\
4443 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4444 The optional argument DISPLAY specifies which display to ask about.\n\
4445 DISPLAY should be either a frame or a display name (a string).\n\
4446 If omitted or nil, that stands for the selected frame's display.")
4448 Lisp_Object display
;
4450 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4452 switch (dpyinfo
->visual
->class)
4454 case StaticGray
: return (intern ("static-gray"));
4455 case GrayScale
: return (intern ("gray-scale"));
4456 case StaticColor
: return (intern ("static-color"));
4457 case PseudoColor
: return (intern ("pseudo-color"));
4458 case TrueColor
: return (intern ("true-color"));
4459 case DirectColor
: return (intern ("direct-color"));
4461 error ("Display has an unknown visual class");
4465 DEFUN ("x-display-save-under", Fx_display_save_under
,
4466 Sx_display_save_under
, 0, 1, 0,
4467 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4468 The optional argument DISPLAY specifies which display to ask about.\n\
4469 DISPLAY should be either a frame or a display name (a string).\n\
4470 If omitted or nil, that stands for the selected frame's display.")
4472 Lisp_Object display
;
4474 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4476 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4484 register struct frame
*f
;
4486 return PIXEL_WIDTH (f
);
4491 register struct frame
*f
;
4493 return PIXEL_HEIGHT (f
);
4498 register struct frame
*f
;
4500 return FONT_WIDTH (f
->output_data
.x
->font
);
4505 register struct frame
*f
;
4507 return f
->output_data
.x
->line_height
;
4512 register struct frame
*f
;
4514 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4517 #if 0 /* These no longer seem like the right way to do things. */
4519 /* Draw a rectangle on the frame with left top corner including
4520 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
4521 CHARS by LINES wide and long and is the color of the cursor. */
4524 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
4525 register struct frame
*f
;
4527 register int top_char
, left_char
, chars
, lines
;
4531 int left
= (left_char
* FONT_WIDTH (f
->output_data
.x
->font
)
4532 + f
->output_data
.x
->internal_border_width
);
4533 int top
= (top_char
* f
->output_data
.x
->line_height
4534 + f
->output_data
.x
->internal_border_width
);
4537 width
= FONT_WIDTH (f
->output_data
.x
->font
) / 2;
4539 width
= FONT_WIDTH (f
->output_data
.x
->font
) * chars
;
4541 height
= f
->output_data
.x
->line_height
/ 2;
4543 height
= f
->output_data
.x
->line_height
* lines
;
4545 XDrawRectangle (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4546 gc
, left
, top
, width
, height
);
4549 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
4550 "Draw a rectangle on FRAME between coordinates specified by\n\
4551 numbers X0, Y0, X1, Y1 in the cursor pixel.")
4552 (frame
, X0
, Y0
, X1
, Y1
)
4553 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
4555 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4557 CHECK_LIVE_FRAME (frame
, 0);
4558 CHECK_NUMBER (X0
, 0);
4559 CHECK_NUMBER (Y0
, 1);
4560 CHECK_NUMBER (X1
, 2);
4561 CHECK_NUMBER (Y1
, 3);
4571 n_lines
= y1
- y0
+ 1;
4576 n_lines
= y0
- y1
+ 1;
4582 n_chars
= x1
- x0
+ 1;
4587 n_chars
= x0
- x1
+ 1;
4591 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->cursor_gc
,
4592 left
, top
, n_chars
, n_lines
);
4598 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
4599 "Draw a rectangle drawn on FRAME between coordinates\n\
4600 X0, Y0, X1, Y1 in the regular background-pixel.")
4601 (frame
, X0
, Y0
, X1
, Y1
)
4602 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
4604 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4606 CHECK_LIVE_FRAME (frame
, 0);
4607 CHECK_NUMBER (X0
, 0);
4608 CHECK_NUMBER (Y0
, 1);
4609 CHECK_NUMBER (X1
, 2);
4610 CHECK_NUMBER (Y1
, 3);
4620 n_lines
= y1
- y0
+ 1;
4625 n_lines
= y0
- y1
+ 1;
4631 n_chars
= x1
- x0
+ 1;
4636 n_chars
= x0
- x1
+ 1;
4640 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->reverse_gc
,
4641 left
, top
, n_chars
, n_lines
);
4647 /* Draw lines around the text region beginning at the character position
4648 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4649 pixel and line characteristics. */
4651 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4654 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
4655 register struct frame
*f
;
4657 int top_x
, top_y
, bottom_x
, bottom_y
;
4659 register int ibw
= f
->output_data
.x
->internal_border_width
;
4660 register int font_w
= FONT_WIDTH (f
->output_data
.x
->font
);
4661 register int font_h
= f
->output_data
.x
->line_height
;
4663 int x
= line_len (y
);
4664 XPoint
*pixel_points
4665 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
4666 register XPoint
*this_point
= pixel_points
;
4668 /* Do the horizontal top line/lines */
4671 this_point
->x
= ibw
;
4672 this_point
->y
= ibw
+ (font_h
* top_y
);
4675 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
4677 this_point
->x
= ibw
+ (font_w
* x
);
4678 this_point
->y
= (this_point
- 1)->y
;
4682 this_point
->x
= ibw
;
4683 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
4685 this_point
->x
= ibw
+ (font_w
* top_x
);
4686 this_point
->y
= (this_point
- 1)->y
;
4688 this_point
->x
= (this_point
- 1)->x
;
4689 this_point
->y
= ibw
+ (font_h
* top_y
);
4691 this_point
->x
= ibw
+ (font_w
* x
);
4692 this_point
->y
= (this_point
- 1)->y
;
4695 /* Now do the right side. */
4696 while (y
< bottom_y
)
4697 { /* Right vertical edge */
4699 this_point
->x
= (this_point
- 1)->x
;
4700 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
4703 y
++; /* Horizontal connection to next line */
4706 this_point
->x
= ibw
+ (font_w
/ 2);
4708 this_point
->x
= ibw
+ (font_w
* x
);
4710 this_point
->y
= (this_point
- 1)->y
;
4713 /* Now do the bottom and connect to the top left point. */
4714 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
4717 this_point
->x
= (this_point
- 1)->x
;
4718 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
4720 this_point
->x
= ibw
;
4721 this_point
->y
= (this_point
- 1)->y
;
4723 this_point
->x
= pixel_points
->x
;
4724 this_point
->y
= pixel_points
->y
;
4726 XDrawLines (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4728 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
4731 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
4732 "Highlight the region between point and the character under the mouse\n\
4735 register Lisp_Object event
;
4737 register int x0
, y0
, x1
, y1
;
4738 register struct frame
*f
= selected_frame
;
4739 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4740 register int p1
, p2
;
4742 CHECK_CONS (event
, 0);
4745 x0
= XINT (Fcar (Fcar (event
)));
4746 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4748 /* If the mouse is past the end of the line, don't that area. */
4749 /* ReWrite this... */
4751 /* Where the cursor is. */
4752 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4753 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4755 if (y1
> y0
) /* point below mouse */
4756 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4758 else if (y1
< y0
) /* point above mouse */
4759 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4761 else /* same line: draw horizontal rectangle */
4764 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4765 x0
, y0
, (x1
- x0
+ 1), 1);
4767 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4768 x1
, y1
, (x0
- x1
+ 1), 1);
4771 XFlush (FRAME_X_DISPLAY (f
));
4777 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
4778 "Erase any highlighting of the region between point and the character\n\
4779 at X, Y on the selected frame.")
4781 register Lisp_Object event
;
4783 register int x0
, y0
, x1
, y1
;
4784 register struct frame
*f
= selected_frame
;
4785 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4788 x0
= XINT (Fcar (Fcar (event
)));
4789 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4790 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4791 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4793 if (y1
> y0
) /* point below mouse */
4794 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4796 else if (y1
< y0
) /* point above mouse */
4797 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4799 else /* same line: draw horizontal rectangle */
4802 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4803 x0
, y0
, (x1
- x0
+ 1), 1);
4805 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4806 x1
, y1
, (x0
- x1
+ 1), 1);
4814 int contour_begin_x
, contour_begin_y
;
4815 int contour_end_x
, contour_end_y
;
4816 int contour_npoints
;
4818 /* Clip the top part of the contour lines down (and including) line Y_POS.
4819 If X_POS is in the middle (rather than at the end) of the line, drop
4820 down a line at that character. */
4823 clip_contour_top (y_pos
, x_pos
)
4825 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
4826 register XPoint
*end
;
4827 register int npoints
;
4828 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
4830 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
4832 end
= contour_lines
[y_pos
].top_right
;
4833 npoints
= (end
- begin
+ 1);
4834 XDrawLines (x_current_display
, contour_window
,
4835 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4837 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
4838 contour_last_point
-= (npoints
- 2);
4839 XDrawLines (x_current_display
, contour_window
,
4840 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
4841 XFlush (x_current_display
);
4843 /* Now, update contour_lines structure. */
4848 register XPoint
*p
= begin
+ 1;
4849 end
= contour_lines
[y_pos
].bottom_right
;
4850 npoints
= (end
- begin
+ 1);
4851 XDrawLines (x_current_display
, contour_window
,
4852 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4855 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
4857 p
->y
= begin
->y
+ font_h
;
4859 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
4860 contour_last_point
-= (npoints
- 5);
4861 XDrawLines (x_current_display
, contour_window
,
4862 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
4863 XFlush (x_current_display
);
4865 /* Now, update contour_lines structure. */
4869 /* Erase the top horizontal lines of the contour, and then extend
4870 the contour upwards. */
4873 extend_contour_top (line
)
4878 clip_contour_bottom (x_pos
, y_pos
)
4884 extend_contour_bottom (x_pos
, y_pos
)
4888 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
4893 register struct frame
*f
= selected_frame
;
4894 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4895 register int point_x
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4896 register int point_y
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4897 register int mouse_below_point
;
4898 register Lisp_Object obj
;
4899 register int x_contour_x
, x_contour_y
;
4901 x_contour_x
= x_mouse_x
;
4902 x_contour_y
= x_mouse_y
;
4903 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
4904 && x_contour_x
> point_x
))
4906 mouse_below_point
= 1;
4907 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4908 x_contour_x
, x_contour_y
);
4912 mouse_below_point
= 0;
4913 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
4919 obj
= read_char (-1, 0, 0, Qnil
, 0);
4923 if (mouse_below_point
)
4925 if (x_mouse_y
<= point_y
) /* Flipped. */
4927 mouse_below_point
= 0;
4929 outline_region (f
, f
->output_data
.x
->reverse_gc
, point_x
, point_y
,
4930 x_contour_x
, x_contour_y
);
4931 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
4934 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
4936 clip_contour_bottom (x_mouse_y
);
4938 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
4940 extend_bottom_contour (x_mouse_y
);
4943 x_contour_x
= x_mouse_x
;
4944 x_contour_y
= x_mouse_y
;
4946 else /* mouse above or same line as point */
4948 if (x_mouse_y
>= point_y
) /* Flipped. */
4950 mouse_below_point
= 1;
4952 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4953 x_contour_x
, x_contour_y
, point_x
, point_y
);
4954 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4955 x_mouse_x
, x_mouse_y
);
4957 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
4959 clip_contour_top (x_mouse_y
);
4961 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
4963 extend_contour_top (x_mouse_y
);
4968 unread_command_event
= obj
;
4969 if (mouse_below_point
)
4971 contour_begin_x
= point_x
;
4972 contour_begin_y
= point_y
;
4973 contour_end_x
= x_contour_x
;
4974 contour_end_y
= x_contour_y
;
4978 contour_begin_x
= x_contour_x
;
4979 contour_begin_y
= x_contour_y
;
4980 contour_end_x
= point_x
;
4981 contour_end_y
= point_y
;
4986 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
4991 register Lisp_Object obj
;
4992 struct frame
*f
= selected_frame
;
4993 register struct window
*w
= XWINDOW (selected_window
);
4994 register GC line_gc
= f
->output_data
.x
->cursor_gc
;
4995 register GC erase_gc
= f
->output_data
.x
->reverse_gc
;
4997 char dash_list
[] = {6, 4, 6, 4};
4999 XGCValues gc_values
;
5001 register int previous_y
;
5002 register int line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
5003 + f
->output_data
.x
->internal_border_width
;
5004 register int left
= f
->output_data
.x
->internal_border_width
5005 + (WINDOW_LEFT_MARGIN (w
)
5006 * FONT_WIDTH (f
->output_data
.x
->font
));
5007 register int right
= left
+ (w
->width
5008 * FONT_WIDTH (f
->output_data
.x
->font
))
5009 - f
->output_data
.x
->internal_border_width
;
5013 gc_values
.foreground
= f
->output_data
.x
->cursor_pixel
;
5014 gc_values
.background
= f
->output_data
.x
->background_pixel
;
5015 gc_values
.line_width
= 1;
5016 gc_values
.line_style
= LineOnOffDash
;
5017 gc_values
.cap_style
= CapRound
;
5018 gc_values
.join_style
= JoinRound
;
5020 line_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
5021 GCLineStyle
| GCJoinStyle
| GCCapStyle
5022 | GCLineWidth
| GCForeground
| GCBackground
,
5024 XSetDashes (FRAME_X_DISPLAY (f
), line_gc
, 0, dash_list
, dashes
);
5025 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
5026 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
5027 erase_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
5028 GCLineStyle
| GCJoinStyle
| GCCapStyle
5029 | GCLineWidth
| GCForeground
| GCBackground
,
5031 XSetDashes (FRAME_X_DISPLAY (f
), erase_gc
, 0, dash_list
, dashes
);
5038 if (x_mouse_y
>= XINT (w
->top
)
5039 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
5041 previous_y
= x_mouse_y
;
5042 line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
5043 + f
->output_data
.x
->internal_border_width
;
5044 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
5045 line_gc
, left
, line
, right
, line
);
5047 XFlush (FRAME_X_DISPLAY (f
));
5052 obj
= read_char (-1, 0, 0, Qnil
, 0);
5054 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
5055 Qvertical_scroll_bar
))
5059 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
5060 erase_gc
, left
, line
, right
, line
);
5061 unread_command_event
= obj
;
5063 XFreeGC (FRAME_X_DISPLAY (f
), line_gc
);
5064 XFreeGC (FRAME_X_DISPLAY (f
), erase_gc
);
5070 while (x_mouse_y
== previous_y
);
5073 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
5074 erase_gc
, left
, line
, right
, line
);
5081 /* These keep track of the rectangle following the pointer. */
5082 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
5084 /* Offset in buffer of character under the pointer, or 0. */
5085 int mouse_buffer_offset
;
5087 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
5088 "Track the pointer.")
5091 static Cursor current_pointer_shape
;
5092 FRAME_PTR f
= x_mouse_frame
;
5095 if (EQ (Vmouse_frame_part
, Qtext_part
)
5096 && (current_pointer_shape
!= f
->output_data
.x
->nontext_cursor
))
5101 current_pointer_shape
= f
->output_data
.x
->nontext_cursor
;
5102 XDefineCursor (FRAME_X_DISPLAY (f
),
5104 current_pointer_shape
);
5106 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
5107 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
5109 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
5110 && (current_pointer_shape
!= f
->output_data
.x
->modeline_cursor
))
5112 current_pointer_shape
= f
->output_data
.x
->modeline_cursor
;
5113 XDefineCursor (FRAME_X_DISPLAY (f
),
5115 current_pointer_shape
);
5118 XFlush (FRAME_X_DISPLAY (f
));
5124 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
5125 "Draw rectangle around character under mouse pointer, if there is one.")
5129 struct window
*w
= XWINDOW (Vmouse_window
);
5130 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
5131 struct buffer
*b
= XBUFFER (w
->buffer
);
5134 if (! EQ (Vmouse_window
, selected_window
))
5137 if (EQ (event
, Qnil
))
5141 x_read_mouse_position (selected_frame
, &x
, &y
);
5145 mouse_track_width
= 0;
5146 mouse_track_left
= mouse_track_top
= -1;
5150 if ((x_mouse_x
!= mouse_track_left
5151 && (x_mouse_x
< mouse_track_left
5152 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
5153 || x_mouse_y
!= mouse_track_top
)
5155 int hp
= 0; /* Horizontal position */
5156 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
5157 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
5158 int tab_width
= XINT (b
->tab_width
);
5159 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
5161 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
5162 int in_mode_line
= 0;
5164 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
5167 /* Erase previous rectangle. */
5168 if (mouse_track_width
)
5170 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
5171 mouse_track_left
, mouse_track_top
,
5172 mouse_track_width
, 1);
5174 if ((mouse_track_left
== f
->phys_cursor_x
5175 || mouse_track_left
== f
->phys_cursor_x
- 1)
5176 && mouse_track_top
== f
->phys_cursor_y
)
5178 x_display_cursor (f
, 1);
5182 mouse_track_left
= x_mouse_x
;
5183 mouse_track_top
= x_mouse_y
;
5184 mouse_track_width
= 0;
5186 if (mouse_track_left
> len
) /* Past the end of line. */
5189 if (mouse_track_top
== mode_line_vpos
)
5195 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
5199 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
5205 mouse_track_width
= tab_width
- (hp
% tab_width
);
5207 hp
+= mouse_track_width
;
5210 mouse_track_left
= hp
- mouse_track_width
;
5216 mouse_track_width
= -1;
5220 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
5225 mouse_track_width
= 2;
5230 mouse_track_left
= hp
- mouse_track_width
;
5236 mouse_track_width
= 1;
5243 while (hp
<= x_mouse_x
);
5246 if (mouse_track_width
) /* Over text; use text pointer shape. */
5248 XDefineCursor (FRAME_X_DISPLAY (f
),
5250 f
->output_data
.x
->text_cursor
);
5251 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
5252 mouse_track_left
, mouse_track_top
,
5253 mouse_track_width
, 1);
5255 else if (in_mode_line
)
5256 XDefineCursor (FRAME_X_DISPLAY (f
),
5258 f
->output_data
.x
->modeline_cursor
);
5260 XDefineCursor (FRAME_X_DISPLAY (f
),
5262 f
->output_data
.x
->nontext_cursor
);
5265 XFlush (FRAME_X_DISPLAY (f
));
5268 obj
= read_char (-1, 0, 0, Qnil
, 0);
5271 while (CONSP (obj
) /* Mouse event */
5272 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
5273 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
5274 && EQ (Vmouse_window
, selected_window
) /* In this window */
5277 unread_command_event
= obj
;
5279 if (mouse_track_width
)
5281 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
5282 mouse_track_left
, mouse_track_top
,
5283 mouse_track_width
, 1);
5284 mouse_track_width
= 0;
5285 if ((mouse_track_left
== f
->phys_cursor_x
5286 || mouse_track_left
- 1 == f
->phys_cursor_x
)
5287 && mouse_track_top
== f
->phys_cursor_y
)
5289 x_display_cursor (f
, 1);
5292 XDefineCursor (FRAME_X_DISPLAY (f
),
5294 f
->output_data
.x
->nontext_cursor
);
5295 XFlush (FRAME_X_DISPLAY (f
));
5305 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
5306 on the frame F at position X, Y. */
5308 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
5310 int x
, y
, width
, height
;
5315 image
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
5316 FRAME_X_WINDOW (f
), image_data
,
5318 XCopyPlane (FRAME_X_DISPLAY (f
), image
, FRAME_X_WINDOW (f
),
5319 f
->output_data
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
5323 #if 0 /* I'm told these functions are superfluous
5324 given the ability to bind function keys. */
5327 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
5328 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
5329 KEYSYM is a string which conforms to the X keysym definitions found\n\
5330 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
5331 list of strings specifying modifier keys such as Control_L, which must\n\
5332 also be depressed for NEWSTRING to appear.")
5333 (x_keysym
, modifiers
, newstring
)
5334 register Lisp_Object x_keysym
;
5335 register Lisp_Object modifiers
;
5336 register Lisp_Object newstring
;
5339 register KeySym keysym
;
5340 KeySym modifier_list
[16];
5343 CHECK_STRING (x_keysym
, 1);
5344 CHECK_STRING (newstring
, 3);
5346 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
5347 if (keysym
== NoSymbol
)
5348 error ("Keysym does not exist");
5350 if (NILP (modifiers
))
5351 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
5352 XSTRING (newstring
)->data
,
5353 STRING_BYTES (XSTRING (newstring
)));
5356 register Lisp_Object rest
, mod
;
5359 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
5362 error ("Can't have more than 16 modifiers");
5365 CHECK_STRING (mod
, 3);
5366 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
5368 if (modifier_list
[i
] == NoSymbol
5369 || !(IsModifierKey (modifier_list
[i
])
5370 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
5371 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
5373 if (modifier_list
[i
] == NoSymbol
5374 || !IsModifierKey (modifier_list
[i
]))
5376 error ("Element is not a modifier keysym");
5380 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
5381 XSTRING (newstring
)->data
,
5382 STRING_BYTES (XSTRING (newstring
)));
5388 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
5389 "Rebind KEYCODE to list of strings STRINGS.\n\
5390 STRINGS should be a list of 16 elements, one for each shift combination.\n\
5391 nil as element means don't change.\n\
5392 See the documentation of `x-rebind-key' for more information.")
5394 register Lisp_Object keycode
;
5395 register Lisp_Object strings
;
5397 register Lisp_Object item
;
5398 register unsigned char *rawstring
;
5399 KeySym rawkey
, modifier
[1];
5401 register unsigned i
;
5404 CHECK_NUMBER (keycode
, 1);
5405 CHECK_CONS (strings
, 2);
5406 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
5407 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
5409 item
= Fcar (strings
);
5412 CHECK_STRING (item
, 2);
5413 strsize
= STRING_BYTES (XSTRING (item
));
5414 rawstring
= (unsigned char *) xmalloc (strsize
);
5415 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
5416 modifier
[1] = 1 << i
;
5417 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
5418 rawstring
, strsize
);
5423 #endif /* HAVE_X11 */
5426 #ifndef HAVE_XSCREENNUMBEROFSCREEN
5428 XScreenNumberOfScreen (scr
)
5429 register Screen
*scr
;
5431 register Display
*dpy
;
5432 register Screen
*dpyscr
;
5436 dpyscr
= dpy
->screens
;
5438 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
5444 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5447 select_visual (dpy
, screen
, depth
)
5450 unsigned int *depth
;
5453 XVisualInfo
*vinfo
, vinfo_template
;
5456 v
= DefaultVisualOfScreen (screen
);
5459 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
5461 vinfo_template
.visualid
= v
->visualid
;
5464 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5466 vinfo
= XGetVisualInfo (dpy
,
5467 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
5470 fatal ("Can't get proper X visual info");
5472 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
5473 *depth
= vinfo
->depth
;
5477 int n
= vinfo
->colormap_size
- 1;
5486 XFree ((char *) vinfo
);
5490 /* Return the X display structure for the display named NAME.
5491 Open a new connection if necessary. */
5493 struct x_display_info
*
5494 x_display_info_for_name (name
)
5498 struct x_display_info
*dpyinfo
;
5500 CHECK_STRING (name
, 0);
5502 if (! EQ (Vwindow_system
, intern ("x")))
5503 error ("Not using X Windows");
5505 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5507 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5510 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5515 /* Use this general default value to start with. */
5516 Vx_resource_name
= Vinvocation_name
;
5518 validate_x_resource_name ();
5520 dpyinfo
= x_term_init (name
, (unsigned char *)0,
5521 (char *) XSTRING (Vx_resource_name
)->data
);
5524 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5527 XSETFASTINT (Vwindow_system_version
, 11);
5532 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5533 1, 3, 0, "Open a connection to an X server.\n\
5534 DISPLAY is the name of the display to connect to.\n\
5535 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5536 If the optional third arg MUST-SUCCEED is non-nil,\n\
5537 terminate Emacs if we can't open the connection.")
5538 (display
, xrm_string
, must_succeed
)
5539 Lisp_Object display
, xrm_string
, must_succeed
;
5541 unsigned char *xrm_option
;
5542 struct x_display_info
*dpyinfo
;
5544 CHECK_STRING (display
, 0);
5545 if (! NILP (xrm_string
))
5546 CHECK_STRING (xrm_string
, 1);
5548 if (! EQ (Vwindow_system
, intern ("x")))
5549 error ("Not using X Windows");
5551 if (! NILP (xrm_string
))
5552 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5554 xrm_option
= (unsigned char *) 0;
5556 validate_x_resource_name ();
5558 /* This is what opens the connection and sets x_current_display.
5559 This also initializes many symbols, such as those used for input. */
5560 dpyinfo
= x_term_init (display
, xrm_option
,
5561 (char *) XSTRING (Vx_resource_name
)->data
);
5565 if (!NILP (must_succeed
))
5566 fatal ("Cannot connect to X server %s.\n\
5567 Check the DISPLAY environment variable or use `-d'.\n\
5568 Also use the `xhost' program to verify that it is set to permit\n\
5569 connections from your machine.\n",
5570 XSTRING (display
)->data
);
5572 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5577 XSETFASTINT (Vwindow_system_version
, 11);
5581 DEFUN ("x-close-connection", Fx_close_connection
,
5582 Sx_close_connection
, 1, 1, 0,
5583 "Close the connection to DISPLAY's X server.\n\
5584 For DISPLAY, specify either a frame or a display name (a string).\n\
5585 If DISPLAY is nil, that stands for the selected frame's display.")
5587 Lisp_Object display
;
5589 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5592 if (dpyinfo
->reference_count
> 0)
5593 error ("Display still has frames on it");
5596 /* Free the fonts in the font table. */
5597 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5598 if (dpyinfo
->font_table
[i
].name
)
5600 xfree (dpyinfo
->font_table
[i
].name
);
5601 /* Don't free the full_name string;
5602 it is always shared with something else. */
5603 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5606 x_destroy_all_bitmaps (dpyinfo
);
5607 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5609 #ifdef USE_X_TOOLKIT
5610 XtCloseDisplay (dpyinfo
->display
);
5612 XCloseDisplay (dpyinfo
->display
);
5615 x_delete_display (dpyinfo
);
5621 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5622 "Return the list of display names that Emacs has connections to.")
5625 Lisp_Object tail
, result
;
5628 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5629 result
= Fcons (XCAR (XCAR (tail
)), result
);
5634 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5635 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5636 If ON is nil, allow buffering of requests.\n\
5637 Turning on synchronization prohibits the Xlib routines from buffering\n\
5638 requests and seriously degrades performance, but makes debugging much\n\
5640 The optional second argument DISPLAY specifies which display to act on.\n\
5641 DISPLAY should be either a frame or a display name (a string).\n\
5642 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5644 Lisp_Object display
, on
;
5646 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5648 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5653 /* Wait for responses to all X commands issued so far for frame F. */
5660 XSync (FRAME_X_DISPLAY (f
), False
);
5665 /***********************************************************************
5667 ***********************************************************************/
5669 /* Value is the number of elements of vector VECTOR. */
5671 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5673 /* List of supported image types. Use define_image_type to add new
5674 types. Use lookup_image_type to find a type for a given symbol. */
5676 static struct image_type
*image_types
;
5678 /* A list of symbols, one for each supported image type. */
5680 Lisp_Object Vimage_types
;
5682 /* The symbol `image' which is the car of the lists used to represent
5685 extern Lisp_Object Qimage
;
5687 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5693 Lisp_Object QCtype
, QCdata
, QCascent
, QCmargin
, QCrelief
;
5694 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5695 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
5696 Lisp_Object QCindex
;
5698 /* Other symbols. */
5700 Lisp_Object Qlaplace
;
5702 /* Time in seconds after which images should be removed from the cache
5703 if not displayed. */
5705 Lisp_Object Vimage_cache_eviction_delay
;
5707 /* Function prototypes. */
5709 static void define_image_type
P_ ((struct image_type
*type
));
5710 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5711 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5712 static void x_laplace
P_ ((struct frame
*, struct image
*));
5713 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5717 /* Define a new image type from TYPE. This adds a copy of TYPE to
5718 image_types and adds the symbol *TYPE->type to Vimage_types. */
5721 define_image_type (type
)
5722 struct image_type
*type
;
5724 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5725 The initialized data segment is read-only. */
5726 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5727 bcopy (type
, p
, sizeof *p
);
5728 p
->next
= image_types
;
5730 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5734 /* Look up image type SYMBOL, and return a pointer to its image_type
5735 structure. Value is null if SYMBOL is not a known image type. */
5737 static INLINE
struct image_type
*
5738 lookup_image_type (symbol
)
5741 struct image_type
*type
;
5743 for (type
= image_types
; type
; type
= type
->next
)
5744 if (EQ (symbol
, *type
->type
))
5751 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5752 valid image specification is a list whose car is the symbol
5753 `image', and whose rest is a property list. The property list must
5754 contain a value for key `:type'. That value must be the name of a
5755 supported image type. The rest of the property list depends on the
5759 valid_image_p (object
)
5764 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5766 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5767 struct image_type
*type
= lookup_image_type (symbol
);
5770 valid_p
= type
->valid_p (object
);
5777 /* Log error message with format string FORMAT and argument ARG.
5778 Signaling an error, e.g. when an image cannot be loaded, is not a
5779 good idea because this would interrupt redisplay, and the error
5780 message display would lead to another redisplay. This function
5781 therefore simply displays a message. */
5784 image_error (format
, arg1
, arg2
)
5786 Lisp_Object arg1
, arg2
;
5788 add_to_log (format
, arg1
, arg2
);
5793 /***********************************************************************
5794 Image specifications
5795 ***********************************************************************/
5797 enum image_value_type
5799 IMAGE_DONT_CHECK_VALUE_TYPE
,
5802 IMAGE_POSITIVE_INTEGER_VALUE
,
5803 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5804 IMAGE_INTEGER_VALUE
,
5805 IMAGE_FUNCTION_VALUE
,
5810 /* Structure used when parsing image specifications. */
5812 struct image_keyword
5814 /* Name of keyword. */
5817 /* The type of value allowed. */
5818 enum image_value_type type
;
5820 /* Non-zero means key must be present. */
5823 /* Used to recognize duplicate keywords in a property list. */
5826 /* The value that was found. */
5831 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5833 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5836 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5837 has the format (image KEYWORD VALUE ...). One of the keyword/
5838 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5839 image_keywords structures of size NKEYWORDS describing other
5840 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5843 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5845 struct image_keyword
*keywords
;
5852 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5855 plist
= XCDR (spec
);
5856 while (CONSP (plist
))
5858 Lisp_Object key
, value
;
5860 /* First element of a pair must be a symbol. */
5862 plist
= XCDR (plist
);
5866 /* There must follow a value. */
5869 value
= XCAR (plist
);
5870 plist
= XCDR (plist
);
5872 /* Find key in KEYWORDS. Error if not found. */
5873 for (i
= 0; i
< nkeywords
; ++i
)
5874 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5880 /* Record that we recognized the keyword. If a keywords
5881 was found more than once, it's an error. */
5882 keywords
[i
].value
= value
;
5883 ++keywords
[i
].count
;
5885 if (keywords
[i
].count
> 1)
5888 /* Check type of value against allowed type. */
5889 switch (keywords
[i
].type
)
5891 case IMAGE_STRING_VALUE
:
5892 if (!STRINGP (value
))
5896 case IMAGE_SYMBOL_VALUE
:
5897 if (!SYMBOLP (value
))
5901 case IMAGE_POSITIVE_INTEGER_VALUE
:
5902 if (!INTEGERP (value
) || XINT (value
) <= 0)
5906 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5907 if (!INTEGERP (value
) || XINT (value
) < 0)
5911 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5914 case IMAGE_FUNCTION_VALUE
:
5915 value
= indirect_function (value
);
5917 || COMPILEDP (value
)
5918 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5922 case IMAGE_NUMBER_VALUE
:
5923 if (!INTEGERP (value
) && !FLOATP (value
))
5927 case IMAGE_INTEGER_VALUE
:
5928 if (!INTEGERP (value
))
5932 case IMAGE_BOOL_VALUE
:
5933 if (!NILP (value
) && !EQ (value
, Qt
))
5942 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5946 /* Check that all mandatory fields are present. */
5947 for (i
= 0; i
< nkeywords
; ++i
)
5948 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5951 return NILP (plist
);
5955 /* Return the value of KEY in image specification SPEC. Value is nil
5956 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5957 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5960 image_spec_value (spec
, key
, found
)
5961 Lisp_Object spec
, key
;
5966 xassert (valid_image_p (spec
));
5968 for (tail
= XCDR (spec
);
5969 CONSP (tail
) && CONSP (XCDR (tail
));
5970 tail
= XCDR (XCDR (tail
)))
5972 if (EQ (XCAR (tail
), key
))
5976 return XCAR (XCDR (tail
));
5988 /***********************************************************************
5989 Image type independent image structures
5990 ***********************************************************************/
5992 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5993 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5996 /* Allocate and return a new image structure for image specification
5997 SPEC. SPEC has a hash value of HASH. */
5999 static struct image
*
6000 make_image (spec
, hash
)
6004 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
6006 xassert (valid_image_p (spec
));
6007 bzero (img
, sizeof *img
);
6008 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
6009 xassert (img
->type
!= NULL
);
6011 img
->data
.lisp_val
= Qnil
;
6012 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
6018 /* Free image IMG which was used on frame F, including its resources. */
6027 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6029 /* Remove IMG from the hash table of its cache. */
6031 img
->prev
->next
= img
->next
;
6033 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
6036 img
->next
->prev
= img
->prev
;
6038 c
->images
[img
->id
] = NULL
;
6040 /* Free resources, then free IMG. */
6041 img
->type
->free (f
, img
);
6047 /* Prepare image IMG for display on frame F. Must be called before
6048 drawing an image. */
6051 prepare_image_for_display (f
, img
)
6057 /* We're about to display IMG, so set its timestamp to `now'. */
6059 img
->timestamp
= EMACS_SECS (t
);
6061 /* If IMG doesn't have a pixmap yet, load it now, using the image
6062 type dependent loader function. */
6063 if (img
->pixmap
== 0 && !img
->load_failed_p
)
6064 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6069 /***********************************************************************
6070 Helper functions for X image types
6071 ***********************************************************************/
6073 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
6074 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
6076 Lisp_Object color_name
,
6077 unsigned long dflt
));
6079 /* Free X resources of image IMG which is used on frame F. */
6082 x_clear_image (f
, img
)
6089 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
6097 x_free_colors (f
, img
->colors
, img
->ncolors
);
6100 xfree (img
->colors
);
6107 /* Allocate color COLOR_NAME for image IMG on frame F. If color
6108 cannot be allocated, use DFLT. Add a newly allocated color to
6109 IMG->colors, so that it can be freed again. Value is the pixel
6112 static unsigned long
6113 x_alloc_image_color (f
, img
, color_name
, dflt
)
6116 Lisp_Object color_name
;
6120 unsigned long result
;
6122 xassert (STRINGP (color_name
));
6124 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
6126 /* This isn't called frequently so we get away with simply
6127 reallocating the color vector to the needed size, here. */
6130 (unsigned long *) xrealloc (img
->colors
,
6131 img
->ncolors
* sizeof *img
->colors
);
6132 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
6133 result
= color
.pixel
;
6143 /***********************************************************************
6145 ***********************************************************************/
6147 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
6150 /* Return a new, initialized image cache that is allocated from the
6151 heap. Call free_image_cache to free an image cache. */
6153 struct image_cache
*
6156 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
6159 bzero (c
, sizeof *c
);
6161 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
6162 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
6163 c
->buckets
= (struct image
**) xmalloc (size
);
6164 bzero (c
->buckets
, size
);
6169 /* Free image cache of frame F. Be aware that X frames share images
6173 free_image_cache (f
)
6176 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6181 /* Cache should not be referenced by any frame when freed. */
6182 xassert (c
->refcount
== 0);
6184 for (i
= 0; i
< c
->used
; ++i
)
6185 free_image (f
, c
->images
[i
]);
6189 FRAME_X_IMAGE_CACHE (f
) = NULL
;
6194 /* Clear image cache of frame F. FORCE_P non-zero means free all
6195 images. FORCE_P zero means clear only images that haven't been
6196 displayed for some time. Should be called from time to time to
6197 reduce the number of loaded images. If image-eviction-seconds is
6198 non-nil, this frees images in the cache which weren't displayed for
6199 at least that many seconds. */
6202 clear_image_cache (f
, force_p
)
6206 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6208 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
6212 int i
, any_freed_p
= 0;
6215 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
6217 for (i
= 0; i
< c
->used
; ++i
)
6219 struct image
*img
= c
->images
[i
];
6222 || (img
->timestamp
> old
)))
6224 free_image (f
, img
);
6229 /* We may be clearing the image cache because, for example,
6230 Emacs was iconified for a longer period of time. In that
6231 case, current matrices may still contain references to
6232 images freed above. So, clear these matrices. */
6235 clear_current_matrices (f
);
6236 ++windows_or_buffers_changed
;
6242 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
6244 "Clear the image cache of FRAME.\n\
6245 FRAME nil or omitted means use the selected frame.\n\
6246 FRAME t means clear the image caches of all frames.")
6254 FOR_EACH_FRAME (tail
, frame
)
6255 if (FRAME_X_P (XFRAME (frame
)))
6256 clear_image_cache (XFRAME (frame
), 1);
6259 clear_image_cache (check_x_frame (frame
), 1);
6265 /* Return the id of image with Lisp specification SPEC on frame F.
6266 SPEC must be a valid Lisp image specification (see valid_image_p). */
6269 lookup_image (f
, spec
)
6273 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6277 struct gcpro gcpro1
;
6280 /* F must be a window-system frame, and SPEC must be a valid image
6282 xassert (FRAME_WINDOW_P (f
));
6283 xassert (valid_image_p (spec
));
6287 /* Look up SPEC in the hash table of the image cache. */
6288 hash
= sxhash (spec
, 0);
6289 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6291 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6292 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6295 /* If not found, create a new image and cache it. */
6298 img
= make_image (spec
, hash
);
6299 cache_image (f
, img
);
6300 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6301 xassert (!interrupt_input_blocked
);
6303 /* If we can't load the image, and we don't have a width and
6304 height, use some arbitrary width and height so that we can
6305 draw a rectangle for it. */
6306 if (img
->load_failed_p
)
6310 value
= image_spec_value (spec
, QCwidth
, NULL
);
6311 img
->width
= (INTEGERP (value
)
6312 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6313 value
= image_spec_value (spec
, QCheight
, NULL
);
6314 img
->height
= (INTEGERP (value
)
6315 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6319 /* Handle image type independent image attributes
6320 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
6321 Lisp_Object ascent
, margin
, relief
, algorithm
, heuristic_mask
;
6324 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6325 if (INTEGERP (ascent
))
6326 img
->ascent
= XFASTINT (ascent
);
6328 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6329 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6330 img
->margin
= XFASTINT (margin
);
6332 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6333 if (INTEGERP (relief
))
6335 img
->relief
= XINT (relief
);
6336 img
->margin
+= abs (img
->relief
);
6339 /* Should we apply a Laplace edge-detection algorithm? */
6340 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
6341 if (img
->pixmap
&& EQ (algorithm
, Qlaplace
))
6344 /* Should we built a mask heuristically? */
6345 heuristic_mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6346 if (img
->pixmap
&& !img
->mask
&& !NILP (heuristic_mask
))
6347 x_build_heuristic_mask (f
, img
, heuristic_mask
);
6351 /* We're using IMG, so set its timestamp to `now'. */
6352 EMACS_GET_TIME (now
);
6353 img
->timestamp
= EMACS_SECS (now
);
6357 /* Value is the image id. */
6362 /* Cache image IMG in the image cache of frame F. */
6365 cache_image (f
, img
)
6369 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6372 /* Find a free slot in c->images. */
6373 for (i
= 0; i
< c
->used
; ++i
)
6374 if (c
->images
[i
] == NULL
)
6377 /* If no free slot found, maybe enlarge c->images. */
6378 if (i
== c
->used
&& c
->used
== c
->size
)
6381 c
->images
= (struct image
**) xrealloc (c
->images
,
6382 c
->size
* sizeof *c
->images
);
6385 /* Add IMG to c->images, and assign IMG an id. */
6391 /* Add IMG to the cache's hash table. */
6392 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6393 img
->next
= c
->buckets
[i
];
6395 img
->next
->prev
= img
;
6397 c
->buckets
[i
] = img
;
6401 /* Call FN on every image in the image cache of frame F. Used to mark
6402 Lisp Objects in the image cache. */
6405 forall_images_in_image_cache (f
, fn
)
6407 void (*fn
) P_ ((struct image
*img
));
6409 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6411 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6415 for (i
= 0; i
< c
->used
; ++i
)
6424 /***********************************************************************
6426 ***********************************************************************/
6428 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6429 XImage
**, Pixmap
*));
6430 static void x_destroy_x_image
P_ ((XImage
*));
6431 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6434 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6435 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6436 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6437 via xmalloc. Print error messages via image_error if an error
6438 occurs. Value is non-zero if successful. */
6441 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6443 int width
, height
, depth
;
6447 Display
*display
= FRAME_X_DISPLAY (f
);
6448 Screen
*screen
= FRAME_X_SCREEN (f
);
6449 Window window
= FRAME_X_WINDOW (f
);
6451 xassert (interrupt_input_blocked
);
6454 depth
= DefaultDepthOfScreen (screen
);
6455 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6456 depth
, ZPixmap
, 0, NULL
, width
, height
,
6457 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6460 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6464 /* Allocate image raster. */
6465 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6467 /* Allocate a pixmap of the same size. */
6468 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6471 x_destroy_x_image (*ximg
);
6473 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6481 /* Destroy XImage XIMG. Free XIMG->data. */
6484 x_destroy_x_image (ximg
)
6487 xassert (interrupt_input_blocked
);
6492 XDestroyImage (ximg
);
6497 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6498 are width and height of both the image and pixmap. */
6501 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6508 xassert (interrupt_input_blocked
);
6509 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6510 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6511 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6516 /***********************************************************************
6518 ***********************************************************************/
6520 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6522 /* Find image file FILE. Look in data-directory, then
6523 x-bitmap-file-path. Value is the full name of the file found, or
6524 nil if not found. */
6527 x_find_image_file (file
)
6530 Lisp_Object file_found
, search_path
;
6531 struct gcpro gcpro1
, gcpro2
;
6535 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6536 GCPRO2 (file_found
, search_path
);
6538 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6539 fd
= openp (search_path
, file
, "", &file_found
, 0);
6552 /***********************************************************************
6554 ***********************************************************************/
6556 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6557 static int xbm_load_image_from_file
P_ ((struct frame
*f
, struct image
*img
,
6559 static int xbm_image_p
P_ ((Lisp_Object object
));
6560 static int xbm_read_bitmap_file_data
P_ ((char *, int *, int *,
6564 /* Indices of image specification fields in xbm_format, below. */
6566 enum xbm_keyword_index
6583 /* Vector of image_keyword structures describing the format
6584 of valid XBM image specifications. */
6586 static struct image_keyword xbm_format
[XBM_LAST
] =
6588 {":type", IMAGE_SYMBOL_VALUE
, 1},
6589 {":file", IMAGE_STRING_VALUE
, 0},
6590 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6591 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6592 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6593 {":foreground", IMAGE_STRING_VALUE
, 0},
6594 {":background", IMAGE_STRING_VALUE
, 0},
6595 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6596 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6597 {":relief", IMAGE_INTEGER_VALUE
, 0},
6598 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6599 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6602 /* Structure describing the image type XBM. */
6604 static struct image_type xbm_type
=
6613 /* Tokens returned from xbm_scan. */
6622 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6623 A valid specification is a list starting with the symbol `image'
6624 The rest of the list is a property list which must contain an
6627 If the specification specifies a file to load, it must contain
6628 an entry `:file FILENAME' where FILENAME is a string.
6630 If the specification is for a bitmap loaded from memory it must
6631 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6632 WIDTH and HEIGHT are integers > 0. DATA may be:
6634 1. a string large enough to hold the bitmap data, i.e. it must
6635 have a size >= (WIDTH + 7) / 8 * HEIGHT
6637 2. a bool-vector of size >= WIDTH * HEIGHT
6639 3. a vector of strings or bool-vectors, one for each line of the
6642 Both the file and data forms may contain the additional entries
6643 `:background COLOR' and `:foreground COLOR'. If not present,
6644 foreground and background of the frame on which the image is
6645 displayed, is used. */
6648 xbm_image_p (object
)
6651 struct image_keyword kw
[XBM_LAST
];
6653 bcopy (xbm_format
, kw
, sizeof kw
);
6654 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6657 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6659 if (kw
[XBM_FILE
].count
)
6661 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6669 /* Entries for `:width', `:height' and `:data' must be present. */
6670 if (!kw
[XBM_WIDTH
].count
6671 || !kw
[XBM_HEIGHT
].count
6672 || !kw
[XBM_DATA
].count
)
6675 data
= kw
[XBM_DATA
].value
;
6676 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6677 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6679 /* Check type of data, and width and height against contents of
6685 /* Number of elements of the vector must be >= height. */
6686 if (XVECTOR (data
)->size
< height
)
6689 /* Each string or bool-vector in data must be large enough
6690 for one line of the image. */
6691 for (i
= 0; i
< height
; ++i
)
6693 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6697 if (XSTRING (elt
)->size
6698 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6701 else if (BOOL_VECTOR_P (elt
))
6703 if (XBOOL_VECTOR (elt
)->size
< width
)
6710 else if (STRINGP (data
))
6712 if (XSTRING (data
)->size
6713 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6716 else if (BOOL_VECTOR_P (data
))
6718 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6725 /* Baseline must be a value between 0 and 100 (a percentage). */
6726 if (kw
[XBM_ASCENT
].count
6727 && XFASTINT (kw
[XBM_ASCENT
].value
) > 100)
6734 /* Scan a bitmap file. FP is the stream to read from. Value is
6735 either an enumerator from enum xbm_token, or a character for a
6736 single-character token, or 0 at end of file. If scanning an
6737 identifier, store the lexeme of the identifier in SVAL. If
6738 scanning a number, store its value in *IVAL. */
6741 xbm_scan (fp
, sval
, ival
)
6748 /* Skip white space. */
6749 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
6754 else if (isdigit (c
))
6756 int value
= 0, digit
;
6761 if (c
== 'x' || c
== 'X')
6763 while ((c
= fgetc (fp
)) != EOF
)
6767 else if (c
>= 'a' && c
<= 'f')
6768 digit
= c
- 'a' + 10;
6769 else if (c
>= 'A' && c
<= 'F')
6770 digit
= c
- 'A' + 10;
6773 value
= 16 * value
+ digit
;
6776 else if (isdigit (c
))
6779 while ((c
= fgetc (fp
)) != EOF
6781 value
= 8 * value
+ c
- '0';
6787 while ((c
= fgetc (fp
)) != EOF
6789 value
= 10 * value
+ c
- '0';
6797 else if (isalpha (c
) || c
== '_')
6800 while ((c
= fgetc (fp
)) != EOF
6801 && (isalnum (c
) || c
== '_'))
6813 /* Replacement for XReadBitmapFileData which isn't available under old
6814 X versions. FILE is the name of the bitmap file to read. Set
6815 *WIDTH and *HEIGHT to the width and height of the image. Return in
6816 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
6820 xbm_read_bitmap_file_data (file
, width
, height
, data
)
6822 int *width
, *height
;
6823 unsigned char **data
;
6826 char buffer
[BUFSIZ
];
6829 int bytes_per_line
, i
, nbytes
;
6835 LA1 = xbm_scan (fp, buffer, &value)
6837 #define expect(TOKEN) \
6838 if (LA1 != (TOKEN)) \
6843 #define expect_ident(IDENT) \
6844 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6849 fp
= fopen (file
, "r");
6853 *width
= *height
= -1;
6855 LA1
= xbm_scan (fp
, buffer
, &value
);
6857 /* Parse defines for width, height and hot-spots. */
6861 expect_ident ("define");
6862 expect (XBM_TK_IDENT
);
6864 if (LA1
== XBM_TK_NUMBER
);
6866 char *p
= strrchr (buffer
, '_');
6867 p
= p
? p
+ 1 : buffer
;
6868 if (strcmp (p
, "width") == 0)
6870 else if (strcmp (p
, "height") == 0)
6873 expect (XBM_TK_NUMBER
);
6876 if (*width
< 0 || *height
< 0)
6879 /* Parse bits. Must start with `static'. */
6880 expect_ident ("static");
6881 if (LA1
== XBM_TK_IDENT
)
6883 if (strcmp (buffer
, "unsigned") == 0)
6886 expect_ident ("char");
6888 else if (strcmp (buffer
, "short") == 0)
6892 if (*width
% 16 && *width
% 16 < 9)
6895 else if (strcmp (buffer
, "char") == 0)
6903 expect (XBM_TK_IDENT
);
6909 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6910 nbytes
= bytes_per_line
* *height
;
6911 p
= *data
= (char *) xmalloc (nbytes
);
6916 for (i
= 0; i
< nbytes
; i
+= 2)
6919 expect (XBM_TK_NUMBER
);
6922 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6925 if (LA1
== ',' || LA1
== '}')
6933 for (i
= 0; i
< nbytes
; ++i
)
6936 expect (XBM_TK_NUMBER
);
6940 if (LA1
== ',' || LA1
== '}')
6966 /* Load XBM image IMG which will be displayed on frame F from file
6967 SPECIFIED_FILE. Value is non-zero if successful. */
6970 xbm_load_image_from_file (f
, img
, specified_file
)
6973 Lisp_Object specified_file
;
6976 unsigned char *data
;
6979 struct gcpro gcpro1
;
6981 xassert (STRINGP (specified_file
));
6985 file
= x_find_image_file (specified_file
);
6986 if (!STRINGP (file
))
6988 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
6993 rc
= xbm_read_bitmap_file_data (XSTRING (file
)->data
, &img
->width
,
6994 &img
->height
, &data
);
6997 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6998 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6999 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7002 xassert (img
->width
> 0 && img
->height
> 0);
7004 /* Get foreground and background colors, maybe allocate colors. */
7005 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
7007 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
7009 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
7011 background
= x_alloc_image_color (f
, img
, value
, background
);
7015 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7018 img
->width
, img
->height
,
7019 foreground
, background
,
7023 if (img
->pixmap
== 0)
7025 x_clear_image (f
, img
);
7026 image_error ("Unable to create X pixmap for `%s'", file
, Qnil
);
7034 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
7041 /* Fill image IMG which is used on frame F with pixmap data. Value is
7042 non-zero if successful. */
7050 Lisp_Object file_name
;
7052 xassert (xbm_image_p (img
->spec
));
7054 /* If IMG->spec specifies a file name, create a non-file spec from it. */
7055 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
7056 if (STRINGP (file_name
))
7057 success_p
= xbm_load_image_from_file (f
, img
, file_name
);
7060 struct image_keyword fmt
[XBM_LAST
];
7063 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
7064 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
7068 /* Parse the list specification. */
7069 bcopy (xbm_format
, fmt
, sizeof fmt
);
7070 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
7073 /* Get specified width, and height. */
7074 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
7075 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
7076 xassert (img
->width
> 0 && img
->height
> 0);
7080 if (fmt
[XBM_ASCENT
].count
)
7081 img
->ascent
= XFASTINT (fmt
[XBM_ASCENT
].value
);
7083 /* Get foreground and background colors, maybe allocate colors. */
7084 if (fmt
[XBM_FOREGROUND
].count
)
7085 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
7087 if (fmt
[XBM_BACKGROUND
].count
)
7088 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
7091 /* Set bits to the bitmap image data. */
7092 data
= fmt
[XBM_DATA
].value
;
7097 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
7099 p
= bits
= (char *) alloca (nbytes
* img
->height
);
7100 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
7102 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
7104 bcopy (XSTRING (line
)->data
, p
, nbytes
);
7106 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
7109 else if (STRINGP (data
))
7110 bits
= XSTRING (data
)->data
;
7112 bits
= XBOOL_VECTOR (data
)->data
;
7114 /* Create the pixmap. */
7115 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
7117 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
7120 img
->width
, img
->height
,
7121 foreground
, background
,
7127 image_error ("Unable to create pixmap for XBM image `%s'",
7129 x_clear_image (f
, img
);
7140 /***********************************************************************
7142 ***********************************************************************/
7146 static int xpm_image_p
P_ ((Lisp_Object object
));
7147 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
7148 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
7150 #include "X11/xpm.h"
7152 /* The symbol `xpm' identifying XPM-format images. */
7156 /* Indices of image specification fields in xpm_format, below. */
7158 enum xpm_keyword_index
7172 /* Vector of image_keyword structures describing the format
7173 of valid XPM image specifications. */
7175 static struct image_keyword xpm_format
[XPM_LAST
] =
7177 {":type", IMAGE_SYMBOL_VALUE
, 1},
7178 {":file", IMAGE_STRING_VALUE
, 0},
7179 {":data", IMAGE_STRING_VALUE
, 0},
7180 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7181 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7182 {":relief", IMAGE_INTEGER_VALUE
, 0},
7183 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7184 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7185 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7188 /* Structure describing the image type XBM. */
7190 static struct image_type xpm_type
=
7200 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7201 for XPM images. Such a list must consist of conses whose car and
7205 xpm_valid_color_symbols_p (color_symbols
)
7206 Lisp_Object color_symbols
;
7208 while (CONSP (color_symbols
))
7210 Lisp_Object sym
= XCAR (color_symbols
);
7212 || !STRINGP (XCAR (sym
))
7213 || !STRINGP (XCDR (sym
)))
7215 color_symbols
= XCDR (color_symbols
);
7218 return NILP (color_symbols
);
7222 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7225 xpm_image_p (object
)
7228 struct image_keyword fmt
[XPM_LAST
];
7229 bcopy (xpm_format
, fmt
, sizeof fmt
);
7230 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7231 /* Either `:file' or `:data' must be present. */
7232 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7233 /* Either no `:color-symbols' or it's a list of conses
7234 whose car and cdr are strings. */
7235 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7236 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
7237 && (fmt
[XPM_ASCENT
].count
== 0
7238 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
7242 /* Load image IMG which will be displayed on frame F. Value is
7243 non-zero if successful. */
7251 XpmAttributes attrs
;
7252 Lisp_Object specified_file
, color_symbols
;
7254 /* Configure the XPM lib. Use the visual of frame F. Allocate
7255 close colors. Return colors allocated. */
7256 bzero (&attrs
, sizeof attrs
);
7257 attrs
.visual
= FRAME_X_DISPLAY_INFO (f
)->visual
;
7258 attrs
.valuemask
|= XpmVisual
;
7259 attrs
.valuemask
|= XpmReturnAllocPixels
;
7260 #ifdef XpmAllocCloseColors
7261 attrs
.alloc_close_colors
= 1;
7262 attrs
.valuemask
|= XpmAllocCloseColors
;
7264 attrs
.closeness
= 600;
7265 attrs
.valuemask
|= XpmCloseness
;
7268 /* If image specification contains symbolic color definitions, add
7269 these to `attrs'. */
7270 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7271 if (CONSP (color_symbols
))
7274 XpmColorSymbol
*xpm_syms
;
7277 attrs
.valuemask
|= XpmColorSymbols
;
7279 /* Count number of symbols. */
7280 attrs
.numsymbols
= 0;
7281 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7284 /* Allocate an XpmColorSymbol array. */
7285 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7286 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7287 bzero (xpm_syms
, size
);
7288 attrs
.colorsymbols
= xpm_syms
;
7290 /* Fill the color symbol array. */
7291 for (tail
= color_symbols
, i
= 0;
7293 ++i
, tail
= XCDR (tail
))
7295 Lisp_Object name
= XCAR (XCAR (tail
));
7296 Lisp_Object color
= XCDR (XCAR (tail
));
7297 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7298 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7299 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7300 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7304 /* Create a pixmap for the image, either from a file, or from a
7305 string buffer containing data in the same format as an XPM file. */
7307 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7308 if (STRINGP (specified_file
))
7310 Lisp_Object file
= x_find_image_file (specified_file
);
7311 if (!STRINGP (file
))
7313 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
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
,
7332 if (rc
== XpmSuccess
)
7334 /* Remember allocated colors. */
7335 img
->ncolors
= attrs
.nalloc_pixels
;
7336 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7337 * sizeof *img
->colors
);
7338 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7339 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7341 img
->width
= attrs
.width
;
7342 img
->height
= attrs
.height
;
7343 xassert (img
->width
> 0 && img
->height
> 0);
7345 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7347 XpmFreeAttributes (&attrs
);
7355 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7358 case XpmFileInvalid
:
7359 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7363 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7366 case XpmColorFailed
:
7367 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7371 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7376 return rc
== XpmSuccess
;
7379 #endif /* HAVE_XPM != 0 */
7382 /***********************************************************************
7384 ***********************************************************************/
7386 /* An entry in the color table mapping an RGB color to a pixel color. */
7391 unsigned long pixel
;
7393 /* Next in color table collision list. */
7394 struct ct_color
*next
;
7397 /* The bucket vector size to use. Must be prime. */
7401 /* Value is a hash of the RGB color given by R, G, and B. */
7403 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7405 /* The color hash table. */
7407 struct ct_color
**ct_table
;
7409 /* Number of entries in the color table. */
7411 int ct_colors_allocated
;
7413 /* Function prototypes. */
7415 static void init_color_table
P_ ((void));
7416 static void free_color_table
P_ ((void));
7417 static unsigned long *colors_in_color_table
P_ ((int *n
));
7418 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
7419 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
7422 /* Initialize the color table. */
7427 int size
= CT_SIZE
* sizeof (*ct_table
);
7428 ct_table
= (struct ct_color
**) xmalloc (size
);
7429 bzero (ct_table
, size
);
7430 ct_colors_allocated
= 0;
7434 /* Free memory associated with the color table. */
7440 struct ct_color
*p
, *next
;
7442 for (i
= 0; i
< CT_SIZE
; ++i
)
7443 for (p
= ct_table
[i
]; p
; p
= next
)
7454 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7455 entry for that color already is in the color table, return the
7456 pixel color of that entry. Otherwise, allocate a new color for R,
7457 G, B, and make an entry in the color table. */
7459 static unsigned long
7460 lookup_rgb_color (f
, r
, g
, b
)
7464 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7465 int i
= hash
% CT_SIZE
;
7468 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7469 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7483 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7484 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7489 ++ct_colors_allocated
;
7491 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7495 p
->pixel
= color
.pixel
;
7496 p
->next
= ct_table
[i
];
7500 return FRAME_FOREGROUND_PIXEL (f
);
7507 /* Look up pixel color PIXEL which is used on frame F in the color
7508 table. If not already present, allocate it. Value is PIXEL. */
7510 static unsigned long
7511 lookup_pixel_color (f
, pixel
)
7513 unsigned long pixel
;
7515 int i
= pixel
% CT_SIZE
;
7518 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7519 if (p
->pixel
== pixel
)
7530 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7531 color
.pixel
= pixel
;
7532 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
7533 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7538 ++ct_colors_allocated
;
7540 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7545 p
->next
= ct_table
[i
];
7549 return FRAME_FOREGROUND_PIXEL (f
);
7556 /* Value is a vector of all pixel colors contained in the color table,
7557 allocated via xmalloc. Set *N to the number of colors. */
7559 static unsigned long *
7560 colors_in_color_table (n
)
7565 unsigned long *colors
;
7567 if (ct_colors_allocated
== 0)
7574 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7576 *n
= ct_colors_allocated
;
7578 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7579 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7580 colors
[j
++] = p
->pixel
;
7588 /***********************************************************************
7590 ***********************************************************************/
7592 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7593 int, XImage
*, int));
7594 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7595 XColor
*, int, XImage
*, int));
7598 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
7599 frame we operate on, CMAP is the color-map in effect, and WIDTH is
7600 the width of one row in the image. */
7603 x_laplace_read_row (f
, cmap
, colors
, width
, ximg
, y
)
7613 for (x
= 0; x
< width
; ++x
)
7614 colors
[x
].pixel
= XGetPixel (ximg
, x
, y
);
7616 XQueryColors (FRAME_X_DISPLAY (f
), cmap
, colors
, width
);
7620 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
7621 containing the pixel colors to write. F is the frame we are
7625 x_laplace_write_row (f
, pixels
, width
, ximg
, y
)
7634 for (x
= 0; x
< width
; ++x
)
7635 XPutPixel (ximg
, x
, y
, pixels
[x
]);
7639 /* Transform image IMG which is used on frame F with a Laplace
7640 edge-detection algorithm. The result is an image that can be used
7641 to draw disabled buttons, for example. */
7648 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7649 XImage
*ximg
, *oimg
;
7655 int in_y
, out_y
, rc
;
7660 /* Get the X image IMG->pixmap. */
7661 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7662 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7664 /* Allocate 3 input rows, and one output row of colors. */
7665 for (i
= 0; i
< 3; ++i
)
7666 in
[i
] = (XColor
*) alloca (img
->width
* sizeof (XColor
));
7667 out
= (long *) alloca (img
->width
* sizeof (long));
7669 /* Create an X image for output. */
7670 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7673 /* Fill first two rows. */
7674 x_laplace_read_row (f
, cmap
, in
[0], img
->width
, ximg
, 0);
7675 x_laplace_read_row (f
, cmap
, in
[1], img
->width
, ximg
, 1);
7678 /* Write first row, all zeros. */
7679 init_color_table ();
7680 pixel
= lookup_rgb_color (f
, 0, 0, 0);
7681 for (x
= 0; x
< img
->width
; ++x
)
7683 x_laplace_write_row (f
, out
, img
->width
, oimg
, 0);
7686 for (y
= 2; y
< img
->height
; ++y
)
7689 int rowb
= (y
+ 2) % 3;
7691 x_laplace_read_row (f
, cmap
, in
[rowa
], img
->width
, ximg
, in_y
++);
7693 for (x
= 0; x
< img
->width
- 2; ++x
)
7695 int r
= in
[rowa
][x
].red
+ mv2
- in
[rowb
][x
+ 2].red
;
7696 int g
= in
[rowa
][x
].green
+ mv2
- in
[rowb
][x
+ 2].green
;
7697 int b
= in
[rowa
][x
].blue
+ mv2
- in
[rowb
][x
+ 2].blue
;
7699 out
[x
+ 1] = lookup_rgb_color (f
, r
& 0xffff, g
& 0xffff,
7703 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
++);
7706 /* Write last line, all zeros. */
7707 for (x
= 0; x
< img
->width
; ++x
)
7709 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
);
7711 /* Free the input image, and free resources of IMG. */
7712 XDestroyImage (ximg
);
7713 x_clear_image (f
, img
);
7715 /* Put the output image into pixmap, and destroy it. */
7716 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7717 x_destroy_x_image (oimg
);
7719 /* Remember new pixmap and colors in IMG. */
7720 img
->pixmap
= pixmap
;
7721 img
->colors
= colors_in_color_table (&img
->ncolors
);
7722 free_color_table ();
7728 /* Build a mask for image IMG which is used on frame F. FILE is the
7729 name of an image file, for error messages. HOW determines how to
7730 determine the background color of IMG. If it is a list '(R G B)',
7731 with R, G, and B being integers >= 0, take that as the color of the
7732 background. Otherwise, determine the background color of IMG
7733 heuristically. Value is non-zero if successful. */
7736 x_build_heuristic_mask (f
, img
, how
)
7741 Display
*dpy
= FRAME_X_DISPLAY (f
);
7742 XImage
*ximg
, *mask_img
;
7743 int x
, y
, rc
, look_at_corners_p
;
7748 /* Create an image and pixmap serving as mask. */
7749 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7750 &mask_img
, &img
->mask
);
7757 /* Get the X image of IMG->pixmap. */
7758 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7761 /* Determine the background color of ximg. If HOW is `(R G B)'
7762 take that as color. Otherwise, try to determine the color
7764 look_at_corners_p
= 1;
7772 && NATNUMP (XCAR (how
)))
7774 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7778 if (i
== 3 && NILP (how
))
7780 char color_name
[30];
7781 XColor exact
, color
;
7784 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7786 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7787 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7790 look_at_corners_p
= 0;
7795 if (look_at_corners_p
)
7797 unsigned long corners
[4];
7800 /* Get the colors at the corners of ximg. */
7801 corners
[0] = XGetPixel (ximg
, 0, 0);
7802 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7803 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7804 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7806 /* Choose the most frequently found color as background. */
7807 for (i
= best_count
= 0; i
< 4; ++i
)
7811 for (j
= n
= 0; j
< 4; ++j
)
7812 if (corners
[i
] == corners
[j
])
7816 bg
= corners
[i
], best_count
= n
;
7820 /* Set all bits in mask_img to 1 whose color in ximg is different
7821 from the background color bg. */
7822 for (y
= 0; y
< img
->height
; ++y
)
7823 for (x
= 0; x
< img
->width
; ++x
)
7824 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7826 /* Put mask_img into img->mask. */
7827 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7828 x_destroy_x_image (mask_img
);
7829 XDestroyImage (ximg
);
7837 /***********************************************************************
7838 PBM (mono, gray, color)
7839 ***********************************************************************/
7841 static int pbm_image_p
P_ ((Lisp_Object object
));
7842 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7843 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
7845 /* The symbol `pbm' identifying images of this type. */
7849 /* Indices of image specification fields in gs_format, below. */
7851 enum pbm_keyword_index
7864 /* Vector of image_keyword structures describing the format
7865 of valid user-defined image specifications. */
7867 static struct image_keyword pbm_format
[PBM_LAST
] =
7869 {":type", IMAGE_SYMBOL_VALUE
, 1},
7870 {":file", IMAGE_STRING_VALUE
, 0},
7871 {":data", IMAGE_STRING_VALUE
, 0},
7872 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7873 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7874 {":relief", IMAGE_INTEGER_VALUE
, 0},
7875 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7876 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7879 /* Structure describing the image type `pbm'. */
7881 static struct image_type pbm_type
=
7891 /* Return non-zero if OBJECT is a valid PBM image specification. */
7894 pbm_image_p (object
)
7897 struct image_keyword fmt
[PBM_LAST
];
7899 bcopy (pbm_format
, fmt
, sizeof fmt
);
7901 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
)
7902 || (fmt
[PBM_ASCENT
].count
7903 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
7906 /* Must specify either :data or :file. */
7907 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
7911 /* Scan a decimal number from *S and return it. Advance *S while
7912 reading the number. END is the end of the string. Value is -1 at
7916 pbm_scan_number (s
, end
)
7917 unsigned char **s
, *end
;
7923 /* Skip white-space. */
7924 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
7929 /* Skip comment to end of line. */
7930 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
7933 else if (isdigit (c
))
7935 /* Read decimal number. */
7937 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
7938 val
= 10 * val
+ c
- '0';
7949 /* Read FILE into memory. Value is a pointer to a buffer allocated
7950 with xmalloc holding FILE's contents. Value is null if an error
7951 occured. *SIZE is set to the size of the file. */
7954 pbm_read_file (file
, size
)
7962 if (stat (XSTRING (file
)->data
, &st
) == 0
7963 && (fp
= fopen (XSTRING (file
)->data
, "r")) != NULL
7964 && (buf
= (char *) xmalloc (st
.st_size
),
7965 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
7985 /* Load PBM image IMG for use on frame F. */
7993 int width
, height
, max_color_idx
= 0;
7995 Lisp_Object file
, specified_file
;
7996 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
7997 struct gcpro gcpro1
;
7998 unsigned char *contents
= NULL
;
7999 unsigned char *end
, *p
;
8002 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8006 if (STRINGP (specified_file
))
8008 file
= x_find_image_file (specified_file
);
8009 if (!STRINGP (file
))
8011 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8016 contents
= pbm_read_file (file
, &size
);
8017 if (contents
== NULL
)
8019 image_error ("Error reading `%s'", file
, Qnil
);
8025 end
= contents
+ size
;
8030 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8031 p
= XSTRING (data
)->data
;
8032 end
= p
+ STRING_BYTES (XSTRING (data
));
8035 /* Check magic number. */
8036 if (end
- p
< 2 || *p
++ != 'P')
8038 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8048 raw_p
= 0, type
= PBM_MONO
;
8052 raw_p
= 0, type
= PBM_GRAY
;
8056 raw_p
= 0, type
= PBM_COLOR
;
8060 raw_p
= 1, type
= PBM_MONO
;
8064 raw_p
= 1, type
= PBM_GRAY
;
8068 raw_p
= 1, type
= PBM_COLOR
;
8072 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8076 /* Read width, height, maximum color-component. Characters
8077 starting with `#' up to the end of a line are ignored. */
8078 width
= pbm_scan_number (&p
, end
);
8079 height
= pbm_scan_number (&p
, end
);
8081 if (type
!= PBM_MONO
)
8083 max_color_idx
= pbm_scan_number (&p
, end
);
8084 if (raw_p
&& max_color_idx
> 255)
8085 max_color_idx
= 255;
8090 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8094 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8095 &ximg
, &img
->pixmap
))
8101 /* Initialize the color hash table. */
8102 init_color_table ();
8104 if (type
== PBM_MONO
)
8108 for (y
= 0; y
< height
; ++y
)
8109 for (x
= 0; x
< width
; ++x
)
8119 g
= pbm_scan_number (&p
, end
);
8121 XPutPixel (ximg
, x
, y
, (g
8122 ? FRAME_FOREGROUND_PIXEL (f
)
8123 : FRAME_BACKGROUND_PIXEL (f
)));
8128 for (y
= 0; y
< height
; ++y
)
8129 for (x
= 0; x
< width
; ++x
)
8133 if (type
== PBM_GRAY
)
8134 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8143 r
= pbm_scan_number (&p
, end
);
8144 g
= pbm_scan_number (&p
, end
);
8145 b
= pbm_scan_number (&p
, end
);
8148 if (r
< 0 || g
< 0 || b
< 0)
8152 XDestroyImage (ximg
);
8154 image_error ("Invalid pixel value in image `%s'",
8159 /* RGB values are now in the range 0..max_color_idx.
8160 Scale this to the range 0..0xffff supported by X. */
8161 r
= (double) r
* 65535 / max_color_idx
;
8162 g
= (double) g
* 65535 / max_color_idx
;
8163 b
= (double) b
* 65535 / max_color_idx
;
8164 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8168 /* Store in IMG->colors the colors allocated for the image, and
8169 free the color table. */
8170 img
->colors
= colors_in_color_table (&img
->ncolors
);
8171 free_color_table ();
8173 /* Put the image into a pixmap. */
8174 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8175 x_destroy_x_image (ximg
);
8179 img
->height
= height
;
8188 /***********************************************************************
8190 ***********************************************************************/
8196 /* Function prototypes. */
8198 static int png_image_p
P_ ((Lisp_Object object
));
8199 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8201 /* The symbol `png' identifying images of this type. */
8205 /* Indices of image specification fields in png_format, below. */
8207 enum png_keyword_index
8220 /* Vector of image_keyword structures describing the format
8221 of valid user-defined image specifications. */
8223 static struct image_keyword png_format
[PNG_LAST
] =
8225 {":type", IMAGE_SYMBOL_VALUE
, 1},
8226 {":data", IMAGE_STRING_VALUE
, 0},
8227 {":file", IMAGE_STRING_VALUE
, 0},
8228 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8229 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8230 {":relief", IMAGE_INTEGER_VALUE
, 0},
8231 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8232 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8235 /* Structure describing the image type `png'. */
8237 static struct image_type png_type
=
8247 /* Return non-zero if OBJECT is a valid PNG image specification. */
8250 png_image_p (object
)
8253 struct image_keyword fmt
[PNG_LAST
];
8254 bcopy (png_format
, fmt
, sizeof fmt
);
8256 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
)
8257 || (fmt
[PNG_ASCENT
].count
8258 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
8261 /* Must specify either the :data or :file keyword. */
8262 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8266 /* Error and warning handlers installed when the PNG library
8270 my_png_error (png_ptr
, msg
)
8271 png_struct
*png_ptr
;
8274 xassert (png_ptr
!= NULL
);
8275 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8276 longjmp (png_ptr
->jmpbuf
, 1);
8281 my_png_warning (png_ptr
, msg
)
8282 png_struct
*png_ptr
;
8285 xassert (png_ptr
!= NULL
);
8286 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8289 /* Memory source for PNG decoding. */
8291 struct png_memory_storage
8293 unsigned char *bytes
; /* The data */
8294 size_t len
; /* How big is it? */
8295 int index
; /* Where are we? */
8299 /* Function set as reader function when reading PNG image from memory.
8300 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8301 bytes from the input to DATA. */
8304 png_read_from_memory (png_ptr
, data
, length
)
8305 png_structp png_ptr
;
8309 struct png_memory_storage
*tbr
8310 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8312 if (length
> tbr
->len
- tbr
->index
)
8313 png_error (png_ptr
, "Read error");
8315 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8316 tbr
->index
= tbr
->index
+ length
;
8319 /* Load PNG image IMG for use on frame F. Value is non-zero if
8327 Lisp_Object file
, specified_file
;
8328 Lisp_Object specified_data
;
8330 XImage
*ximg
, *mask_img
= NULL
;
8331 struct gcpro gcpro1
;
8332 png_struct
*png_ptr
= NULL
;
8333 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8336 png_byte
*pixels
= NULL
;
8337 png_byte
**rows
= NULL
;
8338 png_uint_32 width
, height
;
8339 int bit_depth
, color_type
, interlace_type
;
8341 png_uint_32 row_bytes
;
8344 double screen_gamma
, image_gamma
;
8346 struct png_memory_storage tbr
; /* Data to be read */
8348 /* Find out what file to load. */
8349 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8350 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8354 if (NILP (specified_data
))
8356 file
= x_find_image_file (specified_file
);
8357 if (!STRINGP (file
))
8359 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8364 /* Open the image file. */
8365 fp
= fopen (XSTRING (file
)->data
, "rb");
8368 image_error ("Cannot open image file `%s'", file
, Qnil
);
8374 /* Check PNG signature. */
8375 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8376 || !png_check_sig (sig
, sizeof sig
))
8378 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8386 /* Read from memory. */
8387 tbr
.bytes
= XSTRING (specified_data
)->data
;
8388 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8391 /* Check PNG signature. */
8392 if (tbr
.len
< sizeof sig
8393 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8395 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8400 /* Need to skip past the signature. */
8401 tbr
.bytes
+= sizeof (sig
);
8404 /* Initialize read and info structs for PNG lib. */
8405 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8406 my_png_error
, my_png_warning
);
8409 if (fp
) fclose (fp
);
8414 info_ptr
= png_create_info_struct (png_ptr
);
8417 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8418 if (fp
) fclose (fp
);
8423 end_info
= png_create_info_struct (png_ptr
);
8426 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8427 if (fp
) fclose (fp
);
8432 /* Set error jump-back. We come back here when the PNG library
8433 detects an error. */
8434 if (setjmp (png_ptr
->jmpbuf
))
8438 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8441 if (fp
) fclose (fp
);
8446 /* Read image info. */
8447 if (!NILP (specified_data
))
8448 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8450 png_init_io (png_ptr
, fp
);
8452 png_set_sig_bytes (png_ptr
, sizeof sig
);
8453 png_read_info (png_ptr
, info_ptr
);
8454 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8455 &interlace_type
, NULL
, NULL
);
8457 /* If image contains simply transparency data, we prefer to
8458 construct a clipping mask. */
8459 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8464 /* This function is easier to write if we only have to handle
8465 one data format: RGB or RGBA with 8 bits per channel. Let's
8466 transform other formats into that format. */
8468 /* Strip more than 8 bits per channel. */
8469 if (bit_depth
== 16)
8470 png_set_strip_16 (png_ptr
);
8472 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8474 png_set_expand (png_ptr
);
8476 /* Convert grayscale images to RGB. */
8477 if (color_type
== PNG_COLOR_TYPE_GRAY
8478 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8479 png_set_gray_to_rgb (png_ptr
);
8481 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8482 gamma_str
= getenv ("SCREEN_GAMMA");
8483 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8485 /* Tell the PNG lib to handle gamma correction for us. */
8487 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8488 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8489 /* There is a special chunk in the image specifying the gamma. */
8490 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8493 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8494 /* Image contains gamma information. */
8495 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8497 /* Use a default of 0.5 for the image gamma. */
8498 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8500 /* Handle alpha channel by combining the image with a background
8501 color. Do this only if a real alpha channel is supplied. For
8502 simple transparency, we prefer a clipping mask. */
8505 png_color_16
*image_background
;
8507 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8508 /* Image contains a background color with which to
8509 combine the image. */
8510 png_set_background (png_ptr
, image_background
,
8511 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8514 /* Image does not contain a background color with which
8515 to combine the image data via an alpha channel. Use
8516 the frame's background instead. */
8519 png_color_16 frame_background
;
8522 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
8523 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8524 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
8527 bzero (&frame_background
, sizeof frame_background
);
8528 frame_background
.red
= color
.red
;
8529 frame_background
.green
= color
.green
;
8530 frame_background
.blue
= color
.blue
;
8532 png_set_background (png_ptr
, &frame_background
,
8533 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8537 /* Update info structure. */
8538 png_read_update_info (png_ptr
, info_ptr
);
8540 /* Get number of channels. Valid values are 1 for grayscale images
8541 and images with a palette, 2 for grayscale images with transparency
8542 information (alpha channel), 3 for RGB images, and 4 for RGB
8543 images with alpha channel, i.e. RGBA. If conversions above were
8544 sufficient we should only have 3 or 4 channels here. */
8545 channels
= png_get_channels (png_ptr
, info_ptr
);
8546 xassert (channels
== 3 || channels
== 4);
8548 /* Number of bytes needed for one row of the image. */
8549 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8551 /* Allocate memory for the image. */
8552 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8553 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8554 for (i
= 0; i
< height
; ++i
)
8555 rows
[i
] = pixels
+ i
* row_bytes
;
8557 /* Read the entire image. */
8558 png_read_image (png_ptr
, rows
);
8559 png_read_end (png_ptr
, info_ptr
);
8568 /* Create the X image and pixmap. */
8569 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8576 /* Create an image and pixmap serving as mask if the PNG image
8577 contains an alpha channel. */
8580 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8581 &mask_img
, &img
->mask
))
8583 x_destroy_x_image (ximg
);
8584 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8590 /* Fill the X image and mask from PNG data. */
8591 init_color_table ();
8593 for (y
= 0; y
< height
; ++y
)
8595 png_byte
*p
= rows
[y
];
8597 for (x
= 0; x
< width
; ++x
)
8604 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8606 /* An alpha channel, aka mask channel, associates variable
8607 transparency with an image. Where other image formats
8608 support binary transparency---fully transparent or fully
8609 opaque---PNG allows up to 254 levels of partial transparency.
8610 The PNG library implements partial transparency by combining
8611 the image with a specified background color.
8613 I'm not sure how to handle this here nicely: because the
8614 background on which the image is displayed may change, for
8615 real alpha channel support, it would be necessary to create
8616 a new image for each possible background.
8618 What I'm doing now is that a mask is created if we have
8619 boolean transparency information. Otherwise I'm using
8620 the frame's background color to combine the image with. */
8625 XPutPixel (mask_img
, x
, y
, *p
> 0);
8631 /* Remember colors allocated for this image. */
8632 img
->colors
= colors_in_color_table (&img
->ncolors
);
8633 free_color_table ();
8636 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8641 img
->height
= height
;
8643 /* Put the image into the pixmap, then free the X image and its buffer. */
8644 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8645 x_destroy_x_image (ximg
);
8647 /* Same for the mask. */
8650 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8651 x_destroy_x_image (mask_img
);
8659 #endif /* HAVE_PNG != 0 */
8663 /***********************************************************************
8665 ***********************************************************************/
8669 /* Work around a warning about HAVE_STDLIB_H being redefined in
8671 #ifdef HAVE_STDLIB_H
8672 #define HAVE_STDLIB_H_1
8673 #undef HAVE_STDLIB_H
8674 #endif /* HAVE_STLIB_H */
8676 #include <jpeglib.h>
8680 #ifdef HAVE_STLIB_H_1
8681 #define HAVE_STDLIB_H 1
8684 static int jpeg_image_p
P_ ((Lisp_Object object
));
8685 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8687 /* The symbol `jpeg' identifying images of this type. */
8691 /* Indices of image specification fields in gs_format, below. */
8693 enum jpeg_keyword_index
8702 JPEG_HEURISTIC_MASK
,
8706 /* Vector of image_keyword structures describing the format
8707 of valid user-defined image specifications. */
8709 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8711 {":type", IMAGE_SYMBOL_VALUE
, 1},
8712 {":data", IMAGE_STRING_VALUE
, 0},
8713 {":file", IMAGE_STRING_VALUE
, 0},
8714 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8715 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8716 {":relief", IMAGE_INTEGER_VALUE
, 0},
8717 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8718 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8721 /* Structure describing the image type `jpeg'. */
8723 static struct image_type jpeg_type
=
8733 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8736 jpeg_image_p (object
)
8739 struct image_keyword fmt
[JPEG_LAST
];
8741 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8743 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
)
8744 || (fmt
[JPEG_ASCENT
].count
8745 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
8748 /* Must specify either the :data or :file keyword. */
8749 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8753 struct my_jpeg_error_mgr
8755 struct jpeg_error_mgr pub
;
8756 jmp_buf setjmp_buffer
;
8760 my_error_exit (cinfo
)
8763 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8764 longjmp (mgr
->setjmp_buffer
, 1);
8767 /* Init source method for JPEG data source manager. Called by
8768 jpeg_read_header() before any data is actually read. See
8769 libjpeg.doc from the JPEG lib distribution. */
8772 our_init_source (cinfo
)
8773 j_decompress_ptr cinfo
;
8778 /* Fill input buffer method for JPEG data source manager. Called
8779 whenever more data is needed. We read the whole image in one step,
8780 so this only adds a fake end of input marker at the end. */
8783 our_fill_input_buffer (cinfo
)
8784 j_decompress_ptr cinfo
;
8786 /* Insert a fake EOI marker. */
8787 struct jpeg_source_mgr
*src
= cinfo
->src
;
8788 static JOCTET buffer
[2];
8790 buffer
[0] = (JOCTET
) 0xFF;
8791 buffer
[1] = (JOCTET
) JPEG_EOI
;
8793 src
->next_input_byte
= buffer
;
8794 src
->bytes_in_buffer
= 2;
8799 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8800 is the JPEG data source manager. */
8803 our_skip_input_data (cinfo
, num_bytes
)
8804 j_decompress_ptr cinfo
;
8807 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8811 if (num_bytes
> src
->bytes_in_buffer
)
8812 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8814 src
->bytes_in_buffer
-= num_bytes
;
8815 src
->next_input_byte
+= num_bytes
;
8820 /* Method to terminate data source. Called by
8821 jpeg_finish_decompress() after all data has been processed. */
8824 our_term_source (cinfo
)
8825 j_decompress_ptr cinfo
;
8830 /* Set up the JPEG lib for reading an image from DATA which contains
8831 LEN bytes. CINFO is the decompression info structure created for
8832 reading the image. */
8835 jpeg_memory_src (cinfo
, data
, len
)
8836 j_decompress_ptr cinfo
;
8840 struct jpeg_source_mgr
*src
;
8842 if (cinfo
->src
== NULL
)
8844 /* First time for this JPEG object? */
8845 cinfo
->src
= (struct jpeg_source_mgr
*)
8846 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8847 sizeof (struct jpeg_source_mgr
));
8848 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8849 src
->next_input_byte
= data
;
8852 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8853 src
->init_source
= our_init_source
;
8854 src
->fill_input_buffer
= our_fill_input_buffer
;
8855 src
->skip_input_data
= our_skip_input_data
;
8856 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
8857 src
->term_source
= our_term_source
;
8858 src
->bytes_in_buffer
= len
;
8859 src
->next_input_byte
= data
;
8863 /* Load image IMG for use on frame F. Patterned after example.c
8864 from the JPEG lib. */
8871 struct jpeg_decompress_struct cinfo
;
8872 struct my_jpeg_error_mgr mgr
;
8873 Lisp_Object file
, specified_file
;
8874 Lisp_Object specified_data
;
8877 int row_stride
, x
, y
;
8878 XImage
*ximg
= NULL
;
8880 unsigned long *colors
;
8882 struct gcpro gcpro1
;
8884 /* Open the JPEG file. */
8885 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8886 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8890 if (NILP (specified_data
))
8892 file
= x_find_image_file (specified_file
);
8893 if (!STRINGP (file
))
8895 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8900 fp
= fopen (XSTRING (file
)->data
, "r");
8903 image_error ("Cannot open `%s'", file
, Qnil
);
8909 /* Customize libjpeg's error handling to call my_error_exit when an
8910 error is detected. This function will perform a longjmp. */
8911 mgr
.pub
.error_exit
= my_error_exit
;
8912 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8914 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8918 /* Called from my_error_exit. Display a JPEG error. */
8919 char buffer
[JMSG_LENGTH_MAX
];
8920 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8921 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
8922 build_string (buffer
));
8925 /* Close the input file and destroy the JPEG object. */
8928 jpeg_destroy_decompress (&cinfo
);
8932 /* If we already have an XImage, free that. */
8933 x_destroy_x_image (ximg
);
8935 /* Free pixmap and colors. */
8936 x_clear_image (f
, img
);
8943 /* Create the JPEG decompression object. Let it read from fp.
8944 Read the JPEG image header. */
8945 jpeg_create_decompress (&cinfo
);
8947 if (NILP (specified_data
))
8948 jpeg_stdio_src (&cinfo
, fp
);
8950 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
8951 STRING_BYTES (XSTRING (specified_data
)));
8953 jpeg_read_header (&cinfo
, TRUE
);
8955 /* Customize decompression so that color quantization will be used.
8956 Start decompression. */
8957 cinfo
.quantize_colors
= TRUE
;
8958 jpeg_start_decompress (&cinfo
);
8959 width
= img
->width
= cinfo
.output_width
;
8960 height
= img
->height
= cinfo
.output_height
;
8964 /* Create X image and pixmap. */
8965 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8968 longjmp (mgr
.setjmp_buffer
, 2);
8971 /* Allocate colors. When color quantization is used,
8972 cinfo.actual_number_of_colors has been set with the number of
8973 colors generated, and cinfo.colormap is a two-dimensional array
8974 of color indices in the range 0..cinfo.actual_number_of_colors.
8975 No more than 255 colors will be generated. */
8979 if (cinfo
.out_color_components
> 2)
8980 ir
= 0, ig
= 1, ib
= 2;
8981 else if (cinfo
.out_color_components
> 1)
8982 ir
= 0, ig
= 1, ib
= 0;
8984 ir
= 0, ig
= 0, ib
= 0;
8986 /* Use the color table mechanism because it handles colors that
8987 cannot be allocated nicely. Such colors will be replaced with
8988 a default color, and we don't have to care about which colors
8989 can be freed safely, and which can't. */
8990 init_color_table ();
8991 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
8994 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
8996 /* Multiply RGB values with 255 because X expects RGB values
8997 in the range 0..0xffff. */
8998 int r
= cinfo
.colormap
[ir
][i
] << 8;
8999 int g
= cinfo
.colormap
[ig
][i
] << 8;
9000 int b
= cinfo
.colormap
[ib
][i
] << 8;
9001 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9004 /* Remember those colors actually allocated. */
9005 img
->colors
= colors_in_color_table (&img
->ncolors
);
9006 free_color_table ();
9010 row_stride
= width
* cinfo
.output_components
;
9011 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9013 for (y
= 0; y
< height
; ++y
)
9015 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9016 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9017 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9021 jpeg_finish_decompress (&cinfo
);
9022 jpeg_destroy_decompress (&cinfo
);
9026 /* Put the image into the pixmap. */
9027 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9028 x_destroy_x_image (ximg
);
9034 #endif /* HAVE_JPEG */
9038 /***********************************************************************
9040 ***********************************************************************/
9046 static int tiff_image_p
P_ ((Lisp_Object object
));
9047 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9049 /* The symbol `tiff' identifying images of this type. */
9053 /* Indices of image specification fields in tiff_format, below. */
9055 enum tiff_keyword_index
9064 TIFF_HEURISTIC_MASK
,
9068 /* Vector of image_keyword structures describing the format
9069 of valid user-defined image specifications. */
9071 static struct image_keyword tiff_format
[TIFF_LAST
] =
9073 {":type", IMAGE_SYMBOL_VALUE
, 1},
9074 {":data", IMAGE_STRING_VALUE
, 0},
9075 {":file", IMAGE_STRING_VALUE
, 0},
9076 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9077 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9078 {":relief", IMAGE_INTEGER_VALUE
, 0},
9079 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9080 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9083 /* Structure describing the image type `tiff'. */
9085 static struct image_type tiff_type
=
9095 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9098 tiff_image_p (object
)
9101 struct image_keyword fmt
[TIFF_LAST
];
9102 bcopy (tiff_format
, fmt
, sizeof fmt
);
9104 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
)
9105 || (fmt
[TIFF_ASCENT
].count
9106 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
9109 /* Must specify either the :data or :file keyword. */
9110 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9114 /* Reading from a memory buffer for TIFF images Based on the PNG
9115 memory source, but we have to provide a lot of extra functions.
9118 We really only need to implement read and seek, but I am not
9119 convinced that the TIFF library is smart enough not to destroy
9120 itself if we only hand it the function pointers we need to
9125 unsigned char *bytes
;
9132 tiff_read_from_memory (data
, buf
, size
)
9137 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9139 if (size
> src
->len
- src
->index
)
9141 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9147 tiff_write_from_memory (data
, buf
, size
)
9156 tiff_seek_in_memory (data
, off
, whence
)
9161 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9166 case SEEK_SET
: /* Go from beginning of source. */
9170 case SEEK_END
: /* Go from end of source. */
9171 idx
= src
->len
+ off
;
9174 case SEEK_CUR
: /* Go from current position. */
9175 idx
= src
->index
+ off
;
9178 default: /* Invalid `whence'. */
9182 if (idx
> src
->len
|| idx
< 0)
9190 tiff_close_memory (data
)
9198 tiff_mmap_memory (data
, pbase
, psize
)
9203 /* It is already _IN_ memory. */
9208 tiff_unmap_memory (data
, base
, size
)
9213 /* We don't need to do this. */
9217 tiff_size_of_memory (data
)
9220 return ((tiff_memory_source
*) data
)->len
;
9223 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9231 Lisp_Object file
, specified_file
;
9232 Lisp_Object specified_data
;
9234 int width
, height
, x
, y
;
9238 struct gcpro gcpro1
;
9239 tiff_memory_source memsrc
;
9241 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9242 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9246 if (NILP (specified_data
))
9248 /* Read from a file */
9249 file
= x_find_image_file (specified_file
);
9250 if (!STRINGP (file
))
9252 image_error ("Cannot find image file `%s'", file
, Qnil
);
9257 /* Try to open the image file. */
9258 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9261 image_error ("Cannot open `%s'", file
, Qnil
);
9268 /* Memory source! */
9269 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9270 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9273 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9274 (TIFFReadWriteProc
) tiff_read_from_memory
,
9275 (TIFFReadWriteProc
) tiff_write_from_memory
,
9276 tiff_seek_in_memory
,
9278 tiff_size_of_memory
,
9284 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9290 /* Get width and height of the image, and allocate a raster buffer
9291 of width x height 32-bit values. */
9292 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9293 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9294 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9296 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9300 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9308 /* Create the X image and pixmap. */
9309 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9317 /* Initialize the color table. */
9318 init_color_table ();
9320 /* Process the pixel raster. Origin is in the lower-left corner. */
9321 for (y
= 0; y
< height
; ++y
)
9323 uint32
*row
= buf
+ y
* width
;
9325 for (x
= 0; x
< width
; ++x
)
9327 uint32 abgr
= row
[x
];
9328 int r
= TIFFGetR (abgr
) << 8;
9329 int g
= TIFFGetG (abgr
) << 8;
9330 int b
= TIFFGetB (abgr
) << 8;
9331 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9335 /* Remember the colors allocated for the image. Free the color table. */
9336 img
->colors
= colors_in_color_table (&img
->ncolors
);
9337 free_color_table ();
9339 /* Put the image into the pixmap, then free the X image and its buffer. */
9340 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9341 x_destroy_x_image (ximg
);
9346 img
->height
= height
;
9352 #endif /* HAVE_TIFF != 0 */
9356 /***********************************************************************
9358 ***********************************************************************/
9362 #include <gif_lib.h>
9364 static int gif_image_p
P_ ((Lisp_Object object
));
9365 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9367 /* The symbol `gif' identifying images of this type. */
9371 /* Indices of image specification fields in gif_format, below. */
9373 enum gif_keyword_index
9387 /* Vector of image_keyword structures describing the format
9388 of valid user-defined image specifications. */
9390 static struct image_keyword gif_format
[GIF_LAST
] =
9392 {":type", IMAGE_SYMBOL_VALUE
, 1},
9393 {":data", IMAGE_STRING_VALUE
, 0},
9394 {":file", IMAGE_STRING_VALUE
, 0},
9395 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9396 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9397 {":relief", IMAGE_INTEGER_VALUE
, 0},
9398 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9399 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9400 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9403 /* Structure describing the image type `gif'. */
9405 static struct image_type gif_type
=
9414 /* Return non-zero if OBJECT is a valid GIF image specification. */
9417 gif_image_p (object
)
9420 struct image_keyword fmt
[GIF_LAST
];
9421 bcopy (gif_format
, fmt
, sizeof fmt
);
9423 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
)
9424 || (fmt
[GIF_ASCENT
].count
9425 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
9428 /* Must specify either the :data or :file keyword. */
9429 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9432 /* Reading a GIF image from memory
9433 Based on the PNG memory stuff to a certain extent. */
9437 unsigned char *bytes
;
9443 /* Make the current memory source available to gif_read_from_memory.
9444 It's done this way because not all versions of libungif support
9445 a UserData field in the GifFileType structure. */
9446 static gif_memory_source
*current_gif_memory_src
;
9449 gif_read_from_memory (file
, buf
, len
)
9454 gif_memory_source
*src
= current_gif_memory_src
;
9456 if (len
> src
->len
- src
->index
)
9459 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9465 /* Load GIF image IMG for use on frame F. Value is non-zero if
9473 Lisp_Object file
, specified_file
;
9474 Lisp_Object specified_data
;
9475 int rc
, width
, height
, x
, y
, i
;
9477 ColorMapObject
*gif_color_map
;
9478 unsigned long pixel_colors
[256];
9480 struct gcpro gcpro1
;
9482 int ino
, image_left
, image_top
, image_width
, image_height
;
9483 gif_memory_source memsrc
;
9484 unsigned char *raster
;
9486 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9487 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9491 if (NILP (specified_data
))
9493 file
= x_find_image_file (specified_file
);
9494 if (!STRINGP (file
))
9496 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9501 /* Open the GIF file. */
9502 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9505 image_error ("Cannot open `%s'", file
, Qnil
);
9512 /* Read from memory! */
9513 current_gif_memory_src
= &memsrc
;
9514 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9515 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9518 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9521 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9527 /* Read entire contents. */
9528 rc
= DGifSlurp (gif
);
9529 if (rc
== GIF_ERROR
)
9531 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9532 DGifCloseFile (gif
);
9537 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9538 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9539 if (ino
>= gif
->ImageCount
)
9541 image_error ("Invalid image number `%s' in image `%s'",
9543 DGifCloseFile (gif
);
9548 width
= img
->width
= gif
->SWidth
;
9549 height
= img
->height
= gif
->SHeight
;
9553 /* Create the X image and pixmap. */
9554 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9557 DGifCloseFile (gif
);
9562 /* Allocate colors. */
9563 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9565 gif_color_map
= gif
->SColorMap
;
9566 init_color_table ();
9567 bzero (pixel_colors
, sizeof pixel_colors
);
9569 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9571 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9572 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9573 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9574 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9577 img
->colors
= colors_in_color_table (&img
->ncolors
);
9578 free_color_table ();
9580 /* Clear the part of the screen image that are not covered by
9581 the image from the GIF file. Full animated GIF support
9582 requires more than can be done here (see the gif89 spec,
9583 disposal methods). Let's simply assume that the part
9584 not covered by a sub-image is in the frame's background color. */
9585 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9586 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9587 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9588 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9590 for (y
= 0; y
< image_top
; ++y
)
9591 for (x
= 0; x
< width
; ++x
)
9592 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9594 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9595 for (x
= 0; x
< width
; ++x
)
9596 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9598 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9600 for (x
= 0; x
< image_left
; ++x
)
9601 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9602 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9603 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9606 /* Read the GIF image into the X image. We use a local variable
9607 `raster' here because RasterBits below is a char *, and invites
9608 problems with bytes >= 0x80. */
9609 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9611 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9613 static int interlace_start
[] = {0, 4, 2, 1};
9614 static int interlace_increment
[] = {8, 8, 4, 2};
9616 int row
= interlace_start
[0];
9620 for (y
= 0; y
< image_height
; y
++)
9622 if (row
>= image_height
)
9624 row
= interlace_start
[++pass
];
9625 while (row
>= image_height
)
9626 row
= interlace_start
[++pass
];
9629 for (x
= 0; x
< image_width
; x
++)
9631 int i
= raster
[(y
* image_width
) + x
];
9632 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9636 row
+= interlace_increment
[pass
];
9641 for (y
= 0; y
< image_height
; ++y
)
9642 for (x
= 0; x
< image_width
; ++x
)
9644 int i
= raster
[y
* image_width
+ x
];
9645 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9649 DGifCloseFile (gif
);
9651 /* Put the image into the pixmap, then free the X image and its buffer. */
9652 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9653 x_destroy_x_image (ximg
);
9660 #endif /* HAVE_GIF != 0 */
9664 /***********************************************************************
9666 ***********************************************************************/
9668 static int gs_image_p
P_ ((Lisp_Object object
));
9669 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9670 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9672 /* The symbol `postscript' identifying images of this type. */
9674 Lisp_Object Qpostscript
;
9676 /* Keyword symbols. */
9678 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9680 /* Indices of image specification fields in gs_format, below. */
9682 enum gs_keyword_index
9698 /* Vector of image_keyword structures describing the format
9699 of valid user-defined image specifications. */
9701 static struct image_keyword gs_format
[GS_LAST
] =
9703 {":type", IMAGE_SYMBOL_VALUE
, 1},
9704 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9705 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9706 {":file", IMAGE_STRING_VALUE
, 1},
9707 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9708 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9709 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9710 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9711 {":relief", IMAGE_INTEGER_VALUE
, 0},
9712 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9713 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9716 /* Structure describing the image type `ghostscript'. */
9718 static struct image_type gs_type
=
9728 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9731 gs_clear_image (f
, img
)
9735 /* IMG->data.ptr_val may contain a recorded colormap. */
9736 xfree (img
->data
.ptr_val
);
9737 x_clear_image (f
, img
);
9741 /* Return non-zero if OBJECT is a valid Ghostscript image
9748 struct image_keyword fmt
[GS_LAST
];
9752 bcopy (gs_format
, fmt
, sizeof fmt
);
9754 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
)
9755 || (fmt
[GS_ASCENT
].count
9756 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
9759 /* Bounding box must be a list or vector containing 4 integers. */
9760 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9763 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9764 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9769 else if (VECTORP (tem
))
9771 if (XVECTOR (tem
)->size
!= 4)
9773 for (i
= 0; i
< 4; ++i
)
9774 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9784 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9793 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9794 struct gcpro gcpro1
, gcpro2
;
9796 double in_width
, in_height
;
9797 Lisp_Object pixel_colors
= Qnil
;
9799 /* Compute pixel size of pixmap needed from the given size in the
9800 image specification. Sizes in the specification are in pt. 1 pt
9801 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9803 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9804 in_width
= XFASTINT (pt_width
) / 72.0;
9805 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9806 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9807 in_height
= XFASTINT (pt_height
) / 72.0;
9808 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9810 /* Create the pixmap. */
9812 xassert (img
->pixmap
== 0);
9813 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9814 img
->width
, img
->height
,
9815 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9820 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9824 /* Call the loader to fill the pixmap. It returns a process object
9825 if successful. We do not record_unwind_protect here because
9826 other places in redisplay like calling window scroll functions
9827 don't either. Let the Lisp loader use `unwind-protect' instead. */
9828 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9830 sprintf (buffer
, "%lu %lu",
9831 (unsigned long) FRAME_X_WINDOW (f
),
9832 (unsigned long) img
->pixmap
);
9833 window_and_pixmap_id
= build_string (buffer
);
9835 sprintf (buffer
, "%lu %lu",
9836 FRAME_FOREGROUND_PIXEL (f
),
9837 FRAME_BACKGROUND_PIXEL (f
));
9838 pixel_colors
= build_string (buffer
);
9840 XSETFRAME (frame
, f
);
9841 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9843 loader
= intern ("gs-load-image");
9845 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9846 make_number (img
->width
),
9847 make_number (img
->height
),
9848 window_and_pixmap_id
,
9851 return PROCESSP (img
->data
.lisp_val
);
9855 /* Kill the Ghostscript process that was started to fill PIXMAP on
9856 frame F. Called from XTread_socket when receiving an event
9857 telling Emacs that Ghostscript has finished drawing. */
9860 x_kill_gs_process (pixmap
, f
)
9864 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9868 /* Find the image containing PIXMAP. */
9869 for (i
= 0; i
< c
->used
; ++i
)
9870 if (c
->images
[i
]->pixmap
== pixmap
)
9873 /* Kill the GS process. We should have found PIXMAP in the image
9874 cache and its image should contain a process object. */
9875 xassert (i
< c
->used
);
9877 xassert (PROCESSP (img
->data
.lisp_val
));
9878 Fkill_process (img
->data
.lisp_val
, Qnil
);
9879 img
->data
.lisp_val
= Qnil
;
9881 /* On displays with a mutable colormap, figure out the colors
9882 allocated for the image by looking at the pixels of an XImage for
9884 class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
9885 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9891 /* Try to get an XImage for img->pixmep. */
9892 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9893 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9898 /* Initialize the color table. */
9899 init_color_table ();
9901 /* For each pixel of the image, look its color up in the
9902 color table. After having done so, the color table will
9903 contain an entry for each color used by the image. */
9904 for (y
= 0; y
< img
->height
; ++y
)
9905 for (x
= 0; x
< img
->width
; ++x
)
9907 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9908 lookup_pixel_color (f
, pixel
);
9911 /* Record colors in the image. Free color table and XImage. */
9912 img
->colors
= colors_in_color_table (&img
->ncolors
);
9913 free_color_table ();
9914 XDestroyImage (ximg
);
9916 #if 0 /* This doesn't seem to be the case. If we free the colors
9917 here, we get a BadAccess later in x_clear_image when
9918 freeing the colors. */
9919 /* We have allocated colors once, but Ghostscript has also
9920 allocated colors on behalf of us. So, to get the
9921 reference counts right, free them once. */
9923 x_free_colors (f
, img
->colors
, img
->ncolors
);
9927 image_error ("Cannot get X image of `%s'; colors will not be freed",
9936 /***********************************************************************
9938 ***********************************************************************/
9940 DEFUN ("x-change-window-property", Fx_change_window_property
,
9941 Sx_change_window_property
, 2, 3, 0,
9942 "Change window property PROP to VALUE on the X window of FRAME.\n\
9943 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9944 selected frame. Value is VALUE.")
9945 (prop
, value
, frame
)
9946 Lisp_Object frame
, prop
, value
;
9948 struct frame
*f
= check_x_frame (frame
);
9951 CHECK_STRING (prop
, 1);
9952 CHECK_STRING (value
, 2);
9955 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9956 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9957 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9958 XSTRING (value
)->data
, XSTRING (value
)->size
);
9960 /* Make sure the property is set when we return. */
9961 XFlush (FRAME_X_DISPLAY (f
));
9968 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9969 Sx_delete_window_property
, 1, 2, 0,
9970 "Remove window property PROP from X window of FRAME.\n\
9971 FRAME nil or omitted means use the selected frame. Value is PROP.")
9973 Lisp_Object prop
, frame
;
9975 struct frame
*f
= check_x_frame (frame
);
9978 CHECK_STRING (prop
, 1);
9980 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9981 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9983 /* Make sure the property is removed when we return. */
9984 XFlush (FRAME_X_DISPLAY (f
));
9991 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
9993 "Value is the value of window property PROP on FRAME.\n\
9994 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9995 if FRAME hasn't a property with name PROP or if PROP has no string\n\
9998 Lisp_Object prop
, frame
;
10000 struct frame
*f
= check_x_frame (frame
);
10003 Lisp_Object prop_value
= Qnil
;
10004 char *tmp_data
= NULL
;
10007 unsigned long actual_size
, bytes_remaining
;
10009 CHECK_STRING (prop
, 1);
10011 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10012 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10013 prop_atom
, 0, 0, False
, XA_STRING
,
10014 &actual_type
, &actual_format
, &actual_size
,
10015 &bytes_remaining
, (unsigned char **) &tmp_data
);
10018 int size
= bytes_remaining
;
10023 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10024 prop_atom
, 0, bytes_remaining
,
10026 &actual_type
, &actual_format
,
10027 &actual_size
, &bytes_remaining
,
10028 (unsigned char **) &tmp_data
);
10030 prop_value
= make_string (tmp_data
, size
);
10041 /***********************************************************************
10043 ***********************************************************************/
10045 /* If non-null, an asynchronous timer that, when it expires, displays
10046 a busy cursor on all frames. */
10048 static struct atimer
*busy_cursor_atimer
;
10050 /* Non-zero means a busy cursor is currently shown. */
10052 static int busy_cursor_shown_p
;
10054 /* Number of seconds to wait before displaying a busy cursor. */
10056 static Lisp_Object Vbusy_cursor_delay
;
10058 /* Default number of seconds to wait before displaying a busy
10061 #define DEFAULT_BUSY_CURSOR_DELAY 1
10063 /* Function prototypes. */
10065 static void show_busy_cursor
P_ ((struct atimer
*));
10066 static void hide_busy_cursor
P_ ((void));
10069 /* Cancel a currently active busy-cursor timer, and start a new one. */
10072 start_busy_cursor ()
10075 int secs
, usecs
= 0;
10077 cancel_busy_cursor ();
10079 if (INTEGERP (Vbusy_cursor_delay
)
10080 && XINT (Vbusy_cursor_delay
) > 0)
10081 secs
= XFASTINT (Vbusy_cursor_delay
);
10082 else if (FLOATP (Vbusy_cursor_delay
)
10083 && XFLOAT_DATA (Vbusy_cursor_delay
) > 0)
10086 tem
= Ftruncate (Vbusy_cursor_delay
, Qnil
);
10087 secs
= XFASTINT (tem
);
10088 usecs
= (XFLOAT_DATA (Vbusy_cursor_delay
) - secs
) * 1000000;
10091 secs
= DEFAULT_BUSY_CURSOR_DELAY
;
10093 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10094 busy_cursor_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10095 show_busy_cursor
, NULL
);
10099 /* Cancel the busy cursor timer if active, hide a busy cursor if
10103 cancel_busy_cursor ()
10105 if (busy_cursor_atimer
)
10107 cancel_atimer (busy_cursor_atimer
);
10108 busy_cursor_atimer
= NULL
;
10111 if (busy_cursor_shown_p
)
10112 hide_busy_cursor ();
10116 /* Timer function of busy_cursor_atimer. TIMER is equal to
10117 busy_cursor_atimer.
10119 Display a busy cursor on all frames by mapping the frames'
10120 busy_window. Set the busy_p flag in the frames' output_data.x
10121 structure to indicate that a busy cursor is shown on the
10125 show_busy_cursor (timer
)
10126 struct atimer
*timer
;
10128 /* The timer implementation will cancel this timer automatically
10129 after this function has run. Set busy_cursor_atimer to null
10130 so that we know the timer doesn't have to be canceled. */
10131 busy_cursor_atimer
= NULL
;
10133 if (!busy_cursor_shown_p
)
10135 Lisp_Object rest
, frame
;
10139 FOR_EACH_FRAME (rest
, frame
)
10140 if (FRAME_X_P (XFRAME (frame
)))
10142 struct frame
*f
= XFRAME (frame
);
10144 f
->output_data
.x
->busy_p
= 1;
10146 if (!f
->output_data
.x
->busy_window
)
10148 unsigned long mask
= CWCursor
;
10149 XSetWindowAttributes attrs
;
10151 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
10153 f
->output_data
.x
->busy_window
10154 = XCreateWindow (FRAME_X_DISPLAY (f
),
10155 FRAME_OUTER_WINDOW (f
),
10156 0, 0, 32000, 32000, 0, 0,
10162 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10163 XFlush (FRAME_X_DISPLAY (f
));
10166 busy_cursor_shown_p
= 1;
10172 /* Hide the busy cursor on all frames, if it is currently shown. */
10175 hide_busy_cursor ()
10177 if (busy_cursor_shown_p
)
10179 Lisp_Object rest
, frame
;
10182 FOR_EACH_FRAME (rest
, frame
)
10184 struct frame
*f
= XFRAME (frame
);
10187 /* Watch out for newly created frames. */
10188 && f
->output_data
.x
->busy_window
)
10190 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10191 /* Sync here because XTread_socket looks at the busy_p flag
10192 that is reset to zero below. */
10193 XSync (FRAME_X_DISPLAY (f
), False
);
10194 f
->output_data
.x
->busy_p
= 0;
10198 busy_cursor_shown_p
= 0;
10205 /***********************************************************************
10207 ***********************************************************************/
10209 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10212 /* The frame of a currently visible tooltip, or null. */
10214 struct frame
*tip_frame
;
10216 /* If non-nil, a timer started that hides the last tooltip when it
10219 Lisp_Object tip_timer
;
10222 /* Create a frame for a tooltip on the display described by DPYINFO.
10223 PARMS is a list of frame parameters. Value is the frame. */
10226 x_create_tip_frame (dpyinfo
, parms
)
10227 struct x_display_info
*dpyinfo
;
10231 Lisp_Object frame
, tem
;
10233 long window_prompting
= 0;
10235 int count
= specpdl_ptr
- specpdl
;
10236 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10241 /* Use this general default value to start with until we know if
10242 this frame has a specified name. */
10243 Vx_resource_name
= Vinvocation_name
;
10245 #ifdef MULTI_KBOARD
10246 kb
= dpyinfo
->kboard
;
10248 kb
= &the_only_kboard
;
10251 /* Get the name of the frame to use for resource lookup. */
10252 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10253 if (!STRINGP (name
)
10254 && !EQ (name
, Qunbound
)
10256 error ("Invalid frame name--not a string or nil");
10257 Vx_resource_name
= name
;
10260 GCPRO3 (parms
, name
, frame
);
10261 tip_frame
= f
= make_frame (1);
10262 XSETFRAME (frame
, f
);
10263 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10265 f
->output_method
= output_x_window
;
10266 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10267 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10268 f
->output_data
.x
->icon_bitmap
= -1;
10269 f
->output_data
.x
->fontset
= -1;
10270 f
->icon_name
= Qnil
;
10271 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10272 #ifdef MULTI_KBOARD
10273 FRAME_KBOARD (f
) = kb
;
10275 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10276 f
->output_data
.x
->explicit_parent
= 0;
10278 /* Set the name; the functions to which we pass f expect the name to
10280 if (EQ (name
, Qunbound
) || NILP (name
))
10282 f
->name
= build_string (dpyinfo
->x_id_name
);
10283 f
->explicit_name
= 0;
10288 f
->explicit_name
= 1;
10289 /* use the frame's title when getting resources for this frame. */
10290 specbind (Qx_resource_name
, name
);
10293 /* Create fontsets from `global_fontset_alist' before handling fonts. */
10294 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
10295 fs_register_fontset (f
, XCAR (tem
));
10297 /* Extract the window parameters from the supplied values
10298 that are needed to determine window geometry. */
10302 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10305 /* First, try whatever font the caller has specified. */
10306 if (STRINGP (font
))
10308 tem
= Fquery_fontset (font
, Qnil
);
10310 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10312 font
= x_new_font (f
, XSTRING (font
)->data
);
10315 /* Try out a font which we hope has bold and italic variations. */
10316 if (!STRINGP (font
))
10317 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10318 if (!STRINGP (font
))
10319 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10320 if (! STRINGP (font
))
10321 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10322 if (! STRINGP (font
))
10323 /* This was formerly the first thing tried, but it finds too many fonts
10324 and takes too long. */
10325 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10326 /* If those didn't work, look for something which will at least work. */
10327 if (! STRINGP (font
))
10328 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10330 if (! STRINGP (font
))
10331 font
= build_string ("fixed");
10333 x_default_parameter (f
, parms
, Qfont
, font
,
10334 "font", "Font", RES_TYPE_STRING
);
10337 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10338 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10340 /* This defaults to 2 in order to match xterm. We recognize either
10341 internalBorderWidth or internalBorder (which is what xterm calls
10343 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10347 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10348 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10349 if (! EQ (value
, Qunbound
))
10350 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10354 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10355 "internalBorderWidth", "internalBorderWidth",
10358 /* Also do the stuff which must be set before the window exists. */
10359 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10360 "foreground", "Foreground", RES_TYPE_STRING
);
10361 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10362 "background", "Background", RES_TYPE_STRING
);
10363 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10364 "pointerColor", "Foreground", RES_TYPE_STRING
);
10365 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10366 "cursorColor", "Foreground", RES_TYPE_STRING
);
10367 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10368 "borderColor", "BorderColor", RES_TYPE_STRING
);
10370 /* Init faces before x_default_parameter is called for scroll-bar
10371 parameters because that function calls x_set_scroll_bar_width,
10372 which calls change_frame_size, which calls Fset_window_buffer,
10373 which runs hooks, which call Fvertical_motion. At the end, we
10374 end up in init_iterator with a null face cache, which should not
10376 init_frame_faces (f
);
10378 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10379 window_prompting
= x_figure_window_size (f
, parms
);
10381 if (window_prompting
& XNegative
)
10383 if (window_prompting
& YNegative
)
10384 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10386 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10390 if (window_prompting
& YNegative
)
10391 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10393 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10396 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10398 XSetWindowAttributes attrs
;
10399 unsigned long mask
;
10402 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
10403 /* Window managers looks at the override-redirect flag to
10404 determine whether or net to give windows a decoration (Xlib
10406 attrs
.override_redirect
= True
;
10407 attrs
.save_under
= True
;
10408 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10409 /* Arrange for getting MapNotify and UnmapNotify events. */
10410 attrs
.event_mask
= StructureNotifyMask
;
10412 = FRAME_X_WINDOW (f
)
10413 = XCreateWindow (FRAME_X_DISPLAY (f
),
10414 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10415 /* x, y, width, height */
10419 CopyFromParent
, InputOutput
, CopyFromParent
,
10426 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10427 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10428 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10429 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10430 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10431 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10433 /* Dimensions, especially f->height, must be done via change_frame_size.
10434 Change will not be effected unless different from the current
10437 height
= f
->height
;
10439 SET_FRAME_WIDTH (f
, 0);
10440 change_frame_size (f
, height
, width
, 1, 0, 0);
10446 /* It is now ok to make the frame official even if we get an error
10447 below. And the frame needs to be on Vframe_list or making it
10448 visible won't work. */
10449 Vframe_list
= Fcons (frame
, Vframe_list
);
10451 /* Now that the frame is official, it counts as a reference to
10453 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10455 return unbind_to (count
, frame
);
10459 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 4, 0,
10460 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10461 A tooltip window is a small X window displaying STRING at\n\
10462 the current mouse position.\n\
10463 FRAME nil or omitted means use the selected frame.\n\
10464 PARMS is an optional list of frame parameters which can be\n\
10465 used to change the tooltip's appearance.\n\
10466 Automatically hide the tooltip after TIMEOUT seconds.\n\
10467 TIMEOUT nil means use the default timeout of 5 seconds.")
10468 (string
, frame
, parms
, timeout
)
10469 Lisp_Object string
, frame
, parms
, timeout
;
10473 Window root
, child
;
10474 Lisp_Object buffer
;
10475 struct buffer
*old_buffer
;
10476 struct text_pos pos
;
10477 int i
, width
, height
;
10478 int root_x
, root_y
, win_x
, win_y
;
10480 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10481 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10482 int count
= specpdl_ptr
- specpdl
;
10484 specbind (Qinhibit_redisplay
, Qt
);
10486 GCPRO4 (string
, parms
, frame
, timeout
);
10488 CHECK_STRING (string
, 0);
10489 f
= check_x_frame (frame
);
10490 if (NILP (timeout
))
10491 timeout
= make_number (5);
10493 CHECK_NATNUM (timeout
, 2);
10495 /* Hide a previous tip, if any. */
10498 /* Add default values to frame parameters. */
10499 if (NILP (Fassq (Qname
, parms
)))
10500 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10501 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10502 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10503 if (NILP (Fassq (Qborder_width
, parms
)))
10504 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10505 if (NILP (Fassq (Qborder_color
, parms
)))
10506 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10507 if (NILP (Fassq (Qbackground_color
, parms
)))
10508 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10511 /* Create a frame for the tooltip, and record it in the global
10512 variable tip_frame. */
10513 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
10514 tip_frame
= f
= XFRAME (frame
);
10516 /* Set up the frame's root window. Currently we use a size of 80
10517 columns x 40 lines. If someone wants to show a larger tip, he
10518 will loose. I don't think this is a realistic case. */
10519 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10520 w
->left
= w
->top
= make_number (0);
10524 w
->pseudo_window_p
= 1;
10526 /* Display the tooltip text in a temporary buffer. */
10527 buffer
= Fget_buffer_create (build_string (" *tip*"));
10528 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10529 old_buffer
= current_buffer
;
10530 set_buffer_internal_1 (XBUFFER (buffer
));
10532 Finsert (make_number (1), &string
);
10533 clear_glyph_matrix (w
->desired_matrix
);
10534 clear_glyph_matrix (w
->current_matrix
);
10535 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10536 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10538 /* Compute width and height of the tooltip. */
10539 width
= height
= 0;
10540 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10542 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10543 struct glyph
*last
;
10546 /* Stop at the first empty row at the end. */
10547 if (!row
->enabled_p
|| !row
->displays_text_p
)
10550 /* Let the row go over the full width of the frame. */
10551 row
->full_width_p
= 1;
10553 /* There's a glyph at the end of rows that is use to place
10554 the cursor there. Don't include the width of this glyph. */
10555 if (row
->used
[TEXT_AREA
])
10557 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10558 row_width
= row
->pixel_width
- last
->pixel_width
;
10561 row_width
= row
->pixel_width
;
10563 height
+= row
->height
;
10564 width
= max (width
, row_width
);
10567 /* Add the frame's internal border to the width and height the X
10568 window should have. */
10569 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10570 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10572 /* Move the tooltip window where the mouse pointer is. Resize and
10575 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10576 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
10577 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10578 root_x
+ 5, root_y
- height
- 5, width
, height
);
10579 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10582 /* Draw into the window. */
10583 w
->must_be_updated_p
= 1;
10584 update_single_window (w
, 1);
10586 /* Restore original current buffer. */
10587 set_buffer_internal_1 (old_buffer
);
10588 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
10590 /* Let the tip disappear after timeout seconds. */
10591 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
10592 intern ("x-hide-tip"));
10595 return unbind_to (count
, Qnil
);
10599 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
10600 "Hide the current tooltip window, if there is any.\n\
10601 Value is t is tooltip was open, nil otherwise.")
10604 int count
= specpdl_ptr
- specpdl
;
10607 specbind (Qinhibit_redisplay
, Qt
);
10609 if (!NILP (tip_timer
))
10611 call1 (intern ("cancel-timer"), tip_timer
);
10619 XSETFRAME (frame
, tip_frame
);
10620 Fdelete_frame (frame
, Qt
);
10625 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
10630 /***********************************************************************
10631 File selection dialog
10632 ***********************************************************************/
10636 /* Callback for "OK" and "Cancel" on file selection dialog. */
10639 file_dialog_cb (widget
, client_data
, call_data
)
10641 XtPointer call_data
, client_data
;
10643 int *result
= (int *) client_data
;
10644 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
10645 *result
= cb
->reason
;
10649 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
10650 "Read file name, prompting with PROMPT in directory DIR.\n\
10651 Use a file selection dialog.\n\
10652 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10653 specified. Don't let the user enter a file name in the file\n\
10654 selection dialog's entry field, if MUSTMATCH is non-nil.")
10655 (prompt
, dir
, default_filename
, mustmatch
)
10656 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
10659 struct frame
*f
= SELECTED_FRAME ();
10660 Lisp_Object file
= Qnil
;
10661 Widget dialog
, text
, list
, help
;
10664 extern XtAppContext Xt_app_con
;
10666 XmString dir_xmstring
, pattern_xmstring
;
10667 int popup_activated_flag
;
10668 int count
= specpdl_ptr
- specpdl
;
10669 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
10671 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
10672 CHECK_STRING (prompt
, 0);
10673 CHECK_STRING (dir
, 1);
10675 /* Prevent redisplay. */
10676 specbind (Qinhibit_redisplay
, Qt
);
10680 /* Create the dialog with PROMPT as title, using DIR as initial
10681 directory and using "*" as pattern. */
10682 dir
= Fexpand_file_name (dir
, Qnil
);
10683 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
10684 pattern_xmstring
= XmStringCreateLocalized ("*");
10686 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
10687 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
10688 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
10689 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
10690 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
10691 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
10693 XmStringFree (dir_xmstring
);
10694 XmStringFree (pattern_xmstring
);
10696 /* Add callbacks for OK and Cancel. */
10697 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
10698 (XtPointer
) &result
);
10699 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
10700 (XtPointer
) &result
);
10702 /* Disable the help button since we can't display help. */
10703 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
10704 XtSetSensitive (help
, False
);
10706 /* Mark OK button as default. */
10707 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
10708 XmNshowAsDefault
, True
, NULL
);
10710 /* If MUSTMATCH is non-nil, disable the file entry field of the
10711 dialog, so that the user must select a file from the files list
10712 box. We can't remove it because we wouldn't have a way to get at
10713 the result file name, then. */
10714 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
10715 if (!NILP (mustmatch
))
10718 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
10719 XtSetSensitive (text
, False
);
10720 XtSetSensitive (label
, False
);
10723 /* Manage the dialog, so that list boxes get filled. */
10724 XtManageChild (dialog
);
10726 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10727 must include the path for this to work. */
10728 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
10729 if (STRINGP (default_filename
))
10731 XmString default_xmstring
;
10735 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
10737 if (!XmListItemExists (list
, default_xmstring
))
10739 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10740 XmListAddItem (list
, default_xmstring
, 0);
10744 item_pos
= XmListItemPos (list
, default_xmstring
);
10745 XmStringFree (default_xmstring
);
10747 /* Select the item and scroll it into view. */
10748 XmListSelectPos (list
, item_pos
, True
);
10749 XmListSetPos (list
, item_pos
);
10752 /* Process all events until the user presses Cancel or OK. */
10753 for (result
= 0; result
== 0;)
10756 Widget widget
, parent
;
10758 XtAppNextEvent (Xt_app_con
, &event
);
10760 /* See if the receiver of the event is one of the widgets of
10761 the file selection dialog. If so, dispatch it. If not,
10763 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
10765 while (parent
&& parent
!= dialog
)
10766 parent
= XtParent (parent
);
10768 if (parent
== dialog
10769 || (event
.type
== Expose
10770 && !process_expose_from_menu (event
)))
10771 XtDispatchEvent (&event
);
10774 /* Get the result. */
10775 if (result
== XmCR_OK
)
10780 XtVaGetValues (dialog
, XmNtextString
, &text
, 0);
10781 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
10782 XmStringFree (text
);
10783 file
= build_string (data
);
10790 XtUnmanageChild (dialog
);
10791 XtDestroyWidget (dialog
);
10795 /* Make "Cancel" equivalent to C-g. */
10797 Fsignal (Qquit
, Qnil
);
10799 return unbind_to (count
, file
);
10802 #endif /* USE_MOTIF */
10805 /***********************************************************************
10807 ***********************************************************************/
10811 DEFUN ("imagep", Fimagep
, Simagep
, 1, 1, 0,
10812 "Value is non-nil if SPEC is a valid image specification.")
10816 return valid_image_p (spec
) ? Qt
: Qnil
;
10820 DEFUN ("lookup-image", Flookup_image
, Slookup_image
, 1, 1, 0, "")
10826 if (valid_image_p (spec
))
10827 id
= lookup_image (SELECTED_FRAME (), spec
);
10829 debug_print (spec
);
10830 return make_number (id
);
10833 #endif /* GLYPH_DEBUG != 0 */
10837 /***********************************************************************
10839 ***********************************************************************/
10844 /* This is zero if not using X windows. */
10847 /* The section below is built by the lisp expression at the top of the file,
10848 just above where these variables are declared. */
10849 /*&&& init symbols here &&&*/
10850 Qauto_raise
= intern ("auto-raise");
10851 staticpro (&Qauto_raise
);
10852 Qauto_lower
= intern ("auto-lower");
10853 staticpro (&Qauto_lower
);
10854 Qbar
= intern ("bar");
10856 Qborder_color
= intern ("border-color");
10857 staticpro (&Qborder_color
);
10858 Qborder_width
= intern ("border-width");
10859 staticpro (&Qborder_width
);
10860 Qbox
= intern ("box");
10862 Qcursor_color
= intern ("cursor-color");
10863 staticpro (&Qcursor_color
);
10864 Qcursor_type
= intern ("cursor-type");
10865 staticpro (&Qcursor_type
);
10866 Qgeometry
= intern ("geometry");
10867 staticpro (&Qgeometry
);
10868 Qicon_left
= intern ("icon-left");
10869 staticpro (&Qicon_left
);
10870 Qicon_top
= intern ("icon-top");
10871 staticpro (&Qicon_top
);
10872 Qicon_type
= intern ("icon-type");
10873 staticpro (&Qicon_type
);
10874 Qicon_name
= intern ("icon-name");
10875 staticpro (&Qicon_name
);
10876 Qinternal_border_width
= intern ("internal-border-width");
10877 staticpro (&Qinternal_border_width
);
10878 Qleft
= intern ("left");
10879 staticpro (&Qleft
);
10880 Qright
= intern ("right");
10881 staticpro (&Qright
);
10882 Qmouse_color
= intern ("mouse-color");
10883 staticpro (&Qmouse_color
);
10884 Qnone
= intern ("none");
10885 staticpro (&Qnone
);
10886 Qparent_id
= intern ("parent-id");
10887 staticpro (&Qparent_id
);
10888 Qscroll_bar_width
= intern ("scroll-bar-width");
10889 staticpro (&Qscroll_bar_width
);
10890 Qsuppress_icon
= intern ("suppress-icon");
10891 staticpro (&Qsuppress_icon
);
10892 Qundefined_color
= intern ("undefined-color");
10893 staticpro (&Qundefined_color
);
10894 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10895 staticpro (&Qvertical_scroll_bars
);
10896 Qvisibility
= intern ("visibility");
10897 staticpro (&Qvisibility
);
10898 Qwindow_id
= intern ("window-id");
10899 staticpro (&Qwindow_id
);
10900 Qouter_window_id
= intern ("outer-window-id");
10901 staticpro (&Qouter_window_id
);
10902 Qx_frame_parameter
= intern ("x-frame-parameter");
10903 staticpro (&Qx_frame_parameter
);
10904 Qx_resource_name
= intern ("x-resource-name");
10905 staticpro (&Qx_resource_name
);
10906 Quser_position
= intern ("user-position");
10907 staticpro (&Quser_position
);
10908 Quser_size
= intern ("user-size");
10909 staticpro (&Quser_size
);
10910 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10911 staticpro (&Qscroll_bar_foreground
);
10912 Qscroll_bar_background
= intern ("scroll-bar-background");
10913 staticpro (&Qscroll_bar_background
);
10914 Qscreen_gamma
= intern ("screen-gamma");
10915 staticpro (&Qscreen_gamma
);
10916 /* This is the end of symbol initialization. */
10918 /* Text property `display' should be nonsticky by default. */
10919 Vtext_property_default_nonsticky
10920 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
10923 Qlaplace
= intern ("laplace");
10924 staticpro (&Qlaplace
);
10926 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10927 staticpro (&Qface_set_after_frame_default
);
10929 Fput (Qundefined_color
, Qerror_conditions
,
10930 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10931 Fput (Qundefined_color
, Qerror_message
,
10932 build_string ("Undefined color"));
10934 init_x_parm_symbols ();
10936 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
10937 "List of directories to search for bitmap files for X.");
10938 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
10940 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
10941 "The shape of the pointer when over text.\n\
10942 Changing the value does not affect existing frames\n\
10943 unless you set the mouse color.");
10944 Vx_pointer_shape
= Qnil
;
10946 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
10947 "The name Emacs uses to look up X resources.\n\
10948 `x-get-resource' uses this as the first component of the instance name\n\
10949 when requesting resource values.\n\
10950 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10951 was invoked, or to the value specified with the `-name' or `-rn'\n\
10952 switches, if present.\n\
10954 It may be useful to bind this variable locally around a call\n\
10955 to `x-get-resource'. See also the variable `x-resource-class'.");
10956 Vx_resource_name
= Qnil
;
10958 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
10959 "The class Emacs uses to look up X resources.\n\
10960 `x-get-resource' uses this as the first component of the instance class\n\
10961 when requesting resource values.\n\
10962 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10964 Setting this variable permanently is not a reasonable thing to do,\n\
10965 but binding this variable locally around a call to `x-get-resource'\n\
10966 is a reasonable practice. See also the variable `x-resource-name'.");
10967 Vx_resource_class
= build_string (EMACS_CLASS
);
10969 #if 0 /* This doesn't really do anything. */
10970 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
10971 "The shape of the pointer when not over text.\n\
10972 This variable takes effect when you create a new frame\n\
10973 or when you set the mouse color.");
10975 Vx_nontext_pointer_shape
= Qnil
;
10977 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
10978 "The shape of the pointer when Emacs is busy.\n\
10979 This variable takes effect when you create a new frame\n\
10980 or when you set the mouse color.");
10981 Vx_busy_pointer_shape
= Qnil
;
10983 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
10984 "Non-zero means Emacs displays a busy cursor on window systems.");
10985 display_busy_cursor_p
= 1;
10987 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay
,
10988 "*Seconds to wait before displaying a busy-cursor.\n\
10989 Value must be an integer or float.");
10990 Vbusy_cursor_delay
= make_number (DEFAULT_BUSY_CURSOR_DELAY
);
10992 #if 0 /* This doesn't really do anything. */
10993 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
10994 "The shape of the pointer when over the mode line.\n\
10995 This variable takes effect when you create a new frame\n\
10996 or when you set the mouse color.");
10998 Vx_mode_pointer_shape
= Qnil
;
11000 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11001 &Vx_sensitive_text_pointer_shape
,
11002 "The shape of the pointer when over mouse-sensitive text.\n\
11003 This variable takes effect when you create a new frame\n\
11004 or when you set the mouse color.");
11005 Vx_sensitive_text_pointer_shape
= Qnil
;
11007 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11008 "A string indicating the foreground color of the cursor box.");
11009 Vx_cursor_fore_pixel
= Qnil
;
11011 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11012 "Non-nil if no X window manager is in use.\n\
11013 Emacs doesn't try to figure this out; this is always nil\n\
11014 unless you set it to something else.");
11015 /* We don't have any way to find this out, so set it to nil
11016 and maybe the user would like to set it to t. */
11017 Vx_no_window_manager
= Qnil
;
11019 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11020 &Vx_pixel_size_width_font_regexp
,
11021 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11023 Since Emacs gets width of a font matching with this regexp from\n\
11024 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11025 such a font. This is especially effective for such large fonts as\n\
11026 Chinese, Japanese, and Korean.");
11027 Vx_pixel_size_width_font_regexp
= Qnil
;
11029 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11030 "Time after which cached images are removed from the cache.\n\
11031 When an image has not been displayed this many seconds, remove it\n\
11032 from the image cache. Value must be an integer or nil with nil\n\
11033 meaning don't clear the cache.");
11034 Vimage_cache_eviction_delay
= make_number (30 * 60);
11036 DEFVAR_LISP ("image-types", &Vimage_types
,
11037 "List of supported image types.\n\
11038 Each element of the list is a symbol for a supported image type.");
11039 Vimage_types
= Qnil
;
11041 #ifdef USE_X_TOOLKIT
11042 Fprovide (intern ("x-toolkit"));
11045 Fprovide (intern ("motif"));
11048 defsubr (&Sx_get_resource
);
11050 /* X window properties. */
11051 defsubr (&Sx_change_window_property
);
11052 defsubr (&Sx_delete_window_property
);
11053 defsubr (&Sx_window_property
);
11056 defsubr (&Sx_draw_rectangle
);
11057 defsubr (&Sx_erase_rectangle
);
11058 defsubr (&Sx_contour_region
);
11059 defsubr (&Sx_uncontour_region
);
11061 defsubr (&Sxw_display_color_p
);
11062 defsubr (&Sx_display_grayscale_p
);
11063 defsubr (&Sxw_color_defined_p
);
11064 defsubr (&Sxw_color_values
);
11065 defsubr (&Sx_server_max_request_size
);
11066 defsubr (&Sx_server_vendor
);
11067 defsubr (&Sx_server_version
);
11068 defsubr (&Sx_display_pixel_width
);
11069 defsubr (&Sx_display_pixel_height
);
11070 defsubr (&Sx_display_mm_width
);
11071 defsubr (&Sx_display_mm_height
);
11072 defsubr (&Sx_display_screens
);
11073 defsubr (&Sx_display_planes
);
11074 defsubr (&Sx_display_color_cells
);
11075 defsubr (&Sx_display_visual_class
);
11076 defsubr (&Sx_display_backing_store
);
11077 defsubr (&Sx_display_save_under
);
11079 defsubr (&Sx_rebind_key
);
11080 defsubr (&Sx_rebind_keys
);
11081 defsubr (&Sx_track_pointer
);
11082 defsubr (&Sx_grab_pointer
);
11083 defsubr (&Sx_ungrab_pointer
);
11085 defsubr (&Sx_parse_geometry
);
11086 defsubr (&Sx_create_frame
);
11088 defsubr (&Sx_horizontal_line
);
11090 defsubr (&Sx_open_connection
);
11091 defsubr (&Sx_close_connection
);
11092 defsubr (&Sx_display_list
);
11093 defsubr (&Sx_synchronize
);
11095 /* Setting callback functions for fontset handler. */
11096 get_font_info_func
= x_get_font_info
;
11098 #if 0 /* This function pointer doesn't seem to be used anywhere.
11099 And the pointer assigned has the wrong type, anyway. */
11100 list_fonts_func
= x_list_fonts
;
11103 load_font_func
= x_load_font
;
11104 find_ccl_program_func
= x_find_ccl_program
;
11105 query_font_func
= x_query_font
;
11106 set_frame_fontset_func
= x_set_font
;
11107 check_window_system_func
= check_x
;
11110 Qxbm
= intern ("xbm");
11112 QCtype
= intern (":type");
11113 staticpro (&QCtype
);
11114 QCalgorithm
= intern (":algorithm");
11115 staticpro (&QCalgorithm
);
11116 QCheuristic_mask
= intern (":heuristic-mask");
11117 staticpro (&QCheuristic_mask
);
11118 QCcolor_symbols
= intern (":color-symbols");
11119 staticpro (&QCcolor_symbols
);
11120 QCdata
= intern (":data");
11121 staticpro (&QCdata
);
11122 QCascent
= intern (":ascent");
11123 staticpro (&QCascent
);
11124 QCmargin
= intern (":margin");
11125 staticpro (&QCmargin
);
11126 QCrelief
= intern (":relief");
11127 staticpro (&QCrelief
);
11128 Qpostscript
= intern ("postscript");
11129 staticpro (&Qpostscript
);
11130 QCloader
= intern (":loader");
11131 staticpro (&QCloader
);
11132 QCbounding_box
= intern (":bounding-box");
11133 staticpro (&QCbounding_box
);
11134 QCpt_width
= intern (":pt-width");
11135 staticpro (&QCpt_width
);
11136 QCpt_height
= intern (":pt-height");
11137 staticpro (&QCpt_height
);
11138 QCindex
= intern (":index");
11139 staticpro (&QCindex
);
11140 Qpbm
= intern ("pbm");
11144 Qxpm
= intern ("xpm");
11149 Qjpeg
= intern ("jpeg");
11150 staticpro (&Qjpeg
);
11154 Qtiff
= intern ("tiff");
11155 staticpro (&Qtiff
);
11159 Qgif
= intern ("gif");
11164 Qpng
= intern ("png");
11168 defsubr (&Sclear_image_cache
);
11171 defsubr (&Simagep
);
11172 defsubr (&Slookup_image
);
11175 busy_cursor_atimer
= NULL
;
11176 busy_cursor_shown_p
= 0;
11178 defsubr (&Sx_show_tip
);
11179 defsubr (&Sx_hide_tip
);
11180 staticpro (&tip_timer
);
11184 defsubr (&Sx_file_dialog
);
11192 image_types
= NULL
;
11193 Vimage_types
= Qnil
;
11195 define_image_type (&xbm_type
);
11196 define_image_type (&gs_type
);
11197 define_image_type (&pbm_type
);
11200 define_image_type (&xpm_type
);
11204 define_image_type (&jpeg_type
);
11208 define_image_type (&tiff_type
);
11212 define_image_type (&gif_type
);
11216 define_image_type (&png_type
);
11220 #endif /* HAVE_X_WINDOWS */