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. */
22 /* Image support (XBM, XPM, PBM, JPEG, TIFF, GIF, PNG, GS). tooltips,
23 tool-bars, busy-cursor, file selection dialog added by Gerd
24 Moellmann <gerd@gnu.org>. */
26 /* Completely rewritten by Richard Stallman. */
28 /* Rewritten for X11 by Joseph Arceneaux */
35 /* This makes the fields of a Display accessible, in Xlib header files. */
37 #define XLIB_ILLEGAL_ACCESS
44 #include "intervals.h"
45 #include "dispextern.h"
47 #include "blockinput.h"
52 #include "termhooks.h"
58 /* On some systems, the character-composition stuff is broken in X11R5. */
60 #if defined (HAVE_X11R5) && ! defined (HAVE_X11R6)
61 #ifdef X11R5_INHIBIT_I18N
62 #define X_I18N_INHIBITED
67 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
68 #include "bitmaps/gray.xbm"
70 #include <X11/bitmaps/gray>
73 #include "[.bitmaps]gray.xbm"
77 #include <X11/Shell.h>
80 #include <X11/Xaw/Paned.h>
81 #include <X11/Xaw/Label.h>
82 #endif /* USE_MOTIF */
85 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
94 #include "../lwlib/lwlib.h"
98 #include <Xm/DialogS.h>
99 #include <Xm/FileSB.h>
102 /* Do the EDITRES protocol if running X11R5
103 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
105 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
107 extern void _XEditResCheckMessages ();
108 #endif /* R5 + Athena */
110 /* Unique id counter for widgets created by the Lucid Widget Library. */
112 extern LWLIB_ID widget_id_tick
;
115 /* This is part of a kludge--see lwlib/xlwmenu.c. */
116 extern XFontStruct
*xlwmenu_default_font
;
119 extern void free_frame_menubar ();
120 extern double atof ();
122 #endif /* USE_X_TOOLKIT */
124 #define min(a,b) ((a) < (b) ? (a) : (b))
125 #define max(a,b) ((a) > (b) ? (a) : (b))
128 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
130 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
133 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
134 it, and including `bitmaps/gray' more than once is a problem when
135 config.h defines `static' as an empty replacement string. */
137 int gray_bitmap_width
= gray_width
;
138 int gray_bitmap_height
= gray_height
;
139 unsigned char *gray_bitmap_bits
= gray_bits
;
141 /* The name we're using in resource queries. Most often "emacs". */
143 Lisp_Object Vx_resource_name
;
145 /* The application class we're using in resource queries.
148 Lisp_Object Vx_resource_class
;
150 /* Non-zero means we're allowed to display a busy cursor. */
152 int display_busy_cursor_p
;
154 /* The background and shape of the mouse pointer, and shape when not
155 over text or in the modeline. */
157 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
158 Lisp_Object Vx_busy_pointer_shape
;
160 /* The shape when over mouse-sensitive text. */
162 Lisp_Object Vx_sensitive_text_pointer_shape
;
164 /* Color of chars displayed in cursor box. */
166 Lisp_Object Vx_cursor_fore_pixel
;
168 /* Nonzero if using X. */
172 /* Non nil if no window manager is in use. */
174 Lisp_Object Vx_no_window_manager
;
176 /* Search path for bitmap files. */
178 Lisp_Object Vx_bitmap_file_path
;
180 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
182 Lisp_Object Vx_pixel_size_width_font_regexp
;
184 /* Evaluate this expression to rebuild the section of syms_of_xfns
185 that initializes and staticpros the symbols declared below. Note
186 that Emacs 18 has a bug that keeps C-x C-e from being able to
187 evaluate this expression.
190 ;; Accumulate a list of the symbols we want to initialize from the
191 ;; declarations at the top of the file.
192 (goto-char (point-min))
193 (search-forward "/\*&&& symbols declared here &&&*\/\n")
195 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
197 (cons (buffer-substring (match-beginning 1) (match-end 1))
200 (setq symbol-list (nreverse symbol-list))
201 ;; Delete the section of syms_of_... where we initialize the symbols.
202 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
203 (let ((start (point)))
204 (while (looking-at "^ Q")
206 (kill-region start (point)))
207 ;; Write a new symbol initialization section.
209 (insert (format " %s = intern (\"" (car symbol-list)))
210 (let ((start (point)))
211 (insert (substring (car symbol-list) 1))
212 (subst-char-in-region start (point) ?_ ?-))
213 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
214 (setq symbol-list (cdr symbol-list)))))
218 /*&&& symbols declared here &&&*/
219 Lisp_Object Qauto_raise
;
220 Lisp_Object Qauto_lower
;
222 Lisp_Object Qborder_color
;
223 Lisp_Object Qborder_width
;
225 Lisp_Object Qcursor_color
;
226 Lisp_Object Qcursor_type
;
227 Lisp_Object Qgeometry
;
228 Lisp_Object Qicon_left
;
229 Lisp_Object Qicon_top
;
230 Lisp_Object Qicon_type
;
231 Lisp_Object Qicon_name
;
232 Lisp_Object Qinternal_border_width
;
235 Lisp_Object Qmouse_color
;
237 Lisp_Object Qouter_window_id
;
238 Lisp_Object Qparent_id
;
239 Lisp_Object Qscroll_bar_width
;
240 Lisp_Object Qsuppress_icon
;
241 extern Lisp_Object Qtop
;
242 Lisp_Object Qundefined_color
;
243 Lisp_Object Qvertical_scroll_bars
;
244 Lisp_Object Qvisibility
;
245 Lisp_Object Qwindow_id
;
246 Lisp_Object Qx_frame_parameter
;
247 Lisp_Object Qx_resource_name
;
248 Lisp_Object Quser_position
;
249 Lisp_Object Quser_size
;
250 extern Lisp_Object Qdisplay
;
251 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
252 Lisp_Object Qscreen_gamma
;
254 /* The below are defined in frame.c. */
256 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
257 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
258 extern Lisp_Object Qtool_bar_lines
;
260 extern Lisp_Object Vwindow_system_version
;
262 Lisp_Object Qface_set_after_frame_default
;
265 /* Error if we are not connected to X. */
271 error ("X windows are not in use or not initialized");
274 /* Nonzero if we can use mouse menus.
275 You should not call this unless HAVE_MENUS is defined. */
283 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
284 and checking validity for X. */
287 check_x_frame (frame
)
293 frame
= selected_frame
;
294 CHECK_LIVE_FRAME (frame
, 0);
297 error ("Non-X frame used");
301 /* Let the user specify an X display with a frame.
302 nil stands for the selected frame--or, if that is not an X frame,
303 the first X display on the list. */
305 static struct x_display_info
*
306 check_x_display_info (frame
)
311 struct frame
*sf
= XFRAME (selected_frame
);
313 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
314 return FRAME_X_DISPLAY_INFO (sf
);
315 else if (x_display_list
!= 0)
316 return x_display_list
;
318 error ("X windows are not in use or not initialized");
320 else if (STRINGP (frame
))
321 return x_display_info_for_name (frame
);
326 CHECK_LIVE_FRAME (frame
, 0);
329 error ("Non-X frame used");
330 return FRAME_X_DISPLAY_INFO (f
);
335 /* Return the Emacs frame-object corresponding to an X window.
336 It could be the frame's main window or an icon window. */
338 /* This function can be called during GC, so use GC_xxx type test macros. */
341 x_window_to_frame (dpyinfo
, wdesc
)
342 struct x_display_info
*dpyinfo
;
345 Lisp_Object tail
, frame
;
348 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
351 if (!GC_FRAMEP (frame
))
354 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
357 if ((f
->output_data
.x
->edit_widget
358 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
359 /* A tooltip frame? */
360 || (!f
->output_data
.x
->edit_widget
361 && FRAME_X_WINDOW (f
) == wdesc
)
362 || f
->output_data
.x
->icon_desc
== wdesc
)
364 #else /* not USE_X_TOOLKIT */
365 if (FRAME_X_WINDOW (f
) == wdesc
366 || f
->output_data
.x
->icon_desc
== wdesc
)
368 #endif /* not USE_X_TOOLKIT */
374 /* Like x_window_to_frame but also compares the window with the widget's
378 x_any_window_to_frame (dpyinfo
, wdesc
)
379 struct x_display_info
*dpyinfo
;
382 Lisp_Object tail
, frame
;
386 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
389 if (!GC_FRAMEP (frame
))
392 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
394 x
= f
->output_data
.x
;
395 /* This frame matches if the window is any of its widgets. */
398 if (wdesc
== XtWindow (x
->widget
)
399 || wdesc
== XtWindow (x
->column_widget
)
400 || wdesc
== XtWindow (x
->edit_widget
))
402 /* Match if the window is this frame's menubar. */
403 if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
406 else if (FRAME_X_WINDOW (f
) == wdesc
)
407 /* A tooltip frame. */
413 /* Likewise, but exclude the menu bar widget. */
416 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
417 struct x_display_info
*dpyinfo
;
420 Lisp_Object tail
, frame
;
424 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
427 if (!GC_FRAMEP (frame
))
430 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
432 x
= f
->output_data
.x
;
433 /* This frame matches if the window is any of its widgets. */
436 if (wdesc
== XtWindow (x
->widget
)
437 || wdesc
== XtWindow (x
->column_widget
)
438 || wdesc
== XtWindow (x
->edit_widget
))
441 else if (FRAME_X_WINDOW (f
) == wdesc
)
442 /* A tooltip frame. */
448 /* Likewise, but consider only the menu bar widget. */
451 x_menubar_window_to_frame (dpyinfo
, wdesc
)
452 struct x_display_info
*dpyinfo
;
455 Lisp_Object tail
, frame
;
459 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
462 if (!GC_FRAMEP (frame
))
465 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
467 x
= f
->output_data
.x
;
468 /* Match if the window is this frame's menubar. */
469 if (x
->menubar_widget
470 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
476 /* Return the frame whose principal (outermost) window is WDESC.
477 If WDESC is some other (smaller) window, we return 0. */
480 x_top_window_to_frame (dpyinfo
, wdesc
)
481 struct x_display_info
*dpyinfo
;
484 Lisp_Object tail
, frame
;
488 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
491 if (!GC_FRAMEP (frame
))
494 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
496 x
= f
->output_data
.x
;
500 /* This frame matches if the window is its topmost widget. */
501 if (wdesc
== XtWindow (x
->widget
))
503 #if 0 /* I don't know why it did this,
504 but it seems logically wrong,
505 and it causes trouble for MapNotify events. */
506 /* Match if the window is this frame's menubar. */
507 if (x
->menubar_widget
508 && wdesc
== XtWindow (x
->menubar_widget
))
512 else if (FRAME_X_WINDOW (f
) == wdesc
)
518 #endif /* USE_X_TOOLKIT */
522 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
523 id, which is just an int that this section returns. Bitmaps are
524 reference counted so they can be shared among frames.
526 Bitmap indices are guaranteed to be > 0, so a negative number can
527 be used to indicate no bitmap.
529 If you use x_create_bitmap_from_data, then you must keep track of
530 the bitmaps yourself. That is, creating a bitmap from the same
531 data more than once will not be caught. */
534 /* Functions to access the contents of a bitmap, given an id. */
537 x_bitmap_height (f
, id
)
541 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
545 x_bitmap_width (f
, id
)
549 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
553 x_bitmap_pixmap (f
, id
)
557 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
561 /* Allocate a new bitmap record. Returns index of new record. */
564 x_allocate_bitmap_record (f
)
567 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
570 if (dpyinfo
->bitmaps
== NULL
)
572 dpyinfo
->bitmaps_size
= 10;
574 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
575 dpyinfo
->bitmaps_last
= 1;
579 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
580 return ++dpyinfo
->bitmaps_last
;
582 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
583 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
586 dpyinfo
->bitmaps_size
*= 2;
588 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
589 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
590 return ++dpyinfo
->bitmaps_last
;
593 /* Add one reference to the reference count of the bitmap with id ID. */
596 x_reference_bitmap (f
, id
)
600 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
603 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
606 x_create_bitmap_from_data (f
, bits
, width
, height
)
609 unsigned int width
, height
;
611 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
615 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
616 bits
, width
, height
);
621 id
= x_allocate_bitmap_record (f
);
622 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
623 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
624 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
625 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
626 dpyinfo
->bitmaps
[id
- 1].height
= height
;
627 dpyinfo
->bitmaps
[id
- 1].width
= width
;
632 /* Create bitmap from file FILE for frame F. */
635 x_create_bitmap_from_file (f
, file
)
639 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
640 unsigned int width
, height
;
642 int xhot
, yhot
, result
, id
;
647 /* Look for an existing bitmap with the same name. */
648 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
650 if (dpyinfo
->bitmaps
[id
].refcount
651 && dpyinfo
->bitmaps
[id
].file
652 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
654 ++dpyinfo
->bitmaps
[id
].refcount
;
659 /* Search bitmap-file-path for the file, if appropriate. */
660 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
663 /* XReadBitmapFile won't handle magic file names. */
668 filename
= (char *) XSTRING (found
)->data
;
670 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
671 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
672 if (result
!= BitmapSuccess
)
675 id
= x_allocate_bitmap_record (f
);
676 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
677 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
678 dpyinfo
->bitmaps
[id
- 1].file
679 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
680 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
681 dpyinfo
->bitmaps
[id
- 1].height
= height
;
682 dpyinfo
->bitmaps
[id
- 1].width
= width
;
683 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
688 /* Remove reference to bitmap with id number ID. */
691 x_destroy_bitmap (f
, id
)
695 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
699 --dpyinfo
->bitmaps
[id
- 1].refcount
;
700 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
703 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
704 if (dpyinfo
->bitmaps
[id
- 1].file
)
706 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
707 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
714 /* Free all the bitmaps for the display specified by DPYINFO. */
717 x_destroy_all_bitmaps (dpyinfo
)
718 struct x_display_info
*dpyinfo
;
721 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
722 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
724 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
725 if (dpyinfo
->bitmaps
[i
].file
)
726 xfree (dpyinfo
->bitmaps
[i
].file
);
728 dpyinfo
->bitmaps_last
= 0;
731 /* Connect the frame-parameter names for X frames
732 to the ways of passing the parameter values to the window system.
734 The name of a parameter, as a Lisp symbol,
735 has an `x-frame-parameter' property which is an integer in Lisp
736 that is an index in this table. */
738 struct x_frame_parm_table
741 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
744 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
745 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
746 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
750 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
756 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
759 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
761 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
762 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
763 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
764 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
765 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
766 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
767 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
769 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
771 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
776 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
778 static struct x_frame_parm_table x_frame_parms
[] =
780 "auto-raise", x_set_autoraise
,
781 "auto-lower", x_set_autolower
,
782 "background-color", x_set_background_color
,
783 "border-color", x_set_border_color
,
784 "border-width", x_set_border_width
,
785 "cursor-color", x_set_cursor_color
,
786 "cursor-type", x_set_cursor_type
,
788 "foreground-color", x_set_foreground_color
,
789 "icon-name", x_set_icon_name
,
790 "icon-type", x_set_icon_type
,
791 "internal-border-width", x_set_internal_border_width
,
792 "menu-bar-lines", x_set_menu_bar_lines
,
793 "mouse-color", x_set_mouse_color
,
794 "name", x_explicitly_set_name
,
795 "scroll-bar-width", x_set_scroll_bar_width
,
796 "title", x_set_title
,
797 "unsplittable", x_set_unsplittable
,
798 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
799 "visibility", x_set_visibility
,
800 "tool-bar-lines", x_set_tool_bar_lines
,
801 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
802 "scroll-bar-background", x_set_scroll_bar_background
,
803 "screen-gamma", x_set_screen_gamma
806 /* Attach the `x-frame-parameter' properties to
807 the Lisp symbol names of parameters relevant to X. */
810 init_x_parm_symbols ()
814 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
815 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
819 /* Change the parameters of frame F as specified by ALIST.
820 If a parameter is not specially recognized, do nothing;
821 otherwise call the `x_set_...' function for that parameter. */
824 x_set_frame_parameters (f
, alist
)
830 /* If both of these parameters are present, it's more efficient to
831 set them both at once. So we wait until we've looked at the
832 entire list before we set them. */
836 Lisp_Object left
, top
;
838 /* Same with these. */
839 Lisp_Object icon_left
, icon_top
;
841 /* Record in these vectors all the parms specified. */
845 int left_no_change
= 0, top_no_change
= 0;
846 int icon_left_no_change
= 0, icon_top_no_change
= 0;
848 struct gcpro gcpro1
, gcpro2
;
851 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
854 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
855 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
857 /* Extract parm names and values into those vectors. */
860 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
865 parms
[i
] = Fcar (elt
);
866 values
[i
] = Fcdr (elt
);
869 /* TAIL and ALIST are not used again below here. */
872 GCPRO2 (*parms
, *values
);
876 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
877 because their values appear in VALUES and strings are not valid. */
878 top
= left
= Qunbound
;
879 icon_left
= icon_top
= Qunbound
;
881 /* Provide default values for HEIGHT and WIDTH. */
882 if (FRAME_NEW_WIDTH (f
))
883 width
= FRAME_NEW_WIDTH (f
);
885 width
= FRAME_WIDTH (f
);
887 if (FRAME_NEW_HEIGHT (f
))
888 height
= FRAME_NEW_HEIGHT (f
);
890 height
= FRAME_HEIGHT (f
);
892 /* Process foreground_color and background_color before anything else.
893 They are independent of other properties, but other properties (e.g.,
894 cursor_color) are dependent upon them. */
895 for (p
= 0; p
< i
; p
++)
897 Lisp_Object prop
, val
;
901 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
903 register Lisp_Object param_index
, old_value
;
905 param_index
= Fget (prop
, Qx_frame_parameter
);
906 old_value
= get_frame_param (f
, prop
);
907 store_frame_param (f
, prop
, val
);
908 if (NATNUMP (param_index
)
909 && (XFASTINT (param_index
)
910 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
911 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
915 /* Now process them in reverse of specified order. */
916 for (i
--; i
>= 0; i
--)
918 Lisp_Object prop
, val
;
923 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
924 width
= XFASTINT (val
);
925 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
926 height
= XFASTINT (val
);
927 else if (EQ (prop
, Qtop
))
929 else if (EQ (prop
, Qleft
))
931 else if (EQ (prop
, Qicon_top
))
933 else if (EQ (prop
, Qicon_left
))
935 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
936 /* Processed above. */
940 register Lisp_Object param_index
, old_value
;
942 param_index
= Fget (prop
, Qx_frame_parameter
);
943 old_value
= get_frame_param (f
, prop
);
944 store_frame_param (f
, prop
, val
);
945 if (NATNUMP (param_index
)
946 && (XFASTINT (param_index
)
947 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
948 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
952 /* Don't die if just one of these was set. */
953 if (EQ (left
, Qunbound
))
956 if (f
->output_data
.x
->left_pos
< 0)
957 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
959 XSETINT (left
, f
->output_data
.x
->left_pos
);
961 if (EQ (top
, Qunbound
))
964 if (f
->output_data
.x
->top_pos
< 0)
965 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
967 XSETINT (top
, f
->output_data
.x
->top_pos
);
970 /* If one of the icon positions was not set, preserve or default it. */
971 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
973 icon_left_no_change
= 1;
974 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
975 if (NILP (icon_left
))
976 XSETINT (icon_left
, 0);
978 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
980 icon_top_no_change
= 1;
981 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
983 XSETINT (icon_top
, 0);
986 /* Don't set these parameters unless they've been explicitly
987 specified. The window might be mapped or resized while we're in
988 this function, and we don't want to override that unless the lisp
989 code has asked for it.
991 Don't set these parameters unless they actually differ from the
992 window's current parameters; the window may not actually exist
997 check_frame_size (f
, &height
, &width
);
999 XSETFRAME (frame
, f
);
1001 if (width
!= FRAME_WIDTH (f
)
1002 || height
!= FRAME_HEIGHT (f
)
1003 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1004 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1006 if ((!NILP (left
) || !NILP (top
))
1007 && ! (left_no_change
&& top_no_change
)
1008 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1009 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1014 /* Record the signs. */
1015 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1016 if (EQ (left
, Qminus
))
1017 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1018 else if (INTEGERP (left
))
1020 leftpos
= XINT (left
);
1022 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1024 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1025 && CONSP (XCDR (left
))
1026 && INTEGERP (XCAR (XCDR (left
))))
1028 leftpos
= - XINT (XCAR (XCDR (left
)));
1029 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1031 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1032 && CONSP (XCDR (left
))
1033 && INTEGERP (XCAR (XCDR (left
))))
1035 leftpos
= XINT (XCAR (XCDR (left
)));
1038 if (EQ (top
, Qminus
))
1039 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1040 else if (INTEGERP (top
))
1042 toppos
= XINT (top
);
1044 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1046 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1047 && CONSP (XCDR (top
))
1048 && INTEGERP (XCAR (XCDR (top
))))
1050 toppos
= - XINT (XCAR (XCDR (top
)));
1051 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1053 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1054 && CONSP (XCDR (top
))
1055 && INTEGERP (XCAR (XCDR (top
))))
1057 toppos
= XINT (XCAR (XCDR (top
)));
1061 /* Store the numeric value of the position. */
1062 f
->output_data
.x
->top_pos
= toppos
;
1063 f
->output_data
.x
->left_pos
= leftpos
;
1065 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1067 /* Actually set that position, and convert to absolute. */
1068 x_set_offset (f
, leftpos
, toppos
, -1);
1071 if ((!NILP (icon_left
) || !NILP (icon_top
))
1072 && ! (icon_left_no_change
&& icon_top_no_change
))
1073 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1079 /* Store the screen positions of frame F into XPTR and YPTR.
1080 These are the positions of the containing window manager window,
1081 not Emacs's own window. */
1084 x_real_positions (f
, xptr
, yptr
)
1091 /* This is pretty gross, but seems to be the easiest way out of
1092 the problem that arises when restarting window-managers. */
1094 #ifdef USE_X_TOOLKIT
1095 Window outer
= (f
->output_data
.x
->widget
1096 ? XtWindow (f
->output_data
.x
->widget
)
1097 : FRAME_X_WINDOW (f
));
1099 Window outer
= f
->output_data
.x
->window_desc
;
1101 Window tmp_root_window
;
1102 Window
*tmp_children
;
1107 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1108 Window outer_window
;
1110 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1111 &f
->output_data
.x
->parent_desc
,
1112 &tmp_children
, &tmp_nchildren
);
1113 XFree ((char *) tmp_children
);
1117 /* Find the position of the outside upper-left corner of
1118 the inner window, with respect to the outer window. */
1119 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1120 outer_window
= f
->output_data
.x
->parent_desc
;
1122 outer_window
= outer
;
1124 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1126 /* From-window, to-window. */
1128 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1130 /* From-position, to-position. */
1131 0, 0, &win_x
, &win_y
,
1136 /* It is possible for the window returned by the XQueryNotify
1137 to become invalid by the time we call XTranslateCoordinates.
1138 That can happen when you restart some window managers.
1139 If so, we get an error in XTranslateCoordinates.
1140 Detect that and try the whole thing over. */
1141 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1143 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1147 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1154 /* Insert a description of internally-recorded parameters of frame X
1155 into the parameter alist *ALISTPTR that is to be given to the user.
1156 Only parameters that are specific to the X window system
1157 and whose values are not correctly recorded in the frame's
1158 param_alist need to be considered here. */
1161 x_report_frame_params (f
, alistptr
)
1163 Lisp_Object
*alistptr
;
1168 /* Represent negative positions (off the top or left screen edge)
1169 in a way that Fmodify_frame_parameters will understand correctly. */
1170 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1171 if (f
->output_data
.x
->left_pos
>= 0)
1172 store_in_alist (alistptr
, Qleft
, tem
);
1174 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1176 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1177 if (f
->output_data
.x
->top_pos
>= 0)
1178 store_in_alist (alistptr
, Qtop
, tem
);
1180 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1182 store_in_alist (alistptr
, Qborder_width
,
1183 make_number (f
->output_data
.x
->border_width
));
1184 store_in_alist (alistptr
, Qinternal_border_width
,
1185 make_number (f
->output_data
.x
->internal_border_width
));
1186 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1187 store_in_alist (alistptr
, Qwindow_id
,
1188 build_string (buf
));
1189 #ifdef USE_X_TOOLKIT
1190 /* Tooltip frame may not have this widget. */
1191 if (f
->output_data
.x
->widget
)
1193 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1194 store_in_alist (alistptr
, Qouter_window_id
,
1195 build_string (buf
));
1196 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1197 FRAME_SAMPLE_VISIBILITY (f
);
1198 store_in_alist (alistptr
, Qvisibility
,
1199 (FRAME_VISIBLE_P (f
) ? Qt
1200 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1201 store_in_alist (alistptr
, Qdisplay
,
1202 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1204 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1207 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1208 store_in_alist (alistptr
, Qparent_id
, tem
);
1213 /* Gamma-correct COLOR on frame F. */
1216 gamma_correct (f
, color
)
1222 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1223 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1224 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1229 /* Decide if color named COLOR is valid for the display associated with
1230 the selected frame; if so, return the rgb values in COLOR_DEF.
1231 If ALLOC is nonzero, allocate a new colormap cell. */
1234 x_defined_color (f
, color
, color_def
, alloc
)
1240 register int status
;
1241 Colormap screen_colormap
;
1242 Display
*display
= FRAME_X_DISPLAY (f
);
1245 screen_colormap
= DefaultColormap (display
, XDefaultScreen (display
));
1247 status
= XParseColor (display
, screen_colormap
, color
, color_def
);
1248 if (status
&& alloc
)
1250 /* Apply gamma correction. */
1251 gamma_correct (f
, color_def
);
1253 status
= XAllocColor (display
, screen_colormap
, color_def
);
1256 /* If we got to this point, the colormap is full, so we're
1257 going to try and get the next closest color.
1258 The algorithm used is a least-squares matching, which is
1259 what X uses for closest color matching with StaticColor visuals. */
1264 long nearest_delta
, trial_delta
;
1267 no_cells
= XDisplayCells (display
, XDefaultScreen (display
));
1268 cells
= (XColor
*) alloca (sizeof (XColor
) * no_cells
);
1270 for (x
= 0; x
< no_cells
; x
++)
1273 XQueryColors (display
, screen_colormap
, cells
, no_cells
);
1275 /* I'm assuming CSE so I'm not going to condense this. */
1276 nearest_delta
= ((((color_def
->red
>> 8) - (cells
[0].red
>> 8))
1277 * ((color_def
->red
>> 8) - (cells
[0].red
>> 8)))
1279 (((color_def
->green
>> 8) - (cells
[0].green
>> 8))
1280 * ((color_def
->green
>> 8) - (cells
[0].green
>> 8)))
1282 (((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))
1283 * ((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))));
1284 for (x
= 1; x
< no_cells
; x
++)
1286 trial_delta
= ((((color_def
->red
>> 8) - (cells
[x
].red
>> 8))
1287 * ((color_def
->red
>> 8) - (cells
[x
].red
>> 8)))
1289 (((color_def
->green
>> 8) - (cells
[x
].green
>> 8))
1290 * ((color_def
->green
>> 8) - (cells
[x
].green
>> 8)))
1292 (((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))
1293 * ((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))));
1294 if (trial_delta
< nearest_delta
)
1297 temp
.red
= cells
[x
].red
;
1298 temp
.green
= cells
[x
].green
;
1299 temp
.blue
= cells
[x
].blue
;
1300 status
= XAllocColor (display
, screen_colormap
, &temp
);
1304 nearest_delta
= trial_delta
;
1308 color_def
->red
= cells
[nearest
].red
;
1309 color_def
->green
= cells
[nearest
].green
;
1310 color_def
->blue
= cells
[nearest
].blue
;
1311 status
= XAllocColor (display
, screen_colormap
, color_def
);
1322 /* Given a string ARG naming a color, compute a pixel value from it
1323 suitable for screen F.
1324 If F is not a color screen, return DEF (default) regardless of what
1328 x_decode_color (f
, arg
, def
)
1335 CHECK_STRING (arg
, 0);
1337 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1338 return BLACK_PIX_DEFAULT (f
);
1339 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1340 return WHITE_PIX_DEFAULT (f
);
1342 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1345 /* x_defined_color is responsible for coping with failures
1346 by looking for a near-miss. */
1347 if (x_defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1350 Fsignal (Qerror
, Fcons (build_string ("undefined color"),
1351 Fcons (arg
, Qnil
)));
1354 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1355 the previous value of that parameter, NEW_VALUE is the new value. */
1358 x_set_screen_gamma (f
, new_value
, old_value
)
1360 Lisp_Object new_value
, old_value
;
1362 if (NILP (new_value
))
1364 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1365 /* The value 0.4545 is the normal viewing gamma. */
1366 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1368 Fsignal (Qerror
, Fcons (build_string ("Illegal screen-gamma"),
1369 Fcons (new_value
, Qnil
)));
1371 clear_face_cache (0);
1375 /* Functions called only from `x_set_frame_param'
1376 to set individual parameters.
1378 If FRAME_X_WINDOW (f) is 0,
1379 the frame is being created and its X-window does not exist yet.
1380 In that case, just record the parameter's new value
1381 in the standard place; do not attempt to change the window. */
1384 x_set_foreground_color (f
, arg
, oldval
)
1386 Lisp_Object arg
, oldval
;
1389 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1391 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1392 f
->output_data
.x
->foreground_pixel
= pixel
;
1394 if (FRAME_X_WINDOW (f
) != 0)
1397 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1398 f
->output_data
.x
->foreground_pixel
);
1399 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1400 f
->output_data
.x
->foreground_pixel
);
1402 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1403 if (FRAME_VISIBLE_P (f
))
1409 x_set_background_color (f
, arg
, oldval
)
1411 Lisp_Object arg
, oldval
;
1414 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1416 unload_color (f
, f
->output_data
.x
->background_pixel
);
1417 f
->output_data
.x
->background_pixel
= pixel
;
1419 if (FRAME_X_WINDOW (f
) != 0)
1422 /* The main frame area. */
1423 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1424 f
->output_data
.x
->background_pixel
);
1425 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1426 f
->output_data
.x
->background_pixel
);
1427 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1428 f
->output_data
.x
->background_pixel
);
1429 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1430 f
->output_data
.x
->background_pixel
);
1433 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1434 bar
= XSCROLL_BAR (bar
)->next
)
1435 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1436 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1437 f
->output_data
.x
->background_pixel
);
1441 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1443 if (FRAME_VISIBLE_P (f
))
1449 x_set_mouse_color (f
, arg
, oldval
)
1451 Lisp_Object arg
, oldval
;
1453 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1456 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1457 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1459 /* Don't let pointers be invisible. */
1460 if (mask_color
== pixel
1461 && mask_color
== f
->output_data
.x
->background_pixel
)
1462 pixel
= f
->output_data
.x
->foreground_pixel
;
1464 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1465 f
->output_data
.x
->mouse_pixel
= pixel
;
1469 /* It's not okay to crash if the user selects a screwy cursor. */
1470 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1472 if (!EQ (Qnil
, Vx_pointer_shape
))
1474 CHECK_NUMBER (Vx_pointer_shape
, 0);
1475 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1478 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1479 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1481 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1483 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1484 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1485 XINT (Vx_nontext_pointer_shape
));
1488 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1489 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1491 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1493 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1494 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1495 XINT (Vx_busy_pointer_shape
));
1498 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1499 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1501 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1502 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1504 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1505 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1506 XINT (Vx_mode_pointer_shape
));
1509 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1510 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1512 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1514 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1516 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1517 XINT (Vx_sensitive_text_pointer_shape
));
1520 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1522 /* Check and report errors with the above calls. */
1523 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1524 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1527 XColor fore_color
, back_color
;
1529 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1530 back_color
.pixel
= mask_color
;
1531 XQueryColor (FRAME_X_DISPLAY (f
),
1532 DefaultColormap (FRAME_X_DISPLAY (f
),
1533 DefaultScreen (FRAME_X_DISPLAY (f
))),
1535 XQueryColor (FRAME_X_DISPLAY (f
),
1536 DefaultColormap (FRAME_X_DISPLAY (f
),
1537 DefaultScreen (FRAME_X_DISPLAY (f
))),
1539 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1540 &fore_color
, &back_color
);
1541 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1542 &fore_color
, &back_color
);
1543 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1544 &fore_color
, &back_color
);
1545 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1546 &fore_color
, &back_color
);
1547 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1548 &fore_color
, &back_color
);
1551 if (FRAME_X_WINDOW (f
) != 0)
1552 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1554 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1555 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1556 f
->output_data
.x
->text_cursor
= cursor
;
1558 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1559 && f
->output_data
.x
->nontext_cursor
!= 0)
1560 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1561 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1563 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1564 && f
->output_data
.x
->busy_cursor
!= 0)
1565 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1566 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1568 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1569 && f
->output_data
.x
->modeline_cursor
!= 0)
1570 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1571 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1573 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1574 && f
->output_data
.x
->cross_cursor
!= 0)
1575 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1576 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1578 XFlush (FRAME_X_DISPLAY (f
));
1581 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1585 x_set_cursor_color (f
, arg
, oldval
)
1587 Lisp_Object arg
, oldval
;
1589 unsigned long fore_pixel
, pixel
;
1591 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1592 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1593 WHITE_PIX_DEFAULT (f
));
1595 fore_pixel
= f
->output_data
.x
->background_pixel
;
1596 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1598 /* Make sure that the cursor color differs from the background color. */
1599 if (pixel
== f
->output_data
.x
->background_pixel
)
1601 pixel
= f
->output_data
.x
->mouse_pixel
;
1602 if (pixel
== fore_pixel
)
1603 fore_pixel
= f
->output_data
.x
->background_pixel
;
1606 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1607 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1609 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1610 f
->output_data
.x
->cursor_pixel
= pixel
;
1612 if (FRAME_X_WINDOW (f
) != 0)
1615 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1616 f
->output_data
.x
->cursor_pixel
);
1617 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1621 if (FRAME_VISIBLE_P (f
))
1623 x_update_cursor (f
, 0);
1624 x_update_cursor (f
, 1);
1628 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1631 /* Set the border-color of frame F to value described by ARG.
1632 ARG can be a string naming a color.
1633 The border-color is used for the border that is drawn by the X server.
1634 Note that this does not fully take effect if done before
1635 F has an x-window; it must be redone when the window is created.
1637 Note: this is done in two routines because of the way X10 works.
1639 Note: under X11, this is normally the province of the window manager,
1640 and so emacs' border colors may be overridden. */
1643 x_set_border_color (f
, arg
, oldval
)
1645 Lisp_Object arg
, oldval
;
1649 CHECK_STRING (arg
, 0);
1650 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1651 x_set_border_pixel (f
, pix
);
1652 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1655 /* Set the border-color of frame F to pixel value PIX.
1656 Note that this does not fully take effect if done before
1657 F has an x-window. */
1660 x_set_border_pixel (f
, pix
)
1664 unload_color (f
, f
->output_data
.x
->border_pixel
);
1665 f
->output_data
.x
->border_pixel
= pix
;
1667 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1670 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1671 (unsigned long)pix
);
1674 if (FRAME_VISIBLE_P (f
))
1680 x_set_cursor_type (f
, arg
, oldval
)
1682 Lisp_Object arg
, oldval
;
1686 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1687 f
->output_data
.x
->cursor_width
= 2;
1689 else if (CONSP (arg
) && EQ (XCAR (arg
), Qbar
)
1690 && INTEGERP (XCDR (arg
)))
1692 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1693 f
->output_data
.x
->cursor_width
= XINT (XCDR (arg
));
1696 /* Treat anything unknown as "box cursor".
1697 It was bad to signal an error; people have trouble fixing
1698 .Xdefaults with Emacs, when it has something bad in it. */
1699 FRAME_DESIRED_CURSOR (f
) = FILLED_BOX_CURSOR
;
1701 /* Make sure the cursor gets redrawn. This is overkill, but how
1702 often do people change cursor types? */
1703 update_mode_lines
++;
1707 x_set_icon_type (f
, arg
, oldval
)
1709 Lisp_Object arg
, oldval
;
1715 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1718 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1723 result
= x_text_icon (f
,
1724 (char *) XSTRING ((!NILP (f
->icon_name
)
1728 result
= x_bitmap_icon (f
, arg
);
1733 error ("No icon window available");
1736 XFlush (FRAME_X_DISPLAY (f
));
1740 /* Return non-nil if frame F wants a bitmap icon. */
1748 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1756 x_set_icon_name (f
, arg
, oldval
)
1758 Lisp_Object arg
, oldval
;
1764 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1767 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1772 if (f
->output_data
.x
->icon_bitmap
!= 0)
1777 result
= x_text_icon (f
,
1778 (char *) XSTRING ((!NILP (f
->icon_name
)
1787 error ("No icon window available");
1790 XFlush (FRAME_X_DISPLAY (f
));
1795 x_set_font (f
, arg
, oldval
)
1797 Lisp_Object arg
, oldval
;
1800 Lisp_Object fontset_name
;
1803 CHECK_STRING (arg
, 1);
1805 fontset_name
= Fquery_fontset (arg
, Qnil
);
1808 result
= (STRINGP (fontset_name
)
1809 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1810 : x_new_font (f
, XSTRING (arg
)->data
));
1813 if (EQ (result
, Qnil
))
1814 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1815 else if (EQ (result
, Qt
))
1816 error ("The characters of the given font have varying widths");
1817 else if (STRINGP (result
))
1819 store_frame_param (f
, Qfont
, result
);
1820 recompute_basic_faces (f
);
1825 do_pending_window_change (0);
1827 /* Don't call `face-set-after-frame-default' when faces haven't been
1828 initialized yet. This is the case when called from
1829 Fx_create_frame. In that case, the X widget or window doesn't
1830 exist either, and we can end up in x_report_frame_params with a
1831 null widget which gives a segfault. */
1832 if (FRAME_FACE_CACHE (f
))
1834 XSETFRAME (frame
, f
);
1835 call1 (Qface_set_after_frame_default
, frame
);
1840 x_set_border_width (f
, arg
, oldval
)
1842 Lisp_Object arg
, oldval
;
1844 CHECK_NUMBER (arg
, 0);
1846 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1849 if (FRAME_X_WINDOW (f
) != 0)
1850 error ("Cannot change the border width of a window");
1852 f
->output_data
.x
->border_width
= XINT (arg
);
1856 x_set_internal_border_width (f
, arg
, oldval
)
1858 Lisp_Object arg
, oldval
;
1860 int old
= f
->output_data
.x
->internal_border_width
;
1862 CHECK_NUMBER (arg
, 0);
1863 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1864 if (f
->output_data
.x
->internal_border_width
< 0)
1865 f
->output_data
.x
->internal_border_width
= 0;
1867 #ifdef USE_X_TOOLKIT
1868 if (f
->output_data
.x
->edit_widget
)
1869 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1872 if (f
->output_data
.x
->internal_border_width
== old
)
1875 if (FRAME_X_WINDOW (f
) != 0)
1877 x_set_window_size (f
, 0, f
->width
, f
->height
);
1878 SET_FRAME_GARBAGED (f
);
1879 do_pending_window_change (0);
1884 x_set_visibility (f
, value
, oldval
)
1886 Lisp_Object value
, oldval
;
1889 XSETFRAME (frame
, f
);
1892 Fmake_frame_invisible (frame
, Qt
);
1893 else if (EQ (value
, Qicon
))
1894 Ficonify_frame (frame
);
1896 Fmake_frame_visible (frame
);
1900 x_set_menu_bar_lines_1 (window
, n
)
1904 struct window
*w
= XWINDOW (window
);
1906 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1907 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1909 /* Handle just the top child in a vertical split. */
1910 if (!NILP (w
->vchild
))
1911 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1913 /* Adjust all children in a horizontal split. */
1914 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1916 w
= XWINDOW (window
);
1917 x_set_menu_bar_lines_1 (window
, n
);
1922 x_set_menu_bar_lines (f
, value
, oldval
)
1924 Lisp_Object value
, oldval
;
1927 #ifndef USE_X_TOOLKIT
1928 int olines
= FRAME_MENU_BAR_LINES (f
);
1931 /* Right now, menu bars don't work properly in minibuf-only frames;
1932 most of the commands try to apply themselves to the minibuffer
1933 frame itself, and get an error because you can't switch buffers
1934 in or split the minibuffer window. */
1935 if (FRAME_MINIBUF_ONLY_P (f
))
1938 if (INTEGERP (value
))
1939 nlines
= XINT (value
);
1943 /* Make sure we redisplay all windows in this frame. */
1944 windows_or_buffers_changed
++;
1946 #ifdef USE_X_TOOLKIT
1947 FRAME_MENU_BAR_LINES (f
) = 0;
1950 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1951 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1952 /* Make sure next redisplay shows the menu bar. */
1953 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1957 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1958 free_frame_menubar (f
);
1959 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1961 f
->output_data
.x
->menubar_widget
= 0;
1963 #else /* not USE_X_TOOLKIT */
1964 FRAME_MENU_BAR_LINES (f
) = nlines
;
1965 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1966 #endif /* not USE_X_TOOLKIT */
1971 /* Set the number of lines used for the tool bar of frame F to VALUE.
1972 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1973 is the old number of tool bar lines. This function changes the
1974 height of all windows on frame F to match the new tool bar height.
1975 The frame's height doesn't change. */
1978 x_set_tool_bar_lines (f
, value
, oldval
)
1980 Lisp_Object value
, oldval
;
1984 /* Use VALUE only if an integer >= 0. */
1985 if (INTEGERP (value
) && XINT (value
) >= 0)
1986 nlines
= XFASTINT (value
);
1990 /* Make sure we redisplay all windows in this frame. */
1991 ++windows_or_buffers_changed
;
1993 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
1994 FRAME_TOOL_BAR_LINES (f
) = nlines
;
1995 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f
), delta
);
2000 /* Set the foreground color for scroll bars on frame F to VALUE.
2001 VALUE should be a string, a color name. If it isn't a string or
2002 isn't a valid color name, do nothing. OLDVAL is the old value of
2003 the frame parameter. */
2006 x_set_scroll_bar_foreground (f
, value
, oldval
)
2008 Lisp_Object value
, oldval
;
2010 unsigned long pixel
;
2012 if (STRINGP (value
))
2013 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2017 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2018 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2020 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2021 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2023 /* Remove all scroll bars because they have wrong colors. */
2024 if (condemn_scroll_bars_hook
)
2025 (*condemn_scroll_bars_hook
) (f
);
2026 if (judge_scroll_bars_hook
)
2027 (*judge_scroll_bars_hook
) (f
);
2029 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2035 /* Set the background color for scroll bars on frame F to VALUE VALUE
2036 should be a string, a color name. If it isn't a string or isn't a
2037 valid color name, do nothing. OLDVAL is the old value of the frame
2041 x_set_scroll_bar_background (f
, value
, oldval
)
2043 Lisp_Object value
, oldval
;
2045 unsigned long pixel
;
2047 if (STRINGP (value
))
2048 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2052 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2053 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2055 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2056 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2058 /* Remove all scroll bars because they have wrong colors. */
2059 if (condemn_scroll_bars_hook
)
2060 (*condemn_scroll_bars_hook
) (f
);
2061 if (judge_scroll_bars_hook
)
2062 (*judge_scroll_bars_hook
) (f
);
2064 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2070 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2073 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2074 name; if NAME is a string, set F's name to NAME and set
2075 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2077 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2078 suggesting a new name, which lisp code should override; if
2079 F->explicit_name is set, ignore the new name; otherwise, set it. */
2082 x_set_name (f
, name
, explicit)
2087 /* Make sure that requests from lisp code override requests from
2088 Emacs redisplay code. */
2091 /* If we're switching from explicit to implicit, we had better
2092 update the mode lines and thereby update the title. */
2093 if (f
->explicit_name
&& NILP (name
))
2094 update_mode_lines
= 1;
2096 f
->explicit_name
= ! NILP (name
);
2098 else if (f
->explicit_name
)
2101 /* If NAME is nil, set the name to the x_id_name. */
2104 /* Check for no change needed in this very common case
2105 before we do any consing. */
2106 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2107 XSTRING (f
->name
)->data
))
2109 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2112 CHECK_STRING (name
, 0);
2114 /* Don't change the name if it's already NAME. */
2115 if (! NILP (Fstring_equal (name
, f
->name
)))
2120 /* For setting the frame title, the title parameter should override
2121 the name parameter. */
2122 if (! NILP (f
->title
))
2125 if (FRAME_X_WINDOW (f
))
2130 XTextProperty text
, icon
;
2131 Lisp_Object icon_name
;
2133 text
.value
= XSTRING (name
)->data
;
2134 text
.encoding
= XA_STRING
;
2136 text
.nitems
= STRING_BYTES (XSTRING (name
));
2138 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2140 icon
.value
= XSTRING (icon_name
)->data
;
2141 icon
.encoding
= XA_STRING
;
2143 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2144 #ifdef USE_X_TOOLKIT
2145 XSetWMName (FRAME_X_DISPLAY (f
),
2146 XtWindow (f
->output_data
.x
->widget
), &text
);
2147 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2149 #else /* not USE_X_TOOLKIT */
2150 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2151 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2152 #endif /* not USE_X_TOOLKIT */
2154 #else /* not HAVE_X11R4 */
2155 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2156 XSTRING (name
)->data
);
2157 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2158 XSTRING (name
)->data
);
2159 #endif /* not HAVE_X11R4 */
2164 /* This function should be called when the user's lisp code has
2165 specified a name for the frame; the name will override any set by the
2168 x_explicitly_set_name (f
, arg
, oldval
)
2170 Lisp_Object arg
, oldval
;
2172 x_set_name (f
, arg
, 1);
2175 /* This function should be called by Emacs redisplay code to set the
2176 name; names set this way will never override names set by the user's
2179 x_implicitly_set_name (f
, arg
, oldval
)
2181 Lisp_Object arg
, oldval
;
2183 x_set_name (f
, arg
, 0);
2186 /* Change the title of frame F to NAME.
2187 If NAME is nil, use the frame name as the title.
2189 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2190 name; if NAME is a string, set F's name to NAME and set
2191 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2193 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2194 suggesting a new name, which lisp code should override; if
2195 F->explicit_name is set, ignore the new name; otherwise, set it. */
2198 x_set_title (f
, name
, old_name
)
2200 Lisp_Object name
, old_name
;
2202 /* Don't change the title if it's already NAME. */
2203 if (EQ (name
, f
->title
))
2206 update_mode_lines
= 1;
2213 CHECK_STRING (name
, 0);
2215 if (FRAME_X_WINDOW (f
))
2220 XTextProperty text
, icon
;
2221 Lisp_Object icon_name
;
2223 text
.value
= XSTRING (name
)->data
;
2224 text
.encoding
= XA_STRING
;
2226 text
.nitems
= STRING_BYTES (XSTRING (name
));
2228 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2230 icon
.value
= XSTRING (icon_name
)->data
;
2231 icon
.encoding
= XA_STRING
;
2233 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2234 #ifdef USE_X_TOOLKIT
2235 XSetWMName (FRAME_X_DISPLAY (f
),
2236 XtWindow (f
->output_data
.x
->widget
), &text
);
2237 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2239 #else /* not USE_X_TOOLKIT */
2240 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2241 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2242 #endif /* not USE_X_TOOLKIT */
2244 #else /* not HAVE_X11R4 */
2245 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2246 XSTRING (name
)->data
);
2247 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2248 XSTRING (name
)->data
);
2249 #endif /* not HAVE_X11R4 */
2255 x_set_autoraise (f
, arg
, oldval
)
2257 Lisp_Object arg
, oldval
;
2259 f
->auto_raise
= !EQ (Qnil
, arg
);
2263 x_set_autolower (f
, arg
, oldval
)
2265 Lisp_Object arg
, oldval
;
2267 f
->auto_lower
= !EQ (Qnil
, arg
);
2271 x_set_unsplittable (f
, arg
, oldval
)
2273 Lisp_Object arg
, oldval
;
2275 f
->no_split
= !NILP (arg
);
2279 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2281 Lisp_Object arg
, oldval
;
2283 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2284 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2285 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2286 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2288 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2290 ? vertical_scroll_bar_none
2292 ? vertical_scroll_bar_right
2293 : vertical_scroll_bar_left
);
2295 /* We set this parameter before creating the X window for the
2296 frame, so we can get the geometry right from the start.
2297 However, if the window hasn't been created yet, we shouldn't
2298 call x_set_window_size. */
2299 if (FRAME_X_WINDOW (f
))
2300 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2301 do_pending_window_change (0);
2306 x_set_scroll_bar_width (f
, arg
, oldval
)
2308 Lisp_Object arg
, oldval
;
2310 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2314 #ifdef USE_TOOLKIT_SCROLL_BARS
2315 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2316 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2317 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2318 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2320 /* Make the actual width at least 14 pixels and a multiple of a
2322 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2324 /* Use all of that space (aside from required margins) for the
2326 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2329 if (FRAME_X_WINDOW (f
))
2330 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2331 do_pending_window_change (0);
2333 else if (INTEGERP (arg
) && XINT (arg
) > 0
2334 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2336 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2337 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2339 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2340 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2341 if (FRAME_X_WINDOW (f
))
2342 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2345 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2346 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2347 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2352 /* Subroutines of creating an X frame. */
2354 /* Make sure that Vx_resource_name is set to a reasonable value.
2355 Fix it up, or set it to `emacs' if it is too hopeless. */
2358 validate_x_resource_name ()
2361 /* Number of valid characters in the resource name. */
2363 /* Number of invalid characters in the resource name. */
2368 if (!STRINGP (Vx_resource_class
))
2369 Vx_resource_class
= build_string (EMACS_CLASS
);
2371 if (STRINGP (Vx_resource_name
))
2373 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2376 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2378 /* Only letters, digits, - and _ are valid in resource names.
2379 Count the valid characters and count the invalid ones. */
2380 for (i
= 0; i
< len
; i
++)
2383 if (! ((c
>= 'a' && c
<= 'z')
2384 || (c
>= 'A' && c
<= 'Z')
2385 || (c
>= '0' && c
<= '9')
2386 || c
== '-' || c
== '_'))
2393 /* Not a string => completely invalid. */
2394 bad_count
= 5, good_count
= 0;
2396 /* If name is valid already, return. */
2400 /* If name is entirely invalid, or nearly so, use `emacs'. */
2402 || (good_count
== 1 && bad_count
> 0))
2404 Vx_resource_name
= build_string ("emacs");
2408 /* Name is partly valid. Copy it and replace the invalid characters
2409 with underscores. */
2411 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2413 for (i
= 0; i
< len
; i
++)
2415 int c
= XSTRING (new)->data
[i
];
2416 if (! ((c
>= 'a' && c
<= 'z')
2417 || (c
>= 'A' && c
<= 'Z')
2418 || (c
>= '0' && c
<= '9')
2419 || c
== '-' || c
== '_'))
2420 XSTRING (new)->data
[i
] = '_';
2425 extern char *x_get_string_resource ();
2427 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2428 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2429 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2430 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2431 the name specified by the `-name' or `-rn' command-line arguments.\n\
2433 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2434 class, respectively. You must specify both of them or neither.\n\
2435 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2436 and the class is `Emacs.CLASS.SUBCLASS'.")
2437 (attribute
, class, component
, subclass
)
2438 Lisp_Object attribute
, class, component
, subclass
;
2440 register char *value
;
2446 CHECK_STRING (attribute
, 0);
2447 CHECK_STRING (class, 0);
2449 if (!NILP (component
))
2450 CHECK_STRING (component
, 1);
2451 if (!NILP (subclass
))
2452 CHECK_STRING (subclass
, 2);
2453 if (NILP (component
) != NILP (subclass
))
2454 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2456 validate_x_resource_name ();
2458 /* Allocate space for the components, the dots which separate them,
2459 and the final '\0'. Make them big enough for the worst case. */
2460 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2461 + (STRINGP (component
)
2462 ? STRING_BYTES (XSTRING (component
)) : 0)
2463 + STRING_BYTES (XSTRING (attribute
))
2466 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2467 + STRING_BYTES (XSTRING (class))
2468 + (STRINGP (subclass
)
2469 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2472 /* Start with emacs.FRAMENAME for the name (the specific one)
2473 and with `Emacs' for the class key (the general one). */
2474 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2475 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2477 strcat (class_key
, ".");
2478 strcat (class_key
, XSTRING (class)->data
);
2480 if (!NILP (component
))
2482 strcat (class_key
, ".");
2483 strcat (class_key
, XSTRING (subclass
)->data
);
2485 strcat (name_key
, ".");
2486 strcat (name_key
, XSTRING (component
)->data
);
2489 strcat (name_key
, ".");
2490 strcat (name_key
, XSTRING (attribute
)->data
);
2492 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2493 name_key
, class_key
);
2495 if (value
!= (char *) 0)
2496 return build_string (value
);
2501 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2504 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2505 struct x_display_info
*dpyinfo
;
2506 Lisp_Object attribute
, class, component
, subclass
;
2508 register char *value
;
2514 CHECK_STRING (attribute
, 0);
2515 CHECK_STRING (class, 0);
2517 if (!NILP (component
))
2518 CHECK_STRING (component
, 1);
2519 if (!NILP (subclass
))
2520 CHECK_STRING (subclass
, 2);
2521 if (NILP (component
) != NILP (subclass
))
2522 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2524 validate_x_resource_name ();
2526 /* Allocate space for the components, the dots which separate them,
2527 and the final '\0'. Make them big enough for the worst case. */
2528 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2529 + (STRINGP (component
)
2530 ? STRING_BYTES (XSTRING (component
)) : 0)
2531 + STRING_BYTES (XSTRING (attribute
))
2534 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2535 + STRING_BYTES (XSTRING (class))
2536 + (STRINGP (subclass
)
2537 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2540 /* Start with emacs.FRAMENAME for the name (the specific one)
2541 and with `Emacs' for the class key (the general one). */
2542 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2543 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2545 strcat (class_key
, ".");
2546 strcat (class_key
, XSTRING (class)->data
);
2548 if (!NILP (component
))
2550 strcat (class_key
, ".");
2551 strcat (class_key
, XSTRING (subclass
)->data
);
2553 strcat (name_key
, ".");
2554 strcat (name_key
, XSTRING (component
)->data
);
2557 strcat (name_key
, ".");
2558 strcat (name_key
, XSTRING (attribute
)->data
);
2560 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2562 if (value
!= (char *) 0)
2563 return build_string (value
);
2568 /* Used when C code wants a resource value. */
2571 x_get_resource_string (attribute
, class)
2572 char *attribute
, *class;
2576 struct frame
*sf
= SELECTED_FRAME ();
2578 /* Allocate space for the components, the dots which separate them,
2579 and the final '\0'. */
2580 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2581 + strlen (attribute
) + 2);
2582 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2583 + strlen (class) + 2);
2585 sprintf (name_key
, "%s.%s",
2586 XSTRING (Vinvocation_name
)->data
,
2588 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2590 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2591 name_key
, class_key
);
2594 /* Types we might convert a resource string into. */
2604 /* Return the value of parameter PARAM.
2606 First search ALIST, then Vdefault_frame_alist, then the X defaults
2607 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2609 Convert the resource to the type specified by desired_type.
2611 If no default is specified, return Qunbound. If you call
2612 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2613 and don't let it get stored in any Lisp-visible variables! */
2616 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2617 struct x_display_info
*dpyinfo
;
2618 Lisp_Object alist
, param
;
2621 enum resource_types type
;
2623 register Lisp_Object tem
;
2625 tem
= Fassq (param
, alist
);
2627 tem
= Fassq (param
, Vdefault_frame_alist
);
2633 tem
= display_x_get_resource (dpyinfo
,
2634 build_string (attribute
),
2635 build_string (class),
2643 case RES_TYPE_NUMBER
:
2644 return make_number (atoi (XSTRING (tem
)->data
));
2646 case RES_TYPE_FLOAT
:
2647 return make_float (atof (XSTRING (tem
)->data
));
2649 case RES_TYPE_BOOLEAN
:
2650 tem
= Fdowncase (tem
);
2651 if (!strcmp (XSTRING (tem
)->data
, "on")
2652 || !strcmp (XSTRING (tem
)->data
, "true"))
2657 case RES_TYPE_STRING
:
2660 case RES_TYPE_SYMBOL
:
2661 /* As a special case, we map the values `true' and `on'
2662 to Qt, and `false' and `off' to Qnil. */
2665 lower
= Fdowncase (tem
);
2666 if (!strcmp (XSTRING (lower
)->data
, "on")
2667 || !strcmp (XSTRING (lower
)->data
, "true"))
2669 else if (!strcmp (XSTRING (lower
)->data
, "off")
2670 || !strcmp (XSTRING (lower
)->data
, "false"))
2673 return Fintern (tem
, Qnil
);
2686 /* Like x_get_arg, but also record the value in f->param_alist. */
2689 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2691 Lisp_Object alist
, param
;
2694 enum resource_types type
;
2698 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2699 attribute
, class, type
);
2701 store_frame_param (f
, param
, value
);
2706 /* Record in frame F the specified or default value according to ALIST
2707 of the parameter named PROP (a Lisp symbol).
2708 If no value is specified for PROP, look for an X default for XPROP
2709 on the frame named NAME.
2710 If that is not found either, use the value DEFLT. */
2713 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2720 enum resource_types type
;
2724 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2725 if (EQ (tem
, Qunbound
))
2727 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2732 /* Record in frame F the specified or default value according to ALIST
2733 of the parameter named PROP (a Lisp symbol). If no value is
2734 specified for PROP, look for an X default for XPROP on the frame
2735 named NAME. If that is not found either, use the value DEFLT. */
2738 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2747 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2750 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2751 if (EQ (tem
, Qunbound
))
2753 #ifdef USE_TOOLKIT_SCROLL_BARS
2755 /* See if an X resource for the scroll bar color has been
2757 tem
= display_x_get_resource (dpyinfo
,
2758 build_string (foreground_p
2762 build_string ("verticalScrollBar"),
2766 /* If nothing has been specified, scroll bars will use a
2767 toolkit-dependent default. Because these defaults are
2768 difficult to get at without actually creating a scroll
2769 bar, use nil to indicate that no color has been
2774 #else /* not USE_TOOLKIT_SCROLL_BARS */
2778 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2781 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2787 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2788 "Parse an X-style geometry string STRING.\n\
2789 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2790 The properties returned may include `top', `left', `height', and `width'.\n\
2791 The value of `left' or `top' may be an integer,\n\
2792 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2793 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2798 unsigned int width
, height
;
2801 CHECK_STRING (string
, 0);
2803 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2804 &x
, &y
, &width
, &height
);
2807 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2808 error ("Must specify both x and y position, or neither");
2812 if (geometry
& XValue
)
2814 Lisp_Object element
;
2816 if (x
>= 0 && (geometry
& XNegative
))
2817 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2818 else if (x
< 0 && ! (geometry
& XNegative
))
2819 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2821 element
= Fcons (Qleft
, make_number (x
));
2822 result
= Fcons (element
, result
);
2825 if (geometry
& YValue
)
2827 Lisp_Object element
;
2829 if (y
>= 0 && (geometry
& YNegative
))
2830 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2831 else if (y
< 0 && ! (geometry
& YNegative
))
2832 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2834 element
= Fcons (Qtop
, make_number (y
));
2835 result
= Fcons (element
, result
);
2838 if (geometry
& WidthValue
)
2839 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2840 if (geometry
& HeightValue
)
2841 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2846 /* Calculate the desired size and position of this window,
2847 and return the flags saying which aspects were specified.
2849 This function does not make the coordinates positive. */
2851 #define DEFAULT_ROWS 40
2852 #define DEFAULT_COLS 80
2855 x_figure_window_size (f
, parms
)
2859 register Lisp_Object tem0
, tem1
, tem2
;
2860 long window_prompting
= 0;
2861 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2863 /* Default values if we fall through.
2864 Actually, if that happens we should get
2865 window manager prompting. */
2866 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2867 f
->height
= DEFAULT_ROWS
;
2868 /* Window managers expect that if program-specified
2869 positions are not (0,0), they're intentional, not defaults. */
2870 f
->output_data
.x
->top_pos
= 0;
2871 f
->output_data
.x
->left_pos
= 0;
2873 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
2874 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
2875 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
2876 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2878 if (!EQ (tem0
, Qunbound
))
2880 CHECK_NUMBER (tem0
, 0);
2881 f
->height
= XINT (tem0
);
2883 if (!EQ (tem1
, Qunbound
))
2885 CHECK_NUMBER (tem1
, 0);
2886 SET_FRAME_WIDTH (f
, XINT (tem1
));
2888 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2889 window_prompting
|= USSize
;
2891 window_prompting
|= PSize
;
2894 f
->output_data
.x
->vertical_scroll_bar_extra
2895 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2897 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2898 f
->output_data
.x
->flags_areas_extra
2899 = FRAME_FLAGS_AREA_WIDTH (f
);
2900 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2901 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2903 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
2904 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
2905 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
2906 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2908 if (EQ (tem0
, Qminus
))
2910 f
->output_data
.x
->top_pos
= 0;
2911 window_prompting
|= YNegative
;
2913 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
2914 && CONSP (XCDR (tem0
))
2915 && INTEGERP (XCAR (XCDR (tem0
))))
2917 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
2918 window_prompting
|= YNegative
;
2920 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
2921 && CONSP (XCDR (tem0
))
2922 && INTEGERP (XCAR (XCDR (tem0
))))
2924 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
2926 else if (EQ (tem0
, Qunbound
))
2927 f
->output_data
.x
->top_pos
= 0;
2930 CHECK_NUMBER (tem0
, 0);
2931 f
->output_data
.x
->top_pos
= XINT (tem0
);
2932 if (f
->output_data
.x
->top_pos
< 0)
2933 window_prompting
|= YNegative
;
2936 if (EQ (tem1
, Qminus
))
2938 f
->output_data
.x
->left_pos
= 0;
2939 window_prompting
|= XNegative
;
2941 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
2942 && CONSP (XCDR (tem1
))
2943 && INTEGERP (XCAR (XCDR (tem1
))))
2945 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
2946 window_prompting
|= XNegative
;
2948 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
2949 && CONSP (XCDR (tem1
))
2950 && INTEGERP (XCAR (XCDR (tem1
))))
2952 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
2954 else if (EQ (tem1
, Qunbound
))
2955 f
->output_data
.x
->left_pos
= 0;
2958 CHECK_NUMBER (tem1
, 0);
2959 f
->output_data
.x
->left_pos
= XINT (tem1
);
2960 if (f
->output_data
.x
->left_pos
< 0)
2961 window_prompting
|= XNegative
;
2964 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2965 window_prompting
|= USPosition
;
2967 window_prompting
|= PPosition
;
2970 return window_prompting
;
2973 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2976 XSetWMProtocols (dpy
, w
, protocols
, count
)
2983 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
2984 if (prop
== None
) return False
;
2985 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
2986 (unsigned char *) protocols
, count
);
2989 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2991 #ifdef USE_X_TOOLKIT
2993 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2994 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2995 already be present because of the toolkit (Motif adds some of them,
2996 for example, but Xt doesn't). */
2999 hack_wm_protocols (f
, widget
)
3003 Display
*dpy
= XtDisplay (widget
);
3004 Window w
= XtWindow (widget
);
3005 int need_delete
= 1;
3011 Atom type
, *atoms
= 0;
3013 unsigned long nitems
= 0;
3014 unsigned long bytes_after
;
3016 if ((XGetWindowProperty (dpy
, w
,
3017 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3018 (long)0, (long)100, False
, XA_ATOM
,
3019 &type
, &format
, &nitems
, &bytes_after
,
3020 (unsigned char **) &atoms
)
3022 && format
== 32 && type
== XA_ATOM
)
3026 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3028 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3030 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3033 if (atoms
) XFree ((char *) atoms
);
3039 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3041 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3043 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3045 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3046 XA_ATOM
, 32, PropModeAppend
,
3047 (unsigned char *) props
, count
);
3053 #ifdef USE_X_TOOLKIT
3055 /* Create and set up the X widget for frame F. */
3058 x_window (f
, window_prompting
, minibuffer_only
)
3060 long window_prompting
;
3061 int minibuffer_only
;
3063 XClassHint class_hints
;
3064 XSetWindowAttributes attributes
;
3065 unsigned long attribute_mask
;
3067 Widget shell_widget
;
3069 Widget frame_widget
;
3075 /* Use the resource name as the top-level widget name
3076 for looking up resources. Make a non-Lisp copy
3077 for the window manager, so GC relocation won't bother it.
3079 Elsewhere we specify the window name for the window manager. */
3082 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3083 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3084 strcpy (f
->namebuf
, str
);
3088 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3089 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3090 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3091 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3092 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3093 applicationShellWidgetClass
,
3094 FRAME_X_DISPLAY (f
), al
, ac
);
3096 f
->output_data
.x
->widget
= shell_widget
;
3097 /* maybe_set_screen_title_format (shell_widget); */
3099 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3100 (widget_value
*) NULL
,
3101 shell_widget
, False
,
3104 (lw_callback
) NULL
);
3106 f
->output_data
.x
->column_widget
= pane_widget
;
3108 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3109 the emacs screen when changing menubar. This reduces flickering. */
3112 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3113 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3114 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3115 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3116 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3117 frame_widget
= XtCreateWidget (f
->namebuf
,
3119 pane_widget
, al
, ac
);
3121 f
->output_data
.x
->edit_widget
= frame_widget
;
3123 XtManageChild (frame_widget
);
3125 /* Do some needed geometry management. */
3128 char *tem
, shell_position
[32];
3131 int extra_borders
= 0;
3133 = (f
->output_data
.x
->menubar_widget
3134 ? (f
->output_data
.x
->menubar_widget
->core
.height
3135 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3138 #if 0 /* Experimentally, we now get the right results
3139 for -geometry -0-0 without this. 24 Aug 96, rms. */
3140 if (FRAME_EXTERNAL_MENU_BAR (f
))
3143 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3144 menubar_size
+= ibw
;
3148 f
->output_data
.x
->menubar_height
= menubar_size
;
3151 /* Motif seems to need this amount added to the sizes
3152 specified for the shell widget. The Athena/Lucid widgets don't.
3153 Both conclusions reached experimentally. -- rms. */
3154 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3155 &extra_borders
, NULL
);
3159 /* Convert our geometry parameters into a geometry string
3161 Note that we do not specify here whether the position
3162 is a user-specified or program-specified one.
3163 We pass that information later, in x_wm_set_size_hints. */
3165 int left
= f
->output_data
.x
->left_pos
;
3166 int xneg
= window_prompting
& XNegative
;
3167 int top
= f
->output_data
.x
->top_pos
;
3168 int yneg
= window_prompting
& YNegative
;
3174 if (window_prompting
& USPosition
)
3175 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3176 PIXEL_WIDTH (f
) + extra_borders
,
3177 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3178 (xneg
? '-' : '+'), left
,
3179 (yneg
? '-' : '+'), top
);
3181 sprintf (shell_position
, "=%dx%d",
3182 PIXEL_WIDTH (f
) + extra_borders
,
3183 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3186 len
= strlen (shell_position
) + 1;
3187 /* We don't free this because we don't know whether
3188 it is safe to free it while the frame exists.
3189 It isn't worth the trouble of arranging to free it
3190 when the frame is deleted. */
3191 tem
= (char *) xmalloc (len
);
3192 strncpy (tem
, shell_position
, len
);
3193 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3194 XtSetValues (shell_widget
, al
, ac
);
3197 XtManageChild (pane_widget
);
3198 XtRealizeWidget (shell_widget
);
3200 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3202 validate_x_resource_name ();
3204 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3205 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3206 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3209 #ifndef X_I18N_INHIBITED
3214 xim
= XOpenIM (FRAME_X_DISPLAY (f
), NULL
, NULL
, NULL
);
3218 xic
= XCreateIC (xim
,
3219 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
3220 XNClientWindow
, FRAME_X_WINDOW(f
),
3221 XNFocusWindow
, FRAME_X_WINDOW(f
),
3230 FRAME_XIM (f
) = xim
;
3231 FRAME_XIC (f
) = xic
;
3233 #else /* X_I18N_INHIBITED */
3236 #endif /* X_I18N_INHIBITED */
3237 #endif /* HAVE_X_I18N */
3239 f
->output_data
.x
->wm_hints
.input
= True
;
3240 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3241 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3242 &f
->output_data
.x
->wm_hints
);
3244 hack_wm_protocols (f
, shell_widget
);
3247 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3250 /* Do a stupid property change to force the server to generate a
3251 PropertyNotify event so that the event_stream server timestamp will
3252 be initialized to something relevant to the time we created the window.
3254 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3255 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3256 XA_ATOM
, 32, PropModeAppend
,
3257 (unsigned char*) NULL
, 0);
3259 /* Make all the standard events reach the Emacs frame. */
3260 attributes
.event_mask
= STANDARD_EVENT_SET
;
3261 attribute_mask
= CWEventMask
;
3262 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3263 attribute_mask
, &attributes
);
3265 XtMapWidget (frame_widget
);
3267 /* x_set_name normally ignores requests to set the name if the
3268 requested name is the same as the current name. This is the one
3269 place where that assumption isn't correct; f->name is set, but
3270 the X server hasn't been told. */
3273 int explicit = f
->explicit_name
;
3275 f
->explicit_name
= 0;
3278 x_set_name (f
, name
, explicit);
3281 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3282 f
->output_data
.x
->text_cursor
);
3286 /* This is a no-op, except under Motif. Make sure main areas are
3287 set to something reasonable, in case we get an error later. */
3288 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3291 #else /* not USE_X_TOOLKIT */
3293 /* Create and set up the X window for frame F. */
3300 XClassHint class_hints
;
3301 XSetWindowAttributes attributes
;
3302 unsigned long attribute_mask
;
3304 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3305 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3306 attributes
.bit_gravity
= StaticGravity
;
3307 attributes
.backing_store
= NotUseful
;
3308 attributes
.save_under
= True
;
3309 attributes
.event_mask
= STANDARD_EVENT_SET
;
3310 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
3312 | CWBackingStore
| CWSaveUnder
3318 = XCreateWindow (FRAME_X_DISPLAY (f
),
3319 f
->output_data
.x
->parent_desc
,
3320 f
->output_data
.x
->left_pos
,
3321 f
->output_data
.x
->top_pos
,
3322 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3323 f
->output_data
.x
->border_width
,
3324 CopyFromParent
, /* depth */
3325 InputOutput
, /* class */
3326 FRAME_X_DISPLAY_INFO (f
)->visual
,
3327 attribute_mask
, &attributes
);
3329 #ifndef X_I18N_INHIBITED
3334 xim
= XOpenIM (FRAME_X_DISPLAY(f
), NULL
, NULL
, NULL
);
3338 xic
= XCreateIC (xim
,
3339 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
3340 XNClientWindow
, FRAME_X_WINDOW(f
),
3341 XNFocusWindow
, FRAME_X_WINDOW(f
),
3351 FRAME_XIM (f
) = xim
;
3352 FRAME_XIC (f
) = xic
;
3354 #else /* X_I18N_INHIBITED */
3357 #endif /* X_I18N_INHIBITED */
3358 #endif /* HAVE_X_I18N */
3360 validate_x_resource_name ();
3362 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3363 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3364 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3366 /* The menubar is part of the ordinary display;
3367 it does not count in addition to the height of the window. */
3368 f
->output_data
.x
->menubar_height
= 0;
3370 /* This indicates that we use the "Passive Input" input model.
3371 Unless we do this, we don't get the Focus{In,Out} events that we
3372 need to draw the cursor correctly. Accursed bureaucrats.
3373 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3375 f
->output_data
.x
->wm_hints
.input
= True
;
3376 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3377 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3378 &f
->output_data
.x
->wm_hints
);
3379 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3381 /* Request "save yourself" and "delete window" commands from wm. */
3384 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3385 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3386 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3389 /* x_set_name normally ignores requests to set the name if the
3390 requested name is the same as the current name. This is the one
3391 place where that assumption isn't correct; f->name is set, but
3392 the X server hasn't been told. */
3395 int explicit = f
->explicit_name
;
3397 f
->explicit_name
= 0;
3400 x_set_name (f
, name
, explicit);
3403 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3404 f
->output_data
.x
->text_cursor
);
3408 if (FRAME_X_WINDOW (f
) == 0)
3409 error ("Unable to create window");
3412 #endif /* not USE_X_TOOLKIT */
3414 /* Handle the icon stuff for this window. Perhaps later we might
3415 want an x_set_icon_position which can be called interactively as
3423 Lisp_Object icon_x
, icon_y
;
3424 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3426 /* Set the position of the icon. Note that twm groups all
3427 icons in an icon window. */
3428 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3429 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3430 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3432 CHECK_NUMBER (icon_x
, 0);
3433 CHECK_NUMBER (icon_y
, 0);
3435 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3436 error ("Both left and top icon corners of icon must be specified");
3440 if (! EQ (icon_x
, Qunbound
))
3441 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3443 /* Start up iconic or window? */
3444 x_wm_set_window_state
3445 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3450 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3457 /* Make the GC's needed for this window, setting the
3458 background, border and mouse colors; also create the
3459 mouse cursor and the gray border tile. */
3461 static char cursor_bits
[] =
3463 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3464 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3465 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3466 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3473 XGCValues gc_values
;
3477 /* Create the GC's of this frame.
3478 Note that many default values are used. */
3481 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3482 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3483 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3484 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3485 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3487 GCLineWidth
| GCFont
3488 | GCForeground
| GCBackground
,
3491 /* Reverse video style. */
3492 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3493 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3494 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3496 GCFont
| GCForeground
| GCBackground
3500 /* Cursor has cursor-color background, background-color foreground. */
3501 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3502 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3503 gc_values
.fill_style
= FillOpaqueStippled
;
3505 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3506 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3507 cursor_bits
, 16, 16);
3508 f
->output_data
.x
->cursor_gc
3509 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3510 (GCFont
| GCForeground
| GCBackground
3511 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3515 f
->output_data
.x
->white_relief
.gc
= 0;
3516 f
->output_data
.x
->black_relief
.gc
= 0;
3518 /* Create the gray border tile used when the pointer is not in
3519 the frame. Since this depends on the frame's pixel values,
3520 this must be done on a per-frame basis. */
3521 f
->output_data
.x
->border_tile
3522 = (XCreatePixmapFromBitmapData
3523 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3524 gray_bits
, gray_width
, gray_height
,
3525 f
->output_data
.x
->foreground_pixel
,
3526 f
->output_data
.x
->background_pixel
,
3527 DefaultDepth (FRAME_X_DISPLAY (f
),
3528 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3533 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3535 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3536 Returns an Emacs frame object.\n\
3537 ALIST is an alist of frame parameters.\n\
3538 If the parameters specify that the frame should not have a minibuffer,\n\
3539 and do not specify a specific minibuffer window to use,\n\
3540 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3541 be shared by the new frame.\n\
3543 This function is an internal primitive--use `make-frame' instead.")
3548 Lisp_Object frame
, tem
;
3550 int minibuffer_only
= 0;
3551 long window_prompting
= 0;
3553 int count
= specpdl_ptr
- specpdl
;
3554 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3555 Lisp_Object display
;
3556 struct x_display_info
*dpyinfo
= NULL
;
3562 /* Use this general default value to start with
3563 until we know if this frame has a specified name. */
3564 Vx_resource_name
= Vinvocation_name
;
3566 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3567 if (EQ (display
, Qunbound
))
3569 dpyinfo
= check_x_display_info (display
);
3571 kb
= dpyinfo
->kboard
;
3573 kb
= &the_only_kboard
;
3576 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3578 && ! EQ (name
, Qunbound
)
3580 error ("Invalid frame name--not a string or nil");
3583 Vx_resource_name
= name
;
3585 /* See if parent window is specified. */
3586 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
3587 if (EQ (parent
, Qunbound
))
3589 if (! NILP (parent
))
3590 CHECK_NUMBER (parent
, 0);
3592 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3593 /* No need to protect DISPLAY because that's not used after passing
3594 it to make_frame_without_minibuffer. */
3596 GCPRO4 (parms
, parent
, name
, frame
);
3597 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
3599 if (EQ (tem
, Qnone
) || NILP (tem
))
3600 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3601 else if (EQ (tem
, Qonly
))
3603 f
= make_minibuffer_frame ();
3604 minibuffer_only
= 1;
3606 else if (WINDOWP (tem
))
3607 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3611 XSETFRAME (frame
, f
);
3613 /* Note that X Windows does support scroll bars. */
3614 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3616 f
->output_method
= output_x_window
;
3617 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
3618 bzero (f
->output_data
.x
, sizeof (struct x_output
));
3619 f
->output_data
.x
->icon_bitmap
= -1;
3620 f
->output_data
.x
->fontset
= -1;
3621 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
3622 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
3625 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
3627 if (! STRINGP (f
->icon_name
))
3628 f
->icon_name
= Qnil
;
3630 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
3632 FRAME_KBOARD (f
) = kb
;
3635 /* Specify the parent under which to make this X window. */
3639 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
3640 f
->output_data
.x
->explicit_parent
= 1;
3644 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3645 f
->output_data
.x
->explicit_parent
= 0;
3648 /* Set the name; the functions to which we pass f expect the name to
3650 if (EQ (name
, Qunbound
) || NILP (name
))
3652 f
->name
= build_string (dpyinfo
->x_id_name
);
3653 f
->explicit_name
= 0;
3658 f
->explicit_name
= 1;
3659 /* use the frame's title when getting resources for this frame. */
3660 specbind (Qx_resource_name
, name
);
3663 /* Create fontsets from `global_fontset_alist' before handling fonts. */
3664 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
3665 fs_register_fontset (f
, XCAR (tem
));
3667 /* Extract the window parameters from the supplied values
3668 that are needed to determine window geometry. */
3672 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
3675 /* First, try whatever font the caller has specified. */
3678 tem
= Fquery_fontset (font
, Qnil
);
3680 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
3682 font
= x_new_font (f
, XSTRING (font
)->data
);
3685 /* Try out a font which we hope has bold and italic variations. */
3686 if (!STRINGP (font
))
3687 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3688 if (!STRINGP (font
))
3689 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3690 if (! STRINGP (font
))
3691 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3692 if (! STRINGP (font
))
3693 /* This was formerly the first thing tried, but it finds too many fonts
3694 and takes too long. */
3695 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3696 /* If those didn't work, look for something which will at least work. */
3697 if (! STRINGP (font
))
3698 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3700 if (! STRINGP (font
))
3701 font
= build_string ("fixed");
3703 x_default_parameter (f
, parms
, Qfont
, font
,
3704 "font", "Font", RES_TYPE_STRING
);
3708 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3709 whereby it fails to get any font. */
3710 xlwmenu_default_font
= f
->output_data
.x
->font
;
3713 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3714 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
3716 /* This defaults to 2 in order to match xterm. We recognize either
3717 internalBorderWidth or internalBorder (which is what xterm calls
3719 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3723 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
3724 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
3725 if (! EQ (value
, Qunbound
))
3726 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3729 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
3730 "internalBorderWidth", "internalBorderWidth",
3732 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
3733 "verticalScrollBars", "ScrollBars",
3736 /* Also do the stuff which must be set before the window exists. */
3737 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3738 "foreground", "Foreground", RES_TYPE_STRING
);
3739 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3740 "background", "Background", RES_TYPE_STRING
);
3741 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3742 "pointerColor", "Foreground", RES_TYPE_STRING
);
3743 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3744 "cursorColor", "Foreground", RES_TYPE_STRING
);
3745 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3746 "borderColor", "BorderColor", RES_TYPE_STRING
);
3747 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
3748 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
3750 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
3751 "scrollBarForeground",
3752 "ScrollBarForeground", 1);
3753 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
3754 "scrollBarBackground",
3755 "ScrollBarBackground", 0);
3757 /* Init faces before x_default_parameter is called for scroll-bar
3758 parameters because that function calls x_set_scroll_bar_width,
3759 which calls change_frame_size, which calls Fset_window_buffer,
3760 which runs hooks, which call Fvertical_motion. At the end, we
3761 end up in init_iterator with a null face cache, which should not
3763 init_frame_faces (f
);
3765 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3766 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
3767 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
3768 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
3769 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
3770 "scrollBarWidth", "ScrollBarWidth",
3772 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
3773 "bufferPredicate", "BufferPredicate",
3775 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
3776 "title", "Title", RES_TYPE_STRING
);
3778 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3779 window_prompting
= x_figure_window_size (f
, parms
);
3781 if (window_prompting
& XNegative
)
3783 if (window_prompting
& YNegative
)
3784 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
3786 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
3790 if (window_prompting
& YNegative
)
3791 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
3793 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
3796 f
->output_data
.x
->size_hint_flags
= window_prompting
;
3798 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
3799 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
3801 /* Create the X widget or window. Add the tool-bar height to the
3802 initial frame height so that the user gets a text display area of
3803 the size he specified with -g or via .Xdefaults. Later changes
3804 of the tool-bar height don't change the frame size. This is done
3805 so that users can create tall Emacs frames without having to
3806 guess how tall the tool-bar will get. */
3807 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
3809 #ifdef USE_X_TOOLKIT
3810 x_window (f
, window_prompting
, minibuffer_only
);
3818 /* Now consider the frame official. */
3819 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
3820 Vframe_list
= Fcons (frame
, Vframe_list
);
3822 /* We need to do this after creating the X window, so that the
3823 icon-creation functions can say whose icon they're describing. */
3824 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
3825 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
3827 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
3828 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
3829 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
3830 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
3831 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
3832 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
3834 /* Dimensions, especially f->height, must be done via change_frame_size.
3835 Change will not be effected unless different from the current
3840 SET_FRAME_WIDTH (f
, 0);
3841 change_frame_size (f
, height
, width
, 1, 0, 0);
3843 /* Set up faces after all frame parameters are known. */
3844 call1 (Qface_set_after_frame_default
, frame
);
3846 #ifdef USE_X_TOOLKIT
3847 /* Create the menu bar. */
3848 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
3850 /* If this signals an error, we haven't set size hints for the
3851 frame and we didn't make it visible. */
3852 initialize_frame_menubar (f
);
3854 /* This is a no-op, except under Motif where it arranges the
3855 main window for the widgets on it. */
3856 lw_set_main_areas (f
->output_data
.x
->column_widget
,
3857 f
->output_data
.x
->menubar_widget
,
3858 f
->output_data
.x
->edit_widget
);
3860 #endif /* USE_X_TOOLKIT */
3862 /* Tell the server what size and position, etc, we want, and how
3863 badly we want them. This should be done after we have the menu
3864 bar so that its size can be taken into account. */
3866 x_wm_set_size_hint (f
, window_prompting
, 0);
3869 /* Make the window appear on the frame and enable display, unless
3870 the caller says not to. However, with explicit parent, Emacs
3871 cannot control visibility, so don't try. */
3872 if (! f
->output_data
.x
->explicit_parent
)
3874 Lisp_Object visibility
;
3876 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
3878 if (EQ (visibility
, Qunbound
))
3881 if (EQ (visibility
, Qicon
))
3882 x_iconify_frame (f
);
3883 else if (! NILP (visibility
))
3884 x_make_frame_visible (f
);
3886 /* Must have been Qnil. */
3891 return unbind_to (count
, frame
);
3894 /* FRAME is used only to get a handle on the X display. We don't pass the
3895 display info directly because we're called from frame.c, which doesn't
3896 know about that structure. */
3899 x_get_focus_frame (frame
)
3900 struct frame
*frame
;
3902 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
3904 if (! dpyinfo
->x_focus_frame
)
3907 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
3912 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
3913 "Internal function called by `color-defined-p', which see.")
3915 Lisp_Object color
, frame
;
3918 FRAME_PTR f
= check_x_frame (frame
);
3920 CHECK_STRING (color
, 1);
3922 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3928 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
3929 "Internal function called by `color-values', which see.")
3931 Lisp_Object color
, frame
;
3934 FRAME_PTR f
= check_x_frame (frame
);
3936 CHECK_STRING (color
, 1);
3938 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3942 rgb
[0] = make_number (foo
.red
);
3943 rgb
[1] = make_number (foo
.green
);
3944 rgb
[2] = make_number (foo
.blue
);
3945 return Flist (3, rgb
);
3951 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
3952 "Internal function called by `display-color-p', which see.")
3954 Lisp_Object display
;
3956 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3958 if (dpyinfo
->n_planes
<= 2)
3961 switch (dpyinfo
->visual
->class)
3974 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
3976 "Return t if the X display supports shades of gray.\n\
3977 Note that color displays do support shades of gray.\n\
3978 The optional argument DISPLAY specifies which display to ask about.\n\
3979 DISPLAY should be either a frame or a display name (a string).\n\
3980 If omitted or nil, that stands for the selected frame's display.")
3982 Lisp_Object display
;
3984 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3986 if (dpyinfo
->n_planes
<= 1)
3989 switch (dpyinfo
->visual
->class)
4004 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4006 "Returns the width in pixels of the X display DISPLAY.\n\
4007 The optional argument DISPLAY specifies which display to ask about.\n\
4008 DISPLAY should be either a frame or a display name (a string).\n\
4009 If omitted or nil, that stands for the selected frame's display.")
4011 Lisp_Object display
;
4013 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4015 return make_number (dpyinfo
->width
);
4018 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4019 Sx_display_pixel_height
, 0, 1, 0,
4020 "Returns the height in pixels of the X display DISPLAY.\n\
4021 The optional argument DISPLAY specifies which display to ask about.\n\
4022 DISPLAY should be either a frame or a display name (a string).\n\
4023 If omitted or nil, that stands for the selected frame's display.")
4025 Lisp_Object display
;
4027 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4029 return make_number (dpyinfo
->height
);
4032 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4034 "Returns the number of bitplanes of the X display DISPLAY.\n\
4035 The optional argument DISPLAY specifies which display to ask about.\n\
4036 DISPLAY should be either a frame or a display name (a string).\n\
4037 If omitted or nil, that stands for the selected frame's display.")
4039 Lisp_Object display
;
4041 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4043 return make_number (dpyinfo
->n_planes
);
4046 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4048 "Returns the number of color cells of the X display DISPLAY.\n\
4049 The optional argument DISPLAY specifies which display to ask about.\n\
4050 DISPLAY should be either a frame or a display name (a string).\n\
4051 If omitted or nil, that stands for the selected frame's display.")
4053 Lisp_Object display
;
4055 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4057 return make_number (DisplayCells (dpyinfo
->display
,
4058 XScreenNumberOfScreen (dpyinfo
->screen
)));
4061 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4062 Sx_server_max_request_size
,
4064 "Returns the maximum request size of the X server of display DISPLAY.\n\
4065 The optional argument DISPLAY specifies which display to ask about.\n\
4066 DISPLAY should be either a frame or a display name (a string).\n\
4067 If omitted or nil, that stands for the selected frame's display.")
4069 Lisp_Object display
;
4071 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4073 return make_number (MAXREQUEST (dpyinfo
->display
));
4076 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4077 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4078 The optional argument DISPLAY specifies which display to ask about.\n\
4079 DISPLAY should be either a frame or a display name (a string).\n\
4080 If omitted or nil, that stands for the selected frame's display.")
4082 Lisp_Object display
;
4084 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4085 char *vendor
= ServerVendor (dpyinfo
->display
);
4087 if (! vendor
) vendor
= "";
4088 return build_string (vendor
);
4091 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4092 "Returns the version numbers of the X server of display DISPLAY.\n\
4093 The value is a list of three integers: the major and minor\n\
4094 version numbers of the X Protocol in use, and the vendor-specific release\n\
4095 number. See also the function `x-server-vendor'.\n\n\
4096 The optional argument DISPLAY specifies which display to ask about.\n\
4097 DISPLAY should be either a frame or a display name (a string).\n\
4098 If omitted or nil, that stands for the selected frame's display.")
4100 Lisp_Object display
;
4102 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4103 Display
*dpy
= dpyinfo
->display
;
4105 return Fcons (make_number (ProtocolVersion (dpy
)),
4106 Fcons (make_number (ProtocolRevision (dpy
)),
4107 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4110 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4111 "Returns the number of screens on the X server of display DISPLAY.\n\
4112 The optional argument DISPLAY specifies which display to ask about.\n\
4113 DISPLAY should be either a frame or a display name (a string).\n\
4114 If omitted or nil, that stands for the selected frame's display.")
4116 Lisp_Object display
;
4118 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4120 return make_number (ScreenCount (dpyinfo
->display
));
4123 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4124 "Returns the height in millimeters of the X display DISPLAY.\n\
4125 The optional argument DISPLAY specifies which display to ask about.\n\
4126 DISPLAY should be either a frame or a display name (a string).\n\
4127 If omitted or nil, that stands for the selected frame's display.")
4129 Lisp_Object display
;
4131 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4133 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4136 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4137 "Returns the width in millimeters of the X display DISPLAY.\n\
4138 The optional argument DISPLAY specifies which display to ask about.\n\
4139 DISPLAY should be either a frame or a display name (a string).\n\
4140 If omitted or nil, that stands for the selected frame's display.")
4142 Lisp_Object display
;
4144 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4146 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4149 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4150 Sx_display_backing_store
, 0, 1, 0,
4151 "Returns an indication of whether X display DISPLAY does backing store.\n\
4152 The value may be `always', `when-mapped', or `not-useful'.\n\
4153 The optional argument DISPLAY specifies which display to ask about.\n\
4154 DISPLAY should be either a frame or a display name (a string).\n\
4155 If omitted or nil, that stands for the selected frame's display.")
4157 Lisp_Object display
;
4159 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4161 switch (DoesBackingStore (dpyinfo
->screen
))
4164 return intern ("always");
4167 return intern ("when-mapped");
4170 return intern ("not-useful");
4173 error ("Strange value for BackingStore parameter of screen");
4177 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4178 Sx_display_visual_class
, 0, 1, 0,
4179 "Returns the visual class of the X display DISPLAY.\n\
4180 The value is one of the symbols `static-gray', `gray-scale',\n\
4181 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4182 The optional argument DISPLAY specifies which display to ask about.\n\
4183 DISPLAY should be either a frame or a display name (a string).\n\
4184 If omitted or nil, that stands for the selected frame's display.")
4186 Lisp_Object display
;
4188 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4190 switch (dpyinfo
->visual
->class)
4192 case StaticGray
: return (intern ("static-gray"));
4193 case GrayScale
: return (intern ("gray-scale"));
4194 case StaticColor
: return (intern ("static-color"));
4195 case PseudoColor
: return (intern ("pseudo-color"));
4196 case TrueColor
: return (intern ("true-color"));
4197 case DirectColor
: return (intern ("direct-color"));
4199 error ("Display has an unknown visual class");
4203 DEFUN ("x-display-save-under", Fx_display_save_under
,
4204 Sx_display_save_under
, 0, 1, 0,
4205 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4206 The optional argument DISPLAY specifies which display to ask about.\n\
4207 DISPLAY should be either a frame or a display name (a string).\n\
4208 If omitted or nil, that stands for the selected frame's display.")
4210 Lisp_Object display
;
4212 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4214 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4222 register struct frame
*f
;
4224 return PIXEL_WIDTH (f
);
4229 register struct frame
*f
;
4231 return PIXEL_HEIGHT (f
);
4236 register struct frame
*f
;
4238 return FONT_WIDTH (f
->output_data
.x
->font
);
4243 register struct frame
*f
;
4245 return f
->output_data
.x
->line_height
;
4250 register struct frame
*f
;
4252 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4255 #if 0 /* These no longer seem like the right way to do things. */
4257 /* Draw a rectangle on the frame with left top corner including
4258 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
4259 CHARS by LINES wide and long and is the color of the cursor. */
4262 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
4263 register struct frame
*f
;
4265 register int top_char
, left_char
, chars
, lines
;
4269 int left
= (left_char
* FONT_WIDTH (f
->output_data
.x
->font
)
4270 + f
->output_data
.x
->internal_border_width
);
4271 int top
= (top_char
* f
->output_data
.x
->line_height
4272 + f
->output_data
.x
->internal_border_width
);
4275 width
= FONT_WIDTH (f
->output_data
.x
->font
) / 2;
4277 width
= FONT_WIDTH (f
->output_data
.x
->font
) * chars
;
4279 height
= f
->output_data
.x
->line_height
/ 2;
4281 height
= f
->output_data
.x
->line_height
* lines
;
4283 XDrawRectangle (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4284 gc
, left
, top
, width
, height
);
4287 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
4288 "Draw a rectangle on FRAME between coordinates specified by\n\
4289 numbers X0, Y0, X1, Y1 in the cursor pixel.")
4290 (frame
, X0
, Y0
, X1
, Y1
)
4291 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
4293 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4295 CHECK_LIVE_FRAME (frame
, 0);
4296 CHECK_NUMBER (X0
, 0);
4297 CHECK_NUMBER (Y0
, 1);
4298 CHECK_NUMBER (X1
, 2);
4299 CHECK_NUMBER (Y1
, 3);
4309 n_lines
= y1
- y0
+ 1;
4314 n_lines
= y0
- y1
+ 1;
4320 n_chars
= x1
- x0
+ 1;
4325 n_chars
= x0
- x1
+ 1;
4329 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->cursor_gc
,
4330 left
, top
, n_chars
, n_lines
);
4336 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
4337 "Draw a rectangle drawn on FRAME between coordinates\n\
4338 X0, Y0, X1, Y1 in the regular background-pixel.")
4339 (frame
, X0
, Y0
, X1
, Y1
)
4340 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
4342 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4344 CHECK_LIVE_FRAME (frame
, 0);
4345 CHECK_NUMBER (X0
, 0);
4346 CHECK_NUMBER (Y0
, 1);
4347 CHECK_NUMBER (X1
, 2);
4348 CHECK_NUMBER (Y1
, 3);
4358 n_lines
= y1
- y0
+ 1;
4363 n_lines
= y0
- y1
+ 1;
4369 n_chars
= x1
- x0
+ 1;
4374 n_chars
= x0
- x1
+ 1;
4378 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->reverse_gc
,
4379 left
, top
, n_chars
, n_lines
);
4385 /* Draw lines around the text region beginning at the character position
4386 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4387 pixel and line characteristics. */
4389 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4392 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
4393 register struct frame
*f
;
4395 int top_x
, top_y
, bottom_x
, bottom_y
;
4397 register int ibw
= f
->output_data
.x
->internal_border_width
;
4398 register int font_w
= FONT_WIDTH (f
->output_data
.x
->font
);
4399 register int font_h
= f
->output_data
.x
->line_height
;
4401 int x
= line_len (y
);
4402 XPoint
*pixel_points
4403 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
4404 register XPoint
*this_point
= pixel_points
;
4406 /* Do the horizontal top line/lines */
4409 this_point
->x
= ibw
;
4410 this_point
->y
= ibw
+ (font_h
* top_y
);
4413 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
4415 this_point
->x
= ibw
+ (font_w
* x
);
4416 this_point
->y
= (this_point
- 1)->y
;
4420 this_point
->x
= ibw
;
4421 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
4423 this_point
->x
= ibw
+ (font_w
* top_x
);
4424 this_point
->y
= (this_point
- 1)->y
;
4426 this_point
->x
= (this_point
- 1)->x
;
4427 this_point
->y
= ibw
+ (font_h
* top_y
);
4429 this_point
->x
= ibw
+ (font_w
* x
);
4430 this_point
->y
= (this_point
- 1)->y
;
4433 /* Now do the right side. */
4434 while (y
< bottom_y
)
4435 { /* Right vertical edge */
4437 this_point
->x
= (this_point
- 1)->x
;
4438 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
4441 y
++; /* Horizontal connection to next line */
4444 this_point
->x
= ibw
+ (font_w
/ 2);
4446 this_point
->x
= ibw
+ (font_w
* x
);
4448 this_point
->y
= (this_point
- 1)->y
;
4451 /* Now do the bottom and connect to the top left point. */
4452 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
4455 this_point
->x
= (this_point
- 1)->x
;
4456 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
4458 this_point
->x
= ibw
;
4459 this_point
->y
= (this_point
- 1)->y
;
4461 this_point
->x
= pixel_points
->x
;
4462 this_point
->y
= pixel_points
->y
;
4464 XDrawLines (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4466 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
4469 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
4470 "Highlight the region between point and the character under the mouse\n\
4473 register Lisp_Object event
;
4475 register int x0
, y0
, x1
, y1
;
4476 register struct frame
*f
= selected_frame
;
4477 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4478 register int p1
, p2
;
4480 CHECK_CONS (event
, 0);
4483 x0
= XINT (Fcar (Fcar (event
)));
4484 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4486 /* If the mouse is past the end of the line, don't that area. */
4487 /* ReWrite this... */
4489 /* Where the cursor is. */
4490 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4491 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4493 if (y1
> y0
) /* point below mouse */
4494 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4496 else if (y1
< y0
) /* point above mouse */
4497 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4499 else /* same line: draw horizontal rectangle */
4502 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4503 x0
, y0
, (x1
- x0
+ 1), 1);
4505 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4506 x1
, y1
, (x0
- x1
+ 1), 1);
4509 XFlush (FRAME_X_DISPLAY (f
));
4515 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
4516 "Erase any highlighting of the region between point and the character\n\
4517 at X, Y on the selected frame.")
4519 register Lisp_Object event
;
4521 register int x0
, y0
, x1
, y1
;
4522 register struct frame
*f
= selected_frame
;
4523 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4526 x0
= XINT (Fcar (Fcar (event
)));
4527 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4528 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4529 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4531 if (y1
> y0
) /* point below mouse */
4532 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4534 else if (y1
< y0
) /* point above mouse */
4535 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4537 else /* same line: draw horizontal rectangle */
4540 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4541 x0
, y0
, (x1
- x0
+ 1), 1);
4543 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4544 x1
, y1
, (x0
- x1
+ 1), 1);
4552 int contour_begin_x
, contour_begin_y
;
4553 int contour_end_x
, contour_end_y
;
4554 int contour_npoints
;
4556 /* Clip the top part of the contour lines down (and including) line Y_POS.
4557 If X_POS is in the middle (rather than at the end) of the line, drop
4558 down a line at that character. */
4561 clip_contour_top (y_pos
, x_pos
)
4563 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
4564 register XPoint
*end
;
4565 register int npoints
;
4566 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
4568 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
4570 end
= contour_lines
[y_pos
].top_right
;
4571 npoints
= (end
- begin
+ 1);
4572 XDrawLines (x_current_display
, contour_window
,
4573 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4575 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
4576 contour_last_point
-= (npoints
- 2);
4577 XDrawLines (x_current_display
, contour_window
,
4578 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
4579 XFlush (x_current_display
);
4581 /* Now, update contour_lines structure. */
4586 register XPoint
*p
= begin
+ 1;
4587 end
= contour_lines
[y_pos
].bottom_right
;
4588 npoints
= (end
- begin
+ 1);
4589 XDrawLines (x_current_display
, contour_window
,
4590 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4593 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
4595 p
->y
= begin
->y
+ font_h
;
4597 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
4598 contour_last_point
-= (npoints
- 5);
4599 XDrawLines (x_current_display
, contour_window
,
4600 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
4601 XFlush (x_current_display
);
4603 /* Now, update contour_lines structure. */
4607 /* Erase the top horizontal lines of the contour, and then extend
4608 the contour upwards. */
4611 extend_contour_top (line
)
4616 clip_contour_bottom (x_pos
, y_pos
)
4622 extend_contour_bottom (x_pos
, y_pos
)
4626 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
4631 register struct frame
*f
= selected_frame
;
4632 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4633 register int point_x
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4634 register int point_y
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4635 register int mouse_below_point
;
4636 register Lisp_Object obj
;
4637 register int x_contour_x
, x_contour_y
;
4639 x_contour_x
= x_mouse_x
;
4640 x_contour_y
= x_mouse_y
;
4641 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
4642 && x_contour_x
> point_x
))
4644 mouse_below_point
= 1;
4645 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4646 x_contour_x
, x_contour_y
);
4650 mouse_below_point
= 0;
4651 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
4657 obj
= read_char (-1, 0, 0, Qnil
, 0);
4661 if (mouse_below_point
)
4663 if (x_mouse_y
<= point_y
) /* Flipped. */
4665 mouse_below_point
= 0;
4667 outline_region (f
, f
->output_data
.x
->reverse_gc
, point_x
, point_y
,
4668 x_contour_x
, x_contour_y
);
4669 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
4672 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
4674 clip_contour_bottom (x_mouse_y
);
4676 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
4678 extend_bottom_contour (x_mouse_y
);
4681 x_contour_x
= x_mouse_x
;
4682 x_contour_y
= x_mouse_y
;
4684 else /* mouse above or same line as point */
4686 if (x_mouse_y
>= point_y
) /* Flipped. */
4688 mouse_below_point
= 1;
4690 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4691 x_contour_x
, x_contour_y
, point_x
, point_y
);
4692 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4693 x_mouse_x
, x_mouse_y
);
4695 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
4697 clip_contour_top (x_mouse_y
);
4699 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
4701 extend_contour_top (x_mouse_y
);
4706 unread_command_event
= obj
;
4707 if (mouse_below_point
)
4709 contour_begin_x
= point_x
;
4710 contour_begin_y
= point_y
;
4711 contour_end_x
= x_contour_x
;
4712 contour_end_y
= x_contour_y
;
4716 contour_begin_x
= x_contour_x
;
4717 contour_begin_y
= x_contour_y
;
4718 contour_end_x
= point_x
;
4719 contour_end_y
= point_y
;
4724 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
4729 register Lisp_Object obj
;
4730 struct frame
*f
= selected_frame
;
4731 register struct window
*w
= XWINDOW (selected_window
);
4732 register GC line_gc
= f
->output_data
.x
->cursor_gc
;
4733 register GC erase_gc
= f
->output_data
.x
->reverse_gc
;
4735 char dash_list
[] = {6, 4, 6, 4};
4737 XGCValues gc_values
;
4739 register int previous_y
;
4740 register int line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4741 + f
->output_data
.x
->internal_border_width
;
4742 register int left
= f
->output_data
.x
->internal_border_width
4743 + (WINDOW_LEFT_MARGIN (w
)
4744 * FONT_WIDTH (f
->output_data
.x
->font
));
4745 register int right
= left
+ (w
->width
4746 * FONT_WIDTH (f
->output_data
.x
->font
))
4747 - f
->output_data
.x
->internal_border_width
;
4751 gc_values
.foreground
= f
->output_data
.x
->cursor_pixel
;
4752 gc_values
.background
= f
->output_data
.x
->background_pixel
;
4753 gc_values
.line_width
= 1;
4754 gc_values
.line_style
= LineOnOffDash
;
4755 gc_values
.cap_style
= CapRound
;
4756 gc_values
.join_style
= JoinRound
;
4758 line_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4759 GCLineStyle
| GCJoinStyle
| GCCapStyle
4760 | GCLineWidth
| GCForeground
| GCBackground
,
4762 XSetDashes (FRAME_X_DISPLAY (f
), line_gc
, 0, dash_list
, dashes
);
4763 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4764 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
4765 erase_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4766 GCLineStyle
| GCJoinStyle
| GCCapStyle
4767 | GCLineWidth
| GCForeground
| GCBackground
,
4769 XSetDashes (FRAME_X_DISPLAY (f
), erase_gc
, 0, dash_list
, dashes
);
4776 if (x_mouse_y
>= XINT (w
->top
)
4777 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
4779 previous_y
= x_mouse_y
;
4780 line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4781 + f
->output_data
.x
->internal_border_width
;
4782 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4783 line_gc
, left
, line
, right
, line
);
4785 XFlush (FRAME_X_DISPLAY (f
));
4790 obj
= read_char (-1, 0, 0, Qnil
, 0);
4792 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
4793 Qvertical_scroll_bar
))
4797 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4798 erase_gc
, left
, line
, right
, line
);
4799 unread_command_event
= obj
;
4801 XFreeGC (FRAME_X_DISPLAY (f
), line_gc
);
4802 XFreeGC (FRAME_X_DISPLAY (f
), erase_gc
);
4808 while (x_mouse_y
== previous_y
);
4811 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4812 erase_gc
, left
, line
, right
, line
);
4819 /* These keep track of the rectangle following the pointer. */
4820 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
4822 /* Offset in buffer of character under the pointer, or 0. */
4823 int mouse_buffer_offset
;
4825 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
4826 "Track the pointer.")
4829 static Cursor current_pointer_shape
;
4830 FRAME_PTR f
= x_mouse_frame
;
4833 if (EQ (Vmouse_frame_part
, Qtext_part
)
4834 && (current_pointer_shape
!= f
->output_data
.x
->nontext_cursor
))
4839 current_pointer_shape
= f
->output_data
.x
->nontext_cursor
;
4840 XDefineCursor (FRAME_X_DISPLAY (f
),
4842 current_pointer_shape
);
4844 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
4845 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
4847 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
4848 && (current_pointer_shape
!= f
->output_data
.x
->modeline_cursor
))
4850 current_pointer_shape
= f
->output_data
.x
->modeline_cursor
;
4851 XDefineCursor (FRAME_X_DISPLAY (f
),
4853 current_pointer_shape
);
4856 XFlush (FRAME_X_DISPLAY (f
));
4862 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
4863 "Draw rectangle around character under mouse pointer, if there is one.")
4867 struct window
*w
= XWINDOW (Vmouse_window
);
4868 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
4869 struct buffer
*b
= XBUFFER (w
->buffer
);
4872 if (! EQ (Vmouse_window
, selected_window
))
4875 if (EQ (event
, Qnil
))
4879 x_read_mouse_position (selected_frame
, &x
, &y
);
4883 mouse_track_width
= 0;
4884 mouse_track_left
= mouse_track_top
= -1;
4888 if ((x_mouse_x
!= mouse_track_left
4889 && (x_mouse_x
< mouse_track_left
4890 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
4891 || x_mouse_y
!= mouse_track_top
)
4893 int hp
= 0; /* Horizontal position */
4894 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
4895 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
4896 int tab_width
= XINT (b
->tab_width
);
4897 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
4899 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
4900 int in_mode_line
= 0;
4902 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
4905 /* Erase previous rectangle. */
4906 if (mouse_track_width
)
4908 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4909 mouse_track_left
, mouse_track_top
,
4910 mouse_track_width
, 1);
4912 if ((mouse_track_left
== f
->phys_cursor_x
4913 || mouse_track_left
== f
->phys_cursor_x
- 1)
4914 && mouse_track_top
== f
->phys_cursor_y
)
4916 x_display_cursor (f
, 1);
4920 mouse_track_left
= x_mouse_x
;
4921 mouse_track_top
= x_mouse_y
;
4922 mouse_track_width
= 0;
4924 if (mouse_track_left
> len
) /* Past the end of line. */
4927 if (mouse_track_top
== mode_line_vpos
)
4933 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
4937 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
4943 mouse_track_width
= tab_width
- (hp
% tab_width
);
4945 hp
+= mouse_track_width
;
4948 mouse_track_left
= hp
- mouse_track_width
;
4954 mouse_track_width
= -1;
4958 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
4963 mouse_track_width
= 2;
4968 mouse_track_left
= hp
- mouse_track_width
;
4974 mouse_track_width
= 1;
4981 while (hp
<= x_mouse_x
);
4984 if (mouse_track_width
) /* Over text; use text pointer shape. */
4986 XDefineCursor (FRAME_X_DISPLAY (f
),
4988 f
->output_data
.x
->text_cursor
);
4989 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4990 mouse_track_left
, mouse_track_top
,
4991 mouse_track_width
, 1);
4993 else if (in_mode_line
)
4994 XDefineCursor (FRAME_X_DISPLAY (f
),
4996 f
->output_data
.x
->modeline_cursor
);
4998 XDefineCursor (FRAME_X_DISPLAY (f
),
5000 f
->output_data
.x
->nontext_cursor
);
5003 XFlush (FRAME_X_DISPLAY (f
));
5006 obj
= read_char (-1, 0, 0, Qnil
, 0);
5009 while (CONSP (obj
) /* Mouse event */
5010 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
5011 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
5012 && EQ (Vmouse_window
, selected_window
) /* In this window */
5015 unread_command_event
= obj
;
5017 if (mouse_track_width
)
5019 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
5020 mouse_track_left
, mouse_track_top
,
5021 mouse_track_width
, 1);
5022 mouse_track_width
= 0;
5023 if ((mouse_track_left
== f
->phys_cursor_x
5024 || mouse_track_left
- 1 == f
->phys_cursor_x
)
5025 && mouse_track_top
== f
->phys_cursor_y
)
5027 x_display_cursor (f
, 1);
5030 XDefineCursor (FRAME_X_DISPLAY (f
),
5032 f
->output_data
.x
->nontext_cursor
);
5033 XFlush (FRAME_X_DISPLAY (f
));
5043 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
5044 on the frame F at position X, Y. */
5046 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
5048 int x
, y
, width
, height
;
5053 image
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
5054 FRAME_X_WINDOW (f
), image_data
,
5056 XCopyPlane (FRAME_X_DISPLAY (f
), image
, FRAME_X_WINDOW (f
),
5057 f
->output_data
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
5061 #if 0 /* I'm told these functions are superfluous
5062 given the ability to bind function keys. */
5065 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
5066 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
5067 KEYSYM is a string which conforms to the X keysym definitions found\n\
5068 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
5069 list of strings specifying modifier keys such as Control_L, which must\n\
5070 also be depressed for NEWSTRING to appear.")
5071 (x_keysym
, modifiers
, newstring
)
5072 register Lisp_Object x_keysym
;
5073 register Lisp_Object modifiers
;
5074 register Lisp_Object newstring
;
5077 register KeySym keysym
;
5078 KeySym modifier_list
[16];
5081 CHECK_STRING (x_keysym
, 1);
5082 CHECK_STRING (newstring
, 3);
5084 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
5085 if (keysym
== NoSymbol
)
5086 error ("Keysym does not exist");
5088 if (NILP (modifiers
))
5089 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
5090 XSTRING (newstring
)->data
,
5091 STRING_BYTES (XSTRING (newstring
)));
5094 register Lisp_Object rest
, mod
;
5097 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
5100 error ("Can't have more than 16 modifiers");
5103 CHECK_STRING (mod
, 3);
5104 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
5106 if (modifier_list
[i
] == NoSymbol
5107 || !(IsModifierKey (modifier_list
[i
])
5108 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
5109 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
5111 if (modifier_list
[i
] == NoSymbol
5112 || !IsModifierKey (modifier_list
[i
]))
5114 error ("Element is not a modifier keysym");
5118 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
5119 XSTRING (newstring
)->data
,
5120 STRING_BYTES (XSTRING (newstring
)));
5126 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
5127 "Rebind KEYCODE to list of strings STRINGS.\n\
5128 STRINGS should be a list of 16 elements, one for each shift combination.\n\
5129 nil as element means don't change.\n\
5130 See the documentation of `x-rebind-key' for more information.")
5132 register Lisp_Object keycode
;
5133 register Lisp_Object strings
;
5135 register Lisp_Object item
;
5136 register unsigned char *rawstring
;
5137 KeySym rawkey
, modifier
[1];
5139 register unsigned i
;
5142 CHECK_NUMBER (keycode
, 1);
5143 CHECK_CONS (strings
, 2);
5144 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
5145 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
5147 item
= Fcar (strings
);
5150 CHECK_STRING (item
, 2);
5151 strsize
= STRING_BYTES (XSTRING (item
));
5152 rawstring
= (unsigned char *) xmalloc (strsize
);
5153 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
5154 modifier
[1] = 1 << i
;
5155 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
5156 rawstring
, strsize
);
5161 #endif /* HAVE_X11 */
5164 #ifndef HAVE_XSCREENNUMBEROFSCREEN
5166 XScreenNumberOfScreen (scr
)
5167 register Screen
*scr
;
5169 register Display
*dpy
;
5170 register Screen
*dpyscr
;
5174 dpyscr
= dpy
->screens
;
5176 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
5182 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5185 select_visual (dpy
, screen
, depth
)
5188 unsigned int *depth
;
5191 XVisualInfo
*vinfo
, vinfo_template
;
5194 v
= DefaultVisualOfScreen (screen
);
5197 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
5199 vinfo_template
.visualid
= v
->visualid
;
5202 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5204 vinfo
= XGetVisualInfo (dpy
,
5205 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
5208 fatal ("Can't get proper X visual info");
5210 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
5211 *depth
= vinfo
->depth
;
5215 int n
= vinfo
->colormap_size
- 1;
5224 XFree ((char *) vinfo
);
5228 /* Return the X display structure for the display named NAME.
5229 Open a new connection if necessary. */
5231 struct x_display_info
*
5232 x_display_info_for_name (name
)
5236 struct x_display_info
*dpyinfo
;
5238 CHECK_STRING (name
, 0);
5240 if (! EQ (Vwindow_system
, intern ("x")))
5241 error ("Not using X Windows");
5243 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5245 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5248 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5253 /* Use this general default value to start with. */
5254 Vx_resource_name
= Vinvocation_name
;
5256 validate_x_resource_name ();
5258 dpyinfo
= x_term_init (name
, (unsigned char *)0,
5259 (char *) XSTRING (Vx_resource_name
)->data
);
5262 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5265 XSETFASTINT (Vwindow_system_version
, 11);
5270 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5271 1, 3, 0, "Open a connection to an X server.\n\
5272 DISPLAY is the name of the display to connect to.\n\
5273 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5274 If the optional third arg MUST-SUCCEED is non-nil,\n\
5275 terminate Emacs if we can't open the connection.")
5276 (display
, xrm_string
, must_succeed
)
5277 Lisp_Object display
, xrm_string
, must_succeed
;
5279 unsigned char *xrm_option
;
5280 struct x_display_info
*dpyinfo
;
5282 CHECK_STRING (display
, 0);
5283 if (! NILP (xrm_string
))
5284 CHECK_STRING (xrm_string
, 1);
5286 if (! EQ (Vwindow_system
, intern ("x")))
5287 error ("Not using X Windows");
5289 if (! NILP (xrm_string
))
5290 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5292 xrm_option
= (unsigned char *) 0;
5294 validate_x_resource_name ();
5296 /* This is what opens the connection and sets x_current_display.
5297 This also initializes many symbols, such as those used for input. */
5298 dpyinfo
= x_term_init (display
, xrm_option
,
5299 (char *) XSTRING (Vx_resource_name
)->data
);
5303 if (!NILP (must_succeed
))
5304 fatal ("Cannot connect to X server %s.\n\
5305 Check the DISPLAY environment variable or use `-d'.\n\
5306 Also use the `xhost' program to verify that it is set to permit\n\
5307 connections from your machine.\n",
5308 XSTRING (display
)->data
);
5310 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5315 XSETFASTINT (Vwindow_system_version
, 11);
5319 DEFUN ("x-close-connection", Fx_close_connection
,
5320 Sx_close_connection
, 1, 1, 0,
5321 "Close the connection to DISPLAY's X server.\n\
5322 For DISPLAY, specify either a frame or a display name (a string).\n\
5323 If DISPLAY is nil, that stands for the selected frame's display.")
5325 Lisp_Object display
;
5327 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5330 if (dpyinfo
->reference_count
> 0)
5331 error ("Display still has frames on it");
5334 /* Free the fonts in the font table. */
5335 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5336 if (dpyinfo
->font_table
[i
].name
)
5338 xfree (dpyinfo
->font_table
[i
].name
);
5339 /* Don't free the full_name string;
5340 it is always shared with something else. */
5341 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5344 x_destroy_all_bitmaps (dpyinfo
);
5345 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5347 #ifdef USE_X_TOOLKIT
5348 XtCloseDisplay (dpyinfo
->display
);
5350 XCloseDisplay (dpyinfo
->display
);
5353 x_delete_display (dpyinfo
);
5359 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5360 "Return the list of display names that Emacs has connections to.")
5363 Lisp_Object tail
, result
;
5366 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5367 result
= Fcons (XCAR (XCAR (tail
)), result
);
5372 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5373 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5374 If ON is nil, allow buffering of requests.\n\
5375 Turning on synchronization prohibits the Xlib routines from buffering\n\
5376 requests and seriously degrades performance, but makes debugging much\n\
5378 The optional second argument DISPLAY specifies which display to act on.\n\
5379 DISPLAY should be either a frame or a display name (a string).\n\
5380 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5382 Lisp_Object display
, on
;
5384 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5386 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5391 /* Wait for responses to all X commands issued so far for frame F. */
5398 XSync (FRAME_X_DISPLAY (f
), False
);
5403 /***********************************************************************
5405 ***********************************************************************/
5407 /* Value is the number of elements of vector VECTOR. */
5409 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5411 /* List of supported image types. Use define_image_type to add new
5412 types. Use lookup_image_type to find a type for a given symbol. */
5414 static struct image_type
*image_types
;
5416 /* A list of symbols, one for each supported image type. */
5418 Lisp_Object Vimage_types
;
5420 /* The symbol `image' which is the car of the lists used to represent
5423 extern Lisp_Object Qimage
;
5425 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5431 Lisp_Object QCtype
, QCdata
, QCascent
, QCmargin
, QCrelief
;
5432 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5433 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
5434 Lisp_Object QCindex
;
5436 /* Other symbols. */
5438 Lisp_Object Qlaplace
;
5440 /* Time in seconds after which images should be removed from the cache
5441 if not displayed. */
5443 Lisp_Object Vimage_cache_eviction_delay
;
5445 /* Function prototypes. */
5447 static void define_image_type
P_ ((struct image_type
*type
));
5448 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5449 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5450 static void x_laplace
P_ ((struct frame
*, struct image
*));
5451 static int x_build_heuristic_mask
P_ ((struct frame
*, Lisp_Object
,
5452 struct image
*, Lisp_Object
));
5455 /* Define a new image type from TYPE. This adds a copy of TYPE to
5456 image_types and adds the symbol *TYPE->type to Vimage_types. */
5459 define_image_type (type
)
5460 struct image_type
*type
;
5462 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5463 The initialized data segment is read-only. */
5464 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5465 bcopy (type
, p
, sizeof *p
);
5466 p
->next
= image_types
;
5468 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5472 /* Look up image type SYMBOL, and return a pointer to its image_type
5473 structure. Value is null if SYMBOL is not a known image type. */
5475 static INLINE
struct image_type
*
5476 lookup_image_type (symbol
)
5479 struct image_type
*type
;
5481 for (type
= image_types
; type
; type
= type
->next
)
5482 if (EQ (symbol
, *type
->type
))
5489 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5490 valid image specification is a list whose car is the symbol
5491 `image', and whose rest is a property list. The property list must
5492 contain a value for key `:type'. That value must be the name of a
5493 supported image type. The rest of the property list depends on the
5497 valid_image_p (object
)
5502 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5504 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5505 struct image_type
*type
= lookup_image_type (symbol
);
5508 valid_p
= type
->valid_p (object
);
5515 /* Log error message with format string FORMAT and argument ARG.
5516 Signaling an error, e.g. when an image cannot be loaded, is not a
5517 good idea because this would interrupt redisplay, and the error
5518 message display would lead to another redisplay. This function
5519 therefore simply displays a message. */
5522 image_error (format
, arg1
, arg2
)
5524 Lisp_Object arg1
, arg2
;
5526 add_to_log (format
, arg1
, arg2
);
5531 /***********************************************************************
5532 Image specifications
5533 ***********************************************************************/
5535 enum image_value_type
5537 IMAGE_DONT_CHECK_VALUE_TYPE
,
5540 IMAGE_POSITIVE_INTEGER_VALUE
,
5541 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5542 IMAGE_INTEGER_VALUE
,
5543 IMAGE_FUNCTION_VALUE
,
5548 /* Structure used when parsing image specifications. */
5550 struct image_keyword
5552 /* Name of keyword. */
5555 /* The type of value allowed. */
5556 enum image_value_type type
;
5558 /* Non-zero means key must be present. */
5561 /* Used to recognize duplicate keywords in a property list. */
5564 /* The value that was found. */
5569 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5571 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5574 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5575 has the format (image KEYWORD VALUE ...). One of the keyword/
5576 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5577 image_keywords structures of size NKEYWORDS describing other
5578 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5581 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5583 struct image_keyword
*keywords
;
5590 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5593 plist
= XCDR (spec
);
5594 while (CONSP (plist
))
5596 Lisp_Object key
, value
;
5598 /* First element of a pair must be a symbol. */
5600 plist
= XCDR (plist
);
5604 /* There must follow a value. */
5607 value
= XCAR (plist
);
5608 plist
= XCDR (plist
);
5610 /* Find key in KEYWORDS. Error if not found. */
5611 for (i
= 0; i
< nkeywords
; ++i
)
5612 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5618 /* Record that we recognized the keyword. If a keywords
5619 was found more than once, it's an error. */
5620 keywords
[i
].value
= value
;
5621 ++keywords
[i
].count
;
5623 if (keywords
[i
].count
> 1)
5626 /* Check type of value against allowed type. */
5627 switch (keywords
[i
].type
)
5629 case IMAGE_STRING_VALUE
:
5630 if (!STRINGP (value
))
5634 case IMAGE_SYMBOL_VALUE
:
5635 if (!SYMBOLP (value
))
5639 case IMAGE_POSITIVE_INTEGER_VALUE
:
5640 if (!INTEGERP (value
) || XINT (value
) <= 0)
5644 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5645 if (!INTEGERP (value
) || XINT (value
) < 0)
5649 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5652 case IMAGE_FUNCTION_VALUE
:
5653 value
= indirect_function (value
);
5655 || COMPILEDP (value
)
5656 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5660 case IMAGE_NUMBER_VALUE
:
5661 if (!INTEGERP (value
) && !FLOATP (value
))
5665 case IMAGE_INTEGER_VALUE
:
5666 if (!INTEGERP (value
))
5670 case IMAGE_BOOL_VALUE
:
5671 if (!NILP (value
) && !EQ (value
, Qt
))
5680 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5684 /* Check that all mandatory fields are present. */
5685 for (i
= 0; i
< nkeywords
; ++i
)
5686 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5689 return NILP (plist
);
5693 /* Return the value of KEY in image specification SPEC. Value is nil
5694 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5695 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5698 image_spec_value (spec
, key
, found
)
5699 Lisp_Object spec
, key
;
5704 xassert (valid_image_p (spec
));
5706 for (tail
= XCDR (spec
);
5707 CONSP (tail
) && CONSP (XCDR (tail
));
5708 tail
= XCDR (XCDR (tail
)))
5710 if (EQ (XCAR (tail
), key
))
5714 return XCAR (XCDR (tail
));
5726 /***********************************************************************
5727 Image type independent image structures
5728 ***********************************************************************/
5730 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5731 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5734 /* Allocate and return a new image structure for image specification
5735 SPEC. SPEC has a hash value of HASH. */
5737 static struct image
*
5738 make_image (spec
, hash
)
5742 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5744 xassert (valid_image_p (spec
));
5745 bzero (img
, sizeof *img
);
5746 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5747 xassert (img
->type
!= NULL
);
5749 img
->data
.lisp_val
= Qnil
;
5750 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5756 /* Free image IMG which was used on frame F, including its resources. */
5765 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5767 /* Remove IMG from the hash table of its cache. */
5769 img
->prev
->next
= img
->next
;
5771 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5774 img
->next
->prev
= img
->prev
;
5776 c
->images
[img
->id
] = NULL
;
5778 /* Free resources, then free IMG. */
5779 img
->type
->free (f
, img
);
5785 /* Prepare image IMG for display on frame F. Must be called before
5786 drawing an image. */
5789 prepare_image_for_display (f
, img
)
5795 /* We're about to display IMG, so set its timestamp to `now'. */
5797 img
->timestamp
= EMACS_SECS (t
);
5799 /* If IMG doesn't have a pixmap yet, load it now, using the image
5800 type dependent loader function. */
5801 if (img
->pixmap
== 0 && !img
->load_failed_p
)
5802 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5807 /***********************************************************************
5808 Helper functions for X image types
5809 ***********************************************************************/
5811 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5812 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5814 Lisp_Object color_name
,
5815 unsigned long dflt
));
5817 /* Free X resources of image IMG which is used on frame F. */
5820 x_clear_image (f
, img
)
5827 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5834 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
5836 /* If display has an immutable color map, freeing colors is not
5837 necessary and some servers don't allow it. So don't do it. */
5838 if (class != StaticColor
5839 && class != StaticGray
5840 && class != TrueColor
)
5844 cmap
= DefaultColormapOfScreen (FRAME_X_DISPLAY_INFO (f
)->screen
);
5845 XFreeColors (FRAME_X_DISPLAY (f
), cmap
, img
->colors
,
5850 xfree (img
->colors
);
5857 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5858 cannot be allocated, use DFLT. Add a newly allocated color to
5859 IMG->colors, so that it can be freed again. Value is the pixel
5862 static unsigned long
5863 x_alloc_image_color (f
, img
, color_name
, dflt
)
5866 Lisp_Object color_name
;
5870 unsigned long result
;
5872 xassert (STRINGP (color_name
));
5874 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5876 /* This isn't called frequently so we get away with simply
5877 reallocating the color vector to the needed size, here. */
5880 (unsigned long *) xrealloc (img
->colors
,
5881 img
->ncolors
* sizeof *img
->colors
);
5882 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5883 result
= color
.pixel
;
5893 /***********************************************************************
5895 ***********************************************************************/
5897 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5900 /* Return a new, initialized image cache that is allocated from the
5901 heap. Call free_image_cache to free an image cache. */
5903 struct image_cache
*
5906 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5909 bzero (c
, sizeof *c
);
5911 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5912 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5913 c
->buckets
= (struct image
**) xmalloc (size
);
5914 bzero (c
->buckets
, size
);
5919 /* Free image cache of frame F. Be aware that X frames share images
5923 free_image_cache (f
)
5926 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5931 /* Cache should not be referenced by any frame when freed. */
5932 xassert (c
->refcount
== 0);
5934 for (i
= 0; i
< c
->used
; ++i
)
5935 free_image (f
, c
->images
[i
]);
5939 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5944 /* Clear image cache of frame F. FORCE_P non-zero means free all
5945 images. FORCE_P zero means clear only images that haven't been
5946 displayed for some time. Should be called from time to time to
5947 reduce the number of loaded images. If image-eviction-seconds is
5948 non-nil, this frees images in the cache which weren't displayed for
5949 at least that many seconds. */
5952 clear_image_cache (f
, force_p
)
5956 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5958 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5962 int i
, any_freed_p
= 0;
5965 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5967 for (i
= 0; i
< c
->used
; ++i
)
5969 struct image
*img
= c
->images
[i
];
5972 || (img
->timestamp
> old
)))
5974 free_image (f
, img
);
5979 /* We may be clearing the image cache because, for example,
5980 Emacs was iconified for a longer period of time. In that
5981 case, current matrices may still contain references to
5982 images freed above. So, clear these matrices. */
5985 clear_current_matrices (f
);
5986 ++windows_or_buffers_changed
;
5992 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5994 "Clear the image cache of FRAME.\n\
5995 FRAME nil or omitted means use the selected frame.\n\
5996 FRAME t means clear the image caches of all frames.")
6004 FOR_EACH_FRAME (tail
, frame
)
6005 if (FRAME_X_P (XFRAME (frame
)))
6006 clear_image_cache (XFRAME (frame
), 1);
6009 clear_image_cache (check_x_frame (frame
), 1);
6015 /* Return the id of image with Lisp specification SPEC on frame F.
6016 SPEC must be a valid Lisp image specification (see valid_image_p). */
6019 lookup_image (f
, spec
)
6023 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6027 struct gcpro gcpro1
;
6030 /* F must be a window-system frame, and SPEC must be a valid image
6032 xassert (FRAME_WINDOW_P (f
));
6033 xassert (valid_image_p (spec
));
6037 /* Look up SPEC in the hash table of the image cache. */
6038 hash
= sxhash (spec
, 0);
6039 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6041 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6042 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6045 /* If not found, create a new image and cache it. */
6048 img
= make_image (spec
, hash
);
6049 cache_image (f
, img
);
6050 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6051 xassert (!interrupt_input_blocked
);
6053 /* If we can't load the image, and we don't have a width and
6054 height, use some arbitrary width and height so that we can
6055 draw a rectangle for it. */
6056 if (img
->load_failed_p
)
6060 value
= image_spec_value (spec
, QCwidth
, NULL
);
6061 img
->width
= (INTEGERP (value
)
6062 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6063 value
= image_spec_value (spec
, QCheight
, NULL
);
6064 img
->height
= (INTEGERP (value
)
6065 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6069 /* Handle image type independent image attributes
6070 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
6071 Lisp_Object ascent
, margin
, relief
, algorithm
, heuristic_mask
;
6074 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6075 if (INTEGERP (ascent
))
6076 img
->ascent
= XFASTINT (ascent
);
6078 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6079 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6080 img
->margin
= XFASTINT (margin
);
6082 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6083 if (INTEGERP (relief
))
6085 img
->relief
= XINT (relief
);
6086 img
->margin
+= abs (img
->relief
);
6089 /* Should we apply a Laplace edge-detection algorithm? */
6090 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
6091 if (img
->pixmap
&& EQ (algorithm
, Qlaplace
))
6094 /* Should we built a mask heuristically? */
6095 heuristic_mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6096 if (img
->pixmap
&& !img
->mask
&& !NILP (heuristic_mask
))
6098 file
= image_spec_value (spec
, QCfile
, NULL
);
6099 x_build_heuristic_mask (f
, file
, img
, heuristic_mask
);
6104 /* We're using IMG, so set its timestamp to `now'. */
6105 EMACS_GET_TIME (now
);
6106 img
->timestamp
= EMACS_SECS (now
);
6110 /* Value is the image id. */
6115 /* Cache image IMG in the image cache of frame F. */
6118 cache_image (f
, img
)
6122 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6125 /* Find a free slot in c->images. */
6126 for (i
= 0; i
< c
->used
; ++i
)
6127 if (c
->images
[i
] == NULL
)
6130 /* If no free slot found, maybe enlarge c->images. */
6131 if (i
== c
->used
&& c
->used
== c
->size
)
6134 c
->images
= (struct image
**) xrealloc (c
->images
,
6135 c
->size
* sizeof *c
->images
);
6138 /* Add IMG to c->images, and assign IMG an id. */
6144 /* Add IMG to the cache's hash table. */
6145 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6146 img
->next
= c
->buckets
[i
];
6148 img
->next
->prev
= img
;
6150 c
->buckets
[i
] = img
;
6154 /* Call FN on every image in the image cache of frame F. Used to mark
6155 Lisp Objects in the image cache. */
6158 forall_images_in_image_cache (f
, fn
)
6160 void (*fn
) P_ ((struct image
*img
));
6162 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6164 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6168 for (i
= 0; i
< c
->used
; ++i
)
6177 /***********************************************************************
6179 ***********************************************************************/
6181 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, Lisp_Object
,
6182 int, int, int, XImage
**,
6184 static void x_destroy_x_image
P_ ((XImage
*));
6185 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6188 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6189 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6190 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6191 via xmalloc. Print error messages via image_error if an error
6192 occurs. FILE is the name of an image file being processed, for
6193 error messages. Value is non-zero if successful. */
6196 x_create_x_image_and_pixmap (f
, file
, width
, height
, depth
, ximg
, pixmap
)
6199 int width
, height
, depth
;
6203 Display
*display
= FRAME_X_DISPLAY (f
);
6204 Screen
*screen
= FRAME_X_SCREEN (f
);
6205 Window window
= FRAME_X_WINDOW (f
);
6207 xassert (interrupt_input_blocked
);
6210 depth
= DefaultDepthOfScreen (screen
);
6211 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6212 depth
, ZPixmap
, 0, NULL
, width
, height
,
6213 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6216 image_error ("Unable to allocate X image for %s", file
, Qnil
);
6220 /* Allocate image raster. */
6221 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6223 /* Allocate a pixmap of the same size. */
6224 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6227 x_destroy_x_image (*ximg
);
6229 image_error ("Unable to create pixmap for `%s'", file
, Qnil
);
6237 /* Destroy XImage XIMG. Free XIMG->data. */
6240 x_destroy_x_image (ximg
)
6243 xassert (interrupt_input_blocked
);
6248 XDestroyImage (ximg
);
6253 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6254 are width and height of both the image and pixmap. */
6257 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6264 xassert (interrupt_input_blocked
);
6265 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6266 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6267 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6272 /***********************************************************************
6274 ***********************************************************************/
6276 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6278 /* Find image file FILE. Look in data-directory, then
6279 x-bitmap-file-path. Value is the full name of the file found, or
6280 nil if not found. */
6283 x_find_image_file (file
)
6286 Lisp_Object file_found
, search_path
;
6287 struct gcpro gcpro1
, gcpro2
;
6291 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6292 GCPRO2 (file_found
, search_path
);
6294 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6295 fd
= openp (search_path
, file
, "", &file_found
, 0);
6308 /***********************************************************************
6310 ***********************************************************************/
6312 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6313 static int xbm_load_image_from_file
P_ ((struct frame
*f
, struct image
*img
,
6315 static int xbm_image_p
P_ ((Lisp_Object object
));
6316 static int xbm_read_bitmap_file_data
P_ ((char *, int *, int *,
6320 /* Indices of image specification fields in xbm_format, below. */
6322 enum xbm_keyword_index
6339 /* Vector of image_keyword structures describing the format
6340 of valid XBM image specifications. */
6342 static struct image_keyword xbm_format
[XBM_LAST
] =
6344 {":type", IMAGE_SYMBOL_VALUE
, 1},
6345 {":file", IMAGE_STRING_VALUE
, 0},
6346 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6347 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6348 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6349 {":foreground", IMAGE_STRING_VALUE
, 0},
6350 {":background", IMAGE_STRING_VALUE
, 0},
6351 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6352 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6353 {":relief", IMAGE_INTEGER_VALUE
, 0},
6354 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6355 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6358 /* Structure describing the image type XBM. */
6360 static struct image_type xbm_type
=
6369 /* Tokens returned from xbm_scan. */
6378 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6379 A valid specification is a list starting with the symbol `image'
6380 The rest of the list is a property list which must contain an
6383 If the specification specifies a file to load, it must contain
6384 an entry `:file FILENAME' where FILENAME is a string.
6386 If the specification is for a bitmap loaded from memory it must
6387 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6388 WIDTH and HEIGHT are integers > 0. DATA may be:
6390 1. a string large enough to hold the bitmap data, i.e. it must
6391 have a size >= (WIDTH + 7) / 8 * HEIGHT
6393 2. a bool-vector of size >= WIDTH * HEIGHT
6395 3. a vector of strings or bool-vectors, one for each line of the
6398 Both the file and data forms may contain the additional entries
6399 `:background COLOR' and `:foreground COLOR'. If not present,
6400 foreground and background of the frame on which the image is
6401 displayed, is used. */
6404 xbm_image_p (object
)
6407 struct image_keyword kw
[XBM_LAST
];
6409 bcopy (xbm_format
, kw
, sizeof kw
);
6410 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6413 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6415 if (kw
[XBM_FILE
].count
)
6417 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6425 /* Entries for `:width', `:height' and `:data' must be present. */
6426 if (!kw
[XBM_WIDTH
].count
6427 || !kw
[XBM_HEIGHT
].count
6428 || !kw
[XBM_DATA
].count
)
6431 data
= kw
[XBM_DATA
].value
;
6432 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6433 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6435 /* Check type of data, and width and height against contents of
6441 /* Number of elements of the vector must be >= height. */
6442 if (XVECTOR (data
)->size
< height
)
6445 /* Each string or bool-vector in data must be large enough
6446 for one line of the image. */
6447 for (i
= 0; i
< height
; ++i
)
6449 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6453 if (XSTRING (elt
)->size
6454 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6457 else if (BOOL_VECTOR_P (elt
))
6459 if (XBOOL_VECTOR (elt
)->size
< width
)
6466 else if (STRINGP (data
))
6468 if (XSTRING (data
)->size
6469 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6472 else if (BOOL_VECTOR_P (data
))
6474 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6481 /* Baseline must be a value between 0 and 100 (a percentage). */
6482 if (kw
[XBM_ASCENT
].count
6483 && XFASTINT (kw
[XBM_ASCENT
].value
) > 100)
6490 /* Scan a bitmap file. FP is the stream to read from. Value is
6491 either an enumerator from enum xbm_token, or a character for a
6492 single-character token, or 0 at end of file. If scanning an
6493 identifier, store the lexeme of the identifier in SVAL. If
6494 scanning a number, store its value in *IVAL. */
6497 xbm_scan (fp
, sval
, ival
)
6504 /* Skip white space. */
6505 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
6510 else if (isdigit (c
))
6512 int value
= 0, digit
;
6517 if (c
== 'x' || c
== 'X')
6519 while ((c
= fgetc (fp
)) != EOF
)
6523 else if (c
>= 'a' && c
<= 'f')
6524 digit
= c
- 'a' + 10;
6525 else if (c
>= 'A' && c
<= 'F')
6526 digit
= c
- 'A' + 10;
6529 value
= 16 * value
+ digit
;
6532 else if (isdigit (c
))
6535 while ((c
= fgetc (fp
)) != EOF
6537 value
= 8 * value
+ c
- '0';
6543 while ((c
= fgetc (fp
)) != EOF
6545 value
= 10 * value
+ c
- '0';
6553 else if (isalpha (c
) || c
== '_')
6556 while ((c
= fgetc (fp
)) != EOF
6557 && (isalnum (c
) || c
== '_'))
6569 /* Replacement for XReadBitmapFileData which isn't available under old
6570 X versions. FILE is the name of the bitmap file to read. Set
6571 *WIDTH and *HEIGHT to the width and height of the image. Return in
6572 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
6576 xbm_read_bitmap_file_data (file
, width
, height
, data
)
6578 int *width
, *height
;
6579 unsigned char **data
;
6582 char buffer
[BUFSIZ
];
6585 int bytes_per_line
, i
, nbytes
;
6591 LA1 = xbm_scan (fp, buffer, &value)
6593 #define expect(TOKEN) \
6594 if (LA1 != (TOKEN)) \
6599 #define expect_ident(IDENT) \
6600 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6605 fp
= fopen (file
, "r");
6609 *width
= *height
= -1;
6611 LA1
= xbm_scan (fp
, buffer
, &value
);
6613 /* Parse defines for width, height and hot-spots. */
6617 expect_ident ("define");
6618 expect (XBM_TK_IDENT
);
6620 if (LA1
== XBM_TK_NUMBER
);
6622 char *p
= strrchr (buffer
, '_');
6623 p
= p
? p
+ 1 : buffer
;
6624 if (strcmp (p
, "width") == 0)
6626 else if (strcmp (p
, "height") == 0)
6629 expect (XBM_TK_NUMBER
);
6632 if (*width
< 0 || *height
< 0)
6635 /* Parse bits. Must start with `static'. */
6636 expect_ident ("static");
6637 if (LA1
== XBM_TK_IDENT
)
6639 if (strcmp (buffer
, "unsigned") == 0)
6642 expect_ident ("char");
6644 else if (strcmp (buffer
, "short") == 0)
6648 if (*width
% 16 && *width
% 16 < 9)
6651 else if (strcmp (buffer
, "char") == 0)
6659 expect (XBM_TK_IDENT
);
6665 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6666 nbytes
= bytes_per_line
* *height
;
6667 p
= *data
= (char *) xmalloc (nbytes
);
6672 for (i
= 0; i
< nbytes
; i
+= 2)
6675 expect (XBM_TK_NUMBER
);
6678 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6681 if (LA1
== ',' || LA1
== '}')
6689 for (i
= 0; i
< nbytes
; ++i
)
6692 expect (XBM_TK_NUMBER
);
6696 if (LA1
== ',' || LA1
== '}')
6722 /* Load XBM image IMG which will be displayed on frame F from file
6723 SPECIFIED_FILE. Value is non-zero if successful. */
6726 xbm_load_image_from_file (f
, img
, specified_file
)
6729 Lisp_Object specified_file
;
6732 unsigned char *data
;
6735 struct gcpro gcpro1
;
6737 xassert (STRINGP (specified_file
));
6741 file
= x_find_image_file (specified_file
);
6742 if (!STRINGP (file
))
6744 image_error ("Cannot find image file %s", specified_file
, Qnil
);
6749 rc
= xbm_read_bitmap_file_data (XSTRING (file
)->data
, &img
->width
,
6750 &img
->height
, &data
);
6753 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6754 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6755 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6758 xassert (img
->width
> 0 && img
->height
> 0);
6760 /* Get foreground and background colors, maybe allocate colors. */
6761 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6763 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6765 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6767 background
= x_alloc_image_color (f
, img
, value
, background
);
6771 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6774 img
->width
, img
->height
,
6775 foreground
, background
,
6779 if (img
->pixmap
== 0)
6781 x_clear_image (f
, img
);
6782 image_error ("Unable to create X pixmap for `%s'", file
, Qnil
);
6790 image_error ("Error loading XBM image %s", img
->spec
, Qnil
);
6797 /* Fill image IMG which is used on frame F with pixmap data. Value is
6798 non-zero if successful. */
6806 Lisp_Object file_name
;
6808 xassert (xbm_image_p (img
->spec
));
6810 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6811 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6812 if (STRINGP (file_name
))
6813 success_p
= xbm_load_image_from_file (f
, img
, file_name
);
6816 struct image_keyword fmt
[XBM_LAST
];
6819 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6820 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6824 /* Parse the list specification. */
6825 bcopy (xbm_format
, fmt
, sizeof fmt
);
6826 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6829 /* Get specified width, and height. */
6830 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6831 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6832 xassert (img
->width
> 0 && img
->height
> 0);
6836 if (fmt
[XBM_ASCENT
].count
)
6837 img
->ascent
= XFASTINT (fmt
[XBM_ASCENT
].value
);
6839 /* Get foreground and background colors, maybe allocate colors. */
6840 if (fmt
[XBM_FOREGROUND
].count
)
6841 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6843 if (fmt
[XBM_BACKGROUND
].count
)
6844 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6847 /* Set bits to the bitmap image data. */
6848 data
= fmt
[XBM_DATA
].value
;
6853 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6855 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6856 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6858 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6860 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6862 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6865 else if (STRINGP (data
))
6866 bits
= XSTRING (data
)->data
;
6868 bits
= XBOOL_VECTOR (data
)->data
;
6870 /* Create the pixmap. */
6871 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6873 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6876 img
->width
, img
->height
,
6877 foreground
, background
,
6883 image_error ("Unable to create pixmap for XBM image", Qnil
, Qnil
);
6884 x_clear_image (f
, img
);
6895 /***********************************************************************
6897 ***********************************************************************/
6901 static int xpm_image_p
P_ ((Lisp_Object object
));
6902 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6903 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6905 #include "X11/xpm.h"
6907 /* The symbol `xpm' identifying XPM-format images. */
6911 /* Indices of image specification fields in xpm_format, below. */
6913 enum xpm_keyword_index
6927 /* Vector of image_keyword structures describing the format
6928 of valid XPM image specifications. */
6930 static struct image_keyword xpm_format
[XPM_LAST
] =
6932 {":type", IMAGE_SYMBOL_VALUE
, 1},
6933 {":file", IMAGE_STRING_VALUE
, 0},
6934 {":data", IMAGE_STRING_VALUE
, 0},
6935 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6936 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6937 {":relief", IMAGE_INTEGER_VALUE
, 0},
6938 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6939 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6940 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6943 /* Structure describing the image type XBM. */
6945 static struct image_type xpm_type
=
6955 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6956 for XPM images. Such a list must consist of conses whose car and
6960 xpm_valid_color_symbols_p (color_symbols
)
6961 Lisp_Object color_symbols
;
6963 while (CONSP (color_symbols
))
6965 Lisp_Object sym
= XCAR (color_symbols
);
6967 || !STRINGP (XCAR (sym
))
6968 || !STRINGP (XCDR (sym
)))
6970 color_symbols
= XCDR (color_symbols
);
6973 return NILP (color_symbols
);
6977 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6980 xpm_image_p (object
)
6983 struct image_keyword fmt
[XPM_LAST
];
6984 bcopy (xpm_format
, fmt
, sizeof fmt
);
6985 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
6986 /* Either `:file' or `:data' must be present. */
6987 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
6988 /* Either no `:color-symbols' or it's a list of conses
6989 whose car and cdr are strings. */
6990 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
6991 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
6992 && (fmt
[XPM_ASCENT
].count
== 0
6993 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
6997 /* Load image IMG which will be displayed on frame F. Value is
6998 non-zero if successful. */
7006 XpmAttributes attrs
;
7007 Lisp_Object specified_file
, color_symbols
;
7009 /* Configure the XPM lib. Use the visual of frame F. Allocate
7010 close colors. Return colors allocated. */
7011 bzero (&attrs
, sizeof attrs
);
7012 attrs
.visual
= FRAME_X_DISPLAY_INFO (f
)->visual
;
7013 attrs
.valuemask
|= XpmVisual
;
7014 attrs
.valuemask
|= XpmReturnAllocPixels
;
7015 #ifdef XpmAllocCloseColors
7016 attrs
.alloc_close_colors
= 1;
7017 attrs
.valuemask
|= XpmAllocCloseColors
;
7019 attrs
.closeness
= 600;
7020 attrs
.valuemask
|= XpmCloseness
;
7023 /* If image specification contains symbolic color definitions, add
7024 these to `attrs'. */
7025 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7026 if (CONSP (color_symbols
))
7029 XpmColorSymbol
*xpm_syms
;
7032 attrs
.valuemask
|= XpmColorSymbols
;
7034 /* Count number of symbols. */
7035 attrs
.numsymbols
= 0;
7036 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7039 /* Allocate an XpmColorSymbol array. */
7040 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7041 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7042 bzero (xpm_syms
, size
);
7043 attrs
.colorsymbols
= xpm_syms
;
7045 /* Fill the color symbol array. */
7046 for (tail
= color_symbols
, i
= 0;
7048 ++i
, tail
= XCDR (tail
))
7050 Lisp_Object name
= XCAR (XCAR (tail
));
7051 Lisp_Object color
= XCDR (XCAR (tail
));
7052 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7053 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7054 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7055 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7059 /* Create a pixmap for the image, either from a file, or from a
7060 string buffer containing data in the same format as an XPM file. */
7062 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7063 if (STRINGP (specified_file
))
7065 Lisp_Object file
= x_find_image_file (specified_file
);
7066 if (!STRINGP (file
))
7068 image_error ("Cannot find image file %s", specified_file
, Qnil
);
7073 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7074 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7079 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7080 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7081 XSTRING (buffer
)->data
,
7082 &img
->pixmap
, &img
->mask
,
7087 if (rc
== XpmSuccess
)
7089 /* Remember allocated colors. */
7090 img
->ncolors
= attrs
.nalloc_pixels
;
7091 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7092 * sizeof *img
->colors
);
7093 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7094 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7096 img
->width
= attrs
.width
;
7097 img
->height
= attrs
.height
;
7098 xassert (img
->width
> 0 && img
->height
> 0);
7100 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7102 XpmFreeAttributes (&attrs
);
7110 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7113 case XpmFileInvalid
:
7114 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7118 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7121 case XpmColorFailed
:
7122 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7126 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7131 return rc
== XpmSuccess
;
7134 #endif /* HAVE_XPM != 0 */
7137 /***********************************************************************
7139 ***********************************************************************/
7141 /* An entry in the color table mapping an RGB color to a pixel color. */
7146 unsigned long pixel
;
7148 /* Next in color table collision list. */
7149 struct ct_color
*next
;
7152 /* The bucket vector size to use. Must be prime. */
7156 /* Value is a hash of the RGB color given by R, G, and B. */
7158 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7160 /* The color hash table. */
7162 struct ct_color
**ct_table
;
7164 /* Number of entries in the color table. */
7166 int ct_colors_allocated
;
7168 /* Function prototypes. */
7170 static void init_color_table
P_ ((void));
7171 static void free_color_table
P_ ((void));
7172 static unsigned long *colors_in_color_table
P_ ((int *n
));
7173 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
7174 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
7177 /* Initialize the color table. */
7182 int size
= CT_SIZE
* sizeof (*ct_table
);
7183 ct_table
= (struct ct_color
**) xmalloc (size
);
7184 bzero (ct_table
, size
);
7185 ct_colors_allocated
= 0;
7189 /* Free memory associated with the color table. */
7195 struct ct_color
*p
, *next
;
7197 for (i
= 0; i
< CT_SIZE
; ++i
)
7198 for (p
= ct_table
[i
]; p
; p
= next
)
7209 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7210 entry for that color already is in the color table, return the
7211 pixel color of that entry. Otherwise, allocate a new color for R,
7212 G, B, and make an entry in the color table. */
7214 static unsigned long
7215 lookup_rgb_color (f
, r
, g
, b
)
7219 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7220 int i
= hash
% CT_SIZE
;
7223 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7224 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7238 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7239 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7244 ++ct_colors_allocated
;
7246 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7250 p
->pixel
= color
.pixel
;
7251 p
->next
= ct_table
[i
];
7255 return FRAME_FOREGROUND_PIXEL (f
);
7262 /* Look up pixel color PIXEL which is used on frame F in the color
7263 table. If not already present, allocate it. Value is PIXEL. */
7265 static unsigned long
7266 lookup_pixel_color (f
, pixel
)
7268 unsigned long pixel
;
7270 int i
= pixel
% CT_SIZE
;
7273 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7274 if (p
->pixel
== pixel
)
7285 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7286 color
.pixel
= pixel
;
7287 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
7288 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7293 ++ct_colors_allocated
;
7295 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7300 p
->next
= ct_table
[i
];
7304 return FRAME_FOREGROUND_PIXEL (f
);
7311 /* Value is a vector of all pixel colors contained in the color table,
7312 allocated via xmalloc. Set *N to the number of colors. */
7314 static unsigned long *
7315 colors_in_color_table (n
)
7320 unsigned long *colors
;
7322 if (ct_colors_allocated
== 0)
7329 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7331 *n
= ct_colors_allocated
;
7333 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7334 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7335 colors
[j
++] = p
->pixel
;
7343 /***********************************************************************
7345 ***********************************************************************/
7347 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7348 int, XImage
*, int));
7349 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7350 XColor
*, int, XImage
*, int));
7353 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
7354 frame we operate on, CMAP is the color-map in effect, and WIDTH is
7355 the width of one row in the image. */
7358 x_laplace_read_row (f
, cmap
, colors
, width
, ximg
, y
)
7368 for (x
= 0; x
< width
; ++x
)
7369 colors
[x
].pixel
= XGetPixel (ximg
, x
, y
);
7371 XQueryColors (FRAME_X_DISPLAY (f
), cmap
, colors
, width
);
7375 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
7376 containing the pixel colors to write. F is the frame we are
7380 x_laplace_write_row (f
, pixels
, width
, ximg
, y
)
7389 for (x
= 0; x
< width
; ++x
)
7390 XPutPixel (ximg
, x
, y
, pixels
[x
]);
7394 /* Transform image IMG which is used on frame F with a Laplace
7395 edge-detection algorithm. The result is an image that can be used
7396 to draw disabled buttons, for example. */
7403 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7404 XImage
*ximg
, *oimg
;
7410 int in_y
, out_y
, rc
;
7415 /* Get the X image IMG->pixmap. */
7416 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7417 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7419 /* Allocate 3 input rows, and one output row of colors. */
7420 for (i
= 0; i
< 3; ++i
)
7421 in
[i
] = (XColor
*) alloca (img
->width
* sizeof (XColor
));
7422 out
= (long *) alloca (img
->width
* sizeof (long));
7424 /* Create an X image for output. */
7425 rc
= x_create_x_image_and_pixmap (f
, Qnil
, img
->width
, img
->height
, 0,
7428 /* Fill first two rows. */
7429 x_laplace_read_row (f
, cmap
, in
[0], img
->width
, ximg
, 0);
7430 x_laplace_read_row (f
, cmap
, in
[1], img
->width
, ximg
, 1);
7433 /* Write first row, all zeros. */
7434 init_color_table ();
7435 pixel
= lookup_rgb_color (f
, 0, 0, 0);
7436 for (x
= 0; x
< img
->width
; ++x
)
7438 x_laplace_write_row (f
, out
, img
->width
, oimg
, 0);
7441 for (y
= 2; y
< img
->height
; ++y
)
7444 int rowb
= (y
+ 2) % 3;
7446 x_laplace_read_row (f
, cmap
, in
[rowa
], img
->width
, ximg
, in_y
++);
7448 for (x
= 0; x
< img
->width
- 2; ++x
)
7450 int r
= in
[rowa
][x
].red
+ mv2
- in
[rowb
][x
+ 2].red
;
7451 int g
= in
[rowa
][x
].green
+ mv2
- in
[rowb
][x
+ 2].green
;
7452 int b
= in
[rowa
][x
].blue
+ mv2
- in
[rowb
][x
+ 2].blue
;
7454 out
[x
+ 1] = lookup_rgb_color (f
, r
& 0xffff, g
& 0xffff,
7458 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
++);
7461 /* Write last line, all zeros. */
7462 for (x
= 0; x
< img
->width
; ++x
)
7464 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
);
7466 /* Free the input image, and free resources of IMG. */
7467 XDestroyImage (ximg
);
7468 x_clear_image (f
, img
);
7470 /* Put the output image into pixmap, and destroy it. */
7471 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7472 x_destroy_x_image (oimg
);
7474 /* Remember new pixmap and colors in IMG. */
7475 img
->pixmap
= pixmap
;
7476 img
->colors
= colors_in_color_table (&img
->ncolors
);
7477 free_color_table ();
7483 /* Build a mask for image IMG which is used on frame F. FILE is the
7484 name of an image file, for error messages. HOW determines how to
7485 determine the background color of IMG. If it is a list '(R G B)',
7486 with R, G, and B being integers >= 0, take that as the color of the
7487 background. Otherwise, determine the background color of IMG
7488 heuristically. Value is non-zero if successful. */
7491 x_build_heuristic_mask (f
, file
, img
, how
)
7497 Display
*dpy
= FRAME_X_DISPLAY (f
);
7498 XImage
*ximg
, *mask_img
;
7499 int x
, y
, rc
, look_at_corners_p
;
7504 /* Create an image and pixmap serving as mask. */
7505 rc
= x_create_x_image_and_pixmap (f
, file
, img
->width
, img
->height
, 1,
7506 &mask_img
, &img
->mask
);
7513 /* Get the X image of IMG->pixmap. */
7514 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7517 /* Determine the background color of ximg. If HOW is `(R G B)'
7518 take that as color. Otherwise, try to determine the color
7520 look_at_corners_p
= 1;
7528 && NATNUMP (XCAR (how
)))
7530 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7534 if (i
== 3 && NILP (how
))
7536 char color_name
[30];
7537 XColor exact
, color
;
7540 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7542 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7543 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7546 look_at_corners_p
= 0;
7551 if (look_at_corners_p
)
7553 unsigned long corners
[4];
7556 /* Get the colors at the corners of ximg. */
7557 corners
[0] = XGetPixel (ximg
, 0, 0);
7558 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7559 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7560 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7562 /* Choose the most frequently found color as background. */
7563 for (i
= best_count
= 0; i
< 4; ++i
)
7567 for (j
= n
= 0; j
< 4; ++j
)
7568 if (corners
[i
] == corners
[j
])
7572 bg
= corners
[i
], best_count
= n
;
7576 /* Set all bits in mask_img to 1 whose color in ximg is different
7577 from the background color bg. */
7578 for (y
= 0; y
< img
->height
; ++y
)
7579 for (x
= 0; x
< img
->width
; ++x
)
7580 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7582 /* Put mask_img into img->mask. */
7583 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7584 x_destroy_x_image (mask_img
);
7585 XDestroyImage (ximg
);
7593 /***********************************************************************
7594 PBM (mono, gray, color)
7595 ***********************************************************************/
7597 static int pbm_image_p
P_ ((Lisp_Object object
));
7598 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7599 static int pbm_scan_number
P_ ((FILE *fp
));
7601 /* The symbol `pbm' identifying images of this type. */
7605 /* Indices of image specification fields in gs_format, below. */
7607 enum pbm_keyword_index
7619 /* Vector of image_keyword structures describing the format
7620 of valid user-defined image specifications. */
7622 static struct image_keyword pbm_format
[PBM_LAST
] =
7624 {":type", IMAGE_SYMBOL_VALUE
, 1},
7625 {":file", IMAGE_STRING_VALUE
, 1},
7626 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7627 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7628 {":relief", IMAGE_INTEGER_VALUE
, 0},
7629 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7630 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7633 /* Structure describing the image type `pbm'. */
7635 static struct image_type pbm_type
=
7645 /* Return non-zero if OBJECT is a valid PBM image specification. */
7648 pbm_image_p (object
)
7651 struct image_keyword fmt
[PBM_LAST
];
7653 bcopy (pbm_format
, fmt
, sizeof fmt
);
7655 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
)
7656 || (fmt
[PBM_ASCENT
].count
7657 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
7663 /* Scan a decimal number from PBM input file FP and return it. Value
7664 is -1 at end of file or if an error occurs. */
7667 pbm_scan_number (fp
)
7674 /* Skip white-space. */
7675 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
7680 /* Skip comment to end of line. */
7681 while ((c
= fgetc (fp
)) != EOF
&& c
!= '\n')
7684 else if (isdigit (c
))
7686 /* Read decimal number. */
7688 while ((c
= fgetc (fp
)) != EOF
&& isdigit (c
))
7689 val
= 10 * val
+ c
- '0';
7700 /* Load PBM image IMG for use on frame F. */
7710 int width
, height
, max_color_idx
= 0;
7712 Lisp_Object file
, specified_file
;
7713 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
7714 struct gcpro gcpro1
;
7716 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7717 file
= x_find_image_file (specified_file
);
7719 if (!STRINGP (file
))
7721 image_error ("Cannot find image file %s", specified_file
, Qnil
);
7726 fp
= fopen (XSTRING (file
)->data
, "r");
7733 /* Read first two characters. */
7734 if (fread (magic
, sizeof *magic
, 2, fp
) != 2)
7737 image_error ("Not a PBM image file: %s", file
, Qnil
);
7745 image_error ("Not a PBM image file: %s", file
, Qnil
);
7753 raw_p
= 0, type
= PBM_MONO
;
7757 raw_p
= 0, type
= PBM_GRAY
;
7761 raw_p
= 0, type
= PBM_COLOR
;
7765 raw_p
= 1, type
= PBM_MONO
;
7769 raw_p
= 1, type
= PBM_GRAY
;
7773 raw_p
= 1, type
= PBM_COLOR
;
7778 image_error ("Not a PBM image file: %s", file
, Qnil
);
7783 /* Read width, height, maximum color-component. Characters
7784 starting with `#' up to the end of a line are ignored. */
7785 width
= pbm_scan_number (fp
);
7786 height
= pbm_scan_number (fp
);
7788 if (type
!= PBM_MONO
)
7790 max_color_idx
= pbm_scan_number (fp
);
7791 if (raw_p
&& max_color_idx
> 255)
7792 max_color_idx
= 255;
7795 if (width
< 0 || height
< 0
7796 || (type
!= PBM_MONO
&& max_color_idx
< 0))
7804 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0,
7805 &ximg
, &img
->pixmap
))
7813 /* Initialize the color hash table. */
7814 init_color_table ();
7816 if (type
== PBM_MONO
)
7820 for (y
= 0; y
< height
; ++y
)
7821 for (x
= 0; x
< width
; ++x
)
7831 g
= pbm_scan_number (fp
);
7833 XPutPixel (ximg
, x
, y
, (g
7834 ? FRAME_FOREGROUND_PIXEL (f
)
7835 : FRAME_BACKGROUND_PIXEL (f
)));
7840 for (y
= 0; y
< height
; ++y
)
7841 for (x
= 0; x
< width
; ++x
)
7845 if (type
== PBM_GRAY
)
7846 r
= g
= b
= raw_p
? fgetc (fp
) : pbm_scan_number (fp
);
7855 r
= pbm_scan_number (fp
);
7856 g
= pbm_scan_number (fp
);
7857 b
= pbm_scan_number (fp
);
7860 if (r
< 0 || g
< 0 || b
< 0)
7865 XDestroyImage (ximg
);
7867 image_error ("Invalid pixel value in file `%s'",
7873 /* RGB values are now in the range 0..max_color_idx.
7874 Scale this to the range 0..0xffff supported by X. */
7875 r
= (double) r
* 65535 / max_color_idx
;
7876 g
= (double) g
* 65535 / max_color_idx
;
7877 b
= (double) b
* 65535 / max_color_idx
;
7878 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7884 /* Store in IMG->colors the colors allocated for the image, and
7885 free the color table. */
7886 img
->colors
= colors_in_color_table (&img
->ncolors
);
7887 free_color_table ();
7889 /* Put the image into a pixmap. */
7890 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7891 x_destroy_x_image (ximg
);
7895 img
->height
= height
;
7903 /***********************************************************************
7905 ***********************************************************************/
7911 /* Function prototypes. */
7913 static int png_image_p
P_ ((Lisp_Object object
));
7914 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
7916 /* The symbol `png' identifying images of this type. */
7920 /* Indices of image specification fields in png_format, below. */
7922 enum png_keyword_index
7934 /* Vector of image_keyword structures describing the format
7935 of valid user-defined image specifications. */
7937 static struct image_keyword png_format
[PNG_LAST
] =
7939 {":type", IMAGE_SYMBOL_VALUE
, 1},
7940 {":file", IMAGE_STRING_VALUE
, 1},
7941 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7942 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7943 {":relief", IMAGE_INTEGER_VALUE
, 0},
7944 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7945 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7948 /* Structure describing the image type `png'. */
7950 static struct image_type png_type
=
7960 /* Return non-zero if OBJECT is a valid PNG image specification. */
7963 png_image_p (object
)
7966 struct image_keyword fmt
[PNG_LAST
];
7967 bcopy (png_format
, fmt
, sizeof fmt
);
7969 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
)
7970 || (fmt
[PNG_ASCENT
].count
7971 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
7977 /* Error and warning handlers installed when the PNG library
7981 my_png_error (png_ptr
, msg
)
7982 png_struct
*png_ptr
;
7985 xassert (png_ptr
!= NULL
);
7986 image_error ("PNG error: %s", build_string (msg
), Qnil
);
7987 longjmp (png_ptr
->jmpbuf
, 1);
7992 my_png_warning (png_ptr
, msg
)
7993 png_struct
*png_ptr
;
7996 xassert (png_ptr
!= NULL
);
7997 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8001 /* Load PNG image IMG for use on frame F. Value is non-zero if
8009 Lisp_Object file
, specified_file
;
8011 XImage
*ximg
, *mask_img
= NULL
;
8012 struct gcpro gcpro1
;
8013 png_struct
*png_ptr
= NULL
;
8014 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8017 png_byte
*pixels
= NULL
;
8018 png_byte
**rows
= NULL
;
8019 png_uint_32 width
, height
;
8020 int bit_depth
, color_type
, interlace_type
;
8022 png_uint_32 row_bytes
;
8025 double screen_gamma
, image_gamma
;
8028 /* Find out what file to load. */
8029 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8030 file
= x_find_image_file (specified_file
);
8032 if (!STRINGP (file
))
8034 image_error ("Cannot find image file %s", specified_file
, Qnil
);
8039 /* Open the image file. */
8040 fp
= fopen (XSTRING (file
)->data
, "rb");
8043 image_error ("Cannot open image file %s", file
, Qnil
);
8049 /* Check PNG signature. */
8050 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8051 || !png_check_sig (sig
, sizeof sig
))
8053 image_error ("Not a PNG file: %s", file
, Qnil
);
8059 /* Initialize read and info structs for PNG lib. */
8060 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8061 my_png_error
, my_png_warning
);
8069 info_ptr
= png_create_info_struct (png_ptr
);
8072 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8078 end_info
= png_create_info_struct (png_ptr
);
8081 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8087 /* Set error jump-back. We come back here when the PNG library
8088 detects an error. */
8089 if (setjmp (png_ptr
->jmpbuf
))
8093 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8102 /* Read image info. */
8103 png_init_io (png_ptr
, fp
);
8104 png_set_sig_bytes (png_ptr
, sizeof sig
);
8105 png_read_info (png_ptr
, info_ptr
);
8106 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8107 &interlace_type
, NULL
, NULL
);
8109 /* If image contains simply transparency data, we prefer to
8110 construct a clipping mask. */
8111 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8116 /* This function is easier to write if we only have to handle
8117 one data format: RGB or RGBA with 8 bits per channel. Let's
8118 transform other formats into that format. */
8120 /* Strip more than 8 bits per channel. */
8121 if (bit_depth
== 16)
8122 png_set_strip_16 (png_ptr
);
8124 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8126 png_set_expand (png_ptr
);
8128 /* Convert grayscale images to RGB. */
8129 if (color_type
== PNG_COLOR_TYPE_GRAY
8130 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8131 png_set_gray_to_rgb (png_ptr
);
8133 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8134 gamma_str
= getenv ("SCREEN_GAMMA");
8135 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8137 /* Tell the PNG lib to handle gamma correction for us. */
8139 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8140 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8141 /* There is a special chunk in the image specifying the gamma. */
8142 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8145 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8146 /* Image contains gamma information. */
8147 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8149 /* Use a default of 0.5 for the image gamma. */
8150 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8152 /* Handle alpha channel by combining the image with a background
8153 color. Do this only if a real alpha channel is supplied. For
8154 simple transparency, we prefer a clipping mask. */
8157 png_color_16
*image_background
;
8159 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8160 /* Image contains a background color with which to
8161 combine the image. */
8162 png_set_background (png_ptr
, image_background
,
8163 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8166 /* Image does not contain a background color with which
8167 to combine the image data via an alpha channel. Use
8168 the frame's background instead. */
8171 png_color_16 frame_background
;
8174 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
8175 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8176 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
8179 bzero (&frame_background
, sizeof frame_background
);
8180 frame_background
.red
= color
.red
;
8181 frame_background
.green
= color
.green
;
8182 frame_background
.blue
= color
.blue
;
8184 png_set_background (png_ptr
, &frame_background
,
8185 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8189 /* Update info structure. */
8190 png_read_update_info (png_ptr
, info_ptr
);
8192 /* Get number of channels. Valid values are 1 for grayscale images
8193 and images with a palette, 2 for grayscale images with transparency
8194 information (alpha channel), 3 for RGB images, and 4 for RGB
8195 images with alpha channel, i.e. RGBA. If conversions above were
8196 sufficient we should only have 3 or 4 channels here. */
8197 channels
= png_get_channels (png_ptr
, info_ptr
);
8198 xassert (channels
== 3 || channels
== 4);
8200 /* Number of bytes needed for one row of the image. */
8201 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8203 /* Allocate memory for the image. */
8204 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8205 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8206 for (i
= 0; i
< height
; ++i
)
8207 rows
[i
] = pixels
+ i
* row_bytes
;
8209 /* Read the entire image. */
8210 png_read_image (png_ptr
, rows
);
8211 png_read_end (png_ptr
, info_ptr
);
8217 /* Create the X image and pixmap. */
8218 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8225 /* Create an image and pixmap serving as mask if the PNG image
8226 contains an alpha channel. */
8229 && !x_create_x_image_and_pixmap (f
, file
, width
, height
, 1,
8230 &mask_img
, &img
->mask
))
8232 x_destroy_x_image (ximg
);
8233 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8239 /* Fill the X image and mask from PNG data. */
8240 init_color_table ();
8242 for (y
= 0; y
< height
; ++y
)
8244 png_byte
*p
= rows
[y
];
8246 for (x
= 0; x
< width
; ++x
)
8253 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8255 /* An alpha channel, aka mask channel, associates variable
8256 transparency with an image. Where other image formats
8257 support binary transparency---fully transparent or fully
8258 opaque---PNG allows up to 254 levels of partial transparency.
8259 The PNG library implements partial transparency by combining
8260 the image with a specified background color.
8262 I'm not sure how to handle this here nicely: because the
8263 background on which the image is displayed may change, for
8264 real alpha channel support, it would be necessary to create
8265 a new image for each possible background.
8267 What I'm doing now is that a mask is created if we have
8268 boolean transparency information. Otherwise I'm using
8269 the frame's background color to combine the image with. */
8274 XPutPixel (mask_img
, x
, y
, *p
> 0);
8280 /* Remember colors allocated for this image. */
8281 img
->colors
= colors_in_color_table (&img
->ncolors
);
8282 free_color_table ();
8285 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8290 img
->height
= height
;
8292 /* Put the image into the pixmap, then free the X image and its buffer. */
8293 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8294 x_destroy_x_image (ximg
);
8296 /* Same for the mask. */
8299 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8300 x_destroy_x_image (mask_img
);
8308 #endif /* HAVE_PNG != 0 */
8312 /***********************************************************************
8314 ***********************************************************************/
8318 /* Work around a warning about HAVE_STDLIB_H being redefined in
8320 #ifdef HAVE_STDLIB_H
8321 #define HAVE_STDLIB_H_1
8322 #undef HAVE_STDLIB_H
8323 #endif /* HAVE_STLIB_H */
8325 #include <jpeglib.h>
8329 #ifdef HAVE_STLIB_H_1
8330 #define HAVE_STDLIB_H 1
8333 static int jpeg_image_p
P_ ((Lisp_Object object
));
8334 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8336 /* The symbol `jpeg' identifying images of this type. */
8340 /* Indices of image specification fields in gs_format, below. */
8342 enum jpeg_keyword_index
8350 JPEG_HEURISTIC_MASK
,
8354 /* Vector of image_keyword structures describing the format
8355 of valid user-defined image specifications. */
8357 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8359 {":type", IMAGE_SYMBOL_VALUE
, 1},
8360 {":file", IMAGE_STRING_VALUE
, 1},
8361 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8362 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8363 {":relief", IMAGE_INTEGER_VALUE
, 0},
8364 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8365 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8368 /* Structure describing the image type `jpeg'. */
8370 static struct image_type jpeg_type
=
8380 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8383 jpeg_image_p (object
)
8386 struct image_keyword fmt
[JPEG_LAST
];
8388 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8390 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
)
8391 || (fmt
[JPEG_ASCENT
].count
8392 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
8397 struct my_jpeg_error_mgr
8399 struct jpeg_error_mgr pub
;
8400 jmp_buf setjmp_buffer
;
8404 my_error_exit (cinfo
)
8407 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8408 longjmp (mgr
->setjmp_buffer
, 1);
8411 /* Load image IMG for use on frame F. Patterned after example.c
8412 from the JPEG lib. */
8419 struct jpeg_decompress_struct cinfo
;
8420 struct my_jpeg_error_mgr mgr
;
8421 Lisp_Object file
, specified_file
;
8424 int row_stride
, x
, y
;
8425 XImage
*ximg
= NULL
;
8427 unsigned long *colors
;
8429 struct gcpro gcpro1
;
8431 /* Open the JPEG file. */
8432 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8433 file
= x_find_image_file (specified_file
);
8435 if (!STRINGP (file
))
8437 image_error ("Cannot find image file %s", specified_file
, Qnil
);
8442 fp
= fopen (XSTRING (file
)->data
, "r");
8445 image_error ("Cannot open `%s'", file
, Qnil
);
8450 /* Customize libjpeg's error handling to call my_error_exit
8451 when an error is detected. This function will perform
8453 mgr
.pub
.error_exit
= my_error_exit
;
8454 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8456 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8460 /* Called from my_error_exit. Display a JPEG error. */
8461 char buffer
[JMSG_LENGTH_MAX
];
8462 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8463 image_error ("Error reading JPEG file `%s': %s", file
,
8464 build_string (buffer
));
8467 /* Close the input file and destroy the JPEG object. */
8469 jpeg_destroy_decompress (&cinfo
);
8473 /* If we already have an XImage, free that. */
8474 x_destroy_x_image (ximg
);
8476 /* Free pixmap and colors. */
8477 x_clear_image (f
, img
);
8484 /* Create the JPEG decompression object. Let it read from fp.
8485 Read the JPEG image header. */
8486 jpeg_create_decompress (&cinfo
);
8487 jpeg_stdio_src (&cinfo
, fp
);
8488 jpeg_read_header (&cinfo
, TRUE
);
8490 /* Customize decompression so that color quantization will be used.
8491 Start decompression. */
8492 cinfo
.quantize_colors
= TRUE
;
8493 jpeg_start_decompress (&cinfo
);
8494 width
= img
->width
= cinfo
.output_width
;
8495 height
= img
->height
= cinfo
.output_height
;
8499 /* Create X image and pixmap. */
8500 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8504 longjmp (mgr
.setjmp_buffer
, 2);
8507 /* Allocate colors. When color quantization is used,
8508 cinfo.actual_number_of_colors has been set with the number of
8509 colors generated, and cinfo.colormap is a two-dimensional array
8510 of color indices in the range 0..cinfo.actual_number_of_colors.
8511 No more than 255 colors will be generated. */
8515 if (cinfo
.out_color_components
> 2)
8516 ir
= 0, ig
= 1, ib
= 2;
8517 else if (cinfo
.out_color_components
> 1)
8518 ir
= 0, ig
= 1, ib
= 0;
8520 ir
= 0, ig
= 0, ib
= 0;
8522 /* Use the color table mechanism because it handles colors that
8523 cannot be allocated nicely. Such colors will be replaced with
8524 a default color, and we don't have to care about which colors
8525 can be freed safely, and which can't. */
8526 init_color_table ();
8527 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
8530 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
8532 /* Multiply RGB values with 255 because X expects RGB values
8533 in the range 0..0xffff. */
8534 int r
= cinfo
.colormap
[ir
][i
] << 8;
8535 int g
= cinfo
.colormap
[ig
][i
] << 8;
8536 int b
= cinfo
.colormap
[ib
][i
] << 8;
8537 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8540 /* Remember those colors actually allocated. */
8541 img
->colors
= colors_in_color_table (&img
->ncolors
);
8542 free_color_table ();
8546 row_stride
= width
* cinfo
.output_components
;
8547 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
8549 for (y
= 0; y
< height
; ++y
)
8551 jpeg_read_scanlines (&cinfo
, buffer
, 1);
8552 for (x
= 0; x
< cinfo
.output_width
; ++x
)
8553 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
8557 jpeg_finish_decompress (&cinfo
);
8558 jpeg_destroy_decompress (&cinfo
);
8561 /* Put the image into the pixmap. */
8562 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8563 x_destroy_x_image (ximg
);
8569 #endif /* HAVE_JPEG */
8573 /***********************************************************************
8575 ***********************************************************************/
8581 static int tiff_image_p
P_ ((Lisp_Object object
));
8582 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
8584 /* The symbol `tiff' identifying images of this type. */
8588 /* Indices of image specification fields in tiff_format, below. */
8590 enum tiff_keyword_index
8598 TIFF_HEURISTIC_MASK
,
8602 /* Vector of image_keyword structures describing the format
8603 of valid user-defined image specifications. */
8605 static struct image_keyword tiff_format
[TIFF_LAST
] =
8607 {":type", IMAGE_SYMBOL_VALUE
, 1},
8608 {":file", IMAGE_STRING_VALUE
, 1},
8609 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8610 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8611 {":relief", IMAGE_INTEGER_VALUE
, 0},
8612 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8613 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8616 /* Structure describing the image type `tiff'. */
8618 static struct image_type tiff_type
=
8628 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8631 tiff_image_p (object
)
8634 struct image_keyword fmt
[TIFF_LAST
];
8635 bcopy (tiff_format
, fmt
, sizeof fmt
);
8637 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
)
8638 || (fmt
[TIFF_ASCENT
].count
8639 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
8645 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8653 Lisp_Object file
, specified_file
;
8655 int width
, height
, x
, y
;
8659 struct gcpro gcpro1
;
8661 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8662 file
= x_find_image_file (specified_file
);
8664 if (!STRINGP (file
))
8666 image_error ("Cannot find image file %s", file
, Qnil
);
8671 /* Try to open the image file. */
8672 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
8675 image_error ("Cannot open `%s'", file
, Qnil
);
8680 /* Get width and height of the image, and allocate a raster buffer
8681 of width x height 32-bit values. */
8682 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
8683 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
8684 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
8686 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
8690 image_error ("Error reading `%s'", file
, Qnil
);
8698 /* Create the X image and pixmap. */
8699 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8708 /* Initialize the color table. */
8709 init_color_table ();
8711 /* Process the pixel raster. Origin is in the lower-left corner. */
8712 for (y
= 0; y
< height
; ++y
)
8714 uint32
*row
= buf
+ y
* width
;
8716 for (x
= 0; x
< width
; ++x
)
8718 uint32 abgr
= row
[x
];
8719 int r
= TIFFGetR (abgr
) << 8;
8720 int g
= TIFFGetG (abgr
) << 8;
8721 int b
= TIFFGetB (abgr
) << 8;
8722 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
8726 /* Remember the colors allocated for the image. Free the color table. */
8727 img
->colors
= colors_in_color_table (&img
->ncolors
);
8728 free_color_table ();
8730 /* Put the image into the pixmap, then free the X image and its buffer. */
8731 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8732 x_destroy_x_image (ximg
);
8737 img
->height
= height
;
8743 #endif /* HAVE_TIFF != 0 */
8747 /***********************************************************************
8749 ***********************************************************************/
8753 #include <gif_lib.h>
8755 static int gif_image_p
P_ ((Lisp_Object object
));
8756 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
8758 /* The symbol `gif' identifying images of this type. */
8762 /* Indices of image specification fields in gif_format, below. */
8764 enum gif_keyword_index
8777 /* Vector of image_keyword structures describing the format
8778 of valid user-defined image specifications. */
8780 static struct image_keyword gif_format
[GIF_LAST
] =
8782 {":type", IMAGE_SYMBOL_VALUE
, 1},
8783 {":file", IMAGE_STRING_VALUE
, 1},
8784 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8785 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8786 {":relief", IMAGE_INTEGER_VALUE
, 0},
8787 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8788 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8789 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
8792 /* Structure describing the image type `gif'. */
8794 static struct image_type gif_type
=
8804 /* Return non-zero if OBJECT is a valid GIF image specification. */
8807 gif_image_p (object
)
8810 struct image_keyword fmt
[GIF_LAST
];
8811 bcopy (gif_format
, fmt
, sizeof fmt
);
8813 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
)
8814 || (fmt
[GIF_ASCENT
].count
8815 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
8821 /* Load GIF image IMG for use on frame F. Value is non-zero if
8829 Lisp_Object file
, specified_file
;
8830 int rc
, width
, height
, x
, y
, i
;
8832 ColorMapObject
*gif_color_map
;
8833 unsigned long pixel_colors
[256];
8835 struct gcpro gcpro1
;
8837 int ino
, image_left
, image_top
, image_width
, image_height
;
8839 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8840 file
= x_find_image_file (specified_file
);
8842 if (!STRINGP (file
))
8844 image_error ("Cannot find image file %s", specified_file
, Qnil
);
8849 /* Open the GIF file. */
8850 gif
= DGifOpenFileName (XSTRING (file
)->data
);
8853 image_error ("Cannot open `%s'", file
, Qnil
);
8858 /* Read entire contents. */
8859 rc
= DGifSlurp (gif
);
8860 if (rc
== GIF_ERROR
)
8862 image_error ("Error reading `%s'", file
, Qnil
);
8863 DGifCloseFile (gif
);
8868 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
8869 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
8870 if (ino
>= gif
->ImageCount
)
8872 image_error ("Invalid image number `%s'", image
, Qnil
);
8873 DGifCloseFile (gif
);
8878 width
= img
->width
= gif
->SWidth
;
8879 height
= img
->height
= gif
->SHeight
;
8883 /* Create the X image and pixmap. */
8884 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8888 DGifCloseFile (gif
);
8893 /* Allocate colors. */
8894 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
8896 gif_color_map
= gif
->SColorMap
;
8897 init_color_table ();
8898 bzero (pixel_colors
, sizeof pixel_colors
);
8900 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
8902 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
8903 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
8904 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
8905 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8908 img
->colors
= colors_in_color_table (&img
->ncolors
);
8909 free_color_table ();
8911 /* Clear the part of the screen image that are not covered by
8912 the image from the GIF file. Full animated GIF support
8913 requires more than can be done here (see the gif89 spec,
8914 disposal methods). Let's simply assume that the part
8915 not covered by a sub-image is in the frame's background color. */
8916 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
8917 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
8918 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
8919 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
8921 for (y
= 0; y
< image_top
; ++y
)
8922 for (x
= 0; x
< width
; ++x
)
8923 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8925 for (y
= image_top
+ image_height
; y
< height
; ++y
)
8926 for (x
= 0; x
< width
; ++x
)
8927 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8929 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
8931 for (x
= 0; x
< image_left
; ++x
)
8932 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8933 for (x
= image_left
+ image_width
; x
< width
; ++x
)
8934 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8937 /* Read the GIF image into the X image. */
8938 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
8940 static int interlace_start
[] = {0, 4, 2, 1};
8941 static int interlace_increment
[] = {8, 8, 4, 2};
8943 int row
= interlace_start
[0];
8947 for (y
= 0; y
< image_height
; y
++)
8949 if (row
>= image_height
)
8951 row
= interlace_start
[++pass
];
8952 while (row
>= image_height
)
8953 row
= interlace_start
[++pass
];
8956 for (x
= 0; x
< image_width
; x
++)
8959 = gif
->SavedImages
[ino
].RasterBits
[(y
* image_width
) + x
];
8960 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
8964 row
+= interlace_increment
[pass
];
8969 for (y
= 0; y
< image_height
; ++y
)
8970 for (x
= 0; x
< image_width
; ++x
)
8972 unsigned i
= gif
->SavedImages
[ino
].RasterBits
[y
* image_width
+ x
];
8973 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
8977 DGifCloseFile (gif
);
8979 /* Put the image into the pixmap, then free the X image and its buffer. */
8980 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8981 x_destroy_x_image (ximg
);
8988 #endif /* HAVE_GIF != 0 */
8992 /***********************************************************************
8994 ***********************************************************************/
8996 static int gs_image_p
P_ ((Lisp_Object object
));
8997 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
8998 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9000 /* The symbol `postscript' identifying images of this type. */
9002 Lisp_Object Qpostscript
;
9004 /* Keyword symbols. */
9006 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9008 /* Indices of image specification fields in gs_format, below. */
9010 enum gs_keyword_index
9026 /* Vector of image_keyword structures describing the format
9027 of valid user-defined image specifications. */
9029 static struct image_keyword gs_format
[GS_LAST
] =
9031 {":type", IMAGE_SYMBOL_VALUE
, 1},
9032 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9033 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9034 {":file", IMAGE_STRING_VALUE
, 1},
9035 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9036 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9037 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9038 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9039 {":relief", IMAGE_INTEGER_VALUE
, 0},
9040 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9041 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9044 /* Structure describing the image type `ghostscript'. */
9046 static struct image_type gs_type
=
9056 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9059 gs_clear_image (f
, img
)
9063 /* IMG->data.ptr_val may contain a recorded colormap. */
9064 xfree (img
->data
.ptr_val
);
9065 x_clear_image (f
, img
);
9069 /* Return non-zero if OBJECT is a valid Ghostscript image
9076 struct image_keyword fmt
[GS_LAST
];
9080 bcopy (gs_format
, fmt
, sizeof fmt
);
9082 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
)
9083 || (fmt
[GS_ASCENT
].count
9084 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
9087 /* Bounding box must be a list or vector containing 4 integers. */
9088 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9091 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9092 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9097 else if (VECTORP (tem
))
9099 if (XVECTOR (tem
)->size
!= 4)
9101 for (i
= 0; i
< 4; ++i
)
9102 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9112 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9121 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9122 struct gcpro gcpro1
, gcpro2
;
9124 double in_width
, in_height
;
9125 Lisp_Object pixel_colors
= Qnil
;
9127 /* Compute pixel size of pixmap needed from the given size in the
9128 image specification. Sizes in the specification are in pt. 1 pt
9129 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9131 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9132 in_width
= XFASTINT (pt_width
) / 72.0;
9133 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9134 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9135 in_height
= XFASTINT (pt_height
) / 72.0;
9136 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9138 /* Create the pixmap. */
9140 xassert (img
->pixmap
== 0);
9141 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9142 img
->width
, img
->height
,
9143 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9148 image_error ("Unable to create pixmap for `%s'",
9149 image_spec_value (img
->spec
, QCfile
, NULL
), Qnil
);
9153 /* Call the loader to fill the pixmap. It returns a process object
9154 if successful. We do not record_unwind_protect here because
9155 other places in redisplay like calling window scroll functions
9156 don't either. Let the Lisp loader use `unwind-protect' instead. */
9157 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9159 sprintf (buffer
, "%lu %lu",
9160 (unsigned long) FRAME_X_WINDOW (f
),
9161 (unsigned long) img
->pixmap
);
9162 window_and_pixmap_id
= build_string (buffer
);
9164 sprintf (buffer
, "%lu %lu",
9165 FRAME_FOREGROUND_PIXEL (f
),
9166 FRAME_BACKGROUND_PIXEL (f
));
9167 pixel_colors
= build_string (buffer
);
9169 XSETFRAME (frame
, f
);
9170 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9172 loader
= intern ("gs-load-image");
9174 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9175 make_number (img
->width
),
9176 make_number (img
->height
),
9177 window_and_pixmap_id
,
9180 return PROCESSP (img
->data
.lisp_val
);
9184 /* Kill the Ghostscript process that was started to fill PIXMAP on
9185 frame F. Called from XTread_socket when receiving an event
9186 telling Emacs that Ghostscript has finished drawing. */
9189 x_kill_gs_process (pixmap
, f
)
9193 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9197 /* Find the image containing PIXMAP. */
9198 for (i
= 0; i
< c
->used
; ++i
)
9199 if (c
->images
[i
]->pixmap
== pixmap
)
9202 /* Kill the GS process. We should have found PIXMAP in the image
9203 cache and its image should contain a process object. */
9204 xassert (i
< c
->used
);
9206 xassert (PROCESSP (img
->data
.lisp_val
));
9207 Fkill_process (img
->data
.lisp_val
, Qnil
);
9208 img
->data
.lisp_val
= Qnil
;
9210 /* On displays with a mutable colormap, figure out the colors
9211 allocated for the image by looking at the pixels of an XImage for
9213 class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
9214 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9220 /* Try to get an XImage for img->pixmep. */
9221 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9222 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9227 /* Initialize the color table. */
9228 init_color_table ();
9230 /* For each pixel of the image, look its color up in the
9231 color table. After having done so, the color table will
9232 contain an entry for each color used by the image. */
9233 for (y
= 0; y
< img
->height
; ++y
)
9234 for (x
= 0; x
< img
->width
; ++x
)
9236 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9237 lookup_pixel_color (f
, pixel
);
9240 /* Record colors in the image. Free color table and XImage. */
9241 img
->colors
= colors_in_color_table (&img
->ncolors
);
9242 free_color_table ();
9243 XDestroyImage (ximg
);
9245 #if 0 /* This doesn't seem to be the case. If we free the colors
9246 here, we get a BadAccess later in x_clear_image when
9247 freeing the colors. */
9248 /* We have allocated colors once, but Ghostscript has also
9249 allocated colors on behalf of us. So, to get the
9250 reference counts right, free them once. */
9253 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
9254 XFreeColors (FRAME_X_DISPLAY (f
), cmap
,
9255 img
->colors
, img
->ncolors
, 0);
9260 image_error ("Cannot get X image of `%s'; colors will not be freed",
9261 image_spec_value (img
->spec
, QCfile
, NULL
), Qnil
);
9269 /***********************************************************************
9271 ***********************************************************************/
9273 DEFUN ("x-change-window-property", Fx_change_window_property
,
9274 Sx_change_window_property
, 2, 3, 0,
9275 "Change window property PROP to VALUE on the X window of FRAME.\n\
9276 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9277 selected frame. Value is VALUE.")
9278 (prop
, value
, frame
)
9279 Lisp_Object frame
, prop
, value
;
9281 struct frame
*f
= check_x_frame (frame
);
9284 CHECK_STRING (prop
, 1);
9285 CHECK_STRING (value
, 2);
9288 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9289 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9290 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9291 XSTRING (value
)->data
, XSTRING (value
)->size
);
9293 /* Make sure the property is set when we return. */
9294 XFlush (FRAME_X_DISPLAY (f
));
9301 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9302 Sx_delete_window_property
, 1, 2, 0,
9303 "Remove window property PROP from X window of FRAME.\n\
9304 FRAME nil or omitted means use the selected frame. Value is PROP.")
9306 Lisp_Object prop
, frame
;
9308 struct frame
*f
= check_x_frame (frame
);
9311 CHECK_STRING (prop
, 1);
9313 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9314 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9316 /* Make sure the property is removed when we return. */
9317 XFlush (FRAME_X_DISPLAY (f
));
9324 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
9326 "Value is the value of window property PROP on FRAME.\n\
9327 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9328 if FRAME hasn't a property with name PROP or if PROP has no string\n\
9331 Lisp_Object prop
, frame
;
9333 struct frame
*f
= check_x_frame (frame
);
9336 Lisp_Object prop_value
= Qnil
;
9337 char *tmp_data
= NULL
;
9340 unsigned long actual_size
, bytes_remaining
;
9342 CHECK_STRING (prop
, 1);
9344 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9345 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9346 prop_atom
, 0, 0, False
, XA_STRING
,
9347 &actual_type
, &actual_format
, &actual_size
,
9348 &bytes_remaining
, (unsigned char **) &tmp_data
);
9351 int size
= bytes_remaining
;
9356 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9357 prop_atom
, 0, bytes_remaining
,
9359 &actual_type
, &actual_format
,
9360 &actual_size
, &bytes_remaining
,
9361 (unsigned char **) &tmp_data
);
9363 prop_value
= make_string (tmp_data
, size
);
9374 /***********************************************************************
9376 ***********************************************************************/
9378 /* The implementation partly follows a patch from
9379 F.Pierresteguy@frcl.bull.fr dated 1994. */
9381 /* Setting inhibit_busy_cursor to 2 inhibits busy-cursor display until
9382 the next X event is read and we enter XTread_socket again. Setting
9383 it to 1 inhibits busy-cursor display for direct commands. */
9385 int inhibit_busy_cursor
;
9387 /* Incremented with each call to x-display-busy-cursor.
9388 Decremented in x-undisplay-busy-cursor. */
9390 static int busy_count
;
9393 DEFUN ("x-show-busy-cursor", Fx_show_busy_cursor
,
9394 Sx_show_busy_cursor
, 0, 0, 0,
9395 "Show a busy cursor, if not already shown.\n\
9396 Each call to this function must be matched by a call to\n\
9397 `x-hide-busy-cursor' to make the busy pointer disappear again.")
9401 if (busy_count
== 1)
9403 Lisp_Object rest
, frame
;
9405 FOR_EACH_FRAME (rest
, frame
)
9406 if (FRAME_X_P (XFRAME (frame
)))
9408 struct frame
*f
= XFRAME (frame
);
9411 f
->output_data
.x
->busy_p
= 1;
9413 if (!f
->output_data
.x
->busy_window
)
9415 unsigned long mask
= CWCursor
;
9416 XSetWindowAttributes attrs
;
9418 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
9420 f
->output_data
.x
->busy_window
9421 = XCreateWindow (FRAME_X_DISPLAY (f
),
9422 FRAME_OUTER_WINDOW (f
),
9423 0, 0, 32000, 32000, 0, 0,
9429 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9438 DEFUN ("x-hide-busy-cursor", Fx_hide_busy_cursor
,
9439 Sx_hide_busy_cursor
, 0, 1, 0,
9440 "Hide a busy-cursor.\n\
9441 A busy-cursor will actually be undisplayed when a matching\n\
9442 `x-hide-busy-cursor' is called for each `x-show-busy-cursor'\n\
9443 issued. FORCE non-nil means hide the busy-cursor forcibly,\n\
9444 not counting calls.")
9448 Lisp_Object rest
, frame
;
9450 if (busy_count
== 0)
9453 if (!NILP (force
) && busy_count
!= 0)
9457 if (busy_count
!= 0)
9460 FOR_EACH_FRAME (rest
, frame
)
9462 struct frame
*f
= XFRAME (frame
);
9465 /* Watch out for newly created frames. */
9466 && f
->output_data
.x
->busy_window
)
9470 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9471 /* Sync here because XTread_socket looks at the busy_p flag
9472 that is reset to zero below. */
9473 XSync (FRAME_X_DISPLAY (f
), False
);
9475 f
->output_data
.x
->busy_p
= 0;
9484 /***********************************************************************
9486 ***********************************************************************/
9488 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
9491 /* The frame of a currently visible tooltip, or null. */
9493 struct frame
*tip_frame
;
9495 /* If non-nil, a timer started that hides the last tooltip when it
9498 Lisp_Object tip_timer
;
9501 /* Create a frame for a tooltip on the display described by DPYINFO.
9502 PARMS is a list of frame parameters. Value is the frame. */
9505 x_create_tip_frame (dpyinfo
, parms
)
9506 struct x_display_info
*dpyinfo
;
9510 Lisp_Object frame
, tem
;
9512 long window_prompting
= 0;
9514 int count
= specpdl_ptr
- specpdl
;
9515 struct gcpro gcpro1
, gcpro2
, gcpro3
;
9520 /* Use this general default value to start with until we know if
9521 this frame has a specified name. */
9522 Vx_resource_name
= Vinvocation_name
;
9525 kb
= dpyinfo
->kboard
;
9527 kb
= &the_only_kboard
;
9530 /* Get the name of the frame to use for resource lookup. */
9531 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
9533 && !EQ (name
, Qunbound
)
9535 error ("Invalid frame name--not a string or nil");
9536 Vx_resource_name
= name
;
9539 GCPRO3 (parms
, name
, frame
);
9540 tip_frame
= f
= make_frame (1);
9541 XSETFRAME (frame
, f
);
9542 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
9544 f
->output_method
= output_x_window
;
9545 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
9546 bzero (f
->output_data
.x
, sizeof (struct x_output
));
9547 f
->output_data
.x
->icon_bitmap
= -1;
9548 f
->output_data
.x
->fontset
= -1;
9549 f
->icon_name
= Qnil
;
9550 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
9552 FRAME_KBOARD (f
) = kb
;
9554 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9555 f
->output_data
.x
->explicit_parent
= 0;
9557 /* Set the name; the functions to which we pass f expect the name to
9559 if (EQ (name
, Qunbound
) || NILP (name
))
9561 f
->name
= build_string (dpyinfo
->x_id_name
);
9562 f
->explicit_name
= 0;
9567 f
->explicit_name
= 1;
9568 /* use the frame's title when getting resources for this frame. */
9569 specbind (Qx_resource_name
, name
);
9572 /* Create fontsets from `global_fontset_alist' before handling fonts. */
9573 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
9574 fs_register_fontset (f
, XCAR (tem
));
9576 /* Extract the window parameters from the supplied values
9577 that are needed to determine window geometry. */
9581 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
9584 /* First, try whatever font the caller has specified. */
9587 tem
= Fquery_fontset (font
, Qnil
);
9589 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
9591 font
= x_new_font (f
, XSTRING (font
)->data
);
9594 /* Try out a font which we hope has bold and italic variations. */
9595 if (!STRINGP (font
))
9596 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
9597 if (!STRINGP (font
))
9598 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9599 if (! STRINGP (font
))
9600 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9601 if (! STRINGP (font
))
9602 /* This was formerly the first thing tried, but it finds too many fonts
9603 and takes too long. */
9604 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
9605 /* If those didn't work, look for something which will at least work. */
9606 if (! STRINGP (font
))
9607 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
9609 if (! STRINGP (font
))
9610 font
= build_string ("fixed");
9612 x_default_parameter (f
, parms
, Qfont
, font
,
9613 "font", "Font", RES_TYPE_STRING
);
9616 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
9617 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
9619 /* This defaults to 2 in order to match xterm. We recognize either
9620 internalBorderWidth or internalBorder (which is what xterm calls
9622 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9626 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
9627 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
9628 if (! EQ (value
, Qunbound
))
9629 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
9633 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
9634 "internalBorderWidth", "internalBorderWidth",
9637 /* Also do the stuff which must be set before the window exists. */
9638 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
9639 "foreground", "Foreground", RES_TYPE_STRING
);
9640 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
9641 "background", "Background", RES_TYPE_STRING
);
9642 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
9643 "pointerColor", "Foreground", RES_TYPE_STRING
);
9644 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
9645 "cursorColor", "Foreground", RES_TYPE_STRING
);
9646 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
9647 "borderColor", "BorderColor", RES_TYPE_STRING
);
9649 /* Init faces before x_default_parameter is called for scroll-bar
9650 parameters because that function calls x_set_scroll_bar_width,
9651 which calls change_frame_size, which calls Fset_window_buffer,
9652 which runs hooks, which call Fvertical_motion. At the end, we
9653 end up in init_iterator with a null face cache, which should not
9655 init_frame_faces (f
);
9657 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9658 window_prompting
= x_figure_window_size (f
, parms
);
9660 if (window_prompting
& XNegative
)
9662 if (window_prompting
& YNegative
)
9663 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
9665 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
9669 if (window_prompting
& YNegative
)
9670 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
9672 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
9675 f
->output_data
.x
->size_hint_flags
= window_prompting
;
9677 XSetWindowAttributes attrs
;
9681 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
9682 /* Window managers looks at the override-redirect flag to
9683 determine whether or net to give windows a decoration (Xlib
9685 attrs
.override_redirect
= True
;
9686 attrs
.save_under
= True
;
9687 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
9688 /* Arrange for getting MapNotify and UnmapNotify events. */
9689 attrs
.event_mask
= StructureNotifyMask
;
9691 = FRAME_X_WINDOW (f
)
9692 = XCreateWindow (FRAME_X_DISPLAY (f
),
9693 FRAME_X_DISPLAY_INFO (f
)->root_window
,
9694 /* x, y, width, height */
9698 CopyFromParent
, InputOutput
, CopyFromParent
,
9705 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
9706 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9707 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
9708 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9709 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
9710 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
9712 /* Dimensions, especially f->height, must be done via change_frame_size.
9713 Change will not be effected unless different from the current
9718 SET_FRAME_WIDTH (f
, 0);
9719 change_frame_size (f
, height
, width
, 1, 0, 0);
9725 /* It is now ok to make the frame official even if we get an error
9726 below. And the frame needs to be on Vframe_list or making it
9727 visible won't work. */
9728 Vframe_list
= Fcons (frame
, Vframe_list
);
9730 /* Now that the frame is official, it counts as a reference to
9732 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
9734 return unbind_to (count
, frame
);
9738 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 4, 0,
9739 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
9740 A tooltip window is a small X window displaying STRING at\n\
9741 the current mouse position.\n\
9742 FRAME nil or omitted means use the selected frame.\n\
9743 PARMS is an optional list of frame parameters which can be\n\
9744 used to change the tooltip's appearance.\n\
9745 Automatically hide the tooltip after TIMEOUT seconds.\n\
9746 TIMEOUT nil means use the default timeout of 5 seconds.")
9747 (string
, frame
, parms
, timeout
)
9748 Lisp_Object string
, frame
, parms
, timeout
;
9754 struct buffer
*old_buffer
;
9755 struct text_pos pos
;
9756 int i
, width
, height
;
9757 int root_x
, root_y
, win_x
, win_y
;
9759 struct gcpro gcpro1
, gcpro2
, gcpro3
;
9760 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
9761 int count
= specpdl_ptr
- specpdl
;
9763 specbind (Qinhibit_redisplay
, Qt
);
9765 GCPRO3 (string
, parms
, frame
);
9767 CHECK_STRING (string
, 0);
9768 f
= check_x_frame (frame
);
9770 timeout
= make_number (5);
9772 CHECK_NATNUM (timeout
, 2);
9774 /* Hide a previous tip, if any. */
9777 /* Add default values to frame parameters. */
9778 if (NILP (Fassq (Qname
, parms
)))
9779 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
9780 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9781 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
9782 if (NILP (Fassq (Qborder_width
, parms
)))
9783 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
9784 if (NILP (Fassq (Qborder_color
, parms
)))
9785 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
9786 if (NILP (Fassq (Qbackground_color
, parms
)))
9787 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
9790 /* Create a frame for the tooltip, and record it in the global
9791 variable tip_frame. */
9792 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
9793 tip_frame
= f
= XFRAME (frame
);
9795 /* Set up the frame's root window. Currently we use a size of 80
9796 columns x 40 lines. If someone wants to show a larger tip, he
9797 will loose. I don't think this is a realistic case. */
9798 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
9799 w
->left
= w
->top
= make_number (0);
9803 w
->pseudo_window_p
= 1;
9805 /* Display the tooltip text in a temporary buffer. */
9806 buffer
= Fget_buffer_create (build_string (" *tip*"));
9807 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
9808 old_buffer
= current_buffer
;
9809 set_buffer_internal_1 (XBUFFER (buffer
));
9811 Finsert (make_number (1), &string
);
9812 clear_glyph_matrix (w
->desired_matrix
);
9813 clear_glyph_matrix (w
->current_matrix
);
9814 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
9815 try_window (FRAME_ROOT_WINDOW (f
), pos
);
9817 /* Compute width and height of the tooltip. */
9819 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
9821 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
9825 /* Stop at the first empty row at the end. */
9826 if (!row
->enabled_p
|| !row
->displays_text_p
)
9829 /* Let the row go over the full width of the frame. */
9830 row
->full_width_p
= 1;
9832 /* There's a glyph at the end of rows that is use to place
9833 the cursor there. Don't include the width of this glyph. */
9834 if (row
->used
[TEXT_AREA
])
9836 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
9837 row_width
= row
->pixel_width
- last
->pixel_width
;
9840 row_width
= row
->pixel_width
;
9842 height
+= row
->height
;
9843 width
= max (width
, row_width
);
9846 /* Add the frame's internal border to the width and height the X
9847 window should have. */
9848 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9849 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9851 /* Move the tooltip window where the mouse pointer is. Resize and
9854 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
9855 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
9856 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9857 root_x
+ 5, root_y
- height
- 5, width
, height
);
9858 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
9861 /* Draw into the window. */
9862 w
->must_be_updated_p
= 1;
9863 update_single_window (w
, 1);
9865 /* Restore original current buffer. */
9866 set_buffer_internal_1 (old_buffer
);
9867 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
9869 /* Let the tip disappear after timeout seconds. */
9870 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
9871 intern ("x-hide-tip"));
9873 return unbind_to (count
, Qnil
);
9877 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
9878 "Hide the current tooltip window, if there is any.\n\
9879 Value is t is tooltip was open, nil otherwise.")
9882 int count
= specpdl_ptr
- specpdl
;
9885 specbind (Qinhibit_redisplay
, Qt
);
9887 if (!NILP (tip_timer
))
9889 call1 (intern ("cancel-timer"), tip_timer
);
9897 XSETFRAME (frame
, tip_frame
);
9898 Fdelete_frame (frame
, Qt
);
9903 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
9908 /***********************************************************************
9909 File selection dialog
9910 ***********************************************************************/
9914 /* Callback for "OK" and "Cancel" on file selection dialog. */
9917 file_dialog_cb (widget
, client_data
, call_data
)
9919 XtPointer call_data
, client_data
;
9921 int *result
= (int *) client_data
;
9922 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
9923 *result
= cb
->reason
;
9927 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
9928 "Read file name, prompting with PROMPT in directory DIR.\n\
9929 Use a file selection dialog.\n\
9930 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
9931 specified. Don't let the user enter a file name in the file\n\
9932 selection dialog's entry field, if MUSTMATCH is non-nil.")
9933 (prompt
, dir
, default_filename
, mustmatch
)
9934 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
9937 struct frame
*f
= SELECTED_FRAME ();
9938 Lisp_Object file
= Qnil
;
9939 Widget dialog
, text
, list
, help
;
9942 extern XtAppContext Xt_app_con
;
9944 XmString dir_xmstring
, pattern_xmstring
;
9945 int popup_activated_flag
;
9946 int count
= specpdl_ptr
- specpdl
;
9947 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
9949 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
9950 CHECK_STRING (prompt
, 0);
9951 CHECK_STRING (dir
, 1);
9953 /* Prevent redisplay. */
9954 specbind (Qinhibit_redisplay
, Qt
);
9958 /* Create the dialog with PROMPT as title, using DIR as initial
9959 directory and using "*" as pattern. */
9960 dir
= Fexpand_file_name (dir
, Qnil
);
9961 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
9962 pattern_xmstring
= XmStringCreateLocalized ("*");
9964 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
9965 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
9966 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
9967 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
9968 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
9969 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
9971 XmStringFree (dir_xmstring
);
9972 XmStringFree (pattern_xmstring
);
9974 /* Add callbacks for OK and Cancel. */
9975 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
9976 (XtPointer
) &result
);
9977 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
9978 (XtPointer
) &result
);
9980 /* Disable the help button since we can't display help. */
9981 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
9982 XtSetSensitive (help
, False
);
9984 /* Mark OK button as default. */
9985 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
9986 XmNshowAsDefault
, True
, NULL
);
9988 /* If MUSTMATCH is non-nil, disable the file entry field of the
9989 dialog, so that the user must select a file from the files list
9990 box. We can't remove it because we wouldn't have a way to get at
9991 the result file name, then. */
9992 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
9993 if (!NILP (mustmatch
))
9996 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
9997 XtSetSensitive (text
, False
);
9998 XtSetSensitive (label
, False
);
10001 /* Manage the dialog, so that list boxes get filled. */
10002 XtManageChild (dialog
);
10004 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10005 must include the path for this to work. */
10006 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
10007 if (STRINGP (default_filename
))
10009 XmString default_xmstring
;
10013 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
10015 if (!XmListItemExists (list
, default_xmstring
))
10017 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10018 XmListAddItem (list
, default_xmstring
, 0);
10022 item_pos
= XmListItemPos (list
, default_xmstring
);
10023 XmStringFree (default_xmstring
);
10025 /* Select the item and scroll it into view. */
10026 XmListSelectPos (list
, item_pos
, True
);
10027 XmListSetPos (list
, item_pos
);
10030 /* Process all events until the user presses Cancel or OK. */
10031 for (result
= 0; result
== 0;)
10034 Widget widget
, parent
;
10036 XtAppNextEvent (Xt_app_con
, &event
);
10038 /* See if the receiver of the event is one of the widgets of
10039 the file selection dialog. If so, dispatch it. If not,
10041 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
10043 while (parent
&& parent
!= dialog
)
10044 parent
= XtParent (parent
);
10046 if (parent
== dialog
10047 || (event
.type
== Expose
10048 && !process_expose_from_menu (event
)))
10049 XtDispatchEvent (&event
);
10052 /* Get the result. */
10053 if (result
== XmCR_OK
)
10058 XtVaGetValues (dialog
, XmNtextString
, &text
, 0);
10059 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
10060 XmStringFree (text
);
10061 file
= build_string (data
);
10068 XtUnmanageChild (dialog
);
10069 XtDestroyWidget (dialog
);
10073 /* Make "Cancel" equivalent to C-g. */
10075 Fsignal (Qquit
, Qnil
);
10077 return unbind_to (count
, file
);
10080 #endif /* USE_MOTIF */
10083 /***********************************************************************
10085 ***********************************************************************/
10089 DEFUN ("imagep", Fimagep
, Simagep
, 1, 1, 0,
10090 "Value is non-nil if SPEC is a valid image specification.")
10094 return valid_image_p (spec
) ? Qt
: Qnil
;
10098 DEFUN ("lookup-image", Flookup_image
, Slookup_image
, 1, 1, 0, "")
10104 if (valid_image_p (spec
))
10105 id
= lookup_image (SELECTED_FRAME (), spec
);
10107 debug_print (spec
);
10108 return make_number (id
);
10111 #endif /* GLYPH_DEBUG != 0 */
10115 /***********************************************************************
10117 ***********************************************************************/
10122 /* This is zero if not using X windows. */
10125 /* The section below is built by the lisp expression at the top of the file,
10126 just above where these variables are declared. */
10127 /*&&& init symbols here &&&*/
10128 Qauto_raise
= intern ("auto-raise");
10129 staticpro (&Qauto_raise
);
10130 Qauto_lower
= intern ("auto-lower");
10131 staticpro (&Qauto_lower
);
10132 Qbar
= intern ("bar");
10134 Qborder_color
= intern ("border-color");
10135 staticpro (&Qborder_color
);
10136 Qborder_width
= intern ("border-width");
10137 staticpro (&Qborder_width
);
10138 Qbox
= intern ("box");
10140 Qcursor_color
= intern ("cursor-color");
10141 staticpro (&Qcursor_color
);
10142 Qcursor_type
= intern ("cursor-type");
10143 staticpro (&Qcursor_type
);
10144 Qgeometry
= intern ("geometry");
10145 staticpro (&Qgeometry
);
10146 Qicon_left
= intern ("icon-left");
10147 staticpro (&Qicon_left
);
10148 Qicon_top
= intern ("icon-top");
10149 staticpro (&Qicon_top
);
10150 Qicon_type
= intern ("icon-type");
10151 staticpro (&Qicon_type
);
10152 Qicon_name
= intern ("icon-name");
10153 staticpro (&Qicon_name
);
10154 Qinternal_border_width
= intern ("internal-border-width");
10155 staticpro (&Qinternal_border_width
);
10156 Qleft
= intern ("left");
10157 staticpro (&Qleft
);
10158 Qright
= intern ("right");
10159 staticpro (&Qright
);
10160 Qmouse_color
= intern ("mouse-color");
10161 staticpro (&Qmouse_color
);
10162 Qnone
= intern ("none");
10163 staticpro (&Qnone
);
10164 Qparent_id
= intern ("parent-id");
10165 staticpro (&Qparent_id
);
10166 Qscroll_bar_width
= intern ("scroll-bar-width");
10167 staticpro (&Qscroll_bar_width
);
10168 Qsuppress_icon
= intern ("suppress-icon");
10169 staticpro (&Qsuppress_icon
);
10170 Qundefined_color
= intern ("undefined-color");
10171 staticpro (&Qundefined_color
);
10172 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10173 staticpro (&Qvertical_scroll_bars
);
10174 Qvisibility
= intern ("visibility");
10175 staticpro (&Qvisibility
);
10176 Qwindow_id
= intern ("window-id");
10177 staticpro (&Qwindow_id
);
10178 Qouter_window_id
= intern ("outer-window-id");
10179 staticpro (&Qouter_window_id
);
10180 Qx_frame_parameter
= intern ("x-frame-parameter");
10181 staticpro (&Qx_frame_parameter
);
10182 Qx_resource_name
= intern ("x-resource-name");
10183 staticpro (&Qx_resource_name
);
10184 Quser_position
= intern ("user-position");
10185 staticpro (&Quser_position
);
10186 Quser_size
= intern ("user-size");
10187 staticpro (&Quser_size
);
10188 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10189 staticpro (&Qscroll_bar_foreground
);
10190 Qscroll_bar_background
= intern ("scroll-bar-background");
10191 staticpro (&Qscroll_bar_background
);
10192 Qscreen_gamma
= intern ("screen-gamma");
10193 staticpro (&Qscreen_gamma
);
10194 /* This is the end of symbol initialization. */
10196 /* Text property `display' should be nonsticky by default. */
10197 Vtext_property_default_nonsticky
10198 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
10201 Qlaplace
= intern ("laplace");
10202 staticpro (&Qlaplace
);
10204 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10205 staticpro (&Qface_set_after_frame_default
);
10207 Fput (Qundefined_color
, Qerror_conditions
,
10208 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10209 Fput (Qundefined_color
, Qerror_message
,
10210 build_string ("Undefined color"));
10212 init_x_parm_symbols ();
10214 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
10215 "List of directories to search for bitmap files for X.");
10216 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
10218 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
10219 "The shape of the pointer when over text.\n\
10220 Changing the value does not affect existing frames\n\
10221 unless you set the mouse color.");
10222 Vx_pointer_shape
= Qnil
;
10224 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
10225 "The name Emacs uses to look up X resources.\n\
10226 `x-get-resource' uses this as the first component of the instance name\n\
10227 when requesting resource values.\n\
10228 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10229 was invoked, or to the value specified with the `-name' or `-rn'\n\
10230 switches, if present.\n\
10232 It may be useful to bind this variable locally around a call\n\
10233 to `x-get-resource'. See also the variable `x-resource-class'.");
10234 Vx_resource_name
= Qnil
;
10236 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
10237 "The class Emacs uses to look up X resources.\n\
10238 `x-get-resource' uses this as the first component of the instance class\n\
10239 when requesting resource values.\n\
10240 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10242 Setting this variable permanently is not a reasonable thing to do,\n\
10243 but binding this variable locally around a call to `x-get-resource'\n\
10244 is a reasonable practice. See also the variable `x-resource-name'.");
10245 Vx_resource_class
= build_string (EMACS_CLASS
);
10247 #if 0 /* This doesn't really do anything. */
10248 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
10249 "The shape of the pointer when not over text.\n\
10250 This variable takes effect when you create a new frame\n\
10251 or when you set the mouse color.");
10253 Vx_nontext_pointer_shape
= Qnil
;
10255 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
10256 "The shape of the pointer when Emacs is busy.\n\
10257 This variable takes effect when you create a new frame\n\
10258 or when you set the mouse color.");
10259 Vx_busy_pointer_shape
= Qnil
;
10261 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
10262 "Non-zero means Emacs displays a busy cursor on window systems.");
10263 display_busy_cursor_p
= 1;
10265 #if 0 /* This doesn't really do anything. */
10266 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
10267 "The shape of the pointer when over the mode line.\n\
10268 This variable takes effect when you create a new frame\n\
10269 or when you set the mouse color.");
10271 Vx_mode_pointer_shape
= Qnil
;
10273 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10274 &Vx_sensitive_text_pointer_shape
,
10275 "The shape of the pointer when over mouse-sensitive text.\n\
10276 This variable takes effect when you create a new frame\n\
10277 or when you set the mouse color.");
10278 Vx_sensitive_text_pointer_shape
= Qnil
;
10280 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
10281 "A string indicating the foreground color of the cursor box.");
10282 Vx_cursor_fore_pixel
= Qnil
;
10284 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
10285 "Non-nil if no X window manager is in use.\n\
10286 Emacs doesn't try to figure this out; this is always nil\n\
10287 unless you set it to something else.");
10288 /* We don't have any way to find this out, so set it to nil
10289 and maybe the user would like to set it to t. */
10290 Vx_no_window_manager
= Qnil
;
10292 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
10293 &Vx_pixel_size_width_font_regexp
,
10294 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
10296 Since Emacs gets width of a font matching with this regexp from\n\
10297 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
10298 such a font. This is especially effective for such large fonts as\n\
10299 Chinese, Japanese, and Korean.");
10300 Vx_pixel_size_width_font_regexp
= Qnil
;
10302 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
10303 "Time after which cached images are removed from the cache.\n\
10304 When an image has not been displayed this many seconds, remove it\n\
10305 from the image cache. Value must be an integer or nil with nil\n\
10306 meaning don't clear the cache.");
10307 Vimage_cache_eviction_delay
= make_number (30 * 60);
10309 DEFVAR_LISP ("image-types", &Vimage_types
,
10310 "List of supported image types.\n\
10311 Each element of the list is a symbol for a supported image type.");
10312 Vimage_types
= Qnil
;
10314 #ifdef USE_X_TOOLKIT
10315 Fprovide (intern ("x-toolkit"));
10318 Fprovide (intern ("motif"));
10321 defsubr (&Sx_get_resource
);
10323 /* X window properties. */
10324 defsubr (&Sx_change_window_property
);
10325 defsubr (&Sx_delete_window_property
);
10326 defsubr (&Sx_window_property
);
10329 defsubr (&Sx_draw_rectangle
);
10330 defsubr (&Sx_erase_rectangle
);
10331 defsubr (&Sx_contour_region
);
10332 defsubr (&Sx_uncontour_region
);
10334 defsubr (&Sxw_display_color_p
);
10335 defsubr (&Sx_display_grayscale_p
);
10336 defsubr (&Sxw_color_defined_p
);
10337 defsubr (&Sxw_color_values
);
10338 defsubr (&Sx_server_max_request_size
);
10339 defsubr (&Sx_server_vendor
);
10340 defsubr (&Sx_server_version
);
10341 defsubr (&Sx_display_pixel_width
);
10342 defsubr (&Sx_display_pixel_height
);
10343 defsubr (&Sx_display_mm_width
);
10344 defsubr (&Sx_display_mm_height
);
10345 defsubr (&Sx_display_screens
);
10346 defsubr (&Sx_display_planes
);
10347 defsubr (&Sx_display_color_cells
);
10348 defsubr (&Sx_display_visual_class
);
10349 defsubr (&Sx_display_backing_store
);
10350 defsubr (&Sx_display_save_under
);
10352 defsubr (&Sx_rebind_key
);
10353 defsubr (&Sx_rebind_keys
);
10354 defsubr (&Sx_track_pointer
);
10355 defsubr (&Sx_grab_pointer
);
10356 defsubr (&Sx_ungrab_pointer
);
10358 defsubr (&Sx_parse_geometry
);
10359 defsubr (&Sx_create_frame
);
10361 defsubr (&Sx_horizontal_line
);
10363 defsubr (&Sx_open_connection
);
10364 defsubr (&Sx_close_connection
);
10365 defsubr (&Sx_display_list
);
10366 defsubr (&Sx_synchronize
);
10368 /* Setting callback functions for fontset handler. */
10369 get_font_info_func
= x_get_font_info
;
10371 #if 0 /* This function pointer doesn't seem to be used anywhere.
10372 And the pointer assigned has the wrong type, anyway. */
10373 list_fonts_func
= x_list_fonts
;
10376 load_font_func
= x_load_font
;
10377 find_ccl_program_func
= x_find_ccl_program
;
10378 query_font_func
= x_query_font
;
10379 set_frame_fontset_func
= x_set_font
;
10380 check_window_system_func
= check_x
;
10383 Qxbm
= intern ("xbm");
10385 QCtype
= intern (":type");
10386 staticpro (&QCtype
);
10387 QCalgorithm
= intern (":algorithm");
10388 staticpro (&QCalgorithm
);
10389 QCheuristic_mask
= intern (":heuristic-mask");
10390 staticpro (&QCheuristic_mask
);
10391 QCcolor_symbols
= intern (":color-symbols");
10392 staticpro (&QCcolor_symbols
);
10393 QCdata
= intern (":data");
10394 staticpro (&QCdata
);
10395 QCascent
= intern (":ascent");
10396 staticpro (&QCascent
);
10397 QCmargin
= intern (":margin");
10398 staticpro (&QCmargin
);
10399 QCrelief
= intern (":relief");
10400 staticpro (&QCrelief
);
10401 Qpostscript
= intern ("postscript");
10402 staticpro (&Qpostscript
);
10403 QCloader
= intern (":loader");
10404 staticpro (&QCloader
);
10405 QCbounding_box
= intern (":bounding-box");
10406 staticpro (&QCbounding_box
);
10407 QCpt_width
= intern (":pt-width");
10408 staticpro (&QCpt_width
);
10409 QCpt_height
= intern (":pt-height");
10410 staticpro (&QCpt_height
);
10411 QCindex
= intern (":index");
10412 staticpro (&QCindex
);
10413 Qpbm
= intern ("pbm");
10417 Qxpm
= intern ("xpm");
10422 Qjpeg
= intern ("jpeg");
10423 staticpro (&Qjpeg
);
10427 Qtiff
= intern ("tiff");
10428 staticpro (&Qtiff
);
10432 Qgif
= intern ("gif");
10437 Qpng
= intern ("png");
10441 defsubr (&Sclear_image_cache
);
10444 defsubr (&Simagep
);
10445 defsubr (&Slookup_image
);
10449 defsubr (&Sx_show_busy_cursor
);
10450 defsubr (&Sx_hide_busy_cursor
);
10452 inhibit_busy_cursor
= 0;
10454 defsubr (&Sx_show_tip
);
10455 defsubr (&Sx_hide_tip
);
10456 staticpro (&tip_timer
);
10460 defsubr (&Sx_file_dialog
);
10468 image_types
= NULL
;
10469 Vimage_types
= Qnil
;
10471 define_image_type (&xbm_type
);
10472 define_image_type (&gs_type
);
10473 define_image_type (&pbm_type
);
10476 define_image_type (&xpm_type
);
10480 define_image_type (&jpeg_type
);
10484 define_image_type (&tiff_type
);
10488 define_image_type (&gif_type
);
10492 define_image_type (&png_type
);
10496 #endif /* HAVE_X_WINDOWS */