1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993, 1994 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* Completely rewritten by Richard Stallman. */
22 /* Rewritten for X11 by Joseph Arceneaux */
31 /* This makes the fields of a Display accessible, in Xlib header files. */
32 #define XLIB_ILLEGAL_ACCESS
39 #include "dispextern.h"
41 #include "blockinput.h"
47 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
48 #include "bitmaps/gray.xbm"
50 #include <X11/bitmaps/gray>
53 #include "[.bitmaps]gray.xbm"
57 #include <X11/Shell.h>
59 #include <X11/Xaw/Paned.h>
60 #include <X11/Xaw/Label.h>
63 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
72 #include "../lwlib/lwlib.h"
74 /* The one and only application context associated with the connection
75 to the one and only X display that Emacs uses. */
76 XtAppContext Xt_app_con
;
78 /* The one and only application shell. Emacs screens are popup shells of this
82 extern void free_frame_menubar ();
83 extern void free_frame_menubar ();
84 #endif /* USE_X_TOOLKIT */
86 #define min(a,b) ((a) < (b) ? (a) : (b))
87 #define max(a,b) ((a) > (b) ? (a) : (b))
89 /* X Resource data base */
90 static XrmDatabase xrdb
;
92 /* The class of this X application. */
93 #define EMACS_CLASS "Emacs"
96 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
98 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
101 /* The name we're using in resource queries. */
102 Lisp_Object Vx_resource_name
;
104 /* Title name and application name for X stuff. */
105 extern char *x_id_name
;
107 /* The background and shape of the mouse pointer, and shape when not
108 over text or in the modeline. */
109 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
110 /* The shape when over mouse-sensitive text. */
111 Lisp_Object Vx_sensitive_text_pointer_shape
;
113 /* Color of chars displayed in cursor box. */
114 Lisp_Object Vx_cursor_fore_pixel
;
116 /* The screen being used. */
117 static Screen
*x_screen
;
119 /* The X Visual we are using for X windows (the default) */
120 Visual
*screen_visual
;
122 /* Height of this X screen in pixels. */
125 /* Width of this X screen in pixels. */
128 /* Number of planes for this screen. */
131 /* Non nil if no window manager is in use. */
132 Lisp_Object Vx_no_window_manager
;
134 /* `t' if a mouse button is depressed. */
136 Lisp_Object Vmouse_depressed
;
138 /* For now, we have just one x_display structure since we only support
140 static struct x_screen the_x_screen
;
142 extern unsigned int x_mouse_x
, x_mouse_y
, x_mouse_grabbed
;
144 /* Atom for indicating window state to the window manager. */
145 extern Atom Xatom_wm_change_state
;
147 /* Communication with window managers. */
148 extern Atom Xatom_wm_protocols
;
150 /* Kinds of protocol things we may receive. */
151 extern Atom Xatom_wm_take_focus
;
152 extern Atom Xatom_wm_save_yourself
;
153 extern Atom Xatom_wm_delete_window
;
155 /* Other WM communication */
156 extern Atom Xatom_wm_configure_denied
; /* When our config request is denied */
157 extern Atom Xatom_wm_window_moved
; /* When the WM moves us. */
159 /* EditRes protocol */
160 extern Atom Xatom_editres_name
;
162 /* The last 23 bits of the timestamp of the last mouse button event. */
163 Time mouse_timestamp
;
165 /* Evaluate this expression to rebuild the section of syms_of_xfns
166 that initializes and staticpros the symbols declared below. Note
167 that Emacs 18 has a bug that keeps C-x C-e from being able to
168 evaluate this expression.
171 ;; Accumulate a list of the symbols we want to initialize from the
172 ;; declarations at the top of the file.
173 (goto-char (point-min))
174 (search-forward "/\*&&& symbols declared here &&&*\/\n")
176 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
178 (cons (buffer-substring (match-beginning 1) (match-end 1))
181 (setq symbol-list (nreverse symbol-list))
182 ;; Delete the section of syms_of_... where we initialize the symbols.
183 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
184 (let ((start (point)))
185 (while (looking-at "^ Q")
187 (kill-region start (point)))
188 ;; Write a new symbol initialization section.
190 (insert (format " %s = intern (\"" (car symbol-list)))
191 (let ((start (point)))
192 (insert (substring (car symbol-list) 1))
193 (subst-char-in-region start (point) ?_ ?-))
194 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
195 (setq symbol-list (cdr symbol-list)))))
199 /*&&& symbols declared here &&&*/
200 Lisp_Object Qauto_raise
;
201 Lisp_Object Qauto_lower
;
202 Lisp_Object Qbackground_color
;
204 Lisp_Object Qborder_color
;
205 Lisp_Object Qborder_width
;
207 Lisp_Object Qcursor_color
;
208 Lisp_Object Qcursor_type
;
210 Lisp_Object Qforeground_color
;
211 Lisp_Object Qgeometry
;
212 Lisp_Object Qicon_left
;
213 Lisp_Object Qicon_top
;
214 Lisp_Object Qicon_type
;
215 Lisp_Object Qinternal_border_width
;
217 Lisp_Object Qmouse_color
;
219 Lisp_Object Qparent_id
;
220 Lisp_Object Qscroll_bar_width
;
221 Lisp_Object Qsuppress_icon
;
223 Lisp_Object Qundefined_color
;
224 Lisp_Object Qvertical_scroll_bars
;
225 Lisp_Object Qvisibility
;
226 Lisp_Object Qwindow_id
;
227 Lisp_Object Qx_frame_parameter
;
228 Lisp_Object Qx_resource_name
;
229 Lisp_Object Quser_position
;
230 Lisp_Object Quser_size
;
232 /* The below are defined in frame.c. */
233 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
234 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
;
236 extern Lisp_Object Vwindow_system_version
;
239 /* Error if we are not connected to X. */
243 if (x_current_display
== 0)
244 error ("X windows are not in use or not initialized");
247 /* Nonzero if using X for display. */
252 return x_current_display
!= 0;
255 /* Return the Emacs frame-object corresponding to an X window.
256 It could be the frame's main window or an icon window. */
258 /* This function can be called during GC, so use XGCTYPE. */
261 x_window_to_frame (wdesc
)
264 Lisp_Object tail
, frame
;
267 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
268 tail
= XCONS (tail
)->cdr
)
270 frame
= XCONS (tail
)->car
;
271 if (XGCTYPE (frame
) != Lisp_Frame
)
275 if (f
->display
.nothing
== 1)
277 if ((f
->display
.x
->edit_widget
278 && XtWindow (f
->display
.x
->edit_widget
) == wdesc
)
279 || f
->display
.x
->icon_desc
== wdesc
)
281 #else /* not USE_X_TOOLKIT */
282 if (FRAME_X_WINDOW (f
) == wdesc
283 || f
->display
.x
->icon_desc
== wdesc
)
285 #endif /* not USE_X_TOOLKIT */
291 /* Like x_window_to_frame but also compares the window with the widget's
295 x_any_window_to_frame (wdesc
)
298 Lisp_Object tail
, frame
;
302 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
303 tail
= XCONS (tail
)->cdr
)
305 frame
= XCONS (tail
)->car
;
306 if (XGCTYPE (frame
) != Lisp_Frame
)
309 if (f
->display
.nothing
== 1)
312 /* This frame matches if the window is any of its widgets. */
313 if (wdesc
== XtWindow (x
->widget
)
314 || wdesc
== XtWindow (x
->column_widget
)
315 || wdesc
== XtWindow (x
->edit_widget
))
317 /* Match if the window is this frame's menubar. */
318 if (x
->menubar_widget
319 && wdesc
== XtWindow (x
->menubar_widget
))
325 /* Return the frame whose principal (outermost) window is WDESC.
326 If WDESC is some other (smaller) window, we return 0. */
329 x_top_window_to_frame (wdesc
)
332 Lisp_Object tail
, frame
;
336 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
337 tail
= XCONS (tail
)->cdr
)
339 frame
= XCONS (tail
)->car
;
340 if (XGCTYPE (frame
) != Lisp_Frame
)
343 if (f
->display
.nothing
== 1)
346 /* This frame matches if the window is its topmost widget. */
347 if (wdesc
== XtWindow (x
->widget
))
349 /* Match if the window is this frame's menubar. */
350 if (x
->menubar_widget
351 && wdesc
== XtWindow (x
->menubar_widget
))
356 #endif /* USE_X_TOOLKIT */
359 /* Connect the frame-parameter names for X frames
360 to the ways of passing the parameter values to the window system.
362 The name of a parameter, as a Lisp symbol,
363 has an `x-frame-parameter' property which is an integer in Lisp
364 but can be interpreted as an `enum x_frame_parm' in C. */
368 X_PARM_FOREGROUND_COLOR
,
369 X_PARM_BACKGROUND_COLOR
,
376 X_PARM_INTERNAL_BORDER_WIDTH
,
380 X_PARM_VERT_SCROLL_BAR
,
382 X_PARM_MENU_BAR_LINES
386 struct x_frame_parm_table
389 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
392 void x_set_foreground_color ();
393 void x_set_background_color ();
394 void x_set_mouse_color ();
395 void x_set_cursor_color ();
396 void x_set_border_color ();
397 void x_set_cursor_type ();
398 void x_set_icon_type ();
400 void x_set_border_width ();
401 void x_set_internal_border_width ();
402 void x_explicitly_set_name ();
403 void x_set_autoraise ();
404 void x_set_autolower ();
405 void x_set_vertical_scroll_bars ();
406 void x_set_visibility ();
407 void x_set_menu_bar_lines ();
408 void x_set_scroll_bar_width ();
410 static struct x_frame_parm_table x_frame_parms
[] =
412 "foreground-color", x_set_foreground_color
,
413 "background-color", x_set_background_color
,
414 "mouse-color", x_set_mouse_color
,
415 "cursor-color", x_set_cursor_color
,
416 "border-color", x_set_border_color
,
417 "cursor-type", x_set_cursor_type
,
418 "icon-type", x_set_icon_type
,
420 "border-width", x_set_border_width
,
421 "internal-border-width", x_set_internal_border_width
,
422 "name", x_explicitly_set_name
,
423 "auto-raise", x_set_autoraise
,
424 "auto-lower", x_set_autolower
,
425 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
426 "visibility", x_set_visibility
,
427 "menu-bar-lines", x_set_menu_bar_lines
,
428 "scroll-bar-width", x_set_scroll_bar_width
,
431 /* Attach the `x-frame-parameter' properties to
432 the Lisp symbol names of parameters relevant to X. */
434 init_x_parm_symbols ()
438 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
439 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
443 /* Change the parameters of FRAME as specified by ALIST.
444 If a parameter is not specially recognized, do nothing;
445 otherwise call the `x_set_...' function for that parameter. */
448 x_set_frame_parameters (f
, alist
)
454 /* If both of these parameters are present, it's more efficient to
455 set them both at once. So we wait until we've looked at the
456 entire list before we set them. */
457 Lisp_Object width
, height
;
460 Lisp_Object left
, top
;
462 /* Record in these vectors all the parms specified. */
466 int left_no_change
= 0, top_no_change
= 0;
469 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
472 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
473 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
475 /* Extract parm names and values into those vectors. */
478 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
480 Lisp_Object elt
, prop
, val
;
483 parms
[i
] = Fcar (elt
);
484 values
[i
] = Fcdr (elt
);
488 width
= height
= top
= left
= Qunbound
;
490 /* Now process them in reverse of specified order. */
491 for (i
--; i
>= 0; i
--)
493 Lisp_Object prop
, val
;
498 if (EQ (prop
, Qwidth
))
500 else if (EQ (prop
, Qheight
))
502 else if (EQ (prop
, Qtop
))
504 else if (EQ (prop
, Qleft
))
508 register Lisp_Object param_index
, old_value
;
510 param_index
= Fget (prop
, Qx_frame_parameter
);
511 old_value
= get_frame_param (f
, prop
);
512 store_frame_param (f
, prop
, val
);
513 if (INTEGERP (param_index
)
514 && XINT (param_index
) >= 0
515 && (XINT (param_index
)
516 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
517 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
521 /* Don't die if just one of these was set. */
522 if (EQ (left
, Qunbound
))
525 if (f
->display
.x
->left_pos
< 0)
526 left
= Fcons (Qplus
, Fcons (make_number (f
->display
.x
->left_pos
), Qnil
));
528 XSET (left
, Lisp_Int
, f
->display
.x
->left_pos
);
530 if (EQ (top
, Qunbound
))
533 if (f
->display
.x
->top_pos
< 0)
534 top
= Fcons (Qplus
, Fcons (make_number (f
->display
.x
->top_pos
), Qnil
));
536 XSET (top
, Lisp_Int
, f
->display
.x
->top_pos
);
539 /* Don't die if just one of these was set. */
540 if (EQ (width
, Qunbound
))
541 XSET (width
, Lisp_Int
, FRAME_WIDTH (f
));
542 if (EQ (height
, Qunbound
))
543 XSET (height
, Lisp_Int
, FRAME_HEIGHT (f
));
545 /* Don't set these parameters these unless they've been explicitly
546 specified. The window might be mapped or resized while we're in
547 this function, and we don't want to override that unless the lisp
548 code has asked for it.
550 Don't set these parameters unless they actually differ from the
551 window's current parameters; the window may not actually exist
556 check_frame_size (f
, &height
, &width
);
558 XSET (frame
, Lisp_Frame
, f
);
560 if ((NUMBERP (width
) && XINT (width
) != FRAME_WIDTH (f
))
561 || (NUMBERP (height
) && XINT (height
) != FRAME_HEIGHT (f
)))
562 Fset_frame_size (frame
, width
, height
);
564 if ((!NILP (left
) || !NILP (top
))
565 && ! (left_no_change
&& top_no_change
)
566 && ! (NUMBERP (left
) && XINT (left
) == f
->display
.x
->left_pos
567 && NUMBERP (top
) && XINT (top
) == f
->display
.x
->top_pos
))
572 /* Record the signs. */
573 f
->display
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
574 if (EQ (left
, Qminus
))
575 f
->display
.x
->size_hint_flags
|= XNegative
;
576 else if (INTEGERP (left
))
578 leftpos
= XINT (left
);
580 f
->display
.x
->size_hint_flags
|= XNegative
;
582 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qminus
)
583 && CONSP (XCONS (left
)->cdr
)
584 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
586 leftpos
= - XINT (XCONS (XCONS (left
)->cdr
)->car
);
587 f
->display
.x
->size_hint_flags
|= XNegative
;
589 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qplus
)
590 && CONSP (XCONS (left
)->cdr
)
591 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
593 leftpos
= XINT (XCONS (XCONS (left
)->cdr
)->car
);
596 if (EQ (top
, Qminus
))
597 f
->display
.x
->size_hint_flags
|= YNegative
;
598 else if (INTEGERP (top
))
602 f
->display
.x
->size_hint_flags
|= YNegative
;
604 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qminus
)
605 && CONSP (XCONS (top
)->cdr
)
606 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
608 toppos
= - XINT (XCONS (XCONS (top
)->cdr
)->car
);
609 f
->display
.x
->size_hint_flags
|= YNegative
;
611 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qplus
)
612 && CONSP (XCONS (top
)->cdr
)
613 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
615 toppos
= XINT (XCONS (XCONS (top
)->cdr
)->car
);
619 /* Store the numeric value of the position. */
620 f
->display
.x
->top_pos
= toppos
;
621 f
->display
.x
->left_pos
= leftpos
;
623 f
->display
.x
->win_gravity
= NorthWestGravity
;
625 /* Actually set that position, and convert to absolute. */
626 x_set_offset (f
, leftpos
, toppos
, 0);
631 /* Store the positions of frame F into XPTR and YPTR.
632 These are the positions of the containing window manager window,
633 not Emacs's own window. */
636 x_real_positions (f
, xptr
, yptr
)
640 int win_x
= 0, win_y
= 0;
643 /* This is pretty gross, but seems to be the easiest way out of
644 the problem that arises when restarting window-managers. */
647 Window outer
= XtWindow (f
->display
.x
->widget
);
649 Window outer
= f
->display
.x
->window_desc
;
651 Window tmp_root_window
;
652 Window
*tmp_children
;
655 XQueryTree (x_current_display
, outer
, &tmp_root_window
,
656 &f
->display
.x
->parent_desc
,
657 &tmp_children
, &tmp_nchildren
);
658 xfree (tmp_children
);
660 /* Find the position of the outside upper-left corner of
661 the inner window, with respect to the outer window. */
662 if (f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
665 XTranslateCoordinates (x_current_display
,
667 /* From-window, to-window. */
669 XtWindow (f
->display
.x
->widget
),
671 f
->display
.x
->window_desc
,
673 f
->display
.x
->parent_desc
,
675 /* From-position, to-position. */
676 0, 0, &win_x
, &win_y
,
682 win_x
+= f
->display
.x
->border_width
;
683 win_y
+= f
->display
.x
->border_width
;
685 *xptr
= f
->display
.x
->left_pos
- win_x
;
686 *yptr
= f
->display
.x
->top_pos
- win_y
;
689 /* Insert a description of internally-recorded parameters of frame X
690 into the parameter alist *ALISTPTR that is to be given to the user.
691 Only parameters that are specific to the X window system
692 and whose values are not correctly recorded in the frame's
693 param_alist need to be considered here. */
695 x_report_frame_params (f
, alistptr
)
697 Lisp_Object
*alistptr
;
701 store_in_alist (alistptr
, Qleft
, make_number (f
->display
.x
->left_pos
));
702 store_in_alist (alistptr
, Qtop
, make_number (f
->display
.x
->top_pos
));
703 store_in_alist (alistptr
, Qborder_width
,
704 make_number (f
->display
.x
->border_width
));
705 store_in_alist (alistptr
, Qinternal_border_width
,
706 make_number (f
->display
.x
->internal_border_width
));
707 sprintf (buf
, "%d", FRAME_X_WINDOW (f
));
708 store_in_alist (alistptr
, Qwindow_id
,
710 FRAME_SAMPLE_VISIBILITY (f
);
711 store_in_alist (alistptr
, Qvisibility
,
712 (FRAME_VISIBLE_P (f
) ? Qt
713 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
716 /* Decide if color named COLOR is valid for the display associated with
717 the selected frame; if so, return the rgb values in COLOR_DEF.
718 If ALLOC is nonzero, allocate a new colormap cell. */
721 defined_color (color
, color_def
, alloc
)
727 Colormap screen_colormap
;
731 = DefaultColormap (x_current_display
, XDefaultScreen (x_current_display
));
733 foo
= XParseColor (x_current_display
, screen_colormap
, color
, color_def
);
735 foo
= XAllocColor (x_current_display
, screen_colormap
, color_def
);
744 /* Given a string ARG naming a color, compute a pixel value from it
745 suitable for screen F.
746 If F is not a color screen, return DEF (default) regardless of what
750 x_decode_color (arg
, def
)
756 CHECK_STRING (arg
, 0);
758 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
759 return BLACK_PIX_DEFAULT
;
760 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
761 return WHITE_PIX_DEFAULT
;
763 if (x_screen_planes
== 1)
766 if (defined_color (XSTRING (arg
)->data
, &cdef
, 1))
769 Fsignal (Qundefined_color
, Fcons (arg
, Qnil
));
772 /* Functions called only from `x_set_frame_param'
773 to set individual parameters.
775 If FRAME_X_WINDOW (f) is 0,
776 the frame is being created and its X-window does not exist yet.
777 In that case, just record the parameter's new value
778 in the standard place; do not attempt to change the window. */
781 x_set_foreground_color (f
, arg
, oldval
)
783 Lisp_Object arg
, oldval
;
785 f
->display
.x
->foreground_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
786 if (FRAME_X_WINDOW (f
) != 0)
789 XSetForeground (x_current_display
, f
->display
.x
->normal_gc
,
790 f
->display
.x
->foreground_pixel
);
791 XSetBackground (x_current_display
, f
->display
.x
->reverse_gc
,
792 f
->display
.x
->foreground_pixel
);
794 recompute_basic_faces (f
);
795 if (FRAME_VISIBLE_P (f
))
801 x_set_background_color (f
, arg
, oldval
)
803 Lisp_Object arg
, oldval
;
808 f
->display
.x
->background_pixel
= x_decode_color (arg
, WHITE_PIX_DEFAULT
);
810 if (FRAME_X_WINDOW (f
) != 0)
813 /* The main frame area. */
814 XSetBackground (x_current_display
, f
->display
.x
->normal_gc
,
815 f
->display
.x
->background_pixel
);
816 XSetForeground (x_current_display
, f
->display
.x
->reverse_gc
,
817 f
->display
.x
->background_pixel
);
818 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
819 f
->display
.x
->background_pixel
);
820 XSetWindowBackground (x_current_display
, FRAME_X_WINDOW (f
),
821 f
->display
.x
->background_pixel
);
824 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
825 bar
= XSCROLL_BAR (bar
)->next
)
826 XSetWindowBackground (x_current_display
,
827 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
828 f
->display
.x
->background_pixel
);
832 recompute_basic_faces (f
);
834 if (FRAME_VISIBLE_P (f
))
840 x_set_mouse_color (f
, arg
, oldval
)
842 Lisp_Object arg
, oldval
;
844 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
848 f
->display
.x
->mouse_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
849 mask_color
= f
->display
.x
->background_pixel
;
850 /* No invisible pointers. */
851 if (mask_color
== f
->display
.x
->mouse_pixel
852 && mask_color
== f
->display
.x
->background_pixel
)
853 f
->display
.x
->mouse_pixel
= f
->display
.x
->foreground_pixel
;
857 /* It's not okay to crash if the user selects a screwy cursor. */
860 if (!EQ (Qnil
, Vx_pointer_shape
))
862 CHECK_NUMBER (Vx_pointer_shape
, 0);
863 cursor
= XCreateFontCursor (x_current_display
, XINT (Vx_pointer_shape
));
866 cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
867 x_check_errors ("bad text pointer cursor: %s");
869 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
871 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
872 nontext_cursor
= XCreateFontCursor (x_current_display
,
873 XINT (Vx_nontext_pointer_shape
));
876 nontext_cursor
= XCreateFontCursor (x_current_display
, XC_left_ptr
);
877 x_check_errors ("bad nontext pointer cursor: %s");
879 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
881 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
882 mode_cursor
= XCreateFontCursor (x_current_display
,
883 XINT (Vx_mode_pointer_shape
));
886 mode_cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
887 x_check_errors ("bad modeline pointer cursor: %s");
889 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
891 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
893 = XCreateFontCursor (x_current_display
,
894 XINT (Vx_sensitive_text_pointer_shape
));
897 cross_cursor
= XCreateFontCursor (x_current_display
, XC_crosshair
);
899 /* Check and report errors with the above calls. */
900 x_check_errors ("can't set cursor shape: %s");
904 XColor fore_color
, back_color
;
906 fore_color
.pixel
= f
->display
.x
->mouse_pixel
;
907 back_color
.pixel
= mask_color
;
908 XQueryColor (x_current_display
,
909 DefaultColormap (x_current_display
,
910 DefaultScreen (x_current_display
)),
912 XQueryColor (x_current_display
,
913 DefaultColormap (x_current_display
,
914 DefaultScreen (x_current_display
)),
916 XRecolorCursor (x_current_display
, cursor
,
917 &fore_color
, &back_color
);
918 XRecolorCursor (x_current_display
, nontext_cursor
,
919 &fore_color
, &back_color
);
920 XRecolorCursor (x_current_display
, mode_cursor
,
921 &fore_color
, &back_color
);
922 XRecolorCursor (x_current_display
, cross_cursor
,
923 &fore_color
, &back_color
);
926 if (FRAME_X_WINDOW (f
) != 0)
928 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
), cursor
);
931 if (cursor
!= f
->display
.x
->text_cursor
&& f
->display
.x
->text_cursor
!= 0)
932 XFreeCursor (XDISPLAY f
->display
.x
->text_cursor
);
933 f
->display
.x
->text_cursor
= cursor
;
935 if (nontext_cursor
!= f
->display
.x
->nontext_cursor
936 && f
->display
.x
->nontext_cursor
!= 0)
937 XFreeCursor (XDISPLAY f
->display
.x
->nontext_cursor
);
938 f
->display
.x
->nontext_cursor
= nontext_cursor
;
940 if (mode_cursor
!= f
->display
.x
->modeline_cursor
941 && f
->display
.x
->modeline_cursor
!= 0)
942 XFreeCursor (XDISPLAY f
->display
.x
->modeline_cursor
);
943 f
->display
.x
->modeline_cursor
= mode_cursor
;
944 if (cross_cursor
!= f
->display
.x
->cross_cursor
945 && f
->display
.x
->cross_cursor
!= 0)
946 XFreeCursor (XDISPLAY f
->display
.x
->cross_cursor
);
947 f
->display
.x
->cross_cursor
= cross_cursor
;
954 x_set_cursor_color (f
, arg
, oldval
)
956 Lisp_Object arg
, oldval
;
958 unsigned long fore_pixel
;
960 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
961 fore_pixel
= x_decode_color (Vx_cursor_fore_pixel
, WHITE_PIX_DEFAULT
);
963 fore_pixel
= f
->display
.x
->background_pixel
;
964 f
->display
.x
->cursor_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
966 /* Make sure that the cursor color differs from the background color. */
967 if (f
->display
.x
->cursor_pixel
== f
->display
.x
->background_pixel
)
969 f
->display
.x
->cursor_pixel
= f
->display
.x
->mouse_pixel
;
970 if (f
->display
.x
->cursor_pixel
== fore_pixel
)
971 fore_pixel
= f
->display
.x
->background_pixel
;
973 f
->display
.x
->cursor_foreground_pixel
= fore_pixel
;
975 if (FRAME_X_WINDOW (f
) != 0)
978 XSetBackground (x_current_display
, f
->display
.x
->cursor_gc
,
979 f
->display
.x
->cursor_pixel
);
980 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
984 if (FRAME_VISIBLE_P (f
))
986 x_display_cursor (f
, 0);
987 x_display_cursor (f
, 1);
992 /* Set the border-color of frame F to value described by ARG.
993 ARG can be a string naming a color.
994 The border-color is used for the border that is drawn by the X server.
995 Note that this does not fully take effect if done before
996 F has an x-window; it must be redone when the window is created.
998 Note: this is done in two routines because of the way X10 works.
1000 Note: under X11, this is normally the province of the window manager,
1001 and so emacs' border colors may be overridden. */
1004 x_set_border_color (f
, arg
, oldval
)
1006 Lisp_Object arg
, oldval
;
1011 CHECK_STRING (arg
, 0);
1012 str
= XSTRING (arg
)->data
;
1014 pix
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
1016 x_set_border_pixel (f
, pix
);
1019 /* Set the border-color of frame F to pixel value PIX.
1020 Note that this does not fully take effect if done before
1021 F has an x-window. */
1023 x_set_border_pixel (f
, pix
)
1027 f
->display
.x
->border_pixel
= pix
;
1029 if (FRAME_X_WINDOW (f
) != 0 && f
->display
.x
->border_width
> 0)
1035 XSetWindowBorder (x_current_display
, FRAME_X_WINDOW (f
),
1039 if (FRAME_VISIBLE_P (f
))
1045 x_set_cursor_type (f
, arg
, oldval
)
1047 Lisp_Object arg
, oldval
;
1050 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1055 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
1056 /* Error messages commented out because people have trouble fixing
1057 .Xdefaults with Emacs, when it has something bad in it. */
1061 ("the `cursor-type' frame parameter should be either `bar' or `box'");
1064 /* Make sure the cursor gets redrawn. This is overkill, but how
1065 often do people change cursor types? */
1066 update_mode_lines
++;
1070 x_set_icon_type (f
, arg
, oldval
)
1072 Lisp_Object arg
, oldval
;
1077 if (EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1082 result
= x_text_icon (f
, 0);
1084 result
= x_bitmap_icon (f
);
1089 error ("No icon window available.");
1092 /* If the window was unmapped (and its icon was mapped),
1093 the new icon is not mapped, so map the window in its stead. */
1094 if (FRAME_VISIBLE_P (f
))
1095 #ifdef USE_X_TOOLKIT
1096 XtPopup (f
->display
.x
->widget
, XtGrabNone
);
1098 XMapWindow (XDISPLAY
FRAME_X_WINDOW (f
));
1104 extern Lisp_Object
x_new_font ();
1107 x_set_font (f
, arg
, oldval
)
1109 Lisp_Object arg
, oldval
;
1113 CHECK_STRING (arg
, 1);
1116 result
= x_new_font (f
, XSTRING (arg
)->data
);
1119 if (EQ (result
, Qnil
))
1120 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
1121 else if (EQ (result
, Qt
))
1122 error ("the characters of the given font have varying widths");
1123 else if (STRINGP (result
))
1125 recompute_basic_faces (f
);
1126 store_frame_param (f
, Qfont
, result
);
1133 x_set_border_width (f
, arg
, oldval
)
1135 Lisp_Object arg
, oldval
;
1137 CHECK_NUMBER (arg
, 0);
1139 if (XINT (arg
) == f
->display
.x
->border_width
)
1142 if (FRAME_X_WINDOW (f
) != 0)
1143 error ("Cannot change the border width of a window");
1145 f
->display
.x
->border_width
= XINT (arg
);
1149 x_set_internal_border_width (f
, arg
, oldval
)
1151 Lisp_Object arg
, oldval
;
1154 int old
= f
->display
.x
->internal_border_width
;
1156 CHECK_NUMBER (arg
, 0);
1157 f
->display
.x
->internal_border_width
= XINT (arg
);
1158 if (f
->display
.x
->internal_border_width
< 0)
1159 f
->display
.x
->internal_border_width
= 0;
1161 if (f
->display
.x
->internal_border_width
== old
)
1164 if (FRAME_X_WINDOW (f
) != 0)
1167 x_set_window_size (f
, 0, f
->width
, f
->height
);
1169 x_set_resize_hint (f
);
1173 SET_FRAME_GARBAGED (f
);
1178 x_set_visibility (f
, value
, oldval
)
1180 Lisp_Object value
, oldval
;
1183 XSET (frame
, Lisp_Frame
, f
);
1186 Fmake_frame_invisible (frame
, Qt
);
1187 else if (EQ (value
, Qicon
))
1188 Ficonify_frame (frame
);
1190 Fmake_frame_visible (frame
);
1194 x_set_menu_bar_lines_1 (window
, n
)
1198 struct window
*w
= XWINDOW (window
);
1200 XFASTINT (w
->top
) += n
;
1201 XFASTINT (w
->height
) -= n
;
1203 /* Handle just the top child in a vertical split. */
1204 if (!NILP (w
->vchild
))
1205 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1207 /* Adjust all children in a horizontal split. */
1208 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1210 w
= XWINDOW (window
);
1211 x_set_menu_bar_lines_1 (window
, n
);
1216 x_set_menu_bar_lines (f
, value
, oldval
)
1218 Lisp_Object value
, oldval
;
1221 int olines
= FRAME_MENU_BAR_LINES (f
);
1223 /* Right now, menu bars don't work properly in minibuf-only frames;
1224 most of the commands try to apply themselves to the minibuffer
1225 frame itslef, and get an error because you can't switch buffers
1226 in or split the minibuffer window. */
1227 if (FRAME_MINIBUF_ONLY_P (f
))
1230 if (INTEGERP (value
))
1231 nlines
= XINT (value
);
1235 #ifdef USE_X_TOOLKIT
1236 FRAME_MENU_BAR_LINES (f
) = 0;
1238 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1241 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1242 free_frame_menubar (f
);
1243 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1244 f
->display
.x
->menubar_widget
= 0;
1246 #else /* not USE_X_TOOLKIT */
1247 FRAME_MENU_BAR_LINES (f
) = nlines
;
1248 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1249 #endif /* not USE_X_TOOLKIT */
1252 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1255 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1256 name; if NAME is a string, set F's name to NAME and set
1257 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1259 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1260 suggesting a new name, which lisp code should override; if
1261 F->explicit_name is set, ignore the new name; otherwise, set it. */
1264 x_set_name (f
, name
, explicit)
1269 /* Make sure that requests from lisp code override requests from
1270 Emacs redisplay code. */
1273 /* If we're switching from explicit to implicit, we had better
1274 update the mode lines and thereby update the title. */
1275 if (f
->explicit_name
&& NILP (name
))
1276 update_mode_lines
= 1;
1278 f
->explicit_name
= ! NILP (name
);
1280 else if (f
->explicit_name
)
1283 /* If NAME is nil, set the name to the x_id_name. */
1286 /* Check for no change needed in this very common case
1287 before we do any consing. */
1288 if (!strcmp (x_id_name
, XSTRING (f
->name
)->data
))
1290 name
= build_string (x_id_name
);
1293 CHECK_STRING (name
, 0);
1295 /* Don't change the name if it's already NAME. */
1296 if (! NILP (Fstring_equal (name
, f
->name
)))
1299 if (FRAME_X_WINDOW (f
))
1305 text
.value
= XSTRING (name
)->data
;
1306 text
.encoding
= XA_STRING
;
1308 text
.nitems
= XSTRING (name
)->size
;
1309 #ifdef USE_X_TOOLKIT
1310 XSetWMName (x_current_display
, XtWindow (f
->display
.x
->widget
), &text
);
1311 XSetWMIconName (x_current_display
, XtWindow (f
->display
.x
->widget
),
1313 #else /* not USE_X_TOOLKIT */
1314 XSetWMName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1315 XSetWMIconName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1316 #endif /* not USE_X_TOOLKIT */
1318 #else /* not HAVE_X11R4 */
1319 XSetIconName (XDISPLAY
FRAME_X_WINDOW (f
),
1320 XSTRING (name
)->data
);
1321 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
),
1322 XSTRING (name
)->data
);
1323 #endif /* not HAVE_X11R4 */
1330 /* This function should be called when the user's lisp code has
1331 specified a name for the frame; the name will override any set by the
1334 x_explicitly_set_name (f
, arg
, oldval
)
1336 Lisp_Object arg
, oldval
;
1338 x_set_name (f
, arg
, 1);
1341 /* This function should be called by Emacs redisplay code to set the
1342 name; names set this way will never override names set by the user's
1345 x_implicitly_set_name (f
, arg
, oldval
)
1347 Lisp_Object arg
, oldval
;
1349 x_set_name (f
, arg
, 0);
1353 x_set_autoraise (f
, arg
, oldval
)
1355 Lisp_Object arg
, oldval
;
1357 f
->auto_raise
= !EQ (Qnil
, arg
);
1361 x_set_autolower (f
, arg
, oldval
)
1363 Lisp_Object arg
, oldval
;
1365 f
->auto_lower
= !EQ (Qnil
, arg
);
1369 x_set_vertical_scroll_bars (f
, arg
, oldval
)
1371 Lisp_Object arg
, oldval
;
1373 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
1375 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
1377 /* We set this parameter before creating the X window for the
1378 frame, so we can get the geometry right from the start.
1379 However, if the window hasn't been created yet, we shouldn't
1380 call x_set_window_size. */
1381 if (FRAME_X_WINDOW (f
))
1382 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1387 x_set_scroll_bar_width (f
, arg
, oldval
)
1389 Lisp_Object arg
, oldval
;
1393 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
1394 FRAME_SCROLL_BAR_COLS (f
) = 2;
1396 else if (INTEGERP (arg
) && XINT (arg
) > 0
1397 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
1399 int wid
= FONT_WIDTH (f
->display
.x
->font
);
1400 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
1401 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
1402 if (FRAME_X_WINDOW (f
))
1403 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1407 /* Subroutines of creating an X frame. */
1409 /* Make sure that Vx_resource_name is set to a reasonable value. */
1411 validate_x_resource_name ()
1413 if (STRINGP (Vx_resource_name
))
1415 int len
= XSTRING (Vx_resource_name
)->size
;
1416 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
1419 /* Allow only letters, digits, - and _,
1420 because those are all that X allows. */
1421 for (i
= 0; i
< len
; i
++)
1424 if (! ((c
>= 'a' && c
<= 'z')
1425 || (c
>= 'A' && c
<= 'Z')
1426 || (c
>= '0' && c
<= '9')
1427 || c
== '-' || c
== '_'))
1433 Vx_resource_name
= make_string ("emacs", 5);
1437 extern char *x_get_string_resource ();
1438 extern XrmDatabase
x_load_resources ();
1440 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
1441 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1442 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1443 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1444 the name specified by the `-name' or `-rn' command-line arguments.\n\
1446 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1447 class, respectively. You must specify both of them or neither.\n\
1448 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1449 and the class is `Emacs.CLASS.SUBCLASS'.")
1450 (attribute
, class, component
, subclass
)
1451 Lisp_Object attribute
, class, component
, subclass
;
1453 register char *value
;
1456 Lisp_Object resname
;
1460 CHECK_STRING (attribute
, 0);
1461 CHECK_STRING (class, 0);
1463 if (!NILP (component
))
1464 CHECK_STRING (component
, 1);
1465 if (!NILP (subclass
))
1466 CHECK_STRING (subclass
, 2);
1467 if (NILP (component
) != NILP (subclass
))
1468 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1470 validate_x_resource_name ();
1471 resname
= Vx_resource_name
;
1473 if (NILP (component
))
1475 /* Allocate space for the components, the dots which separate them,
1476 and the final '\0'. */
1477 name_key
= (char *) alloca (XSTRING (resname
)->size
1478 + XSTRING (attribute
)->size
1480 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1481 + XSTRING (class)->size
1484 sprintf (name_key
, "%s.%s",
1485 XSTRING (resname
)->data
,
1486 XSTRING (attribute
)->data
);
1487 sprintf (class_key
, "%s.%s",
1489 XSTRING (class)->data
);
1493 name_key
= (char *) alloca (XSTRING (resname
)->size
1494 + XSTRING (component
)->size
1495 + XSTRING (attribute
)->size
1498 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1499 + XSTRING (class)->size
1500 + XSTRING (subclass
)->size
1503 sprintf (name_key
, "%s.%s.%s",
1504 XSTRING (resname
)->data
,
1505 XSTRING (component
)->data
,
1506 XSTRING (attribute
)->data
);
1507 sprintf (class_key
, "%s.%s.%s",
1509 XSTRING (class)->data
,
1510 XSTRING (subclass
)->data
);
1513 value
= x_get_string_resource (xrdb
, name_key
, class_key
);
1515 if (value
!= (char *) 0)
1516 return build_string (value
);
1521 /* Used when C code wants a resource value. */
1524 x_get_resource_string (attribute
, class)
1525 char *attribute
, *class;
1527 register char *value
;
1531 /* Allocate space for the components, the dots which separate them,
1532 and the final '\0'. */
1533 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
1534 + strlen (attribute
) + 2);
1535 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1536 + strlen (class) + 2);
1538 sprintf (name_key
, "%s.%s",
1539 XSTRING (Vinvocation_name
)->data
,
1541 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
1543 return x_get_string_resource (xrdb
, name_key
, class_key
);
1546 /* Types we might convert a resource string into. */
1549 number
, boolean
, string
, symbol
1552 /* Return the value of parameter PARAM.
1554 First search ALIST, then Vdefault_frame_alist, then the X defaults
1555 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1557 Convert the resource to the type specified by desired_type.
1559 If no default is specified, return Qunbound. If you call
1560 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1561 and don't let it get stored in any lisp-visible variables! */
1564 x_get_arg (alist
, param
, attribute
, class, type
)
1565 Lisp_Object alist
, param
;
1568 enum resource_types type
;
1570 register Lisp_Object tem
;
1572 tem
= Fassq (param
, alist
);
1574 tem
= Fassq (param
, Vdefault_frame_alist
);
1580 tem
= Fx_get_resource (build_string (attribute
),
1581 build_string (class),
1590 return make_number (atoi (XSTRING (tem
)->data
));
1593 tem
= Fdowncase (tem
);
1594 if (!strcmp (XSTRING (tem
)->data
, "on")
1595 || !strcmp (XSTRING (tem
)->data
, "true"))
1604 /* As a special case, we map the values `true' and `on'
1605 to Qt, and `false' and `off' to Qnil. */
1608 lower
= Fdowncase (tem
);
1609 if (!strcmp (XSTRING (lower
)->data
, "on")
1610 || !strcmp (XSTRING (lower
)->data
, "true"))
1612 else if (!strcmp (XSTRING (lower
)->data
, "off")
1613 || !strcmp (XSTRING (lower
)->data
, "false"))
1616 return Fintern (tem
, Qnil
);
1629 /* Record in frame F the specified or default value according to ALIST
1630 of the parameter named PARAM (a Lisp symbol).
1631 If no value is specified for PARAM, look for an X default for XPROP
1632 on the frame named NAME.
1633 If that is not found either, use the value DEFLT. */
1636 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
1643 enum resource_types type
;
1647 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
1648 if (EQ (tem
, Qunbound
))
1650 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
1654 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
1655 "Parse an X-style geometry string STRING.\n\
1656 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
1657 The properties returned may include `top', `left', `height', and `width'.\n\
1658 The value of `left' or `top' may be an integer,\n\
1659 or a list (+ N) meaning N pixels relative to top/left corner,\n\
1660 or a list (- N) meaning -N pixels relative to bottom/right corner.")
1665 unsigned int width
, height
;
1668 CHECK_STRING (string
, 0);
1670 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
1671 &x
, &y
, &width
, &height
);
1674 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
1675 error ("Must specify both x and y position, or neither");
1679 if (geometry
& XValue
)
1681 Lisp_Object element
;
1683 if (x
>= 0 && (geometry
& XNegative
))
1684 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
1685 else if (x
< 0 && ! (geometry
& XNegative
))
1686 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
1688 element
= Fcons (Qleft
, make_number (x
));
1689 result
= Fcons (element
, result
);
1692 if (geometry
& YValue
)
1694 Lisp_Object element
;
1696 if (y
>= 0 && (geometry
& YNegative
))
1697 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
1698 else if (y
< 0 && ! (geometry
& YNegative
))
1699 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
1701 element
= Fcons (Qtop
, make_number (y
));
1702 result
= Fcons (element
, result
);
1705 if (geometry
& WidthValue
)
1706 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
1707 if (geometry
& HeightValue
)
1708 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
1713 /* Calculate the desired size and position of this window,
1714 and return the flags saying which aspects were specified.
1716 This function does not make the coordinates positive. */
1718 #define DEFAULT_ROWS 40
1719 #define DEFAULT_COLS 80
1722 x_figure_window_size (f
, parms
)
1726 register Lisp_Object tem0
, tem1
, tem2
;
1727 int height
, width
, left
, top
;
1728 register int geometry
;
1729 long window_prompting
= 0;
1731 /* Default values if we fall through.
1732 Actually, if that happens we should get
1733 window manager prompting. */
1734 f
->width
= DEFAULT_COLS
;
1735 f
->height
= DEFAULT_ROWS
;
1736 /* Window managers expect that if program-specified
1737 positions are not (0,0), they're intentional, not defaults. */
1738 f
->display
.x
->top_pos
= 0;
1739 f
->display
.x
->left_pos
= 0;
1741 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
1742 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
1743 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
1744 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1746 if (!EQ (tem0
, Qunbound
))
1748 CHECK_NUMBER (tem0
, 0);
1749 f
->height
= XINT (tem0
);
1751 if (!EQ (tem1
, Qunbound
))
1753 CHECK_NUMBER (tem1
, 0);
1754 f
->width
= XINT (tem1
);
1756 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
1757 window_prompting
|= USSize
;
1759 window_prompting
|= PSize
;
1762 f
->display
.x
->vertical_scroll_bar_extra
1763 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1764 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
1766 f
->display
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
1767 f
->display
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
1769 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1770 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1771 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
1772 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1774 if (EQ (tem0
, Qminus
))
1776 f
->display
.x
->top_pos
= 0;
1777 window_prompting
|= YNegative
;
1779 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qminus
)
1780 && CONSP (XCONS (tem0
)->cdr
)
1781 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
1783 f
->display
.x
->top_pos
= - XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
1784 window_prompting
|= YNegative
;
1786 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qplus
)
1787 && CONSP (XCONS (tem0
)->cdr
)
1788 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
1790 f
->display
.x
->top_pos
= XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
1792 else if (EQ (tem0
, Qunbound
))
1793 f
->display
.x
->top_pos
= 0;
1796 CHECK_NUMBER (tem0
, 0);
1797 f
->display
.x
->top_pos
= XINT (tem0
);
1798 if (f
->display
.x
->top_pos
< 0)
1799 window_prompting
|= YNegative
;
1802 if (EQ (tem1
, Qminus
))
1804 f
->display
.x
->left_pos
= 0;
1805 window_prompting
|= XNegative
;
1807 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qminus
)
1808 && CONSP (XCONS (tem1
)->cdr
)
1809 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
1811 f
->display
.x
->left_pos
= - XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
1812 window_prompting
|= XNegative
;
1814 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qplus
)
1815 && CONSP (XCONS (tem1
)->cdr
)
1816 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
1818 f
->display
.x
->left_pos
= XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
1820 else if (EQ (tem1
, Qunbound
))
1821 f
->display
.x
->left_pos
= 0;
1824 CHECK_NUMBER (tem1
, 0);
1825 f
->display
.x
->left_pos
= XINT (tem1
);
1826 if (f
->display
.x
->left_pos
< 0)
1827 window_prompting
|= XNegative
;
1831 window_prompting
|= USPosition
;
1833 window_prompting
|= PPosition
;
1836 return window_prompting
;
1839 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
1842 XSetWMProtocols (dpy
, w
, protocols
, count
)
1849 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
1850 if (prop
== None
) return False
;
1851 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
1852 (unsigned char *) protocols
, count
);
1855 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
1857 #ifdef USE_X_TOOLKIT
1859 /* WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
1860 already be present because of the toolkit (Motif adds some of them,
1861 for example, but Xt doesn't). */
1864 hack_wm_protocols (widget
)
1867 Display
*dpy
= XtDisplay (widget
);
1868 Window w
= XtWindow (widget
);
1869 int need_delete
= 1;
1875 Atom type
, *atoms
= 0;
1877 unsigned long nitems
= 0;
1878 unsigned long bytes_after
;
1880 if (Success
== XGetWindowProperty (dpy
, w
, Xatom_wm_protocols
,
1881 0, 100, False
, XA_ATOM
,
1882 &type
, &format
, &nitems
, &bytes_after
,
1883 (unsigned char **) &atoms
)
1884 && format
== 32 && type
== XA_ATOM
)
1888 if (atoms
[nitems
] == Xatom_wm_delete_window
) need_delete
= 0;
1889 else if (atoms
[nitems
] == Xatom_wm_take_focus
) need_focus
= 0;
1890 else if (atoms
[nitems
] == Xatom_wm_save_yourself
) need_save
= 0;
1892 if (atoms
) XFree ((char *) atoms
);
1897 if (need_delete
) props
[count
++] = Xatom_wm_delete_window
;
1898 if (need_focus
) props
[count
++] = Xatom_wm_take_focus
;
1899 if (need_save
) props
[count
++] = Xatom_wm_save_yourself
;
1901 XChangeProperty (dpy
, w
, Xatom_wm_protocols
, XA_ATOM
, 32, PropModeAppend
,
1902 (unsigned char *) props
, count
);
1908 #ifdef USE_X_TOOLKIT
1910 /* Create and set up the X widget for frame F. */
1913 x_window (f
, window_prompting
, minibuffer_only
)
1915 long window_prompting
;
1916 int minibuffer_only
;
1918 XClassHint class_hints
;
1919 XSetWindowAttributes attributes
;
1920 unsigned long attribute_mask
;
1922 Widget shell_widget
;
1924 Widget screen_widget
;
1931 if (STRINGP (f
->name
))
1932 name
= (char*) XSTRING (f
->name
)->data
;
1937 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
1938 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
1939 shell_widget
= XtCreatePopupShell ("shell",
1940 topLevelShellWidgetClass
,
1941 Xt_app_shell
, al
, ac
);
1943 f
->display
.x
->widget
= shell_widget
;
1944 /* maybe_set_screen_title_format (shell_widget); */
1948 XtSetArg (al
[ac
], XtNborderWidth
, 0); ac
++;
1949 pane_widget
= XtCreateWidget ("pane",
1951 shell_widget
, al
, ac
);
1953 f
->display
.x
->column_widget
= pane_widget
;
1955 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
1956 initialize_frame_menubar (f
);
1958 /* mappedWhenManaged to false tells to the paned window to not map/unmap
1959 the emacs screen when changing menubar. This reduces flickering. */
1962 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
1963 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
1964 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
1965 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
1966 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
1967 screen_widget
= XtCreateWidget (name
,
1969 pane_widget
, al
, ac
);
1971 f
->display
.x
->edit_widget
= screen_widget
;
1973 if (f
->display
.x
->menubar_widget
)
1974 XtManageChild (f
->display
.x
->menubar_widget
);
1975 XtManageChild (screen_widget
);
1977 /* Do some needed geometry management. */
1980 char *tem
, shell_position
[32];
1984 = (f
->display
.x
->menubar_widget
1985 ? (f
->display
.x
->menubar_widget
->core
.height
1986 + f
->display
.x
->menubar_widget
->core
.border_width
)
1989 if (FRAME_EXTERNAL_MENU_BAR (f
))
1992 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
1993 menubar_size
+= ibw
;
1996 if (window_prompting
& USPosition
)
1998 int left
= f
->display
.x
->left_pos
;
1999 int xneg
= window_prompting
& XNegative
;
2000 int top
= f
->display
.x
->top_pos
;
2001 int yneg
= window_prompting
& YNegative
;
2006 sprintf (shell_position
, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f
),
2007 PIXEL_HEIGHT (f
) + menubar_size
,
2008 (xneg
? '-' : '+'), left
,
2009 (yneg
? '-' : '+'), top
);
2012 sprintf (shell_position
, "=%dx%d", PIXEL_WIDTH (f
),
2013 PIXEL_HEIGHT (f
) + menubar_size
);
2014 len
= strlen (shell_position
) + 1;
2015 tem
= (char *) xmalloc (len
);
2016 strncpy (tem
, shell_position
, len
);
2017 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
2018 XtSetValues (shell_widget
, al
, ac
);
2021 x_calc_absolute_position (f
);
2023 XtManageChild (pane_widget
);
2024 XtRealizeWidget (shell_widget
);
2026 FRAME_X_WINDOW (f
) = XtWindow (screen_widget
);
2028 validate_x_resource_name ();
2029 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2030 class_hints
.res_class
= EMACS_CLASS
;
2031 XSetClassHint (x_current_display
, XtWindow (shell_widget
), &class_hints
);
2033 f
->display
.x
->wm_hints
.input
= True
;
2034 f
->display
.x
->wm_hints
.flags
|= InputHint
;
2035 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
2037 hack_wm_protocols (shell_widget
);
2039 /* Do a stupid property change to force the server to generate a
2040 propertyNotify event so that the event_stream server timestamp will
2041 be initialized to something relevant to the time we created the window.
2043 XChangeProperty (XtDisplay (screen_widget
), XtWindow (screen_widget
),
2044 Xatom_wm_protocols
, XA_ATOM
, 32, PropModeAppend
,
2045 (unsigned char*) NULL
, 0);
2047 /* Make all the standard events reach the Emacs frame. */
2048 attributes
.event_mask
= STANDARD_EVENT_SET
;
2049 attribute_mask
= CWEventMask
;
2050 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
2051 attribute_mask
, &attributes
);
2053 XtMapWidget (screen_widget
);
2055 /* x_set_name normally ignores requests to set the name if the
2056 requested name is the same as the current name. This is the one
2057 place where that assumption isn't correct; f->name is set, but
2058 the X server hasn't been told. */
2061 int explicit = f
->explicit_name
;
2063 f
->explicit_name
= 0;
2066 x_set_name (f
, name
, explicit);
2069 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
2070 f
->display
.x
->text_cursor
);
2074 if (FRAME_X_WINDOW (f
) == 0)
2075 error ("Unable to create window");
2078 #else /* not USE_X_TOOLKIT */
2080 /* Create and set up the X window for frame F. */
2086 XClassHint class_hints
;
2087 XSetWindowAttributes attributes
;
2088 unsigned long attribute_mask
;
2090 attributes
.background_pixel
= f
->display
.x
->background_pixel
;
2091 attributes
.border_pixel
= f
->display
.x
->border_pixel
;
2092 attributes
.bit_gravity
= StaticGravity
;
2093 attributes
.backing_store
= NotUseful
;
2094 attributes
.save_under
= True
;
2095 attributes
.event_mask
= STANDARD_EVENT_SET
;
2096 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
2098 | CWBackingStore
| CWSaveUnder
2104 = XCreateWindow (x_current_display
, ROOT_WINDOW
,
2105 f
->display
.x
->left_pos
,
2106 f
->display
.x
->top_pos
,
2107 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
2108 f
->display
.x
->border_width
,
2109 CopyFromParent
, /* depth */
2110 InputOutput
, /* class */
2111 screen_visual
, /* set in Fx_open_connection */
2112 attribute_mask
, &attributes
);
2114 validate_x_resource_name ();
2115 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2116 class_hints
.res_class
= EMACS_CLASS
;
2117 XSetClassHint (x_current_display
, FRAME_X_WINDOW (f
), &class_hints
);
2119 /* This indicates that we use the "Passive Input" input model.
2120 Unless we do this, we don't get the Focus{In,Out} events that we
2121 need to draw the cursor correctly. Accursed bureaucrats.
2122 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
2124 f
->display
.x
->wm_hints
.input
= True
;
2125 f
->display
.x
->wm_hints
.flags
|= InputHint
;
2126 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
2128 /* Request "save yourself" and "delete window" commands from wm. */
2131 protocols
[0] = Xatom_wm_delete_window
;
2132 protocols
[1] = Xatom_wm_save_yourself
;
2133 XSetWMProtocols (x_current_display
, FRAME_X_WINDOW (f
), protocols
, 2);
2136 /* x_set_name normally ignores requests to set the name if the
2137 requested name is the same as the current name. This is the one
2138 place where that assumption isn't correct; f->name is set, but
2139 the X server hasn't been told. */
2142 int explicit = f
->explicit_name
;
2144 f
->explicit_name
= 0;
2147 x_set_name (f
, name
, explicit);
2150 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
2151 f
->display
.x
->text_cursor
);
2155 if (FRAME_X_WINDOW (f
) == 0)
2156 error ("Unable to create window");
2159 #endif /* not USE_X_TOOLKIT */
2161 /* Handle the icon stuff for this window. Perhaps later we might
2162 want an x_set_icon_position which can be called interactively as
2170 Lisp_Object icon_x
, icon_y
;
2172 /* Set the position of the icon. Note that twm groups all
2173 icons in an icon window. */
2174 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
2175 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
2176 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
2178 CHECK_NUMBER (icon_x
, 0);
2179 CHECK_NUMBER (icon_y
, 0);
2181 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
2182 error ("Both left and top icon corners of icon must be specified");
2186 if (! EQ (icon_x
, Qunbound
))
2187 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
2189 /* Start up iconic or window? */
2190 x_wm_set_window_state
2191 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
2198 /* Make the GC's needed for this window, setting the
2199 background, border and mouse colors; also create the
2200 mouse cursor and the gray border tile. */
2202 static char cursor_bits
[] =
2204 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2205 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2206 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2207 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2214 XGCValues gc_values
;
2220 /* Create the GC's of this frame.
2221 Note that many default values are used. */
2224 gc_values
.font
= f
->display
.x
->font
->fid
;
2225 gc_values
.foreground
= f
->display
.x
->foreground_pixel
;
2226 gc_values
.background
= f
->display
.x
->background_pixel
;
2227 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
2228 f
->display
.x
->normal_gc
= XCreateGC (x_current_display
,
2230 GCLineWidth
| GCFont
2231 | GCForeground
| GCBackground
,
2234 /* Reverse video style. */
2235 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2236 gc_values
.background
= f
->display
.x
->foreground_pixel
;
2237 f
->display
.x
->reverse_gc
= XCreateGC (x_current_display
,
2239 GCFont
| GCForeground
| GCBackground
2243 /* Cursor has cursor-color background, background-color foreground. */
2244 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2245 gc_values
.background
= f
->display
.x
->cursor_pixel
;
2246 gc_values
.fill_style
= FillOpaqueStippled
;
2248 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
2249 cursor_bits
, 16, 16);
2250 f
->display
.x
->cursor_gc
2251 = XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
2252 (GCFont
| GCForeground
| GCBackground
2253 | GCFillStyle
| GCStipple
| GCLineWidth
),
2256 /* Create the gray border tile used when the pointer is not in
2257 the frame. Since this depends on the frame's pixel values,
2258 this must be done on a per-frame basis. */
2259 f
->display
.x
->border_tile
2260 = (XCreatePixmapFromBitmapData
2261 (x_current_display
, ROOT_WINDOW
,
2262 gray_bits
, gray_width
, gray_height
,
2263 f
->display
.x
->foreground_pixel
,
2264 f
->display
.x
->background_pixel
,
2265 DefaultDepth (x_current_display
, XDefaultScreen (x_current_display
))));
2270 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
2272 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2273 Return an Emacs frame object representing the X window.\n\
2274 ALIST is an alist of frame parameters.\n\
2275 If the parameters specify that the frame should not have a minibuffer,\n\
2276 and do not specify a specific minibuffer window to use,\n\
2277 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2278 be shared by the new frame.")
2283 Lisp_Object frame
, tem
;
2285 int minibuffer_only
= 0;
2286 long window_prompting
= 0;
2288 int count
= specpdl_ptr
- specpdl
;
2289 struct gcpro gcpro1
;
2293 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
2295 && ! EQ (name
, Qunbound
)
2297 error ("x-create-frame: name parameter must be a string");
2299 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2300 if (EQ (tem
, Qnone
) || NILP (tem
))
2301 f
= make_frame_without_minibuffer (Qnil
);
2302 else if (EQ (tem
, Qonly
))
2304 f
= make_minibuffer_frame ();
2305 minibuffer_only
= 1;
2307 else if (WINDOWP (tem
))
2308 f
= make_frame_without_minibuffer (tem
);
2312 /* Note that X Windows does support scroll bars. */
2313 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
2315 /* Set the name; the functions to which we pass f expect the name to
2317 if (EQ (name
, Qunbound
) || NILP (name
))
2319 f
->name
= build_string (x_id_name
);
2320 f
->explicit_name
= 0;
2325 f
->explicit_name
= 1;
2326 /* use the frame's title when getting resources for this frame. */
2327 specbind (Qx_resource_name
, name
);
2330 XSET (frame
, Lisp_Frame
, f
);
2333 f
->output_method
= output_x_window
;
2334 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2335 bzero (f
->display
.x
, sizeof (struct x_display
));
2337 /* Note that the frame has no physical cursor right now. */
2338 f
->phys_cursor_x
= -1;
2340 /* Extract the window parameters from the supplied values
2341 that are needed to determine window geometry. */
2345 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
2347 /* First, try whatever font the caller has specified. */
2349 font
= x_new_font (f
, XSTRING (font
)->data
);
2350 /* Try out a font which we hope has bold and italic variations. */
2351 if (!STRINGP (font
))
2352 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
2353 if (! STRINGP (font
))
2354 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
2355 if (! STRINGP (font
))
2356 /* This was formerly the first thing tried, but it finds too many fonts
2357 and takes too long. */
2358 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
2359 /* If those didn't work, look for something which will at least work. */
2360 if (! STRINGP (font
))
2361 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
2363 if (! STRINGP (font
))
2364 font
= build_string ("fixed");
2366 x_default_parameter (f
, parms
, Qfont
, font
,
2367 "font", "Font", string
);
2370 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
2371 "borderwidth", "BorderWidth", number
);
2372 /* This defaults to 2 in order to match xterm. We recognize either
2373 internalBorderWidth or internalBorder (which is what xterm calls
2375 if (NILP (Fassq (Qinternal_border_width
, parms
)))
2379 value
= x_get_arg (parms
, Qinternal_border_width
,
2380 "internalBorder", "BorderWidth", number
);
2381 if (! EQ (value
, Qunbound
))
2382 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
2385 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
2386 "internalBorderWidth", "BorderWidth", number
);
2387 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
2388 "verticalScrollBars", "ScrollBars", boolean
);
2390 /* Also do the stuff which must be set before the window exists. */
2391 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
2392 "foreground", "Foreground", string
);
2393 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
2394 "background", "Background", string
);
2395 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
2396 "pointerColor", "Foreground", string
);
2397 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
2398 "cursorColor", "Foreground", string
);
2399 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
2400 "borderColor", "BorderColor", string
);
2402 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
2403 "menuBar", "MenuBar", number
);
2404 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
2405 "scrollBarWidth", "ScrollBarWidth", number
);
2407 f
->display
.x
->parent_desc
= ROOT_WINDOW
;
2408 window_prompting
= x_figure_window_size (f
, parms
);
2410 if (window_prompting
& XNegative
)
2412 if (window_prompting
& YNegative
)
2413 f
->display
.x
->win_gravity
= SouthEastGravity
;
2415 f
->display
.x
->win_gravity
= NorthEastGravity
;
2419 if (window_prompting
& YNegative
)
2420 f
->display
.x
->win_gravity
= SouthWestGravity
;
2422 f
->display
.x
->win_gravity
= NorthWestGravity
;
2425 f
->display
.x
->size_hint_flags
= window_prompting
;
2427 #ifdef USE_X_TOOLKIT
2428 x_window (f
, window_prompting
, minibuffer_only
);
2434 init_frame_faces (f
);
2436 /* We need to do this after creating the X window, so that the
2437 icon-creation functions can say whose icon they're describing. */
2438 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2439 "bitmapIcon", "BitmapIcon", symbol
);
2441 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
2442 "autoRaise", "AutoRaiseLower", boolean
);
2443 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
2444 "autoLower", "AutoRaiseLower", boolean
);
2445 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
2446 "cursorType", "CursorType", symbol
);
2448 /* Dimensions, especially f->height, must be done via change_frame_size.
2449 Change will not be effected unless different from the current
2453 f
->height
= f
->width
= 0;
2454 change_frame_size (f
, height
, width
, 1, 0);
2456 /* With the toolkit, the geometry management is done in x_window. */
2457 #ifndef USE_X_TOOLKIT
2459 x_wm_set_size_hint (f
, window_prompting
, 0);
2461 #endif /* USE_X_TOOLKIT */
2463 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2464 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2466 FRAME_X_SCREEN (f
) = &the_x_screen
;
2467 FRAME_X_SCREEN (f
)->reference_count
++;
2468 the_x_screen
.x_display_value
= x_current_display
;
2472 /* It is now ok to make the frame official
2473 even if we get an error below.
2474 And the frame needs to be on Vframe_list
2475 or making it visible won't work. */
2476 Vframe_list
= Fcons (frame
, Vframe_list
);
2478 /* Make the window appear on the frame and enable display,
2479 unless the caller says not to. */
2481 Lisp_Object visibility
;
2483 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2484 if (EQ (visibility
, Qunbound
))
2487 if (EQ (visibility
, Qicon
))
2488 x_iconify_frame (f
);
2489 else if (! NILP (visibility
))
2490 x_make_frame_visible (f
);
2492 /* Must have been Qnil. */
2496 return unbind_to (count
, frame
);
2500 x_get_focus_frame ()
2503 if (! x_focus_frame
)
2506 XSET (xfocus
, Lisp_Frame
, x_focus_frame
);
2510 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
2511 "Set the focus on FRAME.")
2515 CHECK_LIVE_FRAME (frame
, 0);
2517 if (FRAME_X_P (XFRAME (frame
)))
2520 x_focus_on_frame (XFRAME (frame
));
2528 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
2529 "If a frame has been focused, release it.")
2535 x_unfocus_frame (x_focus_frame
);
2542 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
2543 "Return a list of the names of available fonts matching PATTERN.\n\
2544 If optional arguments FACE and FRAME are specified, return only fonts\n\
2545 the same size as FACE on FRAME.\n\
2547 PATTERN is a string, perhaps with wildcard characters;\n\
2548 the * character matches any substring, and\n\
2549 the ? character matches any single character.\n\
2550 PATTERN is case-insensitive.\n\
2551 FACE is a face name - a symbol.\n\
2553 The return value is a list of strings, suitable as arguments to\n\
2556 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
2557 even if they match PATTERN and FACE.")
2558 (pattern
, face
, frame
)
2559 Lisp_Object pattern
, face
, frame
;
2564 XFontStruct
*size_ref
;
2569 CHECK_STRING (pattern
, 0);
2571 CHECK_SYMBOL (face
, 1);
2573 CHECK_LIVE_FRAME (frame
, 2);
2575 f
= NILP (frame
) ? selected_frame
: XFRAME (frame
);
2577 /* Determine the width standard for comparison with the fonts we find. */
2585 /* Don't die if we get called with a terminal frame. */
2586 if (! FRAME_X_P (f
))
2587 error ("non-X frame used in `x-list-fonts'");
2589 face_id
= face_name_id_number (f
, face
);
2591 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
2592 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
2593 size_ref
= f
->display
.x
->font
;
2596 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
2597 if (size_ref
== (XFontStruct
*) (~0))
2598 size_ref
= f
->display
.x
->font
;
2602 /* See if we cached the result for this particular query. */
2603 list
= Fassoc (pattern
, FRAME_X_SCREEN (f
)->font_list_cache
);
2605 /* We have info in the cache for this PATTERN. */
2608 Lisp_Object tem
, newlist
;
2610 /* We have info about this pattern. */
2611 list
= XCONS (list
)->cdr
;
2618 /* Filter the cached info and return just the fonts that match FACE. */
2620 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
2622 XFontStruct
*thisinfo
;
2624 thisinfo
= XLoadQueryFont (x_current_display
,
2625 XSTRING (XCONS (tem
)->car
)->data
);
2627 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
2628 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
2630 XFreeFont (x_current_display
, thisinfo
);
2640 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
2641 #ifdef BROKEN_XLISTFONTSWITHINFO
2642 names
= XListFonts (x_current_display
,
2643 XSTRING (pattern
)->data
,
2644 2000, /* maxnames */
2645 &num_fonts
); /* count_return */
2647 names
= XListFontsWithInfo (x_current_display
,
2648 XSTRING (pattern
)->data
,
2649 2000, /* maxnames */
2650 &num_fonts
, /* count_return */
2651 &info
); /* info_return */
2660 Lisp_Object full_list
;
2662 /* Make a list of all the fonts we got back.
2663 Store that in the font cache for the display. */
2665 for (i
= 0; i
< num_fonts
; i
++)
2666 full_list
= Fcons (build_string (names
[i
]), full_list
);
2667 FRAME_X_SCREEN (f
)->font_list_cache
2668 = Fcons (Fcons (pattern
, full_list
),
2669 FRAME_X_SCREEN (f
)->font_list_cache
);
2671 /* Make a list of the fonts that have the right width. */
2673 for (i
= 0; i
< num_fonts
; i
++)
2675 XFontStruct
*thisinfo
;
2677 #ifdef BROKEN_XLISTFONTSWITHINFO
2679 thisinfo
= XLoadQueryFont (x_current_display
, names
[i
]);
2682 thisinfo
= &info
[i
];
2684 if (thisinfo
&& (! size_ref
2685 || same_size_fonts (thisinfo
, size_ref
)))
2686 list
= Fcons (build_string (names
[i
]), list
);
2688 list
= Fnreverse (list
);
2691 #ifdef BROKEN_XLISTFONTSWITHINFO
2692 XFreeFontNames (names
);
2694 XFreeFontInfo (names
, info
, num_fonts
);
2703 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 1, 0,
2704 "Return non-nil if the X display supports the color named COLOR.")
2711 CHECK_STRING (color
, 0);
2713 if (defined_color (XSTRING (color
)->data
, &foo
, 0))
2719 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 1, 0,
2720 "Return a description of the color named COLOR.\n\
2721 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
2722 These values appear to range from 0 to 65280; white is (65280 65280 65280).")
2729 CHECK_STRING (color
, 0);
2731 if (defined_color (XSTRING (color
)->data
, &foo
, 0))
2735 rgb
[0] = make_number (foo
.red
);
2736 rgb
[1] = make_number (foo
.green
);
2737 rgb
[2] = make_number (foo
.blue
);
2738 return Flist (3, rgb
);
2744 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 0, 0,
2745 "Return t if the X screen currently in use supports color.")
2750 if (x_screen_planes
<= 2)
2753 switch (screen_visual
->class)
2766 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
2768 "Return t if the X screen currently in use supports grayscale.")
2773 return (x_screen_planes
> 1
2774 && (screen_visual
->class == StaticGray
2775 || screen_visual
->class == GrayScale
));
2778 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
2780 "Returns the width in pixels of the display FRAME is on.")
2784 Display
*dpy
= x_current_display
;
2786 return make_number (DisplayWidth (dpy
, DefaultScreen (dpy
)));
2789 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
2790 Sx_display_pixel_height
, 0, 1, 0,
2791 "Returns the height in pixels of the display FRAME is on.")
2795 Display
*dpy
= x_current_display
;
2797 return make_number (DisplayHeight (dpy
, DefaultScreen (dpy
)));
2800 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
2802 "Returns the number of bitplanes of the display FRAME is on.")
2806 Display
*dpy
= x_current_display
;
2808 return make_number (DisplayPlanes (dpy
, DefaultScreen (dpy
)));
2811 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
2813 "Returns the number of color cells of the display FRAME is on.")
2817 Display
*dpy
= x_current_display
;
2819 return make_number (DisplayCells (dpy
, DefaultScreen (dpy
)));
2822 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
2823 Sx_server_max_request_size
,
2825 "Returns the maximum request size of the X server FRAME is using.")
2829 Display
*dpy
= x_current_display
;
2831 return make_number (MAXREQUEST (dpy
));
2834 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
2835 "Returns the vendor ID string of the X server FRAME is on.")
2839 Display
*dpy
= x_current_display
;
2842 vendor
= ServerVendor (dpy
);
2843 if (! vendor
) vendor
= "";
2844 return build_string (vendor
);
2847 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
2848 "Returns the version numbers of the X server in use.\n\
2849 The value is a list of three integers: the major and minor\n\
2850 version numbers of the X Protocol in use, and the vendor-specific release\n\
2851 number. See also the variable `x-server-vendor'.")
2855 Display
*dpy
= x_current_display
;
2858 return Fcons (make_number (ProtocolVersion (dpy
)),
2859 Fcons (make_number (ProtocolRevision (dpy
)),
2860 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
2863 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
2864 "Returns the number of screens on the X server FRAME is on.")
2869 return make_number (ScreenCount (x_current_display
));
2872 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
2873 "Returns the height in millimeters of the X screen FRAME is on.")
2878 return make_number (HeightMMOfScreen (x_screen
));
2881 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
2882 "Returns the width in millimeters of the X screen FRAME is on.")
2887 return make_number (WidthMMOfScreen (x_screen
));
2890 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
2891 Sx_display_backing_store
, 0, 1, 0,
2892 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2893 The value may be `always', `when-mapped', or `not-useful'.")
2899 switch (DoesBackingStore (x_screen
))
2902 return intern ("always");
2905 return intern ("when-mapped");
2908 return intern ("not-useful");
2911 error ("Strange value for BackingStore parameter of screen");
2915 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
2916 Sx_display_visual_class
, 0, 1, 0,
2917 "Returns the visual class of the display `screen' is on.\n\
2918 The value is one of the symbols `static-gray', `gray-scale',\n\
2919 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2925 switch (screen_visual
->class)
2927 case StaticGray
: return (intern ("static-gray"));
2928 case GrayScale
: return (intern ("gray-scale"));
2929 case StaticColor
: return (intern ("static-color"));
2930 case PseudoColor
: return (intern ("pseudo-color"));
2931 case TrueColor
: return (intern ("true-color"));
2932 case DirectColor
: return (intern ("direct-color"));
2934 error ("Display has an unknown visual class");
2938 DEFUN ("x-display-save-under", Fx_display_save_under
,
2939 Sx_display_save_under
, 0, 1, 0,
2940 "Returns t if the X screen FRAME is on supports the save-under feature.")
2946 if (DoesSaveUnders (x_screen
) == True
)
2953 register struct frame
*f
;
2955 return PIXEL_WIDTH (f
);
2959 register struct frame
*f
;
2961 return PIXEL_HEIGHT (f
);
2965 register struct frame
*f
;
2967 return FONT_WIDTH (f
->display
.x
->font
);
2971 register struct frame
*f
;
2973 return f
->display
.x
->line_height
;
2976 #if 0 /* These no longer seem like the right way to do things. */
2978 /* Draw a rectangle on the frame with left top corner including
2979 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2980 CHARS by LINES wide and long and is the color of the cursor. */
2983 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
2984 register struct frame
*f
;
2986 register int top_char
, left_char
, chars
, lines
;
2990 int left
= (left_char
* FONT_WIDTH (f
->display
.x
->font
)
2991 + f
->display
.x
->internal_border_width
);
2992 int top
= (top_char
* f
->display
.x
->line_height
2993 + f
->display
.x
->internal_border_width
);
2996 width
= FONT_WIDTH (f
->display
.x
->font
) / 2;
2998 width
= FONT_WIDTH (f
->display
.x
->font
) * chars
;
3000 height
= f
->display
.x
->line_height
/ 2;
3002 height
= f
->display
.x
->line_height
* lines
;
3004 XDrawRectangle (x_current_display
, FRAME_X_WINDOW (f
),
3005 gc
, left
, top
, width
, height
);
3008 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
3009 "Draw a rectangle on FRAME between coordinates specified by\n\
3010 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3011 (frame
, X0
, Y0
, X1
, Y1
)
3012 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
3014 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3016 CHECK_LIVE_FRAME (frame
, 0);
3017 CHECK_NUMBER (X0
, 0);
3018 CHECK_NUMBER (Y0
, 1);
3019 CHECK_NUMBER (X1
, 2);
3020 CHECK_NUMBER (Y1
, 3);
3030 n_lines
= y1
- y0
+ 1;
3035 n_lines
= y0
- y1
+ 1;
3041 n_chars
= x1
- x0
+ 1;
3046 n_chars
= x0
- x1
+ 1;
3050 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->cursor_gc
,
3051 left
, top
, n_chars
, n_lines
);
3057 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
3058 "Draw a rectangle drawn on FRAME between coordinates\n\
3059 X0, Y0, X1, Y1 in the regular background-pixel.")
3060 (frame
, X0
, Y0
, X1
, Y1
)
3061 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
3063 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3065 CHECK_FRAME (frame
, 0);
3066 CHECK_NUMBER (X0
, 0);
3067 CHECK_NUMBER (Y0
, 1);
3068 CHECK_NUMBER (X1
, 2);
3069 CHECK_NUMBER (Y1
, 3);
3079 n_lines
= y1
- y0
+ 1;
3084 n_lines
= y0
- y1
+ 1;
3090 n_chars
= x1
- x0
+ 1;
3095 n_chars
= x0
- x1
+ 1;
3099 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->reverse_gc
,
3100 left
, top
, n_chars
, n_lines
);
3106 /* Draw lines around the text region beginning at the character position
3107 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3108 pixel and line characteristics. */
3110 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3113 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
3114 register struct frame
*f
;
3116 int top_x
, top_y
, bottom_x
, bottom_y
;
3118 register int ibw
= f
->display
.x
->internal_border_width
;
3119 register int font_w
= FONT_WIDTH (f
->display
.x
->font
);
3120 register int font_h
= f
->display
.x
->line_height
;
3122 int x
= line_len (y
);
3123 XPoint
*pixel_points
3124 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
3125 register XPoint
*this_point
= pixel_points
;
3127 /* Do the horizontal top line/lines */
3130 this_point
->x
= ibw
;
3131 this_point
->y
= ibw
+ (font_h
* top_y
);
3134 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
3136 this_point
->x
= ibw
+ (font_w
* x
);
3137 this_point
->y
= (this_point
- 1)->y
;
3141 this_point
->x
= ibw
;
3142 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
3144 this_point
->x
= ibw
+ (font_w
* top_x
);
3145 this_point
->y
= (this_point
- 1)->y
;
3147 this_point
->x
= (this_point
- 1)->x
;
3148 this_point
->y
= ibw
+ (font_h
* top_y
);
3150 this_point
->x
= ibw
+ (font_w
* x
);
3151 this_point
->y
= (this_point
- 1)->y
;
3154 /* Now do the right side. */
3155 while (y
< bottom_y
)
3156 { /* Right vertical edge */
3158 this_point
->x
= (this_point
- 1)->x
;
3159 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
3162 y
++; /* Horizontal connection to next line */
3165 this_point
->x
= ibw
+ (font_w
/ 2);
3167 this_point
->x
= ibw
+ (font_w
* x
);
3169 this_point
->y
= (this_point
- 1)->y
;
3172 /* Now do the bottom and connect to the top left point. */
3173 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
3176 this_point
->x
= (this_point
- 1)->x
;
3177 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
3179 this_point
->x
= ibw
;
3180 this_point
->y
= (this_point
- 1)->y
;
3182 this_point
->x
= pixel_points
->x
;
3183 this_point
->y
= pixel_points
->y
;
3185 XDrawLines (x_current_display
, FRAME_X_WINDOW (f
),
3187 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
3190 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
3191 "Highlight the region between point and the character under the mouse\n\
3194 register Lisp_Object event
;
3196 register int x0
, y0
, x1
, y1
;
3197 register struct frame
*f
= selected_frame
;
3198 register int p1
, p2
;
3200 CHECK_CONS (event
, 0);
3203 x0
= XINT (Fcar (Fcar (event
)));
3204 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3206 /* If the mouse is past the end of the line, don't that area. */
3207 /* ReWrite this... */
3212 if (y1
> y0
) /* point below mouse */
3213 outline_region (f
, f
->display
.x
->cursor_gc
,
3215 else if (y1
< y0
) /* point above mouse */
3216 outline_region (f
, f
->display
.x
->cursor_gc
,
3218 else /* same line: draw horizontal rectangle */
3221 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3222 x0
, y0
, (x1
- x0
+ 1), 1);
3224 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3225 x1
, y1
, (x0
- x1
+ 1), 1);
3228 XFlush (x_current_display
);
3234 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
3235 "Erase any highlighting of the region between point and the character\n\
3236 at X, Y on the selected frame.")
3238 register Lisp_Object event
;
3240 register int x0
, y0
, x1
, y1
;
3241 register struct frame
*f
= selected_frame
;
3244 x0
= XINT (Fcar (Fcar (event
)));
3245 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3249 if (y1
> y0
) /* point below mouse */
3250 outline_region (f
, f
->display
.x
->reverse_gc
,
3252 else if (y1
< y0
) /* point above mouse */
3253 outline_region (f
, f
->display
.x
->reverse_gc
,
3255 else /* same line: draw horizontal rectangle */
3258 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3259 x0
, y0
, (x1
- x0
+ 1), 1);
3261 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3262 x1
, y1
, (x0
- x1
+ 1), 1);
3270 int contour_begin_x
, contour_begin_y
;
3271 int contour_end_x
, contour_end_y
;
3272 int contour_npoints
;
3274 /* Clip the top part of the contour lines down (and including) line Y_POS.
3275 If X_POS is in the middle (rather than at the end) of the line, drop
3276 down a line at that character. */
3279 clip_contour_top (y_pos
, x_pos
)
3281 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
3282 register XPoint
*end
;
3283 register int npoints
;
3284 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
3286 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
3288 end
= contour_lines
[y_pos
].top_right
;
3289 npoints
= (end
- begin
+ 1);
3290 XDrawLines (x_current_display
, contour_window
,
3291 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3293 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
3294 contour_last_point
-= (npoints
- 2);
3295 XDrawLines (x_current_display
, contour_window
,
3296 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
3297 XFlush (x_current_display
);
3299 /* Now, update contour_lines structure. */
3304 register XPoint
*p
= begin
+ 1;
3305 end
= contour_lines
[y_pos
].bottom_right
;
3306 npoints
= (end
- begin
+ 1);
3307 XDrawLines (x_current_display
, contour_window
,
3308 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3311 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
3313 p
->y
= begin
->y
+ font_h
;
3315 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
3316 contour_last_point
-= (npoints
- 5);
3317 XDrawLines (x_current_display
, contour_window
,
3318 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
3319 XFlush (x_current_display
);
3321 /* Now, update contour_lines structure. */
3325 /* Erase the top horizontal lines of the contour, and then extend
3326 the contour upwards. */
3329 extend_contour_top (line
)
3334 clip_contour_bottom (x_pos
, y_pos
)
3340 extend_contour_bottom (x_pos
, y_pos
)
3344 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
3349 register struct frame
*f
= selected_frame
;
3350 register int point_x
= f
->cursor_x
;
3351 register int point_y
= f
->cursor_y
;
3352 register int mouse_below_point
;
3353 register Lisp_Object obj
;
3354 register int x_contour_x
, x_contour_y
;
3356 x_contour_x
= x_mouse_x
;
3357 x_contour_y
= x_mouse_y
;
3358 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
3359 && x_contour_x
> point_x
))
3361 mouse_below_point
= 1;
3362 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3363 x_contour_x
, x_contour_y
);
3367 mouse_below_point
= 0;
3368 outline_region (f
, f
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
3374 obj
= read_char (-1, 0, 0, Qnil
, 0);
3378 if (mouse_below_point
)
3380 if (x_mouse_y
<= point_y
) /* Flipped. */
3382 mouse_below_point
= 0;
3384 outline_region (f
, f
->display
.x
->reverse_gc
, point_x
, point_y
,
3385 x_contour_x
, x_contour_y
);
3386 outline_region (f
, f
->display
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
3389 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
3391 clip_contour_bottom (x_mouse_y
);
3393 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
3395 extend_bottom_contour (x_mouse_y
);
3398 x_contour_x
= x_mouse_x
;
3399 x_contour_y
= x_mouse_y
;
3401 else /* mouse above or same line as point */
3403 if (x_mouse_y
>= point_y
) /* Flipped. */
3405 mouse_below_point
= 1;
3407 outline_region (f
, f
->display
.x
->reverse_gc
,
3408 x_contour_x
, x_contour_y
, point_x
, point_y
);
3409 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3410 x_mouse_x
, x_mouse_y
);
3412 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
3414 clip_contour_top (x_mouse_y
);
3416 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
3418 extend_contour_top (x_mouse_y
);
3423 unread_command_event
= obj
;
3424 if (mouse_below_point
)
3426 contour_begin_x
= point_x
;
3427 contour_begin_y
= point_y
;
3428 contour_end_x
= x_contour_x
;
3429 contour_end_y
= x_contour_y
;
3433 contour_begin_x
= x_contour_x
;
3434 contour_begin_y
= x_contour_y
;
3435 contour_end_x
= point_x
;
3436 contour_end_y
= point_y
;
3441 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
3446 register Lisp_Object obj
;
3447 struct frame
*f
= selected_frame
;
3448 register struct window
*w
= XWINDOW (selected_window
);
3449 register GC line_gc
= f
->display
.x
->cursor_gc
;
3450 register GC erase_gc
= f
->display
.x
->reverse_gc
;
3452 char dash_list
[] = {6, 4, 6, 4};
3454 XGCValues gc_values
;
3456 register int previous_y
;
3457 register int line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3458 + f
->display
.x
->internal_border_width
;
3459 register int left
= f
->display
.x
->internal_border_width
3461 * FONT_WIDTH (f
->display
.x
->font
));
3462 register int right
= left
+ (w
->width
3463 * FONT_WIDTH (f
->display
.x
->font
))
3464 - f
->display
.x
->internal_border_width
;
3468 gc_values
.foreground
= f
->display
.x
->cursor_pixel
;
3469 gc_values
.background
= f
->display
.x
->background_pixel
;
3470 gc_values
.line_width
= 1;
3471 gc_values
.line_style
= LineOnOffDash
;
3472 gc_values
.cap_style
= CapRound
;
3473 gc_values
.join_style
= JoinRound
;
3475 line_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3476 GCLineStyle
| GCJoinStyle
| GCCapStyle
3477 | GCLineWidth
| GCForeground
| GCBackground
,
3479 XSetDashes (x_current_display
, line_gc
, 0, dash_list
, dashes
);
3480 gc_values
.foreground
= f
->display
.x
->background_pixel
;
3481 gc_values
.background
= f
->display
.x
->foreground_pixel
;
3482 erase_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3483 GCLineStyle
| GCJoinStyle
| GCCapStyle
3484 | GCLineWidth
| GCForeground
| GCBackground
,
3486 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
3492 if (x_mouse_y
>= XINT (w
->top
)
3493 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
3495 previous_y
= x_mouse_y
;
3496 line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3497 + f
->display
.x
->internal_border_width
;
3498 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3499 line_gc
, left
, line
, right
, line
);
3506 obj
= read_char (-1, 0, 0, Qnil
, 0);
3508 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3509 Qvertical_scroll_bar
))
3513 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3514 erase_gc
, left
, line
, right
, line
);
3516 unread_command_event
= obj
;
3518 XFreeGC (x_current_display
, line_gc
);
3519 XFreeGC (x_current_display
, erase_gc
);
3524 while (x_mouse_y
== previous_y
);
3527 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3528 erase_gc
, left
, line
, right
, line
);
3534 /* Offset in buffer of character under the pointer, or 0. */
3535 int mouse_buffer_offset
;
3538 /* These keep track of the rectangle following the pointer. */
3539 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
3541 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
3542 "Track the pointer.")
3545 static Cursor current_pointer_shape
;
3546 FRAME_PTR f
= x_mouse_frame
;
3549 if (EQ (Vmouse_frame_part
, Qtext_part
)
3550 && (current_pointer_shape
!= f
->display
.x
->nontext_cursor
))
3555 current_pointer_shape
= f
->display
.x
->nontext_cursor
;
3556 XDefineCursor (x_current_display
,
3558 current_pointer_shape
);
3560 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
3561 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
3563 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
3564 && (current_pointer_shape
!= f
->display
.x
->modeline_cursor
))
3566 current_pointer_shape
= f
->display
.x
->modeline_cursor
;
3567 XDefineCursor (x_current_display
,
3569 current_pointer_shape
);
3578 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
3579 "Draw rectangle around character under mouse pointer, if there is one.")
3583 struct window
*w
= XWINDOW (Vmouse_window
);
3584 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
3585 struct buffer
*b
= XBUFFER (w
->buffer
);
3588 if (! EQ (Vmouse_window
, selected_window
))
3591 if (EQ (event
, Qnil
))
3595 x_read_mouse_position (selected_frame
, &x
, &y
);
3599 mouse_track_width
= 0;
3600 mouse_track_left
= mouse_track_top
= -1;
3604 if ((x_mouse_x
!= mouse_track_left
3605 && (x_mouse_x
< mouse_track_left
3606 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
3607 || x_mouse_y
!= mouse_track_top
)
3609 int hp
= 0; /* Horizontal position */
3610 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
3611 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
3612 int tab_width
= XINT (b
->tab_width
);
3613 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
3615 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
3616 int in_mode_line
= 0;
3618 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
3621 /* Erase previous rectangle. */
3622 if (mouse_track_width
)
3624 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3625 mouse_track_left
, mouse_track_top
,
3626 mouse_track_width
, 1);
3628 if ((mouse_track_left
== f
->phys_cursor_x
3629 || mouse_track_left
== f
->phys_cursor_x
- 1)
3630 && mouse_track_top
== f
->phys_cursor_y
)
3632 x_display_cursor (f
, 1);
3636 mouse_track_left
= x_mouse_x
;
3637 mouse_track_top
= x_mouse_y
;
3638 mouse_track_width
= 0;
3640 if (mouse_track_left
> len
) /* Past the end of line. */
3643 if (mouse_track_top
== mode_line_vpos
)
3649 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3653 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
3659 mouse_track_width
= tab_width
- (hp
% tab_width
);
3661 hp
+= mouse_track_width
;
3664 mouse_track_left
= hp
- mouse_track_width
;
3670 mouse_track_width
= -1;
3674 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3679 mouse_track_width
= 2;
3684 mouse_track_left
= hp
- mouse_track_width
;
3690 mouse_track_width
= 1;
3697 while (hp
<= x_mouse_x
);
3700 if (mouse_track_width
) /* Over text; use text pointer shape. */
3702 XDefineCursor (x_current_display
,
3704 f
->display
.x
->text_cursor
);
3705 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3706 mouse_track_left
, mouse_track_top
,
3707 mouse_track_width
, 1);
3709 else if (in_mode_line
)
3710 XDefineCursor (x_current_display
,
3712 f
->display
.x
->modeline_cursor
);
3714 XDefineCursor (x_current_display
,
3716 f
->display
.x
->nontext_cursor
);
3719 XFlush (x_current_display
);
3722 obj
= read_char (-1, 0, 0, Qnil
, 0);
3725 while (CONSP (obj
) /* Mouse event */
3726 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
3727 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
3728 && EQ (Vmouse_window
, selected_window
) /* In this window */
3731 unread_command_event
= obj
;
3733 if (mouse_track_width
)
3735 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3736 mouse_track_left
, mouse_track_top
,
3737 mouse_track_width
, 1);
3738 mouse_track_width
= 0;
3739 if ((mouse_track_left
== f
->phys_cursor_x
3740 || mouse_track_left
- 1 == f
->phys_cursor_x
)
3741 && mouse_track_top
== f
->phys_cursor_y
)
3743 x_display_cursor (f
, 1);
3746 XDefineCursor (x_current_display
,
3748 f
->display
.x
->nontext_cursor
);
3749 XFlush (x_current_display
);
3759 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3760 on the frame F at position X, Y. */
3762 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
3764 int x
, y
, width
, height
;
3769 image
= XCreateBitmapFromData (x_current_display
,
3770 FRAME_X_WINDOW (f
), image_data
,
3772 XCopyPlane (x_current_display
, image
, FRAME_X_WINDOW (f
),
3773 f
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
3777 #if 0 /* I'm told these functions are superfluous
3778 given the ability to bind function keys. */
3781 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3782 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3783 KEYSYM is a string which conforms to the X keysym definitions found\n\
3784 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3785 list of strings specifying modifier keys such as Control_L, which must\n\
3786 also be depressed for NEWSTRING to appear.")
3787 (x_keysym
, modifiers
, newstring
)
3788 register Lisp_Object x_keysym
;
3789 register Lisp_Object modifiers
;
3790 register Lisp_Object newstring
;
3793 register KeySym keysym
;
3794 KeySym modifier_list
[16];
3797 CHECK_STRING (x_keysym
, 1);
3798 CHECK_STRING (newstring
, 3);
3800 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
3801 if (keysym
== NoSymbol
)
3802 error ("Keysym does not exist");
3804 if (NILP (modifiers
))
3805 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
3806 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3809 register Lisp_Object rest
, mod
;
3812 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
3815 error ("Can't have more than 16 modifiers");
3818 CHECK_STRING (mod
, 3);
3819 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
3821 if (modifier_list
[i
] == NoSymbol
3822 || !(IsModifierKey (modifier_list
[i
])
3823 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
3824 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
3826 if (modifier_list
[i
] == NoSymbol
3827 || !IsModifierKey (modifier_list
[i
]))
3829 error ("Element is not a modifier keysym");
3833 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
3834 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3840 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
3841 "Rebind KEYCODE to list of strings STRINGS.\n\
3842 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3843 nil as element means don't change.\n\
3844 See the documentation of `x-rebind-key' for more information.")
3846 register Lisp_Object keycode
;
3847 register Lisp_Object strings
;
3849 register Lisp_Object item
;
3850 register unsigned char *rawstring
;
3851 KeySym rawkey
, modifier
[1];
3853 register unsigned i
;
3856 CHECK_NUMBER (keycode
, 1);
3857 CHECK_CONS (strings
, 2);
3858 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
3859 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
3861 item
= Fcar (strings
);
3864 CHECK_STRING (item
, 2);
3865 strsize
= XSTRING (item
)->size
;
3866 rawstring
= (unsigned char *) xmalloc (strsize
);
3867 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
3868 modifier
[1] = 1 << i
;
3869 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
3870 rawstring
, strsize
);
3875 #endif /* HAVE_X11 */
3878 #ifndef HAVE_XSCREENNUMBEROFSCREEN
3880 XScreenNumberOfScreen (scr
)
3881 register Screen
*scr
;
3883 register Display
*dpy
;
3884 register Screen
*dpyscr
;
3888 dpyscr
= dpy
->screens
;
3890 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
3896 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
3899 select_visual (screen
, depth
)
3901 unsigned int *depth
;
3904 XVisualInfo
*vinfo
, vinfo_template
;
3907 v
= DefaultVisualOfScreen (screen
);
3910 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
3912 vinfo_template
.visualid
= v
->visualid
;
3915 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
3917 vinfo
= XGetVisualInfo (x_current_display
,
3918 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
3921 fatal ("Can't get proper X visual info");
3923 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
3924 *depth
= vinfo
->depth
;
3928 int n
= vinfo
->colormap_size
- 1;
3937 XFree ((char *) vinfo
);
3941 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
3942 1, 2, 0, "Open a connection to an X server.\n\
3943 DISPLAY is the name of the display to connect to.\n\
3944 Optional second arg XRM_STRING is a string of resources in xrdb format.")
3945 (display
, xrm_string
)
3946 Lisp_Object display
, xrm_string
;
3948 unsigned int n_planes
;
3949 unsigned char *xrm_option
;
3951 CHECK_STRING (display
, 0);
3952 if (x_current_display
!= 0)
3953 error ("X server connection is already initialized");
3954 if (! NILP (xrm_string
))
3955 CHECK_STRING (xrm_string
, 1);
3957 if (! NILP (xrm_string
))
3958 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
3960 xrm_option
= (unsigned char *) 0;
3962 validate_x_resource_name ();
3964 /* This is what opens the connection and sets x_current_display.
3965 This also initializes many symbols, such as those used for input. */
3966 x_term_init (XSTRING (display
)->data
, xrm_option
,
3967 XSTRING (Vx_resource_name
)->data
);
3969 XFASTINT (Vwindow_system_version
) = 11;
3972 xrdb
= x_load_resources (x_current_display
, xrm_option
,
3973 (char *) XSTRING (Vx_resource_name
)->data
,
3976 #ifdef HAVE_XRMSETDATABASE
3977 XrmSetDatabase (x_current_display
, xrdb
);
3979 x_current_display
->db
= xrdb
;
3982 the_x_screen
.name
= display
;
3984 x_screen
= DefaultScreenOfDisplay (x_current_display
);
3986 screen_visual
= select_visual (x_screen
, &n_planes
);
3987 x_screen_planes
= n_planes
;
3988 x_screen_height
= HeightOfScreen (x_screen
);
3989 x_screen_width
= WidthOfScreen (x_screen
);
3991 /* X Atoms used by emacs. */
3992 Xatoms_of_xselect ();
3994 Xatom_wm_protocols
= XInternAtom (x_current_display
, "WM_PROTOCOLS",
3996 Xatom_wm_take_focus
= XInternAtom (x_current_display
, "WM_TAKE_FOCUS",
3998 Xatom_wm_save_yourself
= XInternAtom (x_current_display
, "WM_SAVE_YOURSELF",
4000 Xatom_wm_delete_window
= XInternAtom (x_current_display
, "WM_DELETE_WINDOW",
4002 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
4004 Xatom_wm_configure_denied
= XInternAtom (x_current_display
,
4005 "WM_CONFIGURE_DENIED", False
);
4006 Xatom_wm_window_moved
= XInternAtom (x_current_display
, "WM_MOVED",
4008 Xatom_editres_name
= XInternAtom (x_current_display
, "Editres", False
);
4013 DEFUN ("x-close-current-connection", Fx_close_current_connection
,
4014 Sx_close_current_connection
,
4015 0, 0, 0, "Close the connection to the current X server.")
4018 /* Note: If we're going to call check_x here, then the fatal error
4019 can't happen. For the moment, this check is just for safety,
4020 so a user won't try out the function and get a crash. If it's
4021 really intended only to be called when killing emacs, then there's
4022 no reason for it to have a lisp interface at all. */
4025 /* This is ONLY used when killing emacs; For switching displays
4026 we'll have to take care of setting CloseDownMode elsewhere. */
4028 if (x_current_display
)
4031 XSetCloseDownMode (x_current_display
, DestroyAll
);
4032 XCloseDisplay (x_current_display
);
4033 x_current_display
= 0;
4036 fatal ("No current X display connection to close\n");
4041 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
,
4042 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4043 If ON is nil, allow buffering of requests.\n\
4044 Turning on synchronization prohibits the Xlib routines from buffering\n\
4045 requests and seriously degrades performance, but makes debugging much\n\
4052 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
4057 /* Wait for responses to all X commands issued so far for FRAME. */
4064 XSync (x_current_display
, False
);
4070 /* This is zero if not using X windows. */
4071 x_current_display
= 0;
4073 the_x_screen
.font_list_cache
= Qnil
;
4074 the_x_screen
.name
= Qnil
;
4075 staticpro (&the_x_screen
.font_list_cache
);
4076 staticpro (&the_x_screen
.name
);
4078 /* The section below is built by the lisp expression at the top of the file,
4079 just above where these variables are declared. */
4080 /*&&& init symbols here &&&*/
4081 Qauto_raise
= intern ("auto-raise");
4082 staticpro (&Qauto_raise
);
4083 Qauto_lower
= intern ("auto-lower");
4084 staticpro (&Qauto_lower
);
4085 Qbackground_color
= intern ("background-color");
4086 staticpro (&Qbackground_color
);
4087 Qbar
= intern ("bar");
4089 Qborder_color
= intern ("border-color");
4090 staticpro (&Qborder_color
);
4091 Qborder_width
= intern ("border-width");
4092 staticpro (&Qborder_width
);
4093 Qbox
= intern ("box");
4095 Qcursor_color
= intern ("cursor-color");
4096 staticpro (&Qcursor_color
);
4097 Qcursor_type
= intern ("cursor-type");
4098 staticpro (&Qcursor_type
);
4099 Qfont
= intern ("font");
4101 Qforeground_color
= intern ("foreground-color");
4102 staticpro (&Qforeground_color
);
4103 Qgeometry
= intern ("geometry");
4104 staticpro (&Qgeometry
);
4105 Qicon_left
= intern ("icon-left");
4106 staticpro (&Qicon_left
);
4107 Qicon_top
= intern ("icon-top");
4108 staticpro (&Qicon_top
);
4109 Qicon_type
= intern ("icon-type");
4110 staticpro (&Qicon_type
);
4111 Qinternal_border_width
= intern ("internal-border-width");
4112 staticpro (&Qinternal_border_width
);
4113 Qleft
= intern ("left");
4115 Qmouse_color
= intern ("mouse-color");
4116 staticpro (&Qmouse_color
);
4117 Qnone
= intern ("none");
4119 Qparent_id
= intern ("parent-id");
4120 staticpro (&Qparent_id
);
4121 Qscroll_bar_width
= intern ("scroll-bar-width");
4122 staticpro (&Qscroll_bar_width
);
4123 Qsuppress_icon
= intern ("suppress-icon");
4124 staticpro (&Qsuppress_icon
);
4125 Qtop
= intern ("top");
4127 Qundefined_color
= intern ("undefined-color");
4128 staticpro (&Qundefined_color
);
4129 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
4130 staticpro (&Qvertical_scroll_bars
);
4131 Qvisibility
= intern ("visibility");
4132 staticpro (&Qvisibility
);
4133 Qwindow_id
= intern ("window-id");
4134 staticpro (&Qwindow_id
);
4135 Qx_frame_parameter
= intern ("x-frame-parameter");
4136 staticpro (&Qx_frame_parameter
);
4137 Qx_resource_name
= intern ("x-resource-name");
4138 staticpro (&Qx_resource_name
);
4139 Quser_position
= intern ("user-position");
4140 staticpro (&Quser_position
);
4141 Quser_size
= intern ("user-size");
4142 staticpro (&Quser_size
);
4143 /* This is the end of symbol initialization. */
4145 Fput (Qundefined_color
, Qerror_conditions
,
4146 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
4147 Fput (Qundefined_color
, Qerror_message
,
4148 build_string ("Undefined color"));
4150 init_x_parm_symbols ();
4152 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset
,
4153 "The buffer offset of the character under the pointer.");
4154 mouse_buffer_offset
= 0;
4156 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
4157 "The shape of the pointer when over text.\n\
4158 Changing the value does not affect existing frames\n\
4159 unless you set the mouse color.");
4160 Vx_pointer_shape
= Qnil
;
4162 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
4163 "The name Emacs uses to look up X resources; for internal use only.\n\
4164 `x-get-resource' uses this as the first component of the instance name\n\
4165 when requesting resource values.\n\
4166 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4167 was invoked, or to the value specified with the `-name' or `-rn'\n\
4168 switches, if present.");
4169 Vx_resource_name
= Qnil
;
4171 #if 0 /* This doesn't really do anything. */
4172 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
4173 "The shape of the pointer when not over text.\n\
4174 This variable takes effect when you create a new frame\n\
4175 or when you set the mouse color.");
4177 Vx_nontext_pointer_shape
= Qnil
;
4179 #if 0 /* This doesn't really do anything. */
4180 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
4181 "The shape of the pointer when over the mode line.\n\
4182 This variable takes effect when you create a new frame\n\
4183 or when you set the mouse color.");
4185 Vx_mode_pointer_shape
= Qnil
;
4187 DEFVAR_INT ("x-sensitive-text-pointer-shape",
4188 &Vx_sensitive_text_pointer_shape
,
4189 "The shape of the pointer when over mouse-sensitive text.\n\
4190 This variable takes effect when you create a new frame\n\
4191 or when you set the mouse color.");
4192 Vx_sensitive_text_pointer_shape
= Qnil
;
4194 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
4195 "A string indicating the foreground color of the cursor box.");
4196 Vx_cursor_fore_pixel
= Qnil
;
4198 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed
,
4199 "Non-nil if a mouse button is currently depressed.");
4200 Vmouse_depressed
= Qnil
;
4202 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
4203 "Non-nil if no X window manager is in use.");
4205 #ifdef USE_X_TOOLKIT
4206 Fprovide (intern ("x-toolkit"));
4209 defsubr (&Sx_get_resource
);
4211 defsubr (&Sx_draw_rectangle
);
4212 defsubr (&Sx_erase_rectangle
);
4213 defsubr (&Sx_contour_region
);
4214 defsubr (&Sx_uncontour_region
);
4216 defsubr (&Sx_list_fonts
);
4217 defsubr (&Sx_display_color_p
);
4218 defsubr (&Sx_display_grayscale_p
);
4219 defsubr (&Sx_color_defined_p
);
4220 defsubr (&Sx_color_values
);
4221 defsubr (&Sx_server_max_request_size
);
4222 defsubr (&Sx_server_vendor
);
4223 defsubr (&Sx_server_version
);
4224 defsubr (&Sx_display_pixel_width
);
4225 defsubr (&Sx_display_pixel_height
);
4226 defsubr (&Sx_display_mm_width
);
4227 defsubr (&Sx_display_mm_height
);
4228 defsubr (&Sx_display_screens
);
4229 defsubr (&Sx_display_planes
);
4230 defsubr (&Sx_display_color_cells
);
4231 defsubr (&Sx_display_visual_class
);
4232 defsubr (&Sx_display_backing_store
);
4233 defsubr (&Sx_display_save_under
);
4235 defsubr (&Sx_rebind_key
);
4236 defsubr (&Sx_rebind_keys
);
4237 defsubr (&Sx_track_pointer
);
4238 defsubr (&Sx_grab_pointer
);
4239 defsubr (&Sx_ungrab_pointer
);
4241 defsubr (&Sx_parse_geometry
);
4242 defsubr (&Sx_create_frame
);
4243 defsubr (&Sfocus_frame
);
4244 defsubr (&Sunfocus_frame
);
4246 defsubr (&Sx_horizontal_line
);
4248 defsubr (&Sx_open_connection
);
4249 defsubr (&Sx_close_current_connection
);
4250 defsubr (&Sx_synchronize
);
4253 #endif /* HAVE_X_WINDOWS */