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 (XTYPE (param_index
) == Lisp_Int
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 (XTYPE (value
) == Lisp_Int
)
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
;
1391 if (XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
1393 int wid
= FONT_WIDTH (f
->display
.x
->font
);
1394 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
1395 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
1396 if (FRAME_X_WINDOW (f
))
1397 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1401 /* Subroutines of creating an X frame. */
1403 /* Make sure that Vx_resource_name is set to a reasonable value. */
1405 validate_x_resource_name ()
1407 if (STRINGP (Vx_resource_name
))
1409 int len
= XSTRING (Vx_resource_name
)->size
;
1410 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
1413 /* Allow only letters, digits, - and _,
1414 because those are all that X allows. */
1415 for (i
= 0; i
< len
; i
++)
1418 if (! ((c
>= 'a' && c
<= 'z')
1419 || (c
>= 'A' && c
<= 'Z')
1420 || (c
>= '0' && c
<= '9')
1421 || c
== '-' || c
== '_'))
1427 Vx_resource_name
= make_string ("emacs", 5);
1431 extern char *x_get_string_resource ();
1432 extern XrmDatabase
x_load_resources ();
1434 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
1435 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1436 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1437 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1438 the name specified by the `-name' or `-rn' command-line arguments.\n\
1440 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1441 class, respectively. You must specify both of them or neither.\n\
1442 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1443 and the class is `Emacs.CLASS.SUBCLASS'.")
1444 (attribute
, class, component
, subclass
)
1445 Lisp_Object attribute
, class, component
, subclass
;
1447 register char *value
;
1450 Lisp_Object resname
;
1454 CHECK_STRING (attribute
, 0);
1455 CHECK_STRING (class, 0);
1457 if (!NILP (component
))
1458 CHECK_STRING (component
, 1);
1459 if (!NILP (subclass
))
1460 CHECK_STRING (subclass
, 2);
1461 if (NILP (component
) != NILP (subclass
))
1462 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1464 validate_x_resource_name ();
1465 resname
= Vx_resource_name
;
1467 if (NILP (component
))
1469 /* Allocate space for the components, the dots which separate them,
1470 and the final '\0'. */
1471 name_key
= (char *) alloca (XSTRING (resname
)->size
1472 + XSTRING (attribute
)->size
1474 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1475 + XSTRING (class)->size
1478 sprintf (name_key
, "%s.%s",
1479 XSTRING (resname
)->data
,
1480 XSTRING (attribute
)->data
);
1481 sprintf (class_key
, "%s.%s",
1483 XSTRING (class)->data
);
1487 name_key
= (char *) alloca (XSTRING (resname
)->size
1488 + XSTRING (component
)->size
1489 + XSTRING (attribute
)->size
1492 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1493 + XSTRING (class)->size
1494 + XSTRING (subclass
)->size
1497 sprintf (name_key
, "%s.%s.%s",
1498 XSTRING (resname
)->data
,
1499 XSTRING (component
)->data
,
1500 XSTRING (attribute
)->data
);
1501 sprintf (class_key
, "%s.%s.%s",
1503 XSTRING (class)->data
,
1504 XSTRING (subclass
)->data
);
1507 value
= x_get_string_resource (xrdb
, name_key
, class_key
);
1509 if (value
!= (char *) 0)
1510 return build_string (value
);
1515 /* Used when C code wants a resource value. */
1518 x_get_resource_string (attribute
, class)
1519 char *attribute
, *class;
1521 register char *value
;
1525 /* Allocate space for the components, the dots which separate them,
1526 and the final '\0'. */
1527 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
1528 + strlen (attribute
) + 2);
1529 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1530 + strlen (class) + 2);
1532 sprintf (name_key
, "%s.%s",
1533 XSTRING (Vinvocation_name
)->data
,
1535 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
1537 return x_get_string_resource (xrdb
, name_key
, class_key
);
1540 /* Types we might convert a resource string into. */
1543 number
, boolean
, string
, symbol
1546 /* Return the value of parameter PARAM.
1548 First search ALIST, then Vdefault_frame_alist, then the X defaults
1549 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1551 Convert the resource to the type specified by desired_type.
1553 If no default is specified, return Qunbound. If you call
1554 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1555 and don't let it get stored in any lisp-visible variables! */
1558 x_get_arg (alist
, param
, attribute
, class, type
)
1559 Lisp_Object alist
, param
;
1562 enum resource_types type
;
1564 register Lisp_Object tem
;
1566 tem
= Fassq (param
, alist
);
1568 tem
= Fassq (param
, Vdefault_frame_alist
);
1574 tem
= Fx_get_resource (build_string (attribute
),
1575 build_string (class),
1584 return make_number (atoi (XSTRING (tem
)->data
));
1587 tem
= Fdowncase (tem
);
1588 if (!strcmp (XSTRING (tem
)->data
, "on")
1589 || !strcmp (XSTRING (tem
)->data
, "true"))
1598 /* As a special case, we map the values `true' and `on'
1599 to Qt, and `false' and `off' to Qnil. */
1602 lower
= Fdowncase (tem
);
1603 if (!strcmp (XSTRING (lower
)->data
, "on")
1604 || !strcmp (XSTRING (lower
)->data
, "true"))
1606 else if (!strcmp (XSTRING (lower
)->data
, "off")
1607 || !strcmp (XSTRING (lower
)->data
, "false"))
1610 return Fintern (tem
, Qnil
);
1623 /* Record in frame F the specified or default value according to ALIST
1624 of the parameter named PARAM (a Lisp symbol).
1625 If no value is specified for PARAM, look for an X default for XPROP
1626 on the frame named NAME.
1627 If that is not found either, use the value DEFLT. */
1630 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
1637 enum resource_types type
;
1641 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
1642 if (EQ (tem
, Qunbound
))
1644 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
1648 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
1649 "Parse an X-style geometry string STRING.\n\
1650 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
1651 The properties returned may include `top', `left', `height', and `width'.\n\
1652 The value of `left' or `top' may be an integer,\n\
1653 or a list (+ N) meaning N pixels relative to top/left corner,\n\
1654 or a list (- N) meaning -N pixels relative to bottom/right corner.")
1659 unsigned int width
, height
;
1662 CHECK_STRING (string
, 0);
1664 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
1665 &x
, &y
, &width
, &height
);
1668 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
1669 error ("Must specify both x and y position, or neither");
1673 if (geometry
& XValue
)
1675 Lisp_Object element
;
1677 if (x
>= 0 && (geometry
& XNegative
))
1678 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
1679 else if (x
< 0 && ! (geometry
& XNegative
))
1680 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
1682 element
= Fcons (Qleft
, make_number (x
));
1683 result
= Fcons (element
, result
);
1686 if (geometry
& YValue
)
1688 Lisp_Object element
;
1690 if (y
>= 0 && (geometry
& YNegative
))
1691 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
1692 else if (y
< 0 && ! (geometry
& YNegative
))
1693 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
1695 element
= Fcons (Qtop
, make_number (y
));
1696 result
= Fcons (element
, result
);
1699 if (geometry
& WidthValue
)
1700 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
1701 if (geometry
& HeightValue
)
1702 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
1707 /* Calculate the desired size and position of this window,
1708 and return the flags saying which aspects were specified.
1710 This function does not make the coordinates positive. */
1712 #define DEFAULT_ROWS 40
1713 #define DEFAULT_COLS 80
1716 x_figure_window_size (f
, parms
)
1720 register Lisp_Object tem0
, tem1
, tem2
;
1721 int height
, width
, left
, top
;
1722 register int geometry
;
1723 long window_prompting
= 0;
1725 /* Default values if we fall through.
1726 Actually, if that happens we should get
1727 window manager prompting. */
1728 f
->width
= DEFAULT_COLS
;
1729 f
->height
= DEFAULT_ROWS
;
1730 /* Window managers expect that if program-specified
1731 positions are not (0,0), they're intentional, not defaults. */
1732 f
->display
.x
->top_pos
= 0;
1733 f
->display
.x
->left_pos
= 0;
1735 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
1736 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
1737 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
1738 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1740 if (!EQ (tem0
, Qunbound
))
1742 CHECK_NUMBER (tem0
, 0);
1743 f
->height
= XINT (tem0
);
1745 if (!EQ (tem1
, Qunbound
))
1747 CHECK_NUMBER (tem1
, 0);
1748 f
->width
= XINT (tem1
);
1750 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
1751 window_prompting
|= USSize
;
1753 window_prompting
|= PSize
;
1756 f
->display
.x
->vertical_scroll_bar_extra
1757 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1758 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
1760 f
->display
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
1761 f
->display
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
1763 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1764 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1765 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
1766 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1768 if (EQ (tem0
, Qminus
))
1770 f
->display
.x
->top_pos
= 0;
1771 window_prompting
|= YNegative
;
1773 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qminus
)
1774 && CONSP (XCONS (tem0
)->cdr
)
1775 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
1777 f
->display
.x
->top_pos
= - XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
1778 window_prompting
|= YNegative
;
1780 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qplus
)
1781 && CONSP (XCONS (tem0
)->cdr
)
1782 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
1784 f
->display
.x
->top_pos
= XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
1786 else if (EQ (tem0
, Qunbound
))
1787 f
->display
.x
->top_pos
= 0;
1790 CHECK_NUMBER (tem0
, 0);
1791 f
->display
.x
->top_pos
= XINT (tem0
);
1792 if (f
->display
.x
->top_pos
< 0)
1793 window_prompting
|= YNegative
;
1796 if (EQ (tem1
, Qminus
))
1798 f
->display
.x
->left_pos
= 0;
1799 window_prompting
|= XNegative
;
1801 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qminus
)
1802 && CONSP (XCONS (tem1
)->cdr
)
1803 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
1805 f
->display
.x
->left_pos
= - XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
1806 window_prompting
|= XNegative
;
1808 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qplus
)
1809 && CONSP (XCONS (tem1
)->cdr
)
1810 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
1812 f
->display
.x
->left_pos
= XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
1814 else if (EQ (tem1
, Qunbound
))
1815 f
->display
.x
->left_pos
= 0;
1818 CHECK_NUMBER (tem1
, 0);
1819 f
->display
.x
->left_pos
= XINT (tem1
);
1820 if (f
->display
.x
->left_pos
< 0)
1821 window_prompting
|= XNegative
;
1825 window_prompting
|= USPosition
;
1827 window_prompting
|= PPosition
;
1830 return window_prompting
;
1833 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
1836 XSetWMProtocols (dpy
, w
, protocols
, count
)
1843 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
1844 if (prop
== None
) return False
;
1845 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
1846 (unsigned char *) protocols
, count
);
1849 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
1851 #ifdef USE_X_TOOLKIT
1853 /* WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
1854 already be present because of the toolkit (Motif adds some of them,
1855 for example, but Xt doesn't). */
1858 hack_wm_protocols (widget
)
1861 Display
*dpy
= XtDisplay (widget
);
1862 Window w
= XtWindow (widget
);
1863 int need_delete
= 1;
1869 Atom type
, *atoms
= 0;
1871 unsigned long nitems
= 0;
1872 unsigned long bytes_after
;
1874 if (Success
== XGetWindowProperty (dpy
, w
, Xatom_wm_protocols
,
1875 0, 100, False
, XA_ATOM
,
1876 &type
, &format
, &nitems
, &bytes_after
,
1877 (unsigned char **) &atoms
)
1878 && format
== 32 && type
== XA_ATOM
)
1882 if (atoms
[nitems
] == Xatom_wm_delete_window
) need_delete
= 0;
1883 else if (atoms
[nitems
] == Xatom_wm_take_focus
) need_focus
= 0;
1884 else if (atoms
[nitems
] == Xatom_wm_save_yourself
) need_save
= 0;
1886 if (atoms
) XFree ((char *) atoms
);
1891 if (need_delete
) props
[count
++] = Xatom_wm_delete_window
;
1892 if (need_focus
) props
[count
++] = Xatom_wm_take_focus
;
1893 if (need_save
) props
[count
++] = Xatom_wm_save_yourself
;
1895 XChangeProperty (dpy
, w
, Xatom_wm_protocols
, XA_ATOM
, 32, PropModeAppend
,
1896 (unsigned char *) props
, count
);
1902 #ifdef USE_X_TOOLKIT
1904 /* Create and set up the X widget for frame F. */
1907 x_window (f
, window_prompting
, minibuffer_only
)
1909 long window_prompting
;
1910 int minibuffer_only
;
1912 XClassHint class_hints
;
1913 XSetWindowAttributes attributes
;
1914 unsigned long attribute_mask
;
1916 Widget shell_widget
;
1918 Widget screen_widget
;
1925 if (STRINGP (f
->name
))
1926 name
= (char*) XSTRING (f
->name
)->data
;
1931 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
1932 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
1933 shell_widget
= XtCreatePopupShell ("shell",
1934 topLevelShellWidgetClass
,
1935 Xt_app_shell
, al
, ac
);
1937 f
->display
.x
->widget
= shell_widget
;
1938 /* maybe_set_screen_title_format (shell_widget); */
1942 XtSetArg (al
[ac
], XtNborderWidth
, 0); ac
++;
1943 pane_widget
= XtCreateWidget ("pane",
1945 shell_widget
, al
, ac
);
1947 f
->display
.x
->column_widget
= pane_widget
;
1949 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
1950 initialize_frame_menubar (f
);
1952 /* mappedWhenManaged to false tells to the paned window to not map/unmap
1953 the emacs screen when changing menubar. This reduces flickering. */
1956 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
1957 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
1958 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
1959 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
1960 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
1961 screen_widget
= XtCreateWidget (name
,
1963 pane_widget
, al
, ac
);
1965 f
->display
.x
->edit_widget
= screen_widget
;
1967 if (f
->display
.x
->menubar_widget
)
1968 XtManageChild (f
->display
.x
->menubar_widget
);
1969 XtManageChild (screen_widget
);
1971 /* Do some needed geometry management. */
1974 char *tem
, shell_position
[32];
1978 = (f
->display
.x
->menubar_widget
1979 ? (f
->display
.x
->menubar_widget
->core
.height
1980 + f
->display
.x
->menubar_widget
->core
.border_width
)
1983 if (FRAME_EXTERNAL_MENU_BAR (f
))
1986 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
1987 menubar_size
+= ibw
;
1990 if (window_prompting
& USPosition
)
1992 int left
= f
->display
.x
->left_pos
;
1993 int xneg
= window_prompting
& XNegative
;
1994 int top
= f
->display
.x
->top_pos
;
1995 int yneg
= window_prompting
& YNegative
;
2000 sprintf (shell_position
, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f
),
2001 PIXEL_HEIGHT (f
) + menubar_size
,
2002 (xneg
? '-' : '+'), left
,
2003 (yneg
? '-' : '+'), top
);
2006 sprintf (shell_position
, "=%dx%d", PIXEL_WIDTH (f
),
2007 PIXEL_HEIGHT (f
) + menubar_size
);
2008 len
= strlen (shell_position
) + 1;
2009 tem
= (char *) xmalloc (len
);
2010 strncpy (tem
, shell_position
, len
);
2011 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
2012 XtSetValues (shell_widget
, al
, ac
);
2015 x_calc_absolute_position (f
);
2017 XtManageChild (pane_widget
);
2018 XtRealizeWidget (shell_widget
);
2020 FRAME_X_WINDOW (f
) = XtWindow (screen_widget
);
2022 validate_x_resource_name ();
2023 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2024 class_hints
.res_class
= EMACS_CLASS
;
2025 XSetClassHint (x_current_display
, XtWindow (shell_widget
), &class_hints
);
2027 f
->display
.x
->wm_hints
.input
= True
;
2028 f
->display
.x
->wm_hints
.flags
|= InputHint
;
2029 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
2031 hack_wm_protocols (shell_widget
);
2033 /* Do a stupid property change to force the server to generate a
2034 propertyNotify event so that the event_stream server timestamp will
2035 be initialized to something relevant to the time we created the window.
2037 XChangeProperty (XtDisplay (screen_widget
), XtWindow (screen_widget
),
2038 Xatom_wm_protocols
, XA_ATOM
, 32, PropModeAppend
,
2039 (unsigned char*) NULL
, 0);
2041 /* Make all the standard events reach the Emacs frame. */
2042 attributes
.event_mask
= STANDARD_EVENT_SET
;
2043 attribute_mask
= CWEventMask
;
2044 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
2045 attribute_mask
, &attributes
);
2047 XtMapWidget (screen_widget
);
2049 /* x_set_name normally ignores requests to set the name if the
2050 requested name is the same as the current name. This is the one
2051 place where that assumption isn't correct; f->name is set, but
2052 the X server hasn't been told. */
2055 int explicit = f
->explicit_name
;
2057 f
->explicit_name
= 0;
2060 x_set_name (f
, name
, explicit);
2063 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
2064 f
->display
.x
->text_cursor
);
2068 if (FRAME_X_WINDOW (f
) == 0)
2069 error ("Unable to create window");
2072 #else /* not USE_X_TOOLKIT */
2074 /* Create and set up the X window for frame F. */
2080 XClassHint class_hints
;
2081 XSetWindowAttributes attributes
;
2082 unsigned long attribute_mask
;
2084 attributes
.background_pixel
= f
->display
.x
->background_pixel
;
2085 attributes
.border_pixel
= f
->display
.x
->border_pixel
;
2086 attributes
.bit_gravity
= StaticGravity
;
2087 attributes
.backing_store
= NotUseful
;
2088 attributes
.save_under
= True
;
2089 attributes
.event_mask
= STANDARD_EVENT_SET
;
2090 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
2092 | CWBackingStore
| CWSaveUnder
2098 = XCreateWindow (x_current_display
, ROOT_WINDOW
,
2099 f
->display
.x
->left_pos
,
2100 f
->display
.x
->top_pos
,
2101 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
2102 f
->display
.x
->border_width
,
2103 CopyFromParent
, /* depth */
2104 InputOutput
, /* class */
2105 screen_visual
, /* set in Fx_open_connection */
2106 attribute_mask
, &attributes
);
2108 validate_x_resource_name ();
2109 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2110 class_hints
.res_class
= EMACS_CLASS
;
2111 XSetClassHint (x_current_display
, FRAME_X_WINDOW (f
), &class_hints
);
2113 /* This indicates that we use the "Passive Input" input model.
2114 Unless we do this, we don't get the Focus{In,Out} events that we
2115 need to draw the cursor correctly. Accursed bureaucrats.
2116 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
2118 f
->display
.x
->wm_hints
.input
= True
;
2119 f
->display
.x
->wm_hints
.flags
|= InputHint
;
2120 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
2122 /* Request "save yourself" and "delete window" commands from wm. */
2125 protocols
[0] = Xatom_wm_delete_window
;
2126 protocols
[1] = Xatom_wm_save_yourself
;
2127 XSetWMProtocols (x_current_display
, FRAME_X_WINDOW (f
), protocols
, 2);
2130 /* x_set_name normally ignores requests to set the name if the
2131 requested name is the same as the current name. This is the one
2132 place where that assumption isn't correct; f->name is set, but
2133 the X server hasn't been told. */
2136 int explicit = f
->explicit_name
;
2138 f
->explicit_name
= 0;
2141 x_set_name (f
, name
, explicit);
2144 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
2145 f
->display
.x
->text_cursor
);
2149 if (FRAME_X_WINDOW (f
) == 0)
2150 error ("Unable to create window");
2153 #endif /* not USE_X_TOOLKIT */
2155 /* Handle the icon stuff for this window. Perhaps later we might
2156 want an x_set_icon_position which can be called interactively as
2164 Lisp_Object icon_x
, icon_y
;
2166 /* Set the position of the icon. Note that twm groups all
2167 icons in an icon window. */
2168 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
2169 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
2170 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
2172 CHECK_NUMBER (icon_x
, 0);
2173 CHECK_NUMBER (icon_y
, 0);
2175 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
2176 error ("Both left and top icon corners of icon must be specified");
2180 if (! EQ (icon_x
, Qunbound
))
2181 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
2183 /* Start up iconic or window? */
2184 x_wm_set_window_state
2185 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
2192 /* Make the GC's needed for this window, setting the
2193 background, border and mouse colors; also create the
2194 mouse cursor and the gray border tile. */
2196 static char cursor_bits
[] =
2198 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2199 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2200 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2201 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2208 XGCValues gc_values
;
2214 /* Create the GC's of this frame.
2215 Note that many default values are used. */
2218 gc_values
.font
= f
->display
.x
->font
->fid
;
2219 gc_values
.foreground
= f
->display
.x
->foreground_pixel
;
2220 gc_values
.background
= f
->display
.x
->background_pixel
;
2221 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
2222 f
->display
.x
->normal_gc
= XCreateGC (x_current_display
,
2224 GCLineWidth
| GCFont
2225 | GCForeground
| GCBackground
,
2228 /* Reverse video style. */
2229 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2230 gc_values
.background
= f
->display
.x
->foreground_pixel
;
2231 f
->display
.x
->reverse_gc
= XCreateGC (x_current_display
,
2233 GCFont
| GCForeground
| GCBackground
2237 /* Cursor has cursor-color background, background-color foreground. */
2238 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2239 gc_values
.background
= f
->display
.x
->cursor_pixel
;
2240 gc_values
.fill_style
= FillOpaqueStippled
;
2242 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
2243 cursor_bits
, 16, 16);
2244 f
->display
.x
->cursor_gc
2245 = XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
2246 (GCFont
| GCForeground
| GCBackground
2247 | GCFillStyle
| GCStipple
| GCLineWidth
),
2250 /* Create the gray border tile used when the pointer is not in
2251 the frame. Since this depends on the frame's pixel values,
2252 this must be done on a per-frame basis. */
2253 f
->display
.x
->border_tile
2254 = (XCreatePixmapFromBitmapData
2255 (x_current_display
, ROOT_WINDOW
,
2256 gray_bits
, gray_width
, gray_height
,
2257 f
->display
.x
->foreground_pixel
,
2258 f
->display
.x
->background_pixel
,
2259 DefaultDepth (x_current_display
, XDefaultScreen (x_current_display
))));
2264 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
2266 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2267 Return an Emacs frame object representing the X window.\n\
2268 ALIST is an alist of frame parameters.\n\
2269 If the parameters specify that the frame should not have a minibuffer,\n\
2270 and do not specify a specific minibuffer window to use,\n\
2271 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2272 be shared by the new frame.")
2277 Lisp_Object frame
, tem
;
2279 int minibuffer_only
= 0;
2280 long window_prompting
= 0;
2282 int count
= specpdl_ptr
- specpdl
;
2283 struct gcpro gcpro1
;
2287 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
2288 if (XTYPE (name
) != Lisp_String
2289 && ! EQ (name
, Qunbound
)
2291 error ("x-create-frame: name parameter must be a string");
2293 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2294 if (EQ (tem
, Qnone
) || NILP (tem
))
2295 f
= make_frame_without_minibuffer (Qnil
);
2296 else if (EQ (tem
, Qonly
))
2298 f
= make_minibuffer_frame ();
2299 minibuffer_only
= 1;
2301 else if (XTYPE (tem
) == Lisp_Window
)
2302 f
= make_frame_without_minibuffer (tem
);
2306 /* Note that X Windows does support scroll bars. */
2307 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
2309 /* Set the name; the functions to which we pass f expect the name to
2311 if (EQ (name
, Qunbound
) || NILP (name
))
2313 f
->name
= build_string (x_id_name
);
2314 f
->explicit_name
= 0;
2319 f
->explicit_name
= 1;
2320 /* use the frame's title when getting resources for this frame. */
2321 specbind (Qx_resource_name
, name
);
2324 XSET (frame
, Lisp_Frame
, f
);
2327 f
->output_method
= output_x_window
;
2328 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2329 bzero (f
->display
.x
, sizeof (struct x_display
));
2331 /* Note that the frame has no physical cursor right now. */
2332 f
->phys_cursor_x
= -1;
2334 /* Extract the window parameters from the supplied values
2335 that are needed to determine window geometry. */
2339 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
2341 /* First, try whatever font the caller has specified. */
2343 font
= x_new_font (f
, XSTRING (font
)->data
);
2344 /* Try out a font which we hope has bold and italic variations. */
2345 if (!STRINGP (font
))
2346 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
2347 if (! STRINGP (font
))
2348 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
2349 if (! STRINGP (font
))
2350 /* This was formerly the first thing tried, but it finds too many fonts
2351 and takes too long. */
2352 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
2353 /* If those didn't work, look for something which will at least work. */
2354 if (! STRINGP (font
))
2355 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
2357 if (! STRINGP (font
))
2358 font
= build_string ("fixed");
2360 x_default_parameter (f
, parms
, Qfont
, font
,
2361 "font", "Font", string
);
2364 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
2365 "borderwidth", "BorderWidth", number
);
2366 /* This defaults to 2 in order to match xterm. We recognize either
2367 internalBorderWidth or internalBorder (which is what xterm calls
2369 if (NILP (Fassq (Qinternal_border_width
, parms
)))
2373 value
= x_get_arg (parms
, Qinternal_border_width
,
2374 "internalBorder", "BorderWidth", number
);
2375 if (! EQ (value
, Qunbound
))
2376 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
2379 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
2380 "internalBorderWidth", "BorderWidth", number
);
2381 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
2382 "verticalScrollBars", "ScrollBars", boolean
);
2384 /* Also do the stuff which must be set before the window exists. */
2385 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
2386 "foreground", "Foreground", string
);
2387 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
2388 "background", "Background", string
);
2389 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
2390 "pointerColor", "Foreground", string
);
2391 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
2392 "cursorColor", "Foreground", string
);
2393 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
2394 "borderColor", "BorderColor", string
);
2396 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
2397 "menuBar", "MenuBar", number
);
2398 x_default_parameter (f
, parms
, Qscroll_bar_width
, make_number (12),
2399 "scrollBarWidth", "ScrollBarWidth", number
);
2401 f
->display
.x
->parent_desc
= ROOT_WINDOW
;
2402 window_prompting
= x_figure_window_size (f
, parms
);
2404 if (window_prompting
& XNegative
)
2406 if (window_prompting
& YNegative
)
2407 f
->display
.x
->win_gravity
= SouthEastGravity
;
2409 f
->display
.x
->win_gravity
= NorthEastGravity
;
2413 if (window_prompting
& YNegative
)
2414 f
->display
.x
->win_gravity
= SouthWestGravity
;
2416 f
->display
.x
->win_gravity
= NorthWestGravity
;
2419 f
->display
.x
->size_hint_flags
= window_prompting
;
2421 #ifdef USE_X_TOOLKIT
2422 x_window (f
, window_prompting
, minibuffer_only
);
2428 init_frame_faces (f
);
2430 /* We need to do this after creating the X window, so that the
2431 icon-creation functions can say whose icon they're describing. */
2432 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2433 "bitmapIcon", "BitmapIcon", symbol
);
2435 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
2436 "autoRaise", "AutoRaiseLower", boolean
);
2437 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
2438 "autoLower", "AutoRaiseLower", boolean
);
2439 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
2440 "cursorType", "CursorType", symbol
);
2442 /* Dimensions, especially f->height, must be done via change_frame_size.
2443 Change will not be effected unless different from the current
2447 f
->height
= f
->width
= 0;
2448 change_frame_size (f
, height
, width
, 1, 0);
2450 /* With the toolkit, the geometry management is done in x_window. */
2451 #ifndef USE_X_TOOLKIT
2453 x_wm_set_size_hint (f
, window_prompting
, 0);
2455 #endif /* USE_X_TOOLKIT */
2457 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2458 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2460 FRAME_X_SCREEN (f
) = &the_x_screen
;
2461 FRAME_X_SCREEN (f
)->reference_count
++;
2462 the_x_screen
.x_display_value
= x_current_display
;
2466 /* It is now ok to make the frame official
2467 even if we get an error below.
2468 And the frame needs to be on Vframe_list
2469 or making it visible won't work. */
2470 Vframe_list
= Fcons (frame
, Vframe_list
);
2472 /* Make the window appear on the frame and enable display,
2473 unless the caller says not to. */
2475 Lisp_Object visibility
;
2477 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2478 if (EQ (visibility
, Qunbound
))
2481 if (EQ (visibility
, Qicon
))
2482 x_iconify_frame (f
);
2483 else if (! NILP (visibility
))
2484 x_make_frame_visible (f
);
2486 /* Must have been Qnil. */
2490 return unbind_to (count
, frame
);
2494 x_get_focus_frame ()
2497 if (! x_focus_frame
)
2500 XSET (xfocus
, Lisp_Frame
, x_focus_frame
);
2504 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
2505 "Set the focus on FRAME.")
2509 CHECK_LIVE_FRAME (frame
, 0);
2511 if (FRAME_X_P (XFRAME (frame
)))
2514 x_focus_on_frame (XFRAME (frame
));
2522 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
2523 "If a frame has been focused, release it.")
2529 x_unfocus_frame (x_focus_frame
);
2536 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
2537 "Return a list of the names of available fonts matching PATTERN.\n\
2538 If optional arguments FACE and FRAME are specified, return only fonts\n\
2539 the same size as FACE on FRAME.\n\
2541 PATTERN is a string, perhaps with wildcard characters;\n\
2542 the * character matches any substring, and\n\
2543 the ? character matches any single character.\n\
2544 PATTERN is case-insensitive.\n\
2545 FACE is a face name - a symbol.\n\
2547 The return value is a list of strings, suitable as arguments to\n\
2550 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
2551 even if they match PATTERN and FACE.")
2552 (pattern
, face
, frame
)
2553 Lisp_Object pattern
, face
, frame
;
2558 XFontStruct
*size_ref
;
2563 CHECK_STRING (pattern
, 0);
2565 CHECK_SYMBOL (face
, 1);
2567 CHECK_LIVE_FRAME (frame
, 2);
2569 f
= NILP (frame
) ? selected_frame
: XFRAME (frame
);
2571 /* Determine the width standard for comparison with the fonts we find. */
2579 /* Don't die if we get called with a terminal frame. */
2580 if (! FRAME_X_P (f
))
2581 error ("non-X frame used in `x-list-fonts'");
2583 face_id
= face_name_id_number (f
, face
);
2585 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
2586 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
2587 size_ref
= f
->display
.x
->font
;
2590 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
2591 if (size_ref
== (XFontStruct
*) (~0))
2592 size_ref
= f
->display
.x
->font
;
2596 /* See if we cached the result for this particular query. */
2597 list
= Fassoc (pattern
, FRAME_X_SCREEN (f
)->font_list_cache
);
2599 /* We have info in the cache for this PATTERN. */
2602 Lisp_Object tem
, newlist
;
2604 /* We have info about this pattern. */
2605 list
= XCONS (list
)->cdr
;
2612 /* Filter the cached info and return just the fonts that match FACE. */
2614 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
2616 XFontStruct
*thisinfo
;
2618 thisinfo
= XLoadQueryFont (x_current_display
,
2619 XSTRING (XCONS (tem
)->car
)->data
);
2621 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
2622 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
2624 XFreeFont (x_current_display
, thisinfo
);
2634 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
2635 #ifdef BROKEN_XLISTFONTSWITHINFO
2636 names
= XListFonts (x_current_display
,
2637 XSTRING (pattern
)->data
,
2638 2000, /* maxnames */
2639 &num_fonts
); /* count_return */
2641 names
= XListFontsWithInfo (x_current_display
,
2642 XSTRING (pattern
)->data
,
2643 2000, /* maxnames */
2644 &num_fonts
, /* count_return */
2645 &info
); /* info_return */
2654 Lisp_Object full_list
;
2656 /* Make a list of all the fonts we got back.
2657 Store that in the font cache for the display. */
2659 for (i
= 0; i
< num_fonts
; i
++)
2660 full_list
= Fcons (build_string (names
[i
]), full_list
);
2661 FRAME_X_SCREEN (f
)->font_list_cache
2662 = Fcons (Fcons (pattern
, full_list
),
2663 FRAME_X_SCREEN (f
)->font_list_cache
);
2665 /* Make a list of the fonts that have the right width. */
2667 for (i
= 0; i
< num_fonts
; i
++)
2669 XFontStruct
*thisinfo
;
2671 #ifdef BROKEN_XLISTFONTSWITHINFO
2673 thisinfo
= XLoadQueryFont (x_current_display
, names
[i
]);
2676 thisinfo
= &info
[i
];
2678 if (thisinfo
&& (! size_ref
2679 || same_size_fonts (thisinfo
, size_ref
)))
2680 list
= Fcons (build_string (names
[i
]), list
);
2682 list
= Fnreverse (list
);
2685 #ifdef BROKEN_XLISTFONTSWITHINFO
2686 XFreeFontNames (names
);
2688 XFreeFontInfo (names
, info
, num_fonts
);
2697 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 1, 0,
2698 "Return non-nil if the X display supports the color named COLOR.")
2705 CHECK_STRING (color
, 0);
2707 if (defined_color (XSTRING (color
)->data
, &foo
, 0))
2713 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 1, 0,
2714 "Return a description of the color named COLOR.\n\
2715 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
2716 These values appear to range from 0 to 65280; white is (65280 65280 65280).")
2723 CHECK_STRING (color
, 0);
2725 if (defined_color (XSTRING (color
)->data
, &foo
, 0))
2729 rgb
[0] = make_number (foo
.red
);
2730 rgb
[1] = make_number (foo
.green
);
2731 rgb
[2] = make_number (foo
.blue
);
2732 return Flist (3, rgb
);
2738 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 0, 0,
2739 "Return t if the X screen currently in use supports color.")
2744 if (x_screen_planes
<= 2)
2747 switch (screen_visual
->class)
2760 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
2762 "Return t if the X screen currently in use supports grayscale.")
2767 return (x_screen_planes
> 1
2768 && (screen_visual
->class == StaticGray
2769 || screen_visual
->class == GrayScale
));
2772 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
2774 "Returns the width in pixels of the display FRAME is on.")
2778 Display
*dpy
= x_current_display
;
2780 return make_number (DisplayWidth (dpy
, DefaultScreen (dpy
)));
2783 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
2784 Sx_display_pixel_height
, 0, 1, 0,
2785 "Returns the height in pixels of the display FRAME is on.")
2789 Display
*dpy
= x_current_display
;
2791 return make_number (DisplayHeight (dpy
, DefaultScreen (dpy
)));
2794 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
2796 "Returns the number of bitplanes of the display FRAME is on.")
2800 Display
*dpy
= x_current_display
;
2802 return make_number (DisplayPlanes (dpy
, DefaultScreen (dpy
)));
2805 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
2807 "Returns the number of color cells of the display FRAME is on.")
2811 Display
*dpy
= x_current_display
;
2813 return make_number (DisplayCells (dpy
, DefaultScreen (dpy
)));
2816 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
2817 Sx_server_max_request_size
,
2819 "Returns the maximum request size of the X server FRAME is using.")
2823 Display
*dpy
= x_current_display
;
2825 return make_number (MAXREQUEST (dpy
));
2828 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
2829 "Returns the vendor ID string of the X server FRAME is on.")
2833 Display
*dpy
= x_current_display
;
2836 vendor
= ServerVendor (dpy
);
2837 if (! vendor
) vendor
= "";
2838 return build_string (vendor
);
2841 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
2842 "Returns the version numbers of the X server in use.\n\
2843 The value is a list of three integers: the major and minor\n\
2844 version numbers of the X Protocol in use, and the vendor-specific release\n\
2845 number. See also the variable `x-server-vendor'.")
2849 Display
*dpy
= x_current_display
;
2852 return Fcons (make_number (ProtocolVersion (dpy
)),
2853 Fcons (make_number (ProtocolRevision (dpy
)),
2854 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
2857 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
2858 "Returns the number of screens on the X server FRAME is on.")
2863 return make_number (ScreenCount (x_current_display
));
2866 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
2867 "Returns the height in millimeters of the X screen FRAME is on.")
2872 return make_number (HeightMMOfScreen (x_screen
));
2875 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
2876 "Returns the width in millimeters of the X screen FRAME is on.")
2881 return make_number (WidthMMOfScreen (x_screen
));
2884 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
2885 Sx_display_backing_store
, 0, 1, 0,
2886 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2887 The value may be `always', `when-mapped', or `not-useful'.")
2893 switch (DoesBackingStore (x_screen
))
2896 return intern ("always");
2899 return intern ("when-mapped");
2902 return intern ("not-useful");
2905 error ("Strange value for BackingStore parameter of screen");
2909 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
2910 Sx_display_visual_class
, 0, 1, 0,
2911 "Returns the visual class of the display `screen' is on.\n\
2912 The value is one of the symbols `static-gray', `gray-scale',\n\
2913 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2919 switch (screen_visual
->class)
2921 case StaticGray
: return (intern ("static-gray"));
2922 case GrayScale
: return (intern ("gray-scale"));
2923 case StaticColor
: return (intern ("static-color"));
2924 case PseudoColor
: return (intern ("pseudo-color"));
2925 case TrueColor
: return (intern ("true-color"));
2926 case DirectColor
: return (intern ("direct-color"));
2928 error ("Display has an unknown visual class");
2932 DEFUN ("x-display-save-under", Fx_display_save_under
,
2933 Sx_display_save_under
, 0, 1, 0,
2934 "Returns t if the X screen FRAME is on supports the save-under feature.")
2940 if (DoesSaveUnders (x_screen
) == True
)
2947 register struct frame
*f
;
2949 return PIXEL_WIDTH (f
);
2953 register struct frame
*f
;
2955 return PIXEL_HEIGHT (f
);
2959 register struct frame
*f
;
2961 return FONT_WIDTH (f
->display
.x
->font
);
2965 register struct frame
*f
;
2967 return f
->display
.x
->line_height
;
2970 #if 0 /* These no longer seem like the right way to do things. */
2972 /* Draw a rectangle on the frame with left top corner including
2973 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2974 CHARS by LINES wide and long and is the color of the cursor. */
2977 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
2978 register struct frame
*f
;
2980 register int top_char
, left_char
, chars
, lines
;
2984 int left
= (left_char
* FONT_WIDTH (f
->display
.x
->font
)
2985 + f
->display
.x
->internal_border_width
);
2986 int top
= (top_char
* f
->display
.x
->line_height
2987 + f
->display
.x
->internal_border_width
);
2990 width
= FONT_WIDTH (f
->display
.x
->font
) / 2;
2992 width
= FONT_WIDTH (f
->display
.x
->font
) * chars
;
2994 height
= f
->display
.x
->line_height
/ 2;
2996 height
= f
->display
.x
->line_height
* lines
;
2998 XDrawRectangle (x_current_display
, FRAME_X_WINDOW (f
),
2999 gc
, left
, top
, width
, height
);
3002 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
3003 "Draw a rectangle on FRAME between coordinates specified by\n\
3004 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3005 (frame
, X0
, Y0
, X1
, Y1
)
3006 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
3008 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3010 CHECK_LIVE_FRAME (frame
, 0);
3011 CHECK_NUMBER (X0
, 0);
3012 CHECK_NUMBER (Y0
, 1);
3013 CHECK_NUMBER (X1
, 2);
3014 CHECK_NUMBER (Y1
, 3);
3024 n_lines
= y1
- y0
+ 1;
3029 n_lines
= y0
- y1
+ 1;
3035 n_chars
= x1
- x0
+ 1;
3040 n_chars
= x0
- x1
+ 1;
3044 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->cursor_gc
,
3045 left
, top
, n_chars
, n_lines
);
3051 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
3052 "Draw a rectangle drawn on FRAME between coordinates\n\
3053 X0, Y0, X1, Y1 in the regular background-pixel.")
3054 (frame
, X0
, Y0
, X1
, Y1
)
3055 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
3057 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3059 CHECK_FRAME (frame
, 0);
3060 CHECK_NUMBER (X0
, 0);
3061 CHECK_NUMBER (Y0
, 1);
3062 CHECK_NUMBER (X1
, 2);
3063 CHECK_NUMBER (Y1
, 3);
3073 n_lines
= y1
- y0
+ 1;
3078 n_lines
= y0
- y1
+ 1;
3084 n_chars
= x1
- x0
+ 1;
3089 n_chars
= x0
- x1
+ 1;
3093 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->reverse_gc
,
3094 left
, top
, n_chars
, n_lines
);
3100 /* Draw lines around the text region beginning at the character position
3101 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3102 pixel and line characteristics. */
3104 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3107 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
3108 register struct frame
*f
;
3110 int top_x
, top_y
, bottom_x
, bottom_y
;
3112 register int ibw
= f
->display
.x
->internal_border_width
;
3113 register int font_w
= FONT_WIDTH (f
->display
.x
->font
);
3114 register int font_h
= f
->display
.x
->line_height
;
3116 int x
= line_len (y
);
3117 XPoint
*pixel_points
3118 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
3119 register XPoint
*this_point
= pixel_points
;
3121 /* Do the horizontal top line/lines */
3124 this_point
->x
= ibw
;
3125 this_point
->y
= ibw
+ (font_h
* top_y
);
3128 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
3130 this_point
->x
= ibw
+ (font_w
* x
);
3131 this_point
->y
= (this_point
- 1)->y
;
3135 this_point
->x
= ibw
;
3136 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
3138 this_point
->x
= ibw
+ (font_w
* top_x
);
3139 this_point
->y
= (this_point
- 1)->y
;
3141 this_point
->x
= (this_point
- 1)->x
;
3142 this_point
->y
= ibw
+ (font_h
* top_y
);
3144 this_point
->x
= ibw
+ (font_w
* x
);
3145 this_point
->y
= (this_point
- 1)->y
;
3148 /* Now do the right side. */
3149 while (y
< bottom_y
)
3150 { /* Right vertical edge */
3152 this_point
->x
= (this_point
- 1)->x
;
3153 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
3156 y
++; /* Horizontal connection to next line */
3159 this_point
->x
= ibw
+ (font_w
/ 2);
3161 this_point
->x
= ibw
+ (font_w
* x
);
3163 this_point
->y
= (this_point
- 1)->y
;
3166 /* Now do the bottom and connect to the top left point. */
3167 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
3170 this_point
->x
= (this_point
- 1)->x
;
3171 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
3173 this_point
->x
= ibw
;
3174 this_point
->y
= (this_point
- 1)->y
;
3176 this_point
->x
= pixel_points
->x
;
3177 this_point
->y
= pixel_points
->y
;
3179 XDrawLines (x_current_display
, FRAME_X_WINDOW (f
),
3181 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
3184 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
3185 "Highlight the region between point and the character under the mouse\n\
3188 register Lisp_Object event
;
3190 register int x0
, y0
, x1
, y1
;
3191 register struct frame
*f
= selected_frame
;
3192 register int p1
, p2
;
3194 CHECK_CONS (event
, 0);
3197 x0
= XINT (Fcar (Fcar (event
)));
3198 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3200 /* If the mouse is past the end of the line, don't that area. */
3201 /* ReWrite this... */
3206 if (y1
> y0
) /* point below mouse */
3207 outline_region (f
, f
->display
.x
->cursor_gc
,
3209 else if (y1
< y0
) /* point above mouse */
3210 outline_region (f
, f
->display
.x
->cursor_gc
,
3212 else /* same line: draw horizontal rectangle */
3215 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3216 x0
, y0
, (x1
- x0
+ 1), 1);
3218 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3219 x1
, y1
, (x0
- x1
+ 1), 1);
3222 XFlush (x_current_display
);
3228 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
3229 "Erase any highlighting of the region between point and the character\n\
3230 at X, Y on the selected frame.")
3232 register Lisp_Object event
;
3234 register int x0
, y0
, x1
, y1
;
3235 register struct frame
*f
= selected_frame
;
3238 x0
= XINT (Fcar (Fcar (event
)));
3239 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3243 if (y1
> y0
) /* point below mouse */
3244 outline_region (f
, f
->display
.x
->reverse_gc
,
3246 else if (y1
< y0
) /* point above mouse */
3247 outline_region (f
, f
->display
.x
->reverse_gc
,
3249 else /* same line: draw horizontal rectangle */
3252 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3253 x0
, y0
, (x1
- x0
+ 1), 1);
3255 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3256 x1
, y1
, (x0
- x1
+ 1), 1);
3264 int contour_begin_x
, contour_begin_y
;
3265 int contour_end_x
, contour_end_y
;
3266 int contour_npoints
;
3268 /* Clip the top part of the contour lines down (and including) line Y_POS.
3269 If X_POS is in the middle (rather than at the end) of the line, drop
3270 down a line at that character. */
3273 clip_contour_top (y_pos
, x_pos
)
3275 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
3276 register XPoint
*end
;
3277 register int npoints
;
3278 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
3280 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
3282 end
= contour_lines
[y_pos
].top_right
;
3283 npoints
= (end
- begin
+ 1);
3284 XDrawLines (x_current_display
, contour_window
,
3285 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3287 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
3288 contour_last_point
-= (npoints
- 2);
3289 XDrawLines (x_current_display
, contour_window
,
3290 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
3291 XFlush (x_current_display
);
3293 /* Now, update contour_lines structure. */
3298 register XPoint
*p
= begin
+ 1;
3299 end
= contour_lines
[y_pos
].bottom_right
;
3300 npoints
= (end
- begin
+ 1);
3301 XDrawLines (x_current_display
, contour_window
,
3302 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3305 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
3307 p
->y
= begin
->y
+ font_h
;
3309 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
3310 contour_last_point
-= (npoints
- 5);
3311 XDrawLines (x_current_display
, contour_window
,
3312 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
3313 XFlush (x_current_display
);
3315 /* Now, update contour_lines structure. */
3319 /* Erase the top horizontal lines of the contour, and then extend
3320 the contour upwards. */
3323 extend_contour_top (line
)
3328 clip_contour_bottom (x_pos
, y_pos
)
3334 extend_contour_bottom (x_pos
, y_pos
)
3338 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
3343 register struct frame
*f
= selected_frame
;
3344 register int point_x
= f
->cursor_x
;
3345 register int point_y
= f
->cursor_y
;
3346 register int mouse_below_point
;
3347 register Lisp_Object obj
;
3348 register int x_contour_x
, x_contour_y
;
3350 x_contour_x
= x_mouse_x
;
3351 x_contour_y
= x_mouse_y
;
3352 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
3353 && x_contour_x
> point_x
))
3355 mouse_below_point
= 1;
3356 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3357 x_contour_x
, x_contour_y
);
3361 mouse_below_point
= 0;
3362 outline_region (f
, f
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
3368 obj
= read_char (-1, 0, 0, Qnil
, 0);
3369 if (XTYPE (obj
) != Lisp_Cons
)
3372 if (mouse_below_point
)
3374 if (x_mouse_y
<= point_y
) /* Flipped. */
3376 mouse_below_point
= 0;
3378 outline_region (f
, f
->display
.x
->reverse_gc
, point_x
, point_y
,
3379 x_contour_x
, x_contour_y
);
3380 outline_region (f
, f
->display
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
3383 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
3385 clip_contour_bottom (x_mouse_y
);
3387 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
3389 extend_bottom_contour (x_mouse_y
);
3392 x_contour_x
= x_mouse_x
;
3393 x_contour_y
= x_mouse_y
;
3395 else /* mouse above or same line as point */
3397 if (x_mouse_y
>= point_y
) /* Flipped. */
3399 mouse_below_point
= 1;
3401 outline_region (f
, f
->display
.x
->reverse_gc
,
3402 x_contour_x
, x_contour_y
, point_x
, point_y
);
3403 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3404 x_mouse_x
, x_mouse_y
);
3406 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
3408 clip_contour_top (x_mouse_y
);
3410 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
3412 extend_contour_top (x_mouse_y
);
3417 unread_command_event
= obj
;
3418 if (mouse_below_point
)
3420 contour_begin_x
= point_x
;
3421 contour_begin_y
= point_y
;
3422 contour_end_x
= x_contour_x
;
3423 contour_end_y
= x_contour_y
;
3427 contour_begin_x
= x_contour_x
;
3428 contour_begin_y
= x_contour_y
;
3429 contour_end_x
= point_x
;
3430 contour_end_y
= point_y
;
3435 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
3440 register Lisp_Object obj
;
3441 struct frame
*f
= selected_frame
;
3442 register struct window
*w
= XWINDOW (selected_window
);
3443 register GC line_gc
= f
->display
.x
->cursor_gc
;
3444 register GC erase_gc
= f
->display
.x
->reverse_gc
;
3446 char dash_list
[] = {6, 4, 6, 4};
3448 XGCValues gc_values
;
3450 register int previous_y
;
3451 register int line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3452 + f
->display
.x
->internal_border_width
;
3453 register int left
= f
->display
.x
->internal_border_width
3455 * FONT_WIDTH (f
->display
.x
->font
));
3456 register int right
= left
+ (w
->width
3457 * FONT_WIDTH (f
->display
.x
->font
))
3458 - f
->display
.x
->internal_border_width
;
3462 gc_values
.foreground
= f
->display
.x
->cursor_pixel
;
3463 gc_values
.background
= f
->display
.x
->background_pixel
;
3464 gc_values
.line_width
= 1;
3465 gc_values
.line_style
= LineOnOffDash
;
3466 gc_values
.cap_style
= CapRound
;
3467 gc_values
.join_style
= JoinRound
;
3469 line_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3470 GCLineStyle
| GCJoinStyle
| GCCapStyle
3471 | GCLineWidth
| GCForeground
| GCBackground
,
3473 XSetDashes (x_current_display
, line_gc
, 0, dash_list
, dashes
);
3474 gc_values
.foreground
= f
->display
.x
->background_pixel
;
3475 gc_values
.background
= f
->display
.x
->foreground_pixel
;
3476 erase_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3477 GCLineStyle
| GCJoinStyle
| GCCapStyle
3478 | GCLineWidth
| GCForeground
| GCBackground
,
3480 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
3486 if (x_mouse_y
>= XINT (w
->top
)
3487 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
3489 previous_y
= x_mouse_y
;
3490 line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3491 + f
->display
.x
->internal_border_width
;
3492 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3493 line_gc
, left
, line
, right
, line
);
3500 obj
= read_char (-1, 0, 0, Qnil
, 0);
3501 if ((XTYPE (obj
) != Lisp_Cons
)
3502 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3503 Qvertical_scroll_bar
))
3507 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3508 erase_gc
, left
, line
, right
, line
);
3510 unread_command_event
= obj
;
3512 XFreeGC (x_current_display
, line_gc
);
3513 XFreeGC (x_current_display
, erase_gc
);
3518 while (x_mouse_y
== previous_y
);
3521 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3522 erase_gc
, left
, line
, right
, line
);
3528 /* Offset in buffer of character under the pointer, or 0. */
3529 int mouse_buffer_offset
;
3532 /* These keep track of the rectangle following the pointer. */
3533 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
3535 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
3536 "Track the pointer.")
3539 static Cursor current_pointer_shape
;
3540 FRAME_PTR f
= x_mouse_frame
;
3543 if (EQ (Vmouse_frame_part
, Qtext_part
)
3544 && (current_pointer_shape
!= f
->display
.x
->nontext_cursor
))
3549 current_pointer_shape
= f
->display
.x
->nontext_cursor
;
3550 XDefineCursor (x_current_display
,
3552 current_pointer_shape
);
3554 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
3555 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
3557 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
3558 && (current_pointer_shape
!= f
->display
.x
->modeline_cursor
))
3560 current_pointer_shape
= f
->display
.x
->modeline_cursor
;
3561 XDefineCursor (x_current_display
,
3563 current_pointer_shape
);
3572 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
3573 "Draw rectangle around character under mouse pointer, if there is one.")
3577 struct window
*w
= XWINDOW (Vmouse_window
);
3578 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
3579 struct buffer
*b
= XBUFFER (w
->buffer
);
3582 if (! EQ (Vmouse_window
, selected_window
))
3585 if (EQ (event
, Qnil
))
3589 x_read_mouse_position (selected_frame
, &x
, &y
);
3593 mouse_track_width
= 0;
3594 mouse_track_left
= mouse_track_top
= -1;
3598 if ((x_mouse_x
!= mouse_track_left
3599 && (x_mouse_x
< mouse_track_left
3600 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
3601 || x_mouse_y
!= mouse_track_top
)
3603 int hp
= 0; /* Horizontal position */
3604 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
3605 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
3606 int tab_width
= XINT (b
->tab_width
);
3607 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
3609 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
3610 int in_mode_line
= 0;
3612 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
3615 /* Erase previous rectangle. */
3616 if (mouse_track_width
)
3618 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3619 mouse_track_left
, mouse_track_top
,
3620 mouse_track_width
, 1);
3622 if ((mouse_track_left
== f
->phys_cursor_x
3623 || mouse_track_left
== f
->phys_cursor_x
- 1)
3624 && mouse_track_top
== f
->phys_cursor_y
)
3626 x_display_cursor (f
, 1);
3630 mouse_track_left
= x_mouse_x
;
3631 mouse_track_top
= x_mouse_y
;
3632 mouse_track_width
= 0;
3634 if (mouse_track_left
> len
) /* Past the end of line. */
3637 if (mouse_track_top
== mode_line_vpos
)
3643 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3647 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
3653 mouse_track_width
= tab_width
- (hp
% tab_width
);
3655 hp
+= mouse_track_width
;
3658 mouse_track_left
= hp
- mouse_track_width
;
3664 mouse_track_width
= -1;
3668 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3673 mouse_track_width
= 2;
3678 mouse_track_left
= hp
- mouse_track_width
;
3684 mouse_track_width
= 1;
3691 while (hp
<= x_mouse_x
);
3694 if (mouse_track_width
) /* Over text; use text pointer shape. */
3696 XDefineCursor (x_current_display
,
3698 f
->display
.x
->text_cursor
);
3699 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3700 mouse_track_left
, mouse_track_top
,
3701 mouse_track_width
, 1);
3703 else if (in_mode_line
)
3704 XDefineCursor (x_current_display
,
3706 f
->display
.x
->modeline_cursor
);
3708 XDefineCursor (x_current_display
,
3710 f
->display
.x
->nontext_cursor
);
3713 XFlush (x_current_display
);
3716 obj
= read_char (-1, 0, 0, Qnil
, 0);
3719 while (XTYPE (obj
) == Lisp_Cons
/* Mouse event */
3720 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
3721 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
3722 && EQ (Vmouse_window
, selected_window
) /* In this window */
3725 unread_command_event
= obj
;
3727 if (mouse_track_width
)
3729 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3730 mouse_track_left
, mouse_track_top
,
3731 mouse_track_width
, 1);
3732 mouse_track_width
= 0;
3733 if ((mouse_track_left
== f
->phys_cursor_x
3734 || mouse_track_left
- 1 == f
->phys_cursor_x
)
3735 && mouse_track_top
== f
->phys_cursor_y
)
3737 x_display_cursor (f
, 1);
3740 XDefineCursor (x_current_display
,
3742 f
->display
.x
->nontext_cursor
);
3743 XFlush (x_current_display
);
3753 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3754 on the frame F at position X, Y. */
3756 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
3758 int x
, y
, width
, height
;
3763 image
= XCreateBitmapFromData (x_current_display
,
3764 FRAME_X_WINDOW (f
), image_data
,
3766 XCopyPlane (x_current_display
, image
, FRAME_X_WINDOW (f
),
3767 f
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
3771 #if 0 /* I'm told these functions are superfluous
3772 given the ability to bind function keys. */
3775 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3776 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3777 KEYSYM is a string which conforms to the X keysym definitions found\n\
3778 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3779 list of strings specifying modifier keys such as Control_L, which must\n\
3780 also be depressed for NEWSTRING to appear.")
3781 (x_keysym
, modifiers
, newstring
)
3782 register Lisp_Object x_keysym
;
3783 register Lisp_Object modifiers
;
3784 register Lisp_Object newstring
;
3787 register KeySym keysym
;
3788 KeySym modifier_list
[16];
3791 CHECK_STRING (x_keysym
, 1);
3792 CHECK_STRING (newstring
, 3);
3794 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
3795 if (keysym
== NoSymbol
)
3796 error ("Keysym does not exist");
3798 if (NILP (modifiers
))
3799 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
3800 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3803 register Lisp_Object rest
, mod
;
3806 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
3809 error ("Can't have more than 16 modifiers");
3812 CHECK_STRING (mod
, 3);
3813 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
3815 if (modifier_list
[i
] == NoSymbol
3816 || !(IsModifierKey (modifier_list
[i
])
3817 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
3818 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
3820 if (modifier_list
[i
] == NoSymbol
3821 || !IsModifierKey (modifier_list
[i
]))
3823 error ("Element is not a modifier keysym");
3827 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
3828 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3834 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
3835 "Rebind KEYCODE to list of strings STRINGS.\n\
3836 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3837 nil as element means don't change.\n\
3838 See the documentation of `x-rebind-key' for more information.")
3840 register Lisp_Object keycode
;
3841 register Lisp_Object strings
;
3843 register Lisp_Object item
;
3844 register unsigned char *rawstring
;
3845 KeySym rawkey
, modifier
[1];
3847 register unsigned i
;
3850 CHECK_NUMBER (keycode
, 1);
3851 CHECK_CONS (strings
, 2);
3852 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
3853 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
3855 item
= Fcar (strings
);
3858 CHECK_STRING (item
, 2);
3859 strsize
= XSTRING (item
)->size
;
3860 rawstring
= (unsigned char *) xmalloc (strsize
);
3861 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
3862 modifier
[1] = 1 << i
;
3863 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
3864 rawstring
, strsize
);
3869 #endif /* HAVE_X11 */
3872 #ifndef HAVE_XSCREENNUMBEROFSCREEN
3874 XScreenNumberOfScreen (scr
)
3875 register Screen
*scr
;
3877 register Display
*dpy
;
3878 register Screen
*dpyscr
;
3882 dpyscr
= dpy
->screens
;
3884 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
3890 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
3893 select_visual (screen
, depth
)
3895 unsigned int *depth
;
3898 XVisualInfo
*vinfo
, vinfo_template
;
3901 v
= DefaultVisualOfScreen (screen
);
3904 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
3906 vinfo_template
.visualid
= v
->visualid
;
3909 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
3911 vinfo
= XGetVisualInfo (x_current_display
,
3912 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
3915 fatal ("Can't get proper X visual info");
3917 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
3918 *depth
= vinfo
->depth
;
3922 int n
= vinfo
->colormap_size
- 1;
3931 XFree ((char *) vinfo
);
3935 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
3936 1, 2, 0, "Open a connection to an X server.\n\
3937 DISPLAY is the name of the display to connect to.\n\
3938 Optional second arg XRM_STRING is a string of resources in xrdb format.")
3939 (display
, xrm_string
)
3940 Lisp_Object display
, xrm_string
;
3942 unsigned int n_planes
;
3943 unsigned char *xrm_option
;
3945 CHECK_STRING (display
, 0);
3946 if (x_current_display
!= 0)
3947 error ("X server connection is already initialized");
3948 if (! NILP (xrm_string
))
3949 CHECK_STRING (xrm_string
, 1);
3951 if (! NILP (xrm_string
))
3952 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
3954 xrm_option
= (unsigned char *) 0;
3956 validate_x_resource_name ();
3958 /* This is what opens the connection and sets x_current_display.
3959 This also initializes many symbols, such as those used for input. */
3960 x_term_init (XSTRING (display
)->data
, xrm_option
,
3961 XSTRING (Vx_resource_name
)->data
);
3963 XFASTINT (Vwindow_system_version
) = 11;
3966 xrdb
= x_load_resources (x_current_display
, xrm_option
,
3967 (char *) XSTRING (Vx_resource_name
)->data
,
3970 #ifdef HAVE_XRMSETDATABASE
3971 XrmSetDatabase (x_current_display
, xrdb
);
3973 x_current_display
->db
= xrdb
;
3976 the_x_screen
.name
= display
;
3978 x_screen
= DefaultScreenOfDisplay (x_current_display
);
3980 screen_visual
= select_visual (x_screen
, &n_planes
);
3981 x_screen_planes
= n_planes
;
3982 x_screen_height
= HeightOfScreen (x_screen
);
3983 x_screen_width
= WidthOfScreen (x_screen
);
3985 /* X Atoms used by emacs. */
3986 Xatoms_of_xselect ();
3988 Xatom_wm_protocols
= XInternAtom (x_current_display
, "WM_PROTOCOLS",
3990 Xatom_wm_take_focus
= XInternAtom (x_current_display
, "WM_TAKE_FOCUS",
3992 Xatom_wm_save_yourself
= XInternAtom (x_current_display
, "WM_SAVE_YOURSELF",
3994 Xatom_wm_delete_window
= XInternAtom (x_current_display
, "WM_DELETE_WINDOW",
3996 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
3998 Xatom_wm_configure_denied
= XInternAtom (x_current_display
,
3999 "WM_CONFIGURE_DENIED", False
);
4000 Xatom_wm_window_moved
= XInternAtom (x_current_display
, "WM_MOVED",
4002 Xatom_editres_name
= XInternAtom (x_current_display
, "Editres", False
);
4007 DEFUN ("x-close-current-connection", Fx_close_current_connection
,
4008 Sx_close_current_connection
,
4009 0, 0, 0, "Close the connection to the current X server.")
4012 /* Note: If we're going to call check_x here, then the fatal error
4013 can't happen. For the moment, this check is just for safety,
4014 so a user won't try out the function and get a crash. If it's
4015 really intended only to be called when killing emacs, then there's
4016 no reason for it to have a lisp interface at all. */
4019 /* This is ONLY used when killing emacs; For switching displays
4020 we'll have to take care of setting CloseDownMode elsewhere. */
4022 if (x_current_display
)
4025 XSetCloseDownMode (x_current_display
, DestroyAll
);
4026 XCloseDisplay (x_current_display
);
4027 x_current_display
= 0;
4030 fatal ("No current X display connection to close\n");
4035 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
,
4036 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4037 If ON is nil, allow buffering of requests.\n\
4038 Turning on synchronization prohibits the Xlib routines from buffering\n\
4039 requests and seriously degrades performance, but makes debugging much\n\
4046 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
4051 /* Wait for responses to all X commands issued so far for FRAME. */
4058 XSync (x_current_display
, False
);
4064 /* This is zero if not using X windows. */
4065 x_current_display
= 0;
4067 the_x_screen
.font_list_cache
= Qnil
;
4068 the_x_screen
.name
= Qnil
;
4069 staticpro (&the_x_screen
.font_list_cache
);
4070 staticpro (&the_x_screen
.name
);
4072 /* The section below is built by the lisp expression at the top of the file,
4073 just above where these variables are declared. */
4074 /*&&& init symbols here &&&*/
4075 Qauto_raise
= intern ("auto-raise");
4076 staticpro (&Qauto_raise
);
4077 Qauto_lower
= intern ("auto-lower");
4078 staticpro (&Qauto_lower
);
4079 Qbackground_color
= intern ("background-color");
4080 staticpro (&Qbackground_color
);
4081 Qbar
= intern ("bar");
4083 Qborder_color
= intern ("border-color");
4084 staticpro (&Qborder_color
);
4085 Qborder_width
= intern ("border-width");
4086 staticpro (&Qborder_width
);
4087 Qbox
= intern ("box");
4089 Qcursor_color
= intern ("cursor-color");
4090 staticpro (&Qcursor_color
);
4091 Qcursor_type
= intern ("cursor-type");
4092 staticpro (&Qcursor_type
);
4093 Qfont
= intern ("font");
4095 Qforeground_color
= intern ("foreground-color");
4096 staticpro (&Qforeground_color
);
4097 Qgeometry
= intern ("geometry");
4098 staticpro (&Qgeometry
);
4099 Qicon_left
= intern ("icon-left");
4100 staticpro (&Qicon_left
);
4101 Qicon_top
= intern ("icon-top");
4102 staticpro (&Qicon_top
);
4103 Qicon_type
= intern ("icon-type");
4104 staticpro (&Qicon_type
);
4105 Qinternal_border_width
= intern ("internal-border-width");
4106 staticpro (&Qinternal_border_width
);
4107 Qleft
= intern ("left");
4109 Qmouse_color
= intern ("mouse-color");
4110 staticpro (&Qmouse_color
);
4111 Qnone
= intern ("none");
4113 Qparent_id
= intern ("parent-id");
4114 staticpro (&Qparent_id
);
4115 Qscroll_bar_width
= intern ("scroll-bar-width");
4116 staticpro (&Qscroll_bar_width
);
4117 Qsuppress_icon
= intern ("suppress-icon");
4118 staticpro (&Qsuppress_icon
);
4119 Qtop
= intern ("top");
4121 Qundefined_color
= intern ("undefined-color");
4122 staticpro (&Qundefined_color
);
4123 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
4124 staticpro (&Qvertical_scroll_bars
);
4125 Qvisibility
= intern ("visibility");
4126 staticpro (&Qvisibility
);
4127 Qwindow_id
= intern ("window-id");
4128 staticpro (&Qwindow_id
);
4129 Qx_frame_parameter
= intern ("x-frame-parameter");
4130 staticpro (&Qx_frame_parameter
);
4131 Qx_resource_name
= intern ("x-resource-name");
4132 staticpro (&Qx_resource_name
);
4133 Quser_position
= intern ("user-position");
4134 staticpro (&Quser_position
);
4135 Quser_size
= intern ("user-size");
4136 staticpro (&Quser_size
);
4137 /* This is the end of symbol initialization. */
4139 Fput (Qundefined_color
, Qerror_conditions
,
4140 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
4141 Fput (Qundefined_color
, Qerror_message
,
4142 build_string ("Undefined color"));
4144 init_x_parm_symbols ();
4146 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset
,
4147 "The buffer offset of the character under the pointer.");
4148 mouse_buffer_offset
= 0;
4150 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
4151 "The shape of the pointer when over text.\n\
4152 Changing the value does not affect existing frames\n\
4153 unless you set the mouse color.");
4154 Vx_pointer_shape
= Qnil
;
4156 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
4157 "The name Emacs uses to look up X resources; for internal use only.\n\
4158 `x-get-resource' uses this as the first component of the instance name\n\
4159 when requesting resource values.\n\
4160 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4161 was invoked, or to the value specified with the `-name' or `-rn'\n\
4162 switches, if present.");
4163 Vx_resource_name
= Qnil
;
4165 #if 0 /* This doesn't really do anything. */
4166 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
4167 "The shape of the pointer when not over text.\n\
4168 This variable takes effect when you create a new frame\n\
4169 or when you set the mouse color.");
4171 Vx_nontext_pointer_shape
= Qnil
;
4173 #if 0 /* This doesn't really do anything. */
4174 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
4175 "The shape of the pointer when over the mode line.\n\
4176 This variable takes effect when you create a new frame\n\
4177 or when you set the mouse color.");
4179 Vx_mode_pointer_shape
= Qnil
;
4181 DEFVAR_INT ("x-sensitive-text-pointer-shape",
4182 &Vx_sensitive_text_pointer_shape
,
4183 "The shape of the pointer when over mouse-sensitive text.\n\
4184 This variable takes effect when you create a new frame\n\
4185 or when you set the mouse color.");
4186 Vx_sensitive_text_pointer_shape
= Qnil
;
4188 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
4189 "A string indicating the foreground color of the cursor box.");
4190 Vx_cursor_fore_pixel
= Qnil
;
4192 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed
,
4193 "Non-nil if a mouse button is currently depressed.");
4194 Vmouse_depressed
= Qnil
;
4196 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
4197 "Non-nil if no X window manager is in use.");
4199 #ifdef USE_X_TOOLKIT
4200 Fprovide (intern ("x-toolkit"));
4203 defsubr (&Sx_get_resource
);
4205 defsubr (&Sx_draw_rectangle
);
4206 defsubr (&Sx_erase_rectangle
);
4207 defsubr (&Sx_contour_region
);
4208 defsubr (&Sx_uncontour_region
);
4210 defsubr (&Sx_list_fonts
);
4211 defsubr (&Sx_display_color_p
);
4212 defsubr (&Sx_display_grayscale_p
);
4213 defsubr (&Sx_color_defined_p
);
4214 defsubr (&Sx_color_values
);
4215 defsubr (&Sx_server_max_request_size
);
4216 defsubr (&Sx_server_vendor
);
4217 defsubr (&Sx_server_version
);
4218 defsubr (&Sx_display_pixel_width
);
4219 defsubr (&Sx_display_pixel_height
);
4220 defsubr (&Sx_display_mm_width
);
4221 defsubr (&Sx_display_mm_height
);
4222 defsubr (&Sx_display_screens
);
4223 defsubr (&Sx_display_planes
);
4224 defsubr (&Sx_display_color_cells
);
4225 defsubr (&Sx_display_visual_class
);
4226 defsubr (&Sx_display_backing_store
);
4227 defsubr (&Sx_display_save_under
);
4229 defsubr (&Sx_rebind_key
);
4230 defsubr (&Sx_rebind_keys
);
4231 defsubr (&Sx_track_pointer
);
4232 defsubr (&Sx_grab_pointer
);
4233 defsubr (&Sx_ungrab_pointer
);
4235 defsubr (&Sx_parse_geometry
);
4236 defsubr (&Sx_create_frame
);
4237 defsubr (&Sfocus_frame
);
4238 defsubr (&Sunfocus_frame
);
4240 defsubr (&Sx_horizontal_line
);
4242 defsubr (&Sx_open_connection
);
4243 defsubr (&Sx_close_current_connection
);
4244 defsubr (&Sx_synchronize
);
4247 #endif /* HAVE_X_WINDOWS */