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 */
36 #include "dispextern.h"
38 #include "blockinput.h"
44 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
45 #include "bitmaps/gray.xbm"
47 #include <X11/bitmaps/gray>
50 #include "[.bitmaps]gray.xbm"
54 #include <X11/Shell.h>
56 #include <X11/Xaw/Paned.h>
57 #include <X11/Xaw/Label.h>
60 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
69 #include "../lwlib/lwlib.h"
71 /* The one and only application context associated with the connection
72 to the one and only X display that Emacs uses. */
73 XtAppContext Xt_app_con
;
75 /* The one and only application shell. Emacs screens are popup shells of this
79 extern void free_frame_menubar ();
80 extern void free_frame_menubar ();
81 #endif /* USE_X_TOOLKIT */
83 #define min(a,b) ((a) < (b) ? (a) : (b))
84 #define max(a,b) ((a) > (b) ? (a) : (b))
87 /* X Resource data base */
88 static XrmDatabase xrdb
;
90 /* The class of this X application. */
91 #define EMACS_CLASS "Emacs"
94 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
96 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
99 /* The name we're using in resource queries. */
100 Lisp_Object Vx_resource_name
;
102 /* Title name and application name for X stuff. */
103 extern char *x_id_name
;
105 /* The background and shape of the mouse pointer, and shape when not
106 over text or in the modeline. */
107 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
108 /* The shape when over mouse-sensitive text. */
109 Lisp_Object Vx_sensitive_text_pointer_shape
;
111 /* Color of chars displayed in cursor box. */
112 Lisp_Object Vx_cursor_fore_pixel
;
114 /* The screen being used. */
115 static Screen
*x_screen
;
117 /* The X Visual we are using for X windows (the default) */
118 Visual
*screen_visual
;
120 /* Height of this X screen in pixels. */
123 /* Width of this X screen in pixels. */
126 /* Number of planes for this screen. */
129 /* Non nil if no window manager is in use. */
130 Lisp_Object Vx_no_window_manager
;
132 /* `t' if a mouse button is depressed. */
134 Lisp_Object Vmouse_depressed
;
136 extern unsigned int x_mouse_x
, x_mouse_y
, x_mouse_grabbed
;
138 /* Atom for indicating window state to the window manager. */
139 extern Atom Xatom_wm_change_state
;
141 /* Communication with window managers. */
142 extern Atom Xatom_wm_protocols
;
144 /* Kinds of protocol things we may receive. */
145 extern Atom Xatom_wm_take_focus
;
146 extern Atom Xatom_wm_save_yourself
;
147 extern Atom Xatom_wm_delete_window
;
149 /* Other WM communication */
150 extern Atom Xatom_wm_configure_denied
; /* When our config request is denied */
151 extern Atom Xatom_wm_window_moved
; /* When the WM moves us. */
153 /* EditRes protocol */
154 extern Atom Xatom_editres_name
;
158 /* Default size of an Emacs window. */
159 static char *default_window
= "=80x24+0+0";
162 char iconidentity
[MAXICID
];
163 #define ICONTAG "emacs@"
164 char minibuffer_iconidentity
[MAXICID
];
165 #define MINIBUFFER_ICONTAG "minibuffer@"
169 /* The last 23 bits of the timestamp of the last mouse button event. */
170 Time mouse_timestamp
;
172 /* Evaluate this expression to rebuild the section of syms_of_xfns
173 that initializes and staticpros the symbols declared below. Note
174 that Emacs 18 has a bug that keeps C-x C-e from being able to
175 evaluate this expression.
178 ;; Accumulate a list of the symbols we want to initialize from the
179 ;; declarations at the top of the file.
180 (goto-char (point-min))
181 (search-forward "/\*&&& symbols declared here &&&*\/\n")
183 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
185 (cons (buffer-substring (match-beginning 1) (match-end 1))
188 (setq symbol-list (nreverse symbol-list))
189 ;; Delete the section of syms_of_... where we initialize the symbols.
190 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
191 (let ((start (point)))
192 (while (looking-at "^ Q")
194 (kill-region start (point)))
195 ;; Write a new symbol initialization section.
197 (insert (format " %s = intern (\"" (car symbol-list)))
198 (let ((start (point)))
199 (insert (substring (car symbol-list) 1))
200 (subst-char-in-region start (point) ?_ ?-))
201 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
202 (setq symbol-list (cdr symbol-list)))))
206 /*&&& symbols declared here &&&*/
207 Lisp_Object Qauto_raise
;
208 Lisp_Object Qauto_lower
;
209 Lisp_Object Qbackground_color
;
211 Lisp_Object Qborder_color
;
212 Lisp_Object Qborder_width
;
214 Lisp_Object Qcursor_color
;
215 Lisp_Object Qcursor_type
;
217 Lisp_Object Qforeground_color
;
218 Lisp_Object Qgeometry
;
219 /* Lisp_Object Qicon; */
220 Lisp_Object Qicon_left
;
221 Lisp_Object Qicon_top
;
222 Lisp_Object Qicon_type
;
223 Lisp_Object Qinternal_border_width
;
225 Lisp_Object Qmouse_color
;
227 Lisp_Object Qparent_id
;
228 Lisp_Object Qsuppress_icon
;
230 Lisp_Object Qundefined_color
;
231 Lisp_Object Qvertical_scroll_bars
;
232 Lisp_Object Qvisibility
;
233 Lisp_Object Qwindow_id
;
234 Lisp_Object Qx_frame_parameter
;
235 Lisp_Object Qx_resource_name
;
236 Lisp_Object Quser_position
;
237 Lisp_Object Quser_size
;
239 /* The below are defined in frame.c. */
240 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
241 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
;
243 extern Lisp_Object Vwindow_system_version
;
246 /* Error if we are not connected to X. */
250 if (x_current_display
== 0)
251 error ("X windows are not in use or not initialized");
254 /* Nonzero if using X for display. */
259 return x_current_display
!= 0;
262 /* Return the Emacs frame-object corresponding to an X window.
263 It could be the frame's main window or an icon window. */
265 /* This function can be called during GC, so use XGCTYPE. */
268 x_window_to_frame (wdesc
)
271 Lisp_Object tail
, frame
;
274 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
275 tail
= XCONS (tail
)->cdr
)
277 frame
= XCONS (tail
)->car
;
278 if (XGCTYPE (frame
) != Lisp_Frame
)
282 if (f
->display
.nothing
== 1)
284 if ((f
->display
.x
->edit_widget
285 && XtWindow (f
->display
.x
->edit_widget
) == wdesc
)
286 || f
->display
.x
->icon_desc
== wdesc
)
288 #else /* not USE_X_TOOLKIT */
289 if (FRAME_X_WINDOW (f
) == wdesc
290 || f
->display
.x
->icon_desc
== wdesc
)
292 #endif /* not USE_X_TOOLKIT */
298 /* Like x_window_to_frame but also compares the window with the widget's
302 x_any_window_to_frame (wdesc
)
305 Lisp_Object tail
, frame
;
309 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
310 tail
= XCONS (tail
)->cdr
)
312 frame
= XCONS (tail
)->car
;
313 if (XGCTYPE (frame
) != Lisp_Frame
)
316 if (f
->display
.nothing
== 1)
319 /* This frame matches if the window is any of its widgets. */
320 if (wdesc
== XtWindow (x
->widget
)
321 || wdesc
== XtWindow (x
->column_widget
)
322 || wdesc
== XtWindow (x
->edit_widget
))
324 /* Match if the window is this frame's menubar. */
325 if (x
->menubar_widget
326 && wdesc
== XtWindow (x
->menubar_widget
))
332 /* Return the frame whose principal (outermost) window is WDESC.
333 If WDESC is some other (smaller) window, we return 0. */
336 x_top_window_to_frame (wdesc
)
339 Lisp_Object tail
, frame
;
343 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
344 tail
= XCONS (tail
)->cdr
)
346 frame
= XCONS (tail
)->car
;
347 if (XGCTYPE (frame
) != Lisp_Frame
)
350 if (f
->display
.nothing
== 1)
353 /* This frame matches if the window is its topmost widget. */
354 if (wdesc
== XtWindow (x
->widget
))
356 /* Match if the window is this frame's menubar. */
357 if (x
->menubar_widget
358 && wdesc
== XtWindow (x
->menubar_widget
))
363 #endif /* USE_X_TOOLKIT */
366 /* Connect the frame-parameter names for X frames
367 to the ways of passing the parameter values to the window system.
369 The name of a parameter, as a Lisp symbol,
370 has an `x-frame-parameter' property which is an integer in Lisp
371 but can be interpreted as an `enum x_frame_parm' in C. */
375 X_PARM_FOREGROUND_COLOR
,
376 X_PARM_BACKGROUND_COLOR
,
383 X_PARM_INTERNAL_BORDER_WIDTH
,
387 X_PARM_VERT_SCROLL_BAR
,
389 X_PARM_MENU_BAR_LINES
393 struct x_frame_parm_table
396 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
399 void x_set_foreground_color ();
400 void x_set_background_color ();
401 void x_set_mouse_color ();
402 void x_set_cursor_color ();
403 void x_set_border_color ();
404 void x_set_cursor_type ();
405 void x_set_icon_type ();
407 void x_set_border_width ();
408 void x_set_internal_border_width ();
409 void x_explicitly_set_name ();
410 void x_set_autoraise ();
411 void x_set_autolower ();
412 void x_set_vertical_scroll_bars ();
413 void x_set_visibility ();
414 void x_set_menu_bar_lines ();
416 static struct x_frame_parm_table x_frame_parms
[] =
418 "foreground-color", x_set_foreground_color
,
419 "background-color", x_set_background_color
,
420 "mouse-color", x_set_mouse_color
,
421 "cursor-color", x_set_cursor_color
,
422 "border-color", x_set_border_color
,
423 "cursor-type", x_set_cursor_type
,
424 "icon-type", x_set_icon_type
,
426 "border-width", x_set_border_width
,
427 "internal-border-width", x_set_internal_border_width
,
428 "name", x_explicitly_set_name
,
429 "auto-raise", x_set_autoraise
,
430 "auto-lower", x_set_autolower
,
431 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
432 "visibility", x_set_visibility
,
433 "menu-bar-lines", x_set_menu_bar_lines
,
436 /* Attach the `x-frame-parameter' properties to
437 the Lisp symbol names of parameters relevant to X. */
439 init_x_parm_symbols ()
443 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
444 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
448 /* Change the parameters of FRAME as specified by ALIST.
449 If a parameter is not specially recognized, do nothing;
450 otherwise call the `x_set_...' function for that parameter. */
453 x_set_frame_parameters (f
, alist
)
459 /* If both of these parameters are present, it's more efficient to
460 set them both at once. So we wait until we've looked at the
461 entire list before we set them. */
462 Lisp_Object width
, height
;
465 Lisp_Object left
, top
;
467 /* Record in these vectors all the parms specified. */
473 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
476 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
477 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
479 /* Extract parm names and values into those vectors. */
482 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
484 Lisp_Object elt
, prop
, val
;
487 parms
[i
] = Fcar (elt
);
488 values
[i
] = Fcdr (elt
);
492 width
= height
= top
= left
= Qunbound
;
494 /* Now process them in reverse of specified order. */
495 for (i
--; i
>= 0; i
--)
497 Lisp_Object prop
, val
;
502 if (EQ (prop
, Qwidth
))
504 else if (EQ (prop
, Qheight
))
506 else if (EQ (prop
, Qtop
))
508 else if (EQ (prop
, Qleft
))
512 register Lisp_Object param_index
, old_value
;
514 param_index
= Fget (prop
, Qx_frame_parameter
);
515 old_value
= get_frame_param (f
, prop
);
516 store_frame_param (f
, prop
, val
);
517 if (XTYPE (param_index
) == Lisp_Int
518 && XINT (param_index
) >= 0
519 && (XINT (param_index
)
520 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
521 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
525 /* Don't die if just one of these was set. */
526 if (EQ (left
, Qunbound
))
527 XSET (left
, Lisp_Int
, f
->display
.x
->left_pos
);
528 if (EQ (top
, Qunbound
))
529 XSET (top
, Lisp_Int
, f
->display
.x
->top_pos
);
531 /* Don't die if just one of these was set. */
532 if (EQ (width
, Qunbound
))
533 XSET (width
, Lisp_Int
, FRAME_WIDTH (f
));
534 if (EQ (height
, Qunbound
))
535 XSET (height
, Lisp_Int
, FRAME_HEIGHT (f
));
537 /* Don't set these parameters these unless they've been explicitly
538 specified. The window might be mapped or resized while we're in
539 this function, and we don't want to override that unless the lisp
540 code has asked for it.
542 Don't set these parameters unless they actually differ from the
543 window's current parameters; the window may not actually exist
548 check_frame_size (f
, &height
, &width
);
550 XSET (frame
, Lisp_Frame
, f
);
552 if ((NUMBERP (width
) && XINT (width
) != FRAME_WIDTH (f
))
553 || (NUMBERP (height
) && XINT (height
) != FRAME_HEIGHT (f
)))
554 Fset_frame_size (frame
, width
, height
);
555 if ((NUMBERP (left
) && XINT (left
) != f
->display
.x
->left_pos
)
556 || (NUMBERP (top
) && XINT (top
) != f
->display
.x
->top_pos
))
557 Fset_frame_position (frame
, left
, top
);
561 /* Store the positions of frame F into XPTR and YPTR.
562 These are the positions of the containing window manager window,
563 not Emacs's own window. */
566 x_real_positions (f
, xptr
, yptr
)
570 int win_x
= 0, win_y
= 0;
573 /* This is pretty gross, but seems to be the easiest way out of
574 the problem that arises when restarting window-managers. */
577 Window outer
= XtWindow (f
->display
.x
->widget
);
579 Window outer
= f
->display
.x
->window_desc
;
581 Window tmp_root_window
;
582 Window
*tmp_children
;
585 XQueryTree (x_current_display
, outer
, &tmp_root_window
,
586 &f
->display
.x
->parent_desc
,
587 &tmp_children
, &tmp_nchildren
);
588 xfree (tmp_children
);
590 /* Find the position of the outside upper-left corner of
591 the inner window, with respect to the outer window. */
592 if (f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
595 XTranslateCoordinates (x_current_display
,
597 /* From-window, to-window. */
599 XtWindow (f
->display
.x
->widget
),
601 f
->display
.x
->window_desc
,
603 f
->display
.x
->parent_desc
,
605 /* From-position, to-position. */
606 0, 0, &win_x
, &win_y
,
612 win_x
+= f
->display
.x
->border_width
;
613 win_y
+= f
->display
.x
->border_width
;
615 *xptr
= f
->display
.x
->left_pos
- win_x
;
616 *yptr
= f
->display
.x
->top_pos
- win_y
;
619 /* Insert a description of internally-recorded parameters of frame X
620 into the parameter alist *ALISTPTR that is to be given to the user.
621 Only parameters that are specific to the X window system
622 and whose values are not correctly recorded in the frame's
623 param_alist need to be considered here. */
625 x_report_frame_params (f
, alistptr
)
627 Lisp_Object
*alistptr
;
631 store_in_alist (alistptr
, Qleft
, make_number (f
->display
.x
->left_pos
));
632 store_in_alist (alistptr
, Qtop
, make_number (f
->display
.x
->top_pos
));
633 store_in_alist (alistptr
, Qborder_width
,
634 make_number (f
->display
.x
->border_width
));
635 store_in_alist (alistptr
, Qinternal_border_width
,
636 make_number (f
->display
.x
->internal_border_width
));
637 sprintf (buf
, "%d", FRAME_X_WINDOW (f
));
638 store_in_alist (alistptr
, Qwindow_id
,
640 FRAME_SAMPLE_VISIBILITY (f
);
641 store_in_alist (alistptr
, Qvisibility
,
642 (FRAME_VISIBLE_P (f
) ? Qt
643 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
646 /* Decide if color named COLOR is valid for the display
647 associated with the selected frame. */
649 defined_color (color
, color_def
)
654 Colormap screen_colormap
;
659 = DefaultColormap (x_current_display
, XDefaultScreen (x_current_display
));
661 foo
= XParseColor (x_current_display
, screen_colormap
,
663 && XAllocColor (x_current_display
, screen_colormap
, color_def
);
665 foo
= XParseColor (color
, color_def
) && XGetHardwareColor (color_def
);
666 #endif /* not HAVE_X11 */
675 /* Given a string ARG naming a color, compute a pixel value from it
676 suitable for screen F.
677 If F is not a color screen, return DEF (default) regardless of what
681 x_decode_color (arg
, def
)
687 CHECK_STRING (arg
, 0);
689 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
690 return BLACK_PIX_DEFAULT
;
691 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
692 return WHITE_PIX_DEFAULT
;
695 if (x_screen_planes
== 1)
698 if (DISPLAY_CELLS
== 1)
702 if (defined_color (XSTRING (arg
)->data
, &cdef
))
705 Fsignal (Qundefined_color
, Fcons (arg
, Qnil
));
708 /* Functions called only from `x_set_frame_param'
709 to set individual parameters.
711 If FRAME_X_WINDOW (f) is 0,
712 the frame is being created and its X-window does not exist yet.
713 In that case, just record the parameter's new value
714 in the standard place; do not attempt to change the window. */
717 x_set_foreground_color (f
, arg
, oldval
)
719 Lisp_Object arg
, oldval
;
721 f
->display
.x
->foreground_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
722 if (FRAME_X_WINDOW (f
) != 0)
726 XSetForeground (x_current_display
, f
->display
.x
->normal_gc
,
727 f
->display
.x
->foreground_pixel
);
728 XSetBackground (x_current_display
, f
->display
.x
->reverse_gc
,
729 f
->display
.x
->foreground_pixel
);
731 #endif /* HAVE_X11 */
732 recompute_basic_faces (f
);
733 if (FRAME_VISIBLE_P (f
))
739 x_set_background_color (f
, arg
, oldval
)
741 Lisp_Object arg
, oldval
;
746 f
->display
.x
->background_pixel
= x_decode_color (arg
, WHITE_PIX_DEFAULT
);
748 if (FRAME_X_WINDOW (f
) != 0)
752 /* The main frame area. */
753 XSetBackground (x_current_display
, f
->display
.x
->normal_gc
,
754 f
->display
.x
->background_pixel
);
755 XSetForeground (x_current_display
, f
->display
.x
->reverse_gc
,
756 f
->display
.x
->background_pixel
);
757 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
758 f
->display
.x
->background_pixel
);
759 XSetWindowBackground (x_current_display
, FRAME_X_WINDOW (f
),
760 f
->display
.x
->background_pixel
);
763 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
764 bar
= XSCROLL_BAR (bar
)->next
)
765 XSetWindowBackground (x_current_display
,
766 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
767 f
->display
.x
->background_pixel
);
770 temp
= XMakeTile (f
->display
.x
->background_pixel
);
771 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
773 #endif /* not HAVE_X11 */
776 recompute_basic_faces (f
);
778 if (FRAME_VISIBLE_P (f
))
784 x_set_mouse_color (f
, arg
, oldval
)
786 Lisp_Object arg
, oldval
;
788 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
792 f
->display
.x
->mouse_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
793 mask_color
= f
->display
.x
->background_pixel
;
794 /* No invisible pointers. */
795 if (mask_color
== f
->display
.x
->mouse_pixel
796 && mask_color
== f
->display
.x
->background_pixel
)
797 f
->display
.x
->mouse_pixel
= f
->display
.x
->foreground_pixel
;
802 /* It's not okay to crash if the user selects a screwy cursor. */
805 if (!EQ (Qnil
, Vx_pointer_shape
))
807 CHECK_NUMBER (Vx_pointer_shape
, 0);
808 cursor
= XCreateFontCursor (x_current_display
, XINT (Vx_pointer_shape
));
811 cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
812 x_check_errors ("bad text pointer cursor: %s");
814 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
816 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
817 nontext_cursor
= XCreateFontCursor (x_current_display
,
818 XINT (Vx_nontext_pointer_shape
));
821 nontext_cursor
= XCreateFontCursor (x_current_display
, XC_left_ptr
);
822 x_check_errors ("bad nontext pointer cursor: %s");
824 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
826 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
827 mode_cursor
= XCreateFontCursor (x_current_display
,
828 XINT (Vx_mode_pointer_shape
));
831 mode_cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
832 x_check_errors ("bad modeline pointer cursor: %s");
834 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
836 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
838 = XCreateFontCursor (x_current_display
,
839 XINT (Vx_sensitive_text_pointer_shape
));
842 cross_cursor
= XCreateFontCursor (x_current_display
, XC_crosshair
);
844 /* Check and report errors with the above calls. */
845 x_check_errors ("can't set cursor shape: %s");
849 XColor fore_color
, back_color
;
851 fore_color
.pixel
= f
->display
.x
->mouse_pixel
;
852 back_color
.pixel
= mask_color
;
853 XQueryColor (x_current_display
,
854 DefaultColormap (x_current_display
,
855 DefaultScreen (x_current_display
)),
857 XQueryColor (x_current_display
,
858 DefaultColormap (x_current_display
,
859 DefaultScreen (x_current_display
)),
861 XRecolorCursor (x_current_display
, cursor
,
862 &fore_color
, &back_color
);
863 XRecolorCursor (x_current_display
, nontext_cursor
,
864 &fore_color
, &back_color
);
865 XRecolorCursor (x_current_display
, mode_cursor
,
866 &fore_color
, &back_color
);
867 XRecolorCursor (x_current_display
, cross_cursor
,
868 &fore_color
, &back_color
);
871 cursor
= XCreateCursor (16, 16, MouseCursor
, MouseMask
,
873 f
->display
.x
->mouse_pixel
,
874 f
->display
.x
->background_pixel
,
878 if (FRAME_X_WINDOW (f
) != 0)
880 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
), cursor
);
883 if (cursor
!= f
->display
.x
->text_cursor
&& f
->display
.x
->text_cursor
!= 0)
884 XFreeCursor (XDISPLAY f
->display
.x
->text_cursor
);
885 f
->display
.x
->text_cursor
= cursor
;
887 if (nontext_cursor
!= f
->display
.x
->nontext_cursor
888 && f
->display
.x
->nontext_cursor
!= 0)
889 XFreeCursor (XDISPLAY f
->display
.x
->nontext_cursor
);
890 f
->display
.x
->nontext_cursor
= nontext_cursor
;
892 if (mode_cursor
!= f
->display
.x
->modeline_cursor
893 && f
->display
.x
->modeline_cursor
!= 0)
894 XFreeCursor (XDISPLAY f
->display
.x
->modeline_cursor
);
895 f
->display
.x
->modeline_cursor
= mode_cursor
;
896 if (cross_cursor
!= f
->display
.x
->cross_cursor
897 && f
->display
.x
->cross_cursor
!= 0)
898 XFreeCursor (XDISPLAY f
->display
.x
->cross_cursor
);
899 f
->display
.x
->cross_cursor
= cross_cursor
;
900 #endif /* HAVE_X11 */
907 x_set_cursor_color (f
, arg
, oldval
)
909 Lisp_Object arg
, oldval
;
911 unsigned long fore_pixel
;
913 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
914 fore_pixel
= x_decode_color (Vx_cursor_fore_pixel
, WHITE_PIX_DEFAULT
);
916 fore_pixel
= f
->display
.x
->background_pixel
;
917 f
->display
.x
->cursor_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
919 /* Make sure that the cursor color differs from the background color. */
920 if (f
->display
.x
->cursor_pixel
== f
->display
.x
->background_pixel
)
922 f
->display
.x
->cursor_pixel
= f
->display
.x
->mouse_pixel
;
923 if (f
->display
.x
->cursor_pixel
== fore_pixel
)
924 fore_pixel
= f
->display
.x
->background_pixel
;
926 f
->display
.x
->cursor_foreground_pixel
= fore_pixel
;
928 if (FRAME_X_WINDOW (f
) != 0)
932 XSetBackground (x_current_display
, f
->display
.x
->cursor_gc
,
933 f
->display
.x
->cursor_pixel
);
934 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
937 #endif /* HAVE_X11 */
939 if (FRAME_VISIBLE_P (f
))
941 x_display_cursor (f
, 0);
942 x_display_cursor (f
, 1);
947 /* Set the border-color of frame F to value described by ARG.
948 ARG can be a string naming a color.
949 The border-color is used for the border that is drawn by the X server.
950 Note that this does not fully take effect if done before
951 F has an x-window; it must be redone when the window is created.
953 Note: this is done in two routines because of the way X10 works.
955 Note: under X11, this is normally the province of the window manager,
956 and so emacs' border colors may be overridden. */
959 x_set_border_color (f
, arg
, oldval
)
961 Lisp_Object arg
, oldval
;
966 CHECK_STRING (arg
, 0);
967 str
= XSTRING (arg
)->data
;
970 if (!strcmp (str
, "grey") || !strcmp (str
, "Grey")
971 || !strcmp (str
, "gray") || !strcmp (str
, "Gray"))
976 pix
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
978 x_set_border_pixel (f
, pix
);
981 /* Set the border-color of frame F to pixel value PIX.
982 Note that this does not fully take effect if done before
983 F has an x-window. */
985 x_set_border_pixel (f
, pix
)
989 f
->display
.x
->border_pixel
= pix
;
991 if (FRAME_X_WINDOW (f
) != 0 && f
->display
.x
->border_width
> 0)
998 XSetWindowBorder (x_current_display
, FRAME_X_WINDOW (f
),
1002 temp
= XMakePixmap ((Bitmap
) XStoreBitmap (gray_width
, gray_height
,
1004 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
1006 temp
= XMakeTile (pix
);
1007 XChangeBorder (FRAME_X_WINDOW (f
), temp
);
1008 XFreePixmap (XDISPLAY temp
);
1009 #endif /* not HAVE_X11 */
1012 if (FRAME_VISIBLE_P (f
))
1018 x_set_cursor_type (f
, arg
, oldval
)
1020 Lisp_Object arg
, oldval
;
1023 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1028 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
1029 /* Error messages commented out because people have trouble fixing
1030 .Xdefaults with Emacs, when it has something bad in it. */
1034 ("the `cursor-type' frame parameter should be either `bar' or `box'");
1037 /* Make sure the cursor gets redrawn. This is overkill, but how
1038 often do people change cursor types? */
1039 update_mode_lines
++;
1043 x_set_icon_type (f
, arg
, oldval
)
1045 Lisp_Object arg
, oldval
;
1050 if (EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1055 result
= x_text_icon (f
, 0);
1057 result
= x_bitmap_icon (f
);
1062 error ("No icon window available.");
1065 /* If the window was unmapped (and its icon was mapped),
1066 the new icon is not mapped, so map the window in its stead. */
1067 if (FRAME_VISIBLE_P (f
))
1068 #ifdef USE_X_TOOLKIT
1069 XtPopup (f
->display
.x
->widget
, XtGrabNone
);
1071 XMapWindow (XDISPLAY
FRAME_X_WINDOW (f
));
1077 extern Lisp_Object
x_new_font ();
1080 x_set_font (f
, arg
, oldval
)
1082 Lisp_Object arg
, oldval
;
1086 CHECK_STRING (arg
, 1);
1089 result
= x_new_font (f
, XSTRING (arg
)->data
);
1092 if (EQ (result
, Qnil
))
1093 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
1094 else if (EQ (result
, Qt
))
1095 error ("the characters of the given font have varying widths");
1096 else if (STRINGP (result
))
1098 recompute_basic_faces (f
);
1099 store_frame_param (f
, Qfont
, result
);
1106 x_set_border_width (f
, arg
, oldval
)
1108 Lisp_Object arg
, oldval
;
1110 CHECK_NUMBER (arg
, 0);
1112 if (XINT (arg
) == f
->display
.x
->border_width
)
1115 if (FRAME_X_WINDOW (f
) != 0)
1116 error ("Cannot change the border width of a window");
1118 f
->display
.x
->border_width
= XINT (arg
);
1122 x_set_internal_border_width (f
, arg
, oldval
)
1124 Lisp_Object arg
, oldval
;
1127 int old
= f
->display
.x
->internal_border_width
;
1129 CHECK_NUMBER (arg
, 0);
1130 f
->display
.x
->internal_border_width
= XINT (arg
);
1131 if (f
->display
.x
->internal_border_width
< 0)
1132 f
->display
.x
->internal_border_width
= 0;
1134 if (f
->display
.x
->internal_border_width
== old
)
1137 if (FRAME_X_WINDOW (f
) != 0)
1140 x_set_window_size (f
, 0, f
->width
, f
->height
);
1142 x_set_resize_hint (f
);
1146 SET_FRAME_GARBAGED (f
);
1151 x_set_visibility (f
, value
, oldval
)
1153 Lisp_Object value
, oldval
;
1156 XSET (frame
, Lisp_Frame
, f
);
1159 Fmake_frame_invisible (frame
, Qt
);
1160 else if (EQ (value
, Qicon
))
1161 Ficonify_frame (frame
);
1163 Fmake_frame_visible (frame
);
1167 x_set_menu_bar_lines_1 (window
, n
)
1171 struct window
*w
= XWINDOW (window
);
1173 XFASTINT (w
->top
) += n
;
1174 XFASTINT (w
->height
) -= n
;
1176 /* Handle just the top child in a vertical split. */
1177 if (!NILP (w
->vchild
))
1178 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1180 /* Adjust all children in a horizontal split. */
1181 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1183 w
= XWINDOW (window
);
1184 x_set_menu_bar_lines_1 (window
, n
);
1189 x_set_menu_bar_lines (f
, value
, oldval
)
1191 Lisp_Object value
, oldval
;
1194 int olines
= FRAME_MENU_BAR_LINES (f
);
1196 /* Right now, menu bars don't work properly in minibuf-only frames;
1197 most of the commands try to apply themselves to the minibuffer
1198 frame itslef, and get an error because you can't switch buffers
1199 in or split the minibuffer window. */
1200 if (FRAME_MINIBUF_ONLY_P (f
))
1203 if (XTYPE (value
) == Lisp_Int
)
1204 nlines
= XINT (value
);
1208 #ifdef USE_X_TOOLKIT
1209 FRAME_MENU_BAR_LINES (f
) = 0;
1211 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1214 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1215 free_frame_menubar (f
);
1216 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1217 f
->display
.x
->menubar_widget
= 0;
1219 #else /* not USE_X_TOOLKIT */
1220 FRAME_MENU_BAR_LINES (f
) = nlines
;
1221 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1222 #endif /* not USE_X_TOOLKIT */
1225 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1228 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1229 name; if NAME is a string, set F's name to NAME and set
1230 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1232 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1233 suggesting a new name, which lisp code should override; if
1234 F->explicit_name is set, ignore the new name; otherwise, set it. */
1237 x_set_name (f
, name
, explicit)
1242 /* Make sure that requests from lisp code override requests from
1243 Emacs redisplay code. */
1246 /* If we're switching from explicit to implicit, we had better
1247 update the mode lines and thereby update the title. */
1248 if (f
->explicit_name
&& NILP (name
))
1249 update_mode_lines
= 1;
1251 f
->explicit_name
= ! NILP (name
);
1253 else if (f
->explicit_name
)
1256 /* If NAME is nil, set the name to the x_id_name. */
1258 name
= build_string (x_id_name
);
1260 CHECK_STRING (name
, 0);
1262 /* Don't change the name if it's already NAME. */
1263 if (! NILP (Fstring_equal (name
, f
->name
)))
1266 if (FRAME_X_WINDOW (f
))
1272 text
.value
= XSTRING (name
)->data
;
1273 text
.encoding
= XA_STRING
;
1275 text
.nitems
= XSTRING (name
)->size
;
1276 #ifdef USE_X_TOOLKIT
1277 XSetWMName (x_current_display
, XtWindow (f
->display
.x
->widget
), &text
);
1278 XSetWMIconName (x_current_display
, XtWindow (f
->display
.x
->widget
),
1280 #else /* not USE_X_TOOLKIT */
1281 XSetWMName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1282 XSetWMIconName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1283 #endif /* not USE_X_TOOLKIT */
1285 #else /* not HAVE_X11R4 */
1286 XSetIconName (XDISPLAY
FRAME_X_WINDOW (f
),
1287 XSTRING (name
)->data
);
1288 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
),
1289 XSTRING (name
)->data
);
1290 #endif /* not HAVE_X11R4 */
1297 /* This function should be called when the user's lisp code has
1298 specified a name for the frame; the name will override any set by the
1301 x_explicitly_set_name (f
, arg
, oldval
)
1303 Lisp_Object arg
, oldval
;
1305 x_set_name (f
, arg
, 1);
1308 /* This function should be called by Emacs redisplay code to set the
1309 name; names set this way will never override names set by the user's
1312 x_implicitly_set_name (f
, arg
, oldval
)
1314 Lisp_Object arg
, oldval
;
1316 x_set_name (f
, arg
, 0);
1320 x_set_autoraise (f
, arg
, oldval
)
1322 Lisp_Object arg
, oldval
;
1324 f
->auto_raise
= !EQ (Qnil
, arg
);
1328 x_set_autolower (f
, arg
, oldval
)
1330 Lisp_Object arg
, oldval
;
1332 f
->auto_lower
= !EQ (Qnil
, arg
);
1336 x_set_vertical_scroll_bars (f
, arg
, oldval
)
1338 Lisp_Object arg
, oldval
;
1340 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
1342 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
1344 /* We set this parameter before creating the X window for the
1345 frame, so we can get the geometry right from the start.
1346 However, if the window hasn't been created yet, we shouldn't
1347 call x_set_window_size. */
1348 if (FRAME_X_WINDOW (f
))
1349 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1353 /* Subroutines of creating an X frame. */
1357 /* Make sure that Vx_resource_name is set to a reasonable value. */
1359 validate_x_resource_name ()
1361 if (STRINGP (Vx_resource_name
))
1363 int len
= XSTRING (Vx_resource_name
)->size
;
1364 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
1367 /* Allow only letters, digits, - and _,
1368 because those are all that X allows. */
1369 for (i
= 0; i
< len
; i
++)
1372 if (! ((c
>= 'a' && c
<= 'z')
1373 || (c
>= 'A' && c
<= 'Z')
1374 || (c
>= '0' && c
<= '9')
1375 || c
== '-' || c
== '_'))
1381 Vx_resource_name
= make_string ("emacs", 5);
1385 extern char *x_get_string_resource ();
1386 extern XrmDatabase
x_load_resources ();
1388 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
1389 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1390 This uses `NAME.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1391 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1392 the name specified by the `-name' or `-rn' command-line arguments.\n\
1394 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1395 class, respectively. You must specify both of them or neither.\n\
1396 If you specify them, the key is `NAME.COMPONENT.ATTRIBUTE'\n\
1397 and the class is `Emacs.CLASS.SUBCLASS'.")
1398 (attribute
, class, component
, subclass
)
1399 Lisp_Object attribute
, class, component
, subclass
;
1401 register char *value
;
1404 Lisp_Object resname
;
1408 CHECK_STRING (attribute
, 0);
1409 CHECK_STRING (class, 0);
1411 if (!NILP (component
))
1412 CHECK_STRING (component
, 1);
1413 if (!NILP (subclass
))
1414 CHECK_STRING (subclass
, 2);
1415 if (NILP (component
) != NILP (subclass
))
1416 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1418 validate_x_resource_name ();
1419 resname
= Vx_resource_name
;
1421 if (NILP (component
))
1423 /* Allocate space for the components, the dots which separate them,
1424 and the final '\0'. */
1425 name_key
= (char *) alloca (XSTRING (resname
)->size
1426 + XSTRING (attribute
)->size
1428 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1429 + XSTRING (class)->size
1432 sprintf (name_key
, "%s.%s",
1433 XSTRING (resname
)->data
,
1434 XSTRING (attribute
)->data
);
1435 sprintf (class_key
, "%s.%s",
1437 XSTRING (class)->data
);
1441 name_key
= (char *) alloca (XSTRING (resname
)->size
1442 + XSTRING (component
)->size
1443 + XSTRING (attribute
)->size
1446 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1447 + XSTRING (class)->size
1448 + XSTRING (subclass
)->size
1451 sprintf (name_key
, "%s.%s.%s",
1452 XSTRING (resname
)->data
,
1453 XSTRING (component
)->data
,
1454 XSTRING (attribute
)->data
);
1455 sprintf (class_key
, "%s.%s.%s",
1457 XSTRING (class)->data
,
1458 XSTRING (subclass
)->data
);
1461 value
= x_get_string_resource (xrdb
, name_key
, class_key
);
1463 if (value
!= (char *) 0)
1464 return build_string (value
);
1469 /* Used when C code wants a resource value. */
1472 x_get_resource_string (attribute
, class)
1473 char *attribute
, *class;
1475 register char *value
;
1479 /* Allocate space for the components, the dots which separate them,
1480 and the final '\0'. */
1481 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
1482 + strlen (attribute
) + 2);
1483 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1484 + strlen (class) + 2);
1486 sprintf (name_key
, "%s.%s",
1487 XSTRING (Vinvocation_name
)->data
,
1489 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
1491 return x_get_string_resource (xrdb
, name_key
, class_key
);
1496 DEFUN ("x-get-default", Fx_get_default
, Sx_get_default
, 1, 1, 0,
1497 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1498 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1499 The defaults are specified in the file `~/.Xdefaults'.")
1503 register unsigned char *value
;
1505 CHECK_STRING (arg
, 1);
1507 value
= (unsigned char *) XGetDefault (XDISPLAY
1508 XSTRING (Vinvocation_name
)->data
,
1509 XSTRING (arg
)->data
);
1511 /* Try reversing last two args, in case this is the buggy version of X. */
1512 value
= (unsigned char *) XGetDefault (XDISPLAY
1513 XSTRING (arg
)->data
,
1514 XSTRING (Vinvocation_name
)->data
);
1516 return build_string (value
);
1521 #define Fx_get_resource(attribute, class, component, subclass) \
1522 Fx_get_default (attribute)
1526 /* Types we might convert a resource string into. */
1529 number
, boolean
, string
, symbol
1532 /* Return the value of parameter PARAM.
1534 First search ALIST, then Vdefault_frame_alist, then the X defaults
1535 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1537 Convert the resource to the type specified by desired_type.
1539 If no default is specified, return Qunbound. If you call
1540 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1541 and don't let it get stored in any lisp-visible variables! */
1544 x_get_arg (alist
, param
, attribute
, class, type
)
1545 Lisp_Object alist
, param
;
1548 enum resource_types type
;
1550 register Lisp_Object tem
;
1552 tem
= Fassq (param
, alist
);
1554 tem
= Fassq (param
, Vdefault_frame_alist
);
1560 tem
= Fx_get_resource (build_string (attribute
),
1561 build_string (class),
1570 return make_number (atoi (XSTRING (tem
)->data
));
1573 tem
= Fdowncase (tem
);
1574 if (!strcmp (XSTRING (tem
)->data
, "on")
1575 || !strcmp (XSTRING (tem
)->data
, "true"))
1584 /* As a special case, we map the values `true' and `on'
1585 to Qt, and `false' and `off' to Qnil. */
1588 lower
= Fdowncase (tem
);
1589 if (!strcmp (XSTRING (lower
)->data
, "on")
1590 || !strcmp (XSTRING (lower
)->data
, "true"))
1592 else if (!strcmp (XSTRING (lower
)->data
, "off")
1593 || !strcmp (XSTRING (lower
)->data
, "false"))
1596 return Fintern (tem
, Qnil
);
1609 /* Record in frame F the specified or default value according to ALIST
1610 of the parameter named PARAM (a Lisp symbol).
1611 If no value is specified for PARAM, look for an X default for XPROP
1612 on the frame named NAME.
1613 If that is not found either, use the value DEFLT. */
1616 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
1623 enum resource_types type
;
1627 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
1628 if (EQ (tem
, Qunbound
))
1630 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
1634 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
1635 "Parse an X-style geometry string STRING.\n\
1636 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
1637 The properties returned may include `top', `left', `height', and `width'.\n\
1638 The value of `left' or `top' may be an integer or `-'.\n\
1639 `-' means \"minus zero\".")
1644 unsigned int width
, height
;
1647 CHECK_STRING (string
, 0);
1649 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
1650 &x
, &y
, &width
, &height
);
1653 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
1654 error ("Must specify both x and y position, or neither");
1658 if (geometry
& XValue
)
1660 Lisp_Object element
;
1662 if (x
== 0 && (geometry
& XNegative
))
1663 element
= Fcons (Qleft
, Qminus
);
1665 element
= Fcons (Qleft
, make_number (x
));
1666 result
= Fcons (element
, result
);
1669 if (geometry
& YValue
)
1671 Lisp_Object element
;
1673 if (y
== 0 && (geometry
& YNegative
))
1674 element
= Fcons (Qtop
, Qminus
);
1676 element
= Fcons (Qtop
, make_number (y
));
1677 result
= Fcons (element
, result
);
1680 if (geometry
& WidthValue
)
1681 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
1682 if (geometry
& HeightValue
)
1683 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
1689 /* Calculate the desired size and position of this window,
1690 and return the flags saying which aspects were specified.
1692 This function does not make the coordinates positive. */
1694 #define DEFAULT_ROWS 40
1695 #define DEFAULT_COLS 80
1698 x_figure_window_size (f
, parms
)
1702 register Lisp_Object tem0
, tem1
, tem2
;
1703 int height
, width
, left
, top
;
1704 register int geometry
;
1705 long window_prompting
= 0;
1707 /* Default values if we fall through.
1708 Actually, if that happens we should get
1709 window manager prompting. */
1710 f
->width
= DEFAULT_COLS
;
1711 f
->height
= DEFAULT_ROWS
;
1712 /* Window managers expect that if program-specified
1713 positions are not (0,0), they're intentional, not defaults. */
1714 f
->display
.x
->top_pos
= 0;
1715 f
->display
.x
->left_pos
= 0;
1717 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
1718 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
1719 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
1720 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1722 if (!EQ (tem0
, Qunbound
))
1724 CHECK_NUMBER (tem0
, 0);
1725 f
->height
= XINT (tem0
);
1727 if (!EQ (tem1
, Qunbound
))
1729 CHECK_NUMBER (tem1
, 0);
1730 f
->width
= XINT (tem1
);
1732 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
1733 window_prompting
|= USSize
;
1735 window_prompting
|= PSize
;
1738 f
->display
.x
->vertical_scroll_bar_extra
1739 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1740 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f
)
1742 f
->display
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
1743 f
->display
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
1745 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1746 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1747 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
1748 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1750 if (EQ (tem0
, Qminus
))
1752 f
->display
.x
->top_pos
= 0;
1753 window_prompting
|= YNegative
;
1755 else if (EQ (tem0
, Qunbound
))
1756 f
->display
.x
->top_pos
= 0;
1759 CHECK_NUMBER (tem0
, 0);
1760 f
->display
.x
->top_pos
= XINT (tem0
);
1761 if (f
->display
.x
->top_pos
< 0)
1762 window_prompting
|= YNegative
;
1765 if (EQ (tem1
, Qminus
))
1767 f
->display
.x
->left_pos
= 0;
1768 window_prompting
|= XNegative
;
1770 else if (EQ (tem1
, Qunbound
))
1771 f
->display
.x
->left_pos
= 0;
1774 CHECK_NUMBER (tem1
, 0);
1775 f
->display
.x
->left_pos
= XINT (tem1
);
1776 if (f
->display
.x
->left_pos
< 0)
1777 window_prompting
|= XNegative
;
1781 window_prompting
|= USPosition
;
1783 window_prompting
|= PPosition
;
1786 return window_prompting
;
1789 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
1792 XSetWMProtocols (dpy
, w
, protocols
, count
)
1799 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
1800 if (prop
== None
) return False
;
1801 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
1802 (unsigned char *) protocols
, count
);
1805 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
1807 #ifdef USE_X_TOOLKIT
1809 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS
1810 and WM_DELETE_WINDOW, then add them. (They may already be present
1811 because of the toolkit (Motif adds them, for example, but Xt doesn't). */
1814 hack_wm_protocols (widget
)
1817 Display
*dpy
= XtDisplay (widget
);
1818 Window w
= XtWindow (widget
);
1819 int need_delete
= 1;
1824 Atom type
, *atoms
= 0;
1826 unsigned long nitems
= 0;
1827 unsigned long bytes_after
;
1829 if (Success
== XGetWindowProperty (dpy
, w
, Xatom_wm_protocols
,
1830 0, 100, False
, XA_ATOM
,
1831 &type
, &format
, &nitems
, &bytes_after
,
1832 (unsigned char **) &atoms
)
1833 && format
== 32 && type
== XA_ATOM
)
1837 if (atoms
[nitems
] == Xatom_wm_delete_window
) need_delete
= 0;
1838 else if (atoms
[nitems
] == Xatom_wm_take_focus
) need_focus
= 0;
1840 if (atoms
) XFree ((char *) atoms
);
1845 if (need_delete
) props
[count
++] = Xatom_wm_delete_window
;
1846 if (need_focus
) props
[count
++] = Xatom_wm_take_focus
;
1848 XChangeProperty (dpy
, w
, Xatom_wm_protocols
, XA_ATOM
, 32, PropModeAppend
,
1849 (unsigned char *) props
, count
);
1855 #ifdef USE_X_TOOLKIT
1857 /* Create and set up the X widget for frame F. */
1860 x_window (f
, window_prompting
, minibuffer_only
)
1862 long window_prompting
;
1863 int minibuffer_only
;
1865 XClassHint class_hints
;
1866 XSetWindowAttributes attributes
;
1867 unsigned long attribute_mask
;
1869 Widget shell_widget
;
1871 Widget screen_widget
;
1878 if (STRINGP (f
->name
))
1879 name
= (char*) XSTRING (f
->name
)->data
;
1884 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
1885 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
1886 shell_widget
= XtCreatePopupShell ("shell",
1887 topLevelShellWidgetClass
,
1888 Xt_app_shell
, al
, ac
);
1890 f
->display
.x
->widget
= shell_widget
;
1891 /* maybe_set_screen_title_format (shell_widget); */
1895 XtSetArg (al
[ac
], XtNborderWidth
, 0); ac
++;
1896 pane_widget
= XtCreateWidget ("pane",
1898 shell_widget
, al
, ac
);
1900 f
->display
.x
->column_widget
= pane_widget
;
1902 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
1903 initialize_frame_menubar (f
);
1905 /* mappedWhenManaged to false tells to the paned window to not map/unmap
1906 the emacs screen when changing menubar. This reduces flickering. */
1909 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
1910 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
1911 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
1912 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
1913 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
1914 screen_widget
= XtCreateWidget (name
,
1916 pane_widget
, al
, ac
);
1918 f
->display
.x
->edit_widget
= screen_widget
;
1920 if (f
->display
.x
->menubar_widget
)
1921 XtManageChild (f
->display
.x
->menubar_widget
);
1922 XtManageChild (screen_widget
);
1924 /* Do some needed geometry management. */
1927 char *tem
, shell_position
[32];
1931 = (f
->display
.x
->menubar_widget
1932 ? (f
->display
.x
->menubar_widget
->core
.height
1933 + f
->display
.x
->menubar_widget
->core
.border_width
)
1936 if (FRAME_EXTERNAL_MENU_BAR (f
))
1939 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
1940 menubar_size
+= ibw
;
1943 if (window_prompting
& USPosition
)
1945 int left
= f
->display
.x
->left_pos
;
1946 int xneg
= window_prompting
& XNegative
;
1947 int top
= f
->display
.x
->top_pos
;
1948 int yneg
= window_prompting
& YNegative
;
1953 sprintf (shell_position
, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f
),
1954 PIXEL_HEIGHT (f
) + menubar_size
,
1955 (xneg
? '-' : '+'), left
,
1956 (yneg
? '-' : '+'), top
);
1959 sprintf (shell_position
, "=%dx%d", PIXEL_WIDTH (f
),
1960 PIXEL_HEIGHT (f
) + menubar_size
);
1961 len
= strlen (shell_position
) + 1;
1962 tem
= (char *) xmalloc (len
);
1963 strncpy (tem
, shell_position
, len
);
1964 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
1965 XtSetValues (shell_widget
, al
, ac
);
1968 x_calc_absolute_position (f
);
1970 XtManageChild (pane_widget
);
1971 XtRealizeWidget (shell_widget
);
1973 FRAME_X_WINDOW (f
) = XtWindow (screen_widget
);
1975 validate_x_resource_name ();
1976 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
1977 class_hints
.res_class
= EMACS_CLASS
;
1978 XSetClassHint (x_current_display
, XtWindow (shell_widget
), &class_hints
);
1980 f
->display
.x
->wm_hints
.input
= True
;
1981 f
->display
.x
->wm_hints
.flags
|= InputHint
;
1982 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
1984 hack_wm_protocols (shell_widget
);
1986 /* Do a stupid property change to force the server to generate a
1987 propertyNotify event so that the event_stream server timestamp will
1988 be initialized to something relevant to the time we created the window.
1990 XChangeProperty (XtDisplay (screen_widget
), XtWindow (screen_widget
),
1991 Xatom_wm_protocols
, XA_ATOM
, 32, PropModeAppend
,
1992 (unsigned char*) NULL
, 0);
1994 /* Make all the standard events reach the Emacs frame. */
1995 attributes
.event_mask
= STANDARD_EVENT_SET
;
1996 attribute_mask
= CWEventMask
;
1997 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
1998 attribute_mask
, &attributes
);
2000 XtMapWidget (screen_widget
);
2002 /* x_set_name normally ignores requests to set the name if the
2003 requested name is the same as the current name. This is the one
2004 place where that assumption isn't correct; f->name is set, but
2005 the X server hasn't been told. */
2008 int explicit = f
->explicit_name
;
2010 f
->explicit_name
= 0;
2013 x_set_name (f
, name
, explicit);
2016 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
2017 f
->display
.x
->text_cursor
);
2021 if (FRAME_X_WINDOW (f
) == 0)
2022 error ("Unable to create window");
2025 #else /* not USE_X_TOOLKIT */
2027 /* Create and set up the X window for frame F. */
2033 XClassHint class_hints
;
2034 XSetWindowAttributes attributes
;
2035 unsigned long attribute_mask
;
2037 attributes
.background_pixel
= f
->display
.x
->background_pixel
;
2038 attributes
.border_pixel
= f
->display
.x
->border_pixel
;
2039 attributes
.bit_gravity
= StaticGravity
;
2040 attributes
.backing_store
= NotUseful
;
2041 attributes
.save_under
= True
;
2042 attributes
.event_mask
= STANDARD_EVENT_SET
;
2043 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
2045 | CWBackingStore
| CWSaveUnder
2051 = XCreateWindow (x_current_display
, ROOT_WINDOW
,
2052 f
->display
.x
->left_pos
,
2053 f
->display
.x
->top_pos
,
2054 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
2055 f
->display
.x
->border_width
,
2056 CopyFromParent
, /* depth */
2057 InputOutput
, /* class */
2058 screen_visual
, /* set in Fx_open_connection */
2059 attribute_mask
, &attributes
);
2061 validate_x_resource_name ();
2062 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2063 class_hints
.res_class
= EMACS_CLASS
;
2064 XSetClassHint (x_current_display
, FRAME_X_WINDOW (f
), &class_hints
);
2066 /* This indicates that we use the "Passive Input" input model.
2067 Unless we do this, we don't get the Focus{In,Out} events that we
2068 need to draw the cursor correctly. Accursed bureaucrats.
2069 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
2071 f
->display
.x
->wm_hints
.input
= True
;
2072 f
->display
.x
->wm_hints
.flags
|= InputHint
;
2073 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
2075 /* Request "save yourself" and "delete window" commands from wm. */
2078 protocols
[0] = Xatom_wm_delete_window
;
2079 protocols
[1] = Xatom_wm_save_yourself
;
2080 XSetWMProtocols (x_current_display
, FRAME_X_WINDOW (f
), protocols
, 2);
2083 /* x_set_name normally ignores requests to set the name if the
2084 requested name is the same as the current name. This is the one
2085 place where that assumption isn't correct; f->name is set, but
2086 the X server hasn't been told. */
2089 int explicit = f
->explicit_name
;
2091 f
->explicit_name
= 0;
2094 x_set_name (f
, name
, explicit);
2097 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
2098 f
->display
.x
->text_cursor
);
2102 if (FRAME_X_WINDOW (f
) == 0)
2103 error ("Unable to create window");
2106 #endif /* not USE_X_TOOLKIT */
2108 /* Handle the icon stuff for this window. Perhaps later we might
2109 want an x_set_icon_position which can be called interactively as
2117 Lisp_Object icon_x
, icon_y
;
2119 /* Set the position of the icon. Note that twm groups all
2120 icons in an icon window. */
2121 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
2122 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
2123 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
2125 CHECK_NUMBER (icon_x
, 0);
2126 CHECK_NUMBER (icon_y
, 0);
2128 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
2129 error ("Both left and top icon corners of icon must be specified");
2133 if (! EQ (icon_x
, Qunbound
))
2134 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
2136 /* Start up iconic or window? */
2137 x_wm_set_window_state
2138 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
2145 /* Make the GC's needed for this window, setting the
2146 background, border and mouse colors; also create the
2147 mouse cursor and the gray border tile. */
2149 static char cursor_bits
[] =
2151 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2152 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2153 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2154 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2161 XGCValues gc_values
;
2167 /* Create the GC's of this frame.
2168 Note that many default values are used. */
2171 gc_values
.font
= f
->display
.x
->font
->fid
;
2172 gc_values
.foreground
= f
->display
.x
->foreground_pixel
;
2173 gc_values
.background
= f
->display
.x
->background_pixel
;
2174 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
2175 f
->display
.x
->normal_gc
= XCreateGC (x_current_display
,
2177 GCLineWidth
| GCFont
2178 | GCForeground
| GCBackground
,
2181 /* Reverse video style. */
2182 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2183 gc_values
.background
= f
->display
.x
->foreground_pixel
;
2184 f
->display
.x
->reverse_gc
= XCreateGC (x_current_display
,
2186 GCFont
| GCForeground
| GCBackground
2190 /* Cursor has cursor-color background, background-color foreground. */
2191 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2192 gc_values
.background
= f
->display
.x
->cursor_pixel
;
2193 gc_values
.fill_style
= FillOpaqueStippled
;
2195 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
2196 cursor_bits
, 16, 16);
2197 f
->display
.x
->cursor_gc
2198 = XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
2199 (GCFont
| GCForeground
| GCBackground
2200 | GCFillStyle
| GCStipple
| GCLineWidth
),
2203 /* Create the gray border tile used when the pointer is not in
2204 the frame. Since this depends on the frame's pixel values,
2205 this must be done on a per-frame basis. */
2206 f
->display
.x
->border_tile
2207 = (XCreatePixmapFromBitmapData
2208 (x_current_display
, ROOT_WINDOW
,
2209 gray_bits
, gray_width
, gray_height
,
2210 f
->display
.x
->foreground_pixel
,
2211 f
->display
.x
->background_pixel
,
2212 DefaultDepth (x_current_display
, XDefaultScreen (x_current_display
))));
2216 #endif /* HAVE_X11 */
2218 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
2220 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2221 Return an Emacs frame object representing the X window.\n\
2222 ALIST is an alist of frame parameters.\n\
2223 If the parameters specify that the frame should not have a minibuffer,\n\
2224 and do not specify a specific minibuffer window to use,\n\
2225 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2226 be shared by the new frame.")
2232 Lisp_Object frame
, tem
;
2234 int minibuffer_only
= 0;
2235 long window_prompting
= 0;
2237 int count
= specpdl_ptr
- specpdl
;
2241 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
2242 if (XTYPE (name
) != Lisp_String
2243 && ! EQ (name
, Qunbound
)
2245 error ("x-create-frame: name parameter must be a string");
2247 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2248 if (EQ (tem
, Qnone
) || NILP (tem
))
2249 f
= make_frame_without_minibuffer (Qnil
);
2250 else if (EQ (tem
, Qonly
))
2252 f
= make_minibuffer_frame ();
2253 minibuffer_only
= 1;
2255 else if (XTYPE (tem
) == Lisp_Window
)
2256 f
= make_frame_without_minibuffer (tem
);
2260 /* Note that X Windows does support scroll bars. */
2261 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
2263 /* Set the name; the functions to which we pass f expect the name to
2265 if (EQ (name
, Qunbound
) || NILP (name
))
2267 f
->name
= build_string (x_id_name
);
2268 f
->explicit_name
= 0;
2273 f
->explicit_name
= 1;
2274 /* use the frame's title when getting resources for this frame. */
2275 specbind (Qx_resource_name
, name
);
2278 XSET (frame
, Lisp_Frame
, f
);
2279 f
->output_method
= output_x_window
;
2280 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2281 bzero (f
->display
.x
, sizeof (struct x_display
));
2283 /* Note that the frame has no physical cursor right now. */
2284 f
->phys_cursor_x
= -1;
2286 /* Extract the window parameters from the supplied values
2287 that are needed to determine window geometry. */
2291 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
2293 /* First, try whatever font the caller has specified. */
2295 font
= x_new_font (f
, XSTRING (font
)->data
);
2296 /* Try out a font which we hope has bold and italic variations. */
2297 if (!STRINGP (font
))
2298 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2299 if (! STRINGP (font
))
2300 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2301 if (! STRINGP (font
))
2302 /* This was formerly the first thing tried, but it finds too many fonts
2303 and takes too long. */
2304 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
2305 /* If those didn't work, look for something which will at least work. */
2306 if (! STRINGP (font
))
2307 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1");
2309 if (! STRINGP (font
))
2310 font
= build_string ("fixed");
2312 x_default_parameter (f
, parms
, Qfont
, font
,
2313 "font", "Font", string
);
2316 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
2317 "borderwidth", "BorderWidth", number
);
2318 /* This defaults to 2 in order to match xterm. We recognize either
2319 internalBorderWidth or internalBorder (which is what xterm calls
2321 if (NILP (Fassq (Qinternal_border_width
, parms
)))
2325 value
= x_get_arg (parms
, Qinternal_border_width
,
2326 "internalBorder", "BorderWidth", number
);
2327 if (! EQ (value
, Qunbound
))
2328 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
2331 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
2332 "internalBorderWidth", "BorderWidth", number
);
2333 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
2334 "verticalScrollBars", "ScrollBars", boolean
);
2336 /* Also do the stuff which must be set before the window exists. */
2337 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
2338 "foreground", "Foreground", string
);
2339 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
2340 "background", "Background", string
);
2341 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
2342 "pointerColor", "Foreground", string
);
2343 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
2344 "cursorColor", "Foreground", string
);
2345 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
2346 "borderColor", "BorderColor", string
);
2348 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (0),
2349 "menuBarLines", "MenuBarLines", number
);
2351 f
->display
.x
->parent_desc
= ROOT_WINDOW
;
2352 window_prompting
= x_figure_window_size (f
, parms
);
2354 if (window_prompting
& XNegative
)
2356 if (window_prompting
& YNegative
)
2357 f
->display
.x
->win_gravity
= SouthEastGravity
;
2359 f
->display
.x
->win_gravity
= NorthEastGravity
;
2363 if (window_prompting
& YNegative
)
2364 f
->display
.x
->win_gravity
= SouthWestGravity
;
2366 f
->display
.x
->win_gravity
= NorthWestGravity
;
2369 f
->display
.x
->size_hint_flags
= window_prompting
;
2371 #ifdef USE_X_TOOLKIT
2372 x_window (f
, window_prompting
, minibuffer_only
);
2378 init_frame_faces (f
);
2380 /* We need to do this after creating the X window, so that the
2381 icon-creation functions can say whose icon they're describing. */
2382 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2383 "bitmapIcon", "BitmapIcon", symbol
);
2385 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
2386 "autoRaise", "AutoRaiseLower", boolean
);
2387 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
2388 "autoLower", "AutoRaiseLower", boolean
);
2389 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
2390 "cursorType", "CursorType", symbol
);
2392 /* Dimensions, especially f->height, must be done via change_frame_size.
2393 Change will not be effected unless different from the current
2397 f
->height
= f
->width
= 0;
2398 change_frame_size (f
, height
, width
, 1, 0);
2400 /* With the toolkit, the geometry management is done in x_window. */
2401 #ifndef USE_X_TOOLKIT
2403 x_wm_set_size_hint (f
, window_prompting
, 0);
2405 #endif /* USE_X_TOOLKIT */
2407 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2408 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2410 /* It is now ok to make the frame official
2411 even if we get an error below.
2412 And the frame needs to be on Vframe_list
2413 or making it visible won't work. */
2414 Vframe_list
= Fcons (frame
, Vframe_list
);
2416 /* Make the window appear on the frame and enable display,
2417 unless the caller says not to. */
2419 Lisp_Object visibility
;
2421 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2422 if (EQ (visibility
, Qunbound
))
2425 if (EQ (visibility
, Qicon
))
2426 x_iconify_frame (f
);
2427 else if (! NILP (visibility
))
2428 x_make_frame_visible (f
);
2430 /* Must have been Qnil. */
2434 return unbind_to (count
, frame
);
2437 Lisp_Object frame
, tem
;
2439 int pixelwidth
, pixelheight
;
2444 int minibuffer_only
= 0;
2445 Lisp_Object vscroll
, hscroll
;
2447 if (x_current_display
== 0)
2448 error ("X windows are not in use or not initialized");
2450 name
= Fassq (Qname
, parms
);
2452 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2453 if (EQ (tem
, Qnone
))
2454 f
= make_frame_without_minibuffer (Qnil
);
2455 else if (EQ (tem
, Qonly
))
2457 f
= make_minibuffer_frame ();
2458 minibuffer_only
= 1;
2460 else if (EQ (tem
, Qnil
) || EQ (tem
, Qunbound
))
2463 f
= make_frame_without_minibuffer (tem
);
2465 parent
= ROOT_WINDOW
;
2467 XSET (frame
, Lisp_Frame
, f
);
2468 f
->output_method
= output_x_window
;
2469 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2470 bzero (f
->display
.x
, sizeof (struct x_display
));
2472 /* Some temporary default values for height and width. */
2475 f
->display
.x
->left_pos
= -1;
2476 f
->display
.x
->top_pos
= -1;
2478 /* Give the frame a default name (which may be overridden with PARMS). */
2480 strncpy (iconidentity
, ICONTAG
, MAXICID
);
2481 if (gethostname (&iconidentity
[sizeof (ICONTAG
) - 1],
2482 (MAXICID
- 1) - sizeof (ICONTAG
)))
2483 iconidentity
[sizeof (ICONTAG
) - 2] = '\0';
2484 f
->name
= build_string (iconidentity
);
2486 /* Extract some window parameters from the supplied values.
2487 These are the parameters that affect window geometry. */
2489 tem
= x_get_arg (parms
, Qfont
, "BodyFont", 0, string
);
2490 if (EQ (tem
, Qunbound
))
2491 tem
= build_string ("9x15");
2492 x_set_font (f
, tem
, Qnil
);
2493 x_default_parameter (f
, parms
, Qborder_color
,
2494 build_string ("black"), "Border", 0, string
);
2495 x_default_parameter (f
, parms
, Qbackground_color
,
2496 build_string ("white"), "Background", 0, string
);
2497 x_default_parameter (f
, parms
, Qforeground_color
,
2498 build_string ("black"), "Foreground", 0, string
);
2499 x_default_parameter (f
, parms
, Qmouse_color
,
2500 build_string ("black"), "Mouse", 0, string
);
2501 x_default_parameter (f
, parms
, Qcursor_color
,
2502 build_string ("black"), "Cursor", 0, string
);
2503 x_default_parameter (f
, parms
, Qborder_width
,
2504 make_number (2), "BorderWidth", 0, number
);
2505 x_default_parameter (f
, parms
, Qinternal_border_width
,
2506 make_number (4), "InternalBorderWidth", 0, number
);
2507 x_default_parameter (f
, parms
, Qauto_raise
,
2508 Qnil
, "AutoRaise", 0, boolean
);
2510 hscroll
= EQ (x_get_arg (parms
, Qhorizontal_scroll_bar
, 0, 0, boolean
), Qt
);
2511 vscroll
= EQ (x_get_arg (parms
, Qvertical_scroll_bar
, 0, 0, boolean
), Qt
);
2513 if (f
->display
.x
->internal_border_width
< 0)
2514 f
->display
.x
->internal_border_width
= 0;
2516 tem
= x_get_arg (parms
, Qwindow_id
, 0, 0, number
);
2517 if (!EQ (tem
, Qunbound
))
2519 WINDOWINFO_TYPE wininfo
;
2521 Window
*children
, root
;
2523 CHECK_NUMBER (tem
, 0);
2524 FRAME_X_WINDOW (f
) = (Window
) XINT (tem
);
2527 XGetWindowInfo (FRAME_X_WINDOW (f
), &wininfo
);
2528 XQueryTree (FRAME_X_WINDOW (f
), &parent
, &nchildren
, &children
);
2532 height
= PIXEL_TO_CHAR_HEIGHT (f
, wininfo
.height
);
2533 width
= PIXEL_TO_CHAR_WIDTH (f
, wininfo
.width
);
2534 f
->display
.x
->left_pos
= wininfo
.x
;
2535 f
->display
.x
->top_pos
= wininfo
.y
;
2536 FRAME_SET_VISIBILITY (f
, wininfo
.mapped
!= 0);
2537 f
->display
.x
->border_width
= wininfo
.bdrwidth
;
2538 f
->display
.x
->parent_desc
= parent
;
2542 tem
= x_get_arg (parms
, Qparent_id
, 0, 0, number
);
2543 if (!EQ (tem
, Qunbound
))
2545 CHECK_NUMBER (tem
, 0);
2546 parent
= (Window
) XINT (tem
);
2548 f
->display
.x
->parent_desc
= parent
;
2549 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2550 if (EQ (tem
, Qunbound
))
2552 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2553 if (EQ (tem
, Qunbound
))
2555 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2556 if (EQ (tem
, Qunbound
))
2557 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2560 /* Now TEM is Qunbound if no edge or size was specified.
2561 In that case, we must do rubber-banding. */
2562 if (EQ (tem
, Qunbound
))
2564 tem
= x_get_arg (parms
, Qgeometry
, 0, 0, number
);
2566 &f
->display
.x
->left_pos
, &f
->display
.x
->top_pos
,
2568 (XTYPE (tem
) == Lisp_String
2569 ? (char *) XSTRING (tem
)->data
: ""),
2570 XSTRING (f
->name
)->data
,
2571 !NILP (hscroll
), !NILP (vscroll
));
2575 /* Here if at least one edge or size was specified.
2576 Demand that they all were specified, and use them. */
2577 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2578 if (EQ (tem
, Qunbound
))
2579 error ("Height not specified");
2580 CHECK_NUMBER (tem
, 0);
2581 height
= XINT (tem
);
2583 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2584 if (EQ (tem
, Qunbound
))
2585 error ("Width not specified");
2586 CHECK_NUMBER (tem
, 0);
2589 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2590 if (EQ (tem
, Qunbound
))
2591 error ("Top position not specified");
2592 CHECK_NUMBER (tem
, 0);
2593 f
->display
.x
->left_pos
= XINT (tem
);
2595 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2596 if (EQ (tem
, Qunbound
))
2597 error ("Left position not specified");
2598 CHECK_NUMBER (tem
, 0);
2599 f
->display
.x
->top_pos
= XINT (tem
);
2602 pixelwidth
= CHAR_TO_PIXEL_WIDTH (f
, width
);
2603 pixelheight
= CHAR_TO_PIXEL_HEIGHT (f
, height
);
2607 = XCreateWindow (parent
,
2608 f
->display
.x
->left_pos
, /* Absolute horizontal offset */
2609 f
->display
.x
->top_pos
, /* Absolute Vertical offset */
2610 pixelwidth
, pixelheight
,
2611 f
->display
.x
->border_width
,
2612 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
2614 if (FRAME_X_WINDOW (f
) == 0)
2615 error ("Unable to create window.");
2618 /* Install the now determined height and width
2619 in the windows and in phys_lines and desired_lines. */
2620 change_frame_size (f
, height
, width
, 1, 0);
2621 XSelectInput (FRAME_X_WINDOW (f
), KeyPressed
| ExposeWindow
2622 | ButtonPressed
| ButtonReleased
| ExposeRegion
| ExposeCopy
2623 | EnterWindow
| LeaveWindow
| UnmapWindow
);
2624 x_set_resize_hint (f
);
2626 /* Tell the server the window's default name. */
2627 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
), XSTRING (f
->name
)->data
);
2629 /* Now override the defaults with all the rest of the specified
2631 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2632 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2634 /* Do not create an icon window if the caller says not to */
2635 if (!EQ (x_get_arg (parms
, Qsuppress_icon
, 0, 0, boolean
), Qt
)
2636 || f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2638 x_text_icon (f
, iconidentity
);
2639 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2640 "BitmapIcon", 0, symbol
);
2643 /* Tell the X server the previously set values of the
2644 background, border and mouse colors; also create the mouse cursor. */
2646 temp
= XMakeTile (f
->display
.x
->background_pixel
);
2647 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
2650 x_set_border_pixel (f
, f
->display
.x
->border_pixel
);
2652 x_set_mouse_color (f
, Qnil
, Qnil
);
2654 /* Now override the defaults with all the rest of the specified parms. */
2656 Fmodify_frame_parameters (frame
, parms
);
2658 /* Make the window appear on the frame and enable display. */
2660 Lisp_Object visibility
;
2662 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2663 if (EQ (visibility
, Qunbound
))
2666 if (! EQ (visibility
, Qicon
)
2667 && ! NILP (visibility
))
2668 x_make_window_visible (f
);
2671 SET_FRAME_GARBAGED (f
);
2673 Vframe_list
= Fcons (frame
, Vframe_list
);
2679 x_get_focus_frame ()
2682 if (! x_focus_frame
)
2685 XSET (xfocus
, Lisp_Frame
, x_focus_frame
);
2689 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
2690 "Set the focus on FRAME.")
2694 CHECK_LIVE_FRAME (frame
, 0);
2696 if (FRAME_X_P (XFRAME (frame
)))
2699 x_focus_on_frame (XFRAME (frame
));
2707 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
2708 "If a frame has been focused, release it.")
2714 x_unfocus_frame (x_focus_frame
);
2722 /* Computes an X-window size and position either from geometry GEO
2725 F is a frame. It specifies an X window which is used to
2726 determine which display to compute for. Its font, borders
2727 and colors control how the rectangle will be displayed.
2729 X and Y are where to store the positions chosen.
2730 WIDTH and HEIGHT are where to store the sizes chosen.
2732 GEO is the geometry that may specify some of the info.
2733 STR is a prompt to display.
2734 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2737 x_rubber_band (f
, x
, y
, width
, height
, geo
, str
, hscroll
, vscroll
)
2739 int *x
, *y
, *width
, *height
;
2742 int hscroll
, vscroll
;
2748 int background_color
;
2754 background_color
= f
->display
.x
->background_pixel
;
2755 border_color
= f
->display
.x
->border_pixel
;
2757 frame
.bdrwidth
= f
->display
.x
->border_width
;
2758 frame
.border
= XMakeTile (border_color
);
2759 frame
.background
= XMakeTile (background_color
);
2760 tempwindow
= XCreateTerm (str
, "emacs", geo
, default_window
, &frame
, 10, 5,
2761 (2 * f
->display
.x
->internal_border_width
2762 + (vscroll
? VSCROLL_WIDTH
: 0)),
2763 (2 * f
->display
.x
->internal_border_width
2764 + (hscroll
? HSCROLL_HEIGHT
: 0)),
2765 width
, height
, f
->display
.x
->font
,
2766 FONT_WIDTH (f
->display
.x
->font
),
2767 f
->display
.x
->line_height
);
2768 XFreePixmap (frame
.border
);
2769 XFreePixmap (frame
.background
);
2771 if (tempwindow
!= 0)
2773 XQueryWindow (tempwindow
, &wininfo
);
2774 XDestroyWindow (tempwindow
);
2779 /* Coordinates we got are relative to the root window.
2780 Convert them to coordinates relative to desired parent window
2781 by scanning from there up to the root. */
2782 tempwindow
= f
->display
.x
->parent_desc
;
2783 while (tempwindow
!= ROOT_WINDOW
)
2787 XQueryWindow (tempwindow
, &wininfo
);
2790 XQueryTree (tempwindow
, &tempwindow
, &nchildren
, &children
);
2795 return tempwindow
!= 0;
2797 #endif /* not HAVE_X11 */
2799 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
2800 "Return a list of the names of available fonts matching PATTERN.\n\
2801 If optional arguments FACE and FRAME are specified, return only fonts\n\
2802 the same size as FACE on FRAME.\n\
2804 PATTERN is a string, perhaps with wildcard characters;\n\
2805 the * character matches any substring, and\n\
2806 the ? character matches any single character.\n\
2807 PATTERN is case-insensitive.\n\
2808 FACE is a face name - a symbol.\n\
2810 The return value is a list of strings, suitable as arguments to\n\
2813 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
2814 even if they match PATTERN and FACE.")
2815 (pattern
, face
, frame
)
2816 Lisp_Object pattern
, face
, frame
;
2821 XFontStruct
*size_ref
;
2825 CHECK_STRING (pattern
, 0);
2827 CHECK_SYMBOL (face
, 1);
2829 CHECK_LIVE_FRAME (frame
, 2);
2835 FRAME_PTR f
= NILP (frame
) ? selected_frame
: XFRAME (frame
);
2838 /* Don't die if we get called with a terminal frame. */
2839 if (! FRAME_X_P (f
))
2840 error ("non-X frame used in `x-list-fonts'");
2842 face_id
= face_name_id_number (f
, face
);
2844 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
2845 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
2846 size_ref
= f
->display
.x
->font
;
2849 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
2850 if (size_ref
== (XFontStruct
*) (~0))
2851 size_ref
= f
->display
.x
->font
;
2857 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
2858 #ifdef BROKEN_XLISTFONTSWITHINFO
2859 names
= XListFonts (x_current_display
,
2860 XSTRING (pattern
)->data
,
2861 2000, /* maxnames */
2862 &num_fonts
); /* count_return */
2864 names
= XListFontsWithInfo (x_current_display
,
2865 XSTRING (pattern
)->data
,
2866 2000, /* maxnames */
2867 &num_fonts
, /* count_return */
2868 &info
); /* info_return */
2880 for (i
= 0; i
< num_fonts
; i
++)
2882 XFontStruct
*thisinfo
;
2884 #ifdef BROKEN_XLISTFONTSWITHINFO
2886 thisinfo
= XLoadQueryFont (x_current_display
, names
[i
]);
2889 thisinfo
= &info
[i
];
2891 if (thisinfo
&& (! size_ref
2892 || same_size_fonts (thisinfo
, size_ref
)))
2894 *tail
= Fcons (build_string (names
[i
]), Qnil
);
2895 tail
= &XCONS (*tail
)->cdr
;
2900 #ifdef BROKEN_XLISTFONTSWITHINFO
2901 XFreeFontNames (names
);
2903 XFreeFontInfo (names
, info
, num_fonts
);
2912 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 1, 0,
2913 "Return t if the current X display supports the color named COLOR.")
2920 CHECK_STRING (color
, 0);
2922 if (defined_color (XSTRING (color
)->data
, &foo
))
2928 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 0, 0,
2929 "Return t if the X screen currently in use supports color.")
2934 if (x_screen_planes
<= 2)
2937 switch (screen_visual
->class)
2950 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
2952 "Returns the width in pixels of the display FRAME is on.")
2956 Display
*dpy
= x_current_display
;
2958 return make_number (DisplayWidth (dpy
, DefaultScreen (dpy
)));
2961 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
2962 Sx_display_pixel_height
, 0, 1, 0,
2963 "Returns the height in pixels of the display FRAME is on.")
2967 Display
*dpy
= x_current_display
;
2969 return make_number (DisplayHeight (dpy
, DefaultScreen (dpy
)));
2972 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
2974 "Returns the number of bitplanes of the display FRAME is on.")
2978 Display
*dpy
= x_current_display
;
2980 return make_number (DisplayPlanes (dpy
, DefaultScreen (dpy
)));
2983 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
2985 "Returns the number of color cells of the display FRAME is on.")
2989 Display
*dpy
= x_current_display
;
2991 return make_number (DisplayCells (dpy
, DefaultScreen (dpy
)));
2994 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
2995 Sx_server_max_request_size
,
2997 "Returns the maximum request size of the X server FRAME is using.")
3001 Display
*dpy
= x_current_display
;
3003 return make_number (MAXREQUEST (dpy
));
3006 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
3007 "Returns the vendor ID string of the X server FRAME is on.")
3011 Display
*dpy
= x_current_display
;
3014 vendor
= ServerVendor (dpy
);
3015 if (! vendor
) vendor
= "";
3016 return build_string (vendor
);
3019 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
3020 "Returns the version numbers of the X server in use.\n\
3021 The value is a list of three integers: the major and minor\n\
3022 version numbers of the X Protocol in use, and the vendor-specific release\n\
3023 number. See also the variable `x-server-vendor'.")
3027 Display
*dpy
= x_current_display
;
3030 return Fcons (make_number (ProtocolVersion (dpy
)),
3031 Fcons (make_number (ProtocolRevision (dpy
)),
3032 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
3035 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
3036 "Returns the number of screens on the X server FRAME is on.")
3041 return make_number (ScreenCount (x_current_display
));
3044 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
3045 "Returns the height in millimeters of the X screen FRAME is on.")
3050 return make_number (HeightMMOfScreen (x_screen
));
3053 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
3054 "Returns the width in millimeters of the X screen FRAME is on.")
3059 return make_number (WidthMMOfScreen (x_screen
));
3062 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
3063 Sx_display_backing_store
, 0, 1, 0,
3064 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
3065 The value may be `always', `when-mapped', or `not-useful'.")
3071 switch (DoesBackingStore (x_screen
))
3074 return intern ("always");
3077 return intern ("when-mapped");
3080 return intern ("not-useful");
3083 error ("Strange value for BackingStore parameter of screen");
3087 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
3088 Sx_display_visual_class
, 0, 1, 0,
3089 "Returns the visual class of the display `screen' is on.\n\
3090 The value is one of the symbols `static-gray', `gray-scale',\n\
3091 `static-color', `pseudo-color', `true-color', or `direct-color'.")
3097 switch (screen_visual
->class)
3099 case StaticGray
: return (intern ("static-gray"));
3100 case GrayScale
: return (intern ("gray-scale"));
3101 case StaticColor
: return (intern ("static-color"));
3102 case PseudoColor
: return (intern ("pseudo-color"));
3103 case TrueColor
: return (intern ("true-color"));
3104 case DirectColor
: return (intern ("direct-color"));
3106 error ("Display has an unknown visual class");
3110 DEFUN ("x-display-save-under", Fx_display_save_under
,
3111 Sx_display_save_under
, 0, 1, 0,
3112 "Returns t if the X screen FRAME is on supports the save-under feature.")
3118 if (DoesSaveUnders (x_screen
) == True
)
3125 register struct frame
*f
;
3127 return PIXEL_WIDTH (f
);
3131 register struct frame
*f
;
3133 return PIXEL_HEIGHT (f
);
3137 register struct frame
*f
;
3139 return FONT_WIDTH (f
->display
.x
->font
);
3143 register struct frame
*f
;
3145 return f
->display
.x
->line_height
;
3148 #if 0 /* These no longer seem like the right way to do things. */
3150 /* Draw a rectangle on the frame with left top corner including
3151 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3152 CHARS by LINES wide and long and is the color of the cursor. */
3155 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
3156 register struct frame
*f
;
3158 register int top_char
, left_char
, chars
, lines
;
3162 int left
= (left_char
* FONT_WIDTH (f
->display
.x
->font
)
3163 + f
->display
.x
->internal_border_width
);
3164 int top
= (top_char
* f
->display
.x
->line_height
3165 + f
->display
.x
->internal_border_width
);
3168 width
= FONT_WIDTH (f
->display
.x
->font
) / 2;
3170 width
= FONT_WIDTH (f
->display
.x
->font
) * chars
;
3172 height
= f
->display
.x
->line_height
/ 2;
3174 height
= f
->display
.x
->line_height
* lines
;
3176 XDrawRectangle (x_current_display
, FRAME_X_WINDOW (f
),
3177 gc
, left
, top
, width
, height
);
3180 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
3181 "Draw a rectangle on FRAME between coordinates specified by\n\
3182 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3183 (frame
, X0
, Y0
, X1
, Y1
)
3184 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
3186 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3188 CHECK_LIVE_FRAME (frame
, 0);
3189 CHECK_NUMBER (X0
, 0);
3190 CHECK_NUMBER (Y0
, 1);
3191 CHECK_NUMBER (X1
, 2);
3192 CHECK_NUMBER (Y1
, 3);
3202 n_lines
= y1
- y0
+ 1;
3207 n_lines
= y0
- y1
+ 1;
3213 n_chars
= x1
- x0
+ 1;
3218 n_chars
= x0
- x1
+ 1;
3222 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->cursor_gc
,
3223 left
, top
, n_chars
, n_lines
);
3229 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
3230 "Draw a rectangle drawn on FRAME between coordinates\n\
3231 X0, Y0, X1, Y1 in the regular background-pixel.")
3232 (frame
, X0
, Y0
, X1
, Y1
)
3233 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
3235 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3237 CHECK_FRAME (frame
, 0);
3238 CHECK_NUMBER (X0
, 0);
3239 CHECK_NUMBER (Y0
, 1);
3240 CHECK_NUMBER (X1
, 2);
3241 CHECK_NUMBER (Y1
, 3);
3251 n_lines
= y1
- y0
+ 1;
3256 n_lines
= y0
- y1
+ 1;
3262 n_chars
= x1
- x0
+ 1;
3267 n_chars
= x0
- x1
+ 1;
3271 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->reverse_gc
,
3272 left
, top
, n_chars
, n_lines
);
3278 /* Draw lines around the text region beginning at the character position
3279 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3280 pixel and line characteristics. */
3282 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3285 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
3286 register struct frame
*f
;
3288 int top_x
, top_y
, bottom_x
, bottom_y
;
3290 register int ibw
= f
->display
.x
->internal_border_width
;
3291 register int font_w
= FONT_WIDTH (f
->display
.x
->font
);
3292 register int font_h
= f
->display
.x
->line_height
;
3294 int x
= line_len (y
);
3295 XPoint
*pixel_points
3296 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
3297 register XPoint
*this_point
= pixel_points
;
3299 /* Do the horizontal top line/lines */
3302 this_point
->x
= ibw
;
3303 this_point
->y
= ibw
+ (font_h
* top_y
);
3306 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
3308 this_point
->x
= ibw
+ (font_w
* x
);
3309 this_point
->y
= (this_point
- 1)->y
;
3313 this_point
->x
= ibw
;
3314 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
3316 this_point
->x
= ibw
+ (font_w
* top_x
);
3317 this_point
->y
= (this_point
- 1)->y
;
3319 this_point
->x
= (this_point
- 1)->x
;
3320 this_point
->y
= ibw
+ (font_h
* top_y
);
3322 this_point
->x
= ibw
+ (font_w
* x
);
3323 this_point
->y
= (this_point
- 1)->y
;
3326 /* Now do the right side. */
3327 while (y
< bottom_y
)
3328 { /* Right vertical edge */
3330 this_point
->x
= (this_point
- 1)->x
;
3331 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
3334 y
++; /* Horizontal connection to next line */
3337 this_point
->x
= ibw
+ (font_w
/ 2);
3339 this_point
->x
= ibw
+ (font_w
* x
);
3341 this_point
->y
= (this_point
- 1)->y
;
3344 /* Now do the bottom and connect to the top left point. */
3345 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
3348 this_point
->x
= (this_point
- 1)->x
;
3349 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
3351 this_point
->x
= ibw
;
3352 this_point
->y
= (this_point
- 1)->y
;
3354 this_point
->x
= pixel_points
->x
;
3355 this_point
->y
= pixel_points
->y
;
3357 XDrawLines (x_current_display
, FRAME_X_WINDOW (f
),
3359 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
3362 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
3363 "Highlight the region between point and the character under the mouse\n\
3366 register Lisp_Object event
;
3368 register int x0
, y0
, x1
, y1
;
3369 register struct frame
*f
= selected_frame
;
3370 register int p1
, p2
;
3372 CHECK_CONS (event
, 0);
3375 x0
= XINT (Fcar (Fcar (event
)));
3376 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3378 /* If the mouse is past the end of the line, don't that area. */
3379 /* ReWrite this... */
3384 if (y1
> y0
) /* point below mouse */
3385 outline_region (f
, f
->display
.x
->cursor_gc
,
3387 else if (y1
< y0
) /* point above mouse */
3388 outline_region (f
, f
->display
.x
->cursor_gc
,
3390 else /* same line: draw horizontal rectangle */
3393 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3394 x0
, y0
, (x1
- x0
+ 1), 1);
3396 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3397 x1
, y1
, (x0
- x1
+ 1), 1);
3400 XFlush (x_current_display
);
3406 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
3407 "Erase any highlighting of the region between point and the character\n\
3408 at X, Y on the selected frame.")
3410 register Lisp_Object event
;
3412 register int x0
, y0
, x1
, y1
;
3413 register struct frame
*f
= selected_frame
;
3416 x0
= XINT (Fcar (Fcar (event
)));
3417 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3421 if (y1
> y0
) /* point below mouse */
3422 outline_region (f
, f
->display
.x
->reverse_gc
,
3424 else if (y1
< y0
) /* point above mouse */
3425 outline_region (f
, f
->display
.x
->reverse_gc
,
3427 else /* same line: draw horizontal rectangle */
3430 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3431 x0
, y0
, (x1
- x0
+ 1), 1);
3433 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3434 x1
, y1
, (x0
- x1
+ 1), 1);
3442 int contour_begin_x
, contour_begin_y
;
3443 int contour_end_x
, contour_end_y
;
3444 int contour_npoints
;
3446 /* Clip the top part of the contour lines down (and including) line Y_POS.
3447 If X_POS is in the middle (rather than at the end) of the line, drop
3448 down a line at that character. */
3451 clip_contour_top (y_pos
, x_pos
)
3453 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
3454 register XPoint
*end
;
3455 register int npoints
;
3456 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
3458 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
3460 end
= contour_lines
[y_pos
].top_right
;
3461 npoints
= (end
- begin
+ 1);
3462 XDrawLines (x_current_display
, contour_window
,
3463 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3465 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
3466 contour_last_point
-= (npoints
- 2);
3467 XDrawLines (x_current_display
, contour_window
,
3468 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
3469 XFlush (x_current_display
);
3471 /* Now, update contour_lines structure. */
3476 register XPoint
*p
= begin
+ 1;
3477 end
= contour_lines
[y_pos
].bottom_right
;
3478 npoints
= (end
- begin
+ 1);
3479 XDrawLines (x_current_display
, contour_window
,
3480 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3483 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
3485 p
->y
= begin
->y
+ font_h
;
3487 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
3488 contour_last_point
-= (npoints
- 5);
3489 XDrawLines (x_current_display
, contour_window
,
3490 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
3491 XFlush (x_current_display
);
3493 /* Now, update contour_lines structure. */
3497 /* Erase the top horizontal lines of the contour, and then extend
3498 the contour upwards. */
3501 extend_contour_top (line
)
3506 clip_contour_bottom (x_pos
, y_pos
)
3512 extend_contour_bottom (x_pos
, y_pos
)
3516 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
3521 register struct frame
*f
= selected_frame
;
3522 register int point_x
= f
->cursor_x
;
3523 register int point_y
= f
->cursor_y
;
3524 register int mouse_below_point
;
3525 register Lisp_Object obj
;
3526 register int x_contour_x
, x_contour_y
;
3528 x_contour_x
= x_mouse_x
;
3529 x_contour_y
= x_mouse_y
;
3530 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
3531 && x_contour_x
> point_x
))
3533 mouse_below_point
= 1;
3534 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3535 x_contour_x
, x_contour_y
);
3539 mouse_below_point
= 0;
3540 outline_region (f
, f
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
3546 obj
= read_char (-1, 0, 0, Qnil
, 0);
3547 if (XTYPE (obj
) != Lisp_Cons
)
3550 if (mouse_below_point
)
3552 if (x_mouse_y
<= point_y
) /* Flipped. */
3554 mouse_below_point
= 0;
3556 outline_region (f
, f
->display
.x
->reverse_gc
, point_x
, point_y
,
3557 x_contour_x
, x_contour_y
);
3558 outline_region (f
, f
->display
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
3561 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
3563 clip_contour_bottom (x_mouse_y
);
3565 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
3567 extend_bottom_contour (x_mouse_y
);
3570 x_contour_x
= x_mouse_x
;
3571 x_contour_y
= x_mouse_y
;
3573 else /* mouse above or same line as point */
3575 if (x_mouse_y
>= point_y
) /* Flipped. */
3577 mouse_below_point
= 1;
3579 outline_region (f
, f
->display
.x
->reverse_gc
,
3580 x_contour_x
, x_contour_y
, point_x
, point_y
);
3581 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3582 x_mouse_x
, x_mouse_y
);
3584 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
3586 clip_contour_top (x_mouse_y
);
3588 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
3590 extend_contour_top (x_mouse_y
);
3595 unread_command_event
= obj
;
3596 if (mouse_below_point
)
3598 contour_begin_x
= point_x
;
3599 contour_begin_y
= point_y
;
3600 contour_end_x
= x_contour_x
;
3601 contour_end_y
= x_contour_y
;
3605 contour_begin_x
= x_contour_x
;
3606 contour_begin_y
= x_contour_y
;
3607 contour_end_x
= point_x
;
3608 contour_end_y
= point_y
;
3613 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
3618 register Lisp_Object obj
;
3619 struct frame
*f
= selected_frame
;
3620 register struct window
*w
= XWINDOW (selected_window
);
3621 register GC line_gc
= f
->display
.x
->cursor_gc
;
3622 register GC erase_gc
= f
->display
.x
->reverse_gc
;
3624 char dash_list
[] = {6, 4, 6, 4};
3626 XGCValues gc_values
;
3628 register int previous_y
;
3629 register int line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3630 + f
->display
.x
->internal_border_width
;
3631 register int left
= f
->display
.x
->internal_border_width
3633 * FONT_WIDTH (f
->display
.x
->font
));
3634 register int right
= left
+ (w
->width
3635 * FONT_WIDTH (f
->display
.x
->font
))
3636 - f
->display
.x
->internal_border_width
;
3640 gc_values
.foreground
= f
->display
.x
->cursor_pixel
;
3641 gc_values
.background
= f
->display
.x
->background_pixel
;
3642 gc_values
.line_width
= 1;
3643 gc_values
.line_style
= LineOnOffDash
;
3644 gc_values
.cap_style
= CapRound
;
3645 gc_values
.join_style
= JoinRound
;
3647 line_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3648 GCLineStyle
| GCJoinStyle
| GCCapStyle
3649 | GCLineWidth
| GCForeground
| GCBackground
,
3651 XSetDashes (x_current_display
, line_gc
, 0, dash_list
, dashes
);
3652 gc_values
.foreground
= f
->display
.x
->background_pixel
;
3653 gc_values
.background
= f
->display
.x
->foreground_pixel
;
3654 erase_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3655 GCLineStyle
| GCJoinStyle
| GCCapStyle
3656 | GCLineWidth
| GCForeground
| GCBackground
,
3658 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
3664 if (x_mouse_y
>= XINT (w
->top
)
3665 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
3667 previous_y
= x_mouse_y
;
3668 line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3669 + f
->display
.x
->internal_border_width
;
3670 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3671 line_gc
, left
, line
, right
, line
);
3678 obj
= read_char (-1, 0, 0, Qnil
, 0);
3679 if ((XTYPE (obj
) != Lisp_Cons
)
3680 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3681 Qvertical_scroll_bar
))
3685 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3686 erase_gc
, left
, line
, right
, line
);
3688 unread_command_event
= obj
;
3690 XFreeGC (x_current_display
, line_gc
);
3691 XFreeGC (x_current_display
, erase_gc
);
3696 while (x_mouse_y
== previous_y
);
3699 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3700 erase_gc
, left
, line
, right
, line
);
3706 /* Offset in buffer of character under the pointer, or 0. */
3707 int mouse_buffer_offset
;
3710 /* These keep track of the rectangle following the pointer. */
3711 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
3713 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
3714 "Track the pointer.")
3717 static Cursor current_pointer_shape
;
3718 FRAME_PTR f
= x_mouse_frame
;
3721 if (EQ (Vmouse_frame_part
, Qtext_part
)
3722 && (current_pointer_shape
!= f
->display
.x
->nontext_cursor
))
3727 current_pointer_shape
= f
->display
.x
->nontext_cursor
;
3728 XDefineCursor (x_current_display
,
3730 current_pointer_shape
);
3732 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
3733 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
3735 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
3736 && (current_pointer_shape
!= f
->display
.x
->modeline_cursor
))
3738 current_pointer_shape
= f
->display
.x
->modeline_cursor
;
3739 XDefineCursor (x_current_display
,
3741 current_pointer_shape
);
3750 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
3751 "Draw rectangle around character under mouse pointer, if there is one.")
3755 struct window
*w
= XWINDOW (Vmouse_window
);
3756 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
3757 struct buffer
*b
= XBUFFER (w
->buffer
);
3760 if (! EQ (Vmouse_window
, selected_window
))
3763 if (EQ (event
, Qnil
))
3767 x_read_mouse_position (selected_frame
, &x
, &y
);
3771 mouse_track_width
= 0;
3772 mouse_track_left
= mouse_track_top
= -1;
3776 if ((x_mouse_x
!= mouse_track_left
3777 && (x_mouse_x
< mouse_track_left
3778 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
3779 || x_mouse_y
!= mouse_track_top
)
3781 int hp
= 0; /* Horizontal position */
3782 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
3783 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
3784 int tab_width
= XINT (b
->tab_width
);
3785 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
3787 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
3788 int in_mode_line
= 0;
3790 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
3793 /* Erase previous rectangle. */
3794 if (mouse_track_width
)
3796 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3797 mouse_track_left
, mouse_track_top
,
3798 mouse_track_width
, 1);
3800 if ((mouse_track_left
== f
->phys_cursor_x
3801 || mouse_track_left
== f
->phys_cursor_x
- 1)
3802 && mouse_track_top
== f
->phys_cursor_y
)
3804 x_display_cursor (f
, 1);
3808 mouse_track_left
= x_mouse_x
;
3809 mouse_track_top
= x_mouse_y
;
3810 mouse_track_width
= 0;
3812 if (mouse_track_left
> len
) /* Past the end of line. */
3815 if (mouse_track_top
== mode_line_vpos
)
3821 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3825 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
3831 mouse_track_width
= tab_width
- (hp
% tab_width
);
3833 hp
+= mouse_track_width
;
3836 mouse_track_left
= hp
- mouse_track_width
;
3842 mouse_track_width
= -1;
3846 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3851 mouse_track_width
= 2;
3856 mouse_track_left
= hp
- mouse_track_width
;
3862 mouse_track_width
= 1;
3869 while (hp
<= x_mouse_x
);
3872 if (mouse_track_width
) /* Over text; use text pointer shape. */
3874 XDefineCursor (x_current_display
,
3876 f
->display
.x
->text_cursor
);
3877 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3878 mouse_track_left
, mouse_track_top
,
3879 mouse_track_width
, 1);
3881 else if (in_mode_line
)
3882 XDefineCursor (x_current_display
,
3884 f
->display
.x
->modeline_cursor
);
3886 XDefineCursor (x_current_display
,
3888 f
->display
.x
->nontext_cursor
);
3891 XFlush (x_current_display
);
3894 obj
= read_char (-1, 0, 0, Qnil
, 0);
3897 while (XTYPE (obj
) == Lisp_Cons
/* Mouse event */
3898 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
3899 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
3900 && EQ (Vmouse_window
, selected_window
) /* In this window */
3903 unread_command_event
= obj
;
3905 if (mouse_track_width
)
3907 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3908 mouse_track_left
, mouse_track_top
,
3909 mouse_track_width
, 1);
3910 mouse_track_width
= 0;
3911 if ((mouse_track_left
== f
->phys_cursor_x
3912 || mouse_track_left
- 1 == f
->phys_cursor_x
)
3913 && mouse_track_top
== f
->phys_cursor_y
)
3915 x_display_cursor (f
, 1);
3918 XDefineCursor (x_current_display
,
3920 f
->display
.x
->nontext_cursor
);
3921 XFlush (x_current_display
);
3931 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3932 on the frame F at position X, Y. */
3934 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
3936 int x
, y
, width
, height
;
3941 image
= XCreateBitmapFromData (x_current_display
,
3942 FRAME_X_WINDOW (f
), image_data
,
3944 XCopyPlane (x_current_display
, image
, FRAME_X_WINDOW (f
),
3945 f
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
3950 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer
, Sx_store_cut_buffer
,
3951 1, 1, "sStore text in cut buffer: ",
3952 "Store contents of STRING into the cut buffer of the X window system.")
3954 register Lisp_Object string
;
3958 CHECK_STRING (string
, 1);
3959 if (! FRAME_X_P (selected_frame
))
3960 error ("Selected frame does not understand X protocol.");
3963 XStoreBytes ((char *) XSTRING (string
)->data
, XSTRING (string
)->size
);
3969 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer
, Sx_get_cut_buffer
, 0, 0, 0,
3970 "Return contents of cut buffer of the X window system, as a string.")
3974 register Lisp_Object string
;
3979 d
= XFetchBytes (&len
);
3980 string
= make_string (d
, len
);
3987 #if 0 /* I'm told these functions are superfluous
3988 given the ability to bind function keys. */
3991 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3992 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3993 KEYSYM is a string which conforms to the X keysym definitions found\n\
3994 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3995 list of strings specifying modifier keys such as Control_L, which must\n\
3996 also be depressed for NEWSTRING to appear.")
3997 (x_keysym
, modifiers
, newstring
)
3998 register Lisp_Object x_keysym
;
3999 register Lisp_Object modifiers
;
4000 register Lisp_Object newstring
;
4003 register KeySym keysym
;
4004 KeySym modifier_list
[16];
4007 CHECK_STRING (x_keysym
, 1);
4008 CHECK_STRING (newstring
, 3);
4010 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
4011 if (keysym
== NoSymbol
)
4012 error ("Keysym does not exist");
4014 if (NILP (modifiers
))
4015 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
4016 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
4019 register Lisp_Object rest
, mod
;
4022 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
4025 error ("Can't have more than 16 modifiers");
4028 CHECK_STRING (mod
, 3);
4029 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
4031 if (modifier_list
[i
] == NoSymbol
4032 || !(IsModifierKey (modifier_list
[i
])
4033 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
4034 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
4036 if (modifier_list
[i
] == NoSymbol
4037 || !IsModifierKey (modifier_list
[i
]))
4039 error ("Element is not a modifier keysym");
4043 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
4044 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
4050 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
4051 "Rebind KEYCODE to list of strings STRINGS.\n\
4052 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4053 nil as element means don't change.\n\
4054 See the documentation of `x-rebind-key' for more information.")
4056 register Lisp_Object keycode
;
4057 register Lisp_Object strings
;
4059 register Lisp_Object item
;
4060 register unsigned char *rawstring
;
4061 KeySym rawkey
, modifier
[1];
4063 register unsigned i
;
4066 CHECK_NUMBER (keycode
, 1);
4067 CHECK_CONS (strings
, 2);
4068 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
4069 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
4071 item
= Fcar (strings
);
4074 CHECK_STRING (item
, 2);
4075 strsize
= XSTRING (item
)->size
;
4076 rawstring
= (unsigned char *) xmalloc (strsize
);
4077 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
4078 modifier
[1] = 1 << i
;
4079 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
4080 rawstring
, strsize
);
4085 #endif /* HAVE_X11 */
4090 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4092 XScreenNumberOfScreen (scr
)
4093 register Screen
*scr
;
4095 register Display
*dpy
;
4096 register Screen
*dpyscr
;
4100 dpyscr
= dpy
->screens
;
4102 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
4108 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4111 select_visual (screen
, depth
)
4113 unsigned int *depth
;
4116 XVisualInfo
*vinfo
, vinfo_template
;
4119 v
= DefaultVisualOfScreen (screen
);
4122 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
4124 vinfo_template
.visualid
= v
->visualid
;
4127 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4129 vinfo
= XGetVisualInfo (x_current_display
,
4130 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
4133 fatal ("Can't get proper X visual info");
4135 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
4136 *depth
= vinfo
->depth
;
4140 int n
= vinfo
->colormap_size
- 1;
4149 XFree ((char *) vinfo
);
4152 #endif /* HAVE_X11 */
4154 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4155 1, 2, 0, "Open a connection to an X server.\n\
4156 DISPLAY is the name of the display to connect to.\n\
4157 Optional second arg XRM_STRING is a string of resources in xrdb format.")
4158 (display
, xrm_string
)
4159 Lisp_Object display
, xrm_string
;
4161 unsigned int n_planes
;
4162 unsigned char *xrm_option
;
4164 CHECK_STRING (display
, 0);
4165 if (x_current_display
!= 0)
4166 error ("X server connection is already initialized");
4167 if (! NILP (xrm_string
))
4168 CHECK_STRING (xrm_string
, 1);
4170 if (! NILP (xrm_string
))
4171 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4173 xrm_option
= (unsigned char *) 0;
4175 validate_x_resource_name ();
4177 /* This is what opens the connection and sets x_current_display.
4178 This also initializes many symbols, such as those used for input. */
4179 x_term_init (XSTRING (display
)->data
, xrm_option
,
4180 XSTRING (Vx_resource_name
)->data
);
4183 XFASTINT (Vwindow_system_version
) = 11;
4186 xrdb
= x_load_resources (x_current_display
, xrm_option
,
4187 (char *) XSTRING (Vx_resource_name
)->data
,
4190 #ifdef HAVE_XRMSETDATABASE
4191 XrmSetDatabase (x_current_display
, xrdb
);
4193 x_current_display
->db
= xrdb
;
4196 x_screen
= DefaultScreenOfDisplay (x_current_display
);
4198 screen_visual
= select_visual (x_screen
, &n_planes
);
4199 x_screen_planes
= n_planes
;
4200 x_screen_height
= HeightOfScreen (x_screen
);
4201 x_screen_width
= WidthOfScreen (x_screen
);
4203 /* X Atoms used by emacs. */
4204 Xatoms_of_xselect ();
4206 Xatom_wm_protocols
= XInternAtom (x_current_display
, "WM_PROTOCOLS",
4208 Xatom_wm_take_focus
= XInternAtom (x_current_display
, "WM_TAKE_FOCUS",
4210 Xatom_wm_save_yourself
= XInternAtom (x_current_display
, "WM_SAVE_YOURSELF",
4212 Xatom_wm_delete_window
= XInternAtom (x_current_display
, "WM_DELETE_WINDOW",
4214 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
4216 Xatom_wm_configure_denied
= XInternAtom (x_current_display
,
4217 "WM_CONFIGURE_DENIED", False
);
4218 Xatom_wm_window_moved
= XInternAtom (x_current_display
, "WM_MOVED",
4220 Xatom_editres_name
= XInternAtom (x_current_display
, "Editres", False
);
4222 #else /* not HAVE_X11 */
4223 XFASTINT (Vwindow_system_version
) = 10;
4224 #endif /* not HAVE_X11 */
4228 DEFUN ("x-close-current-connection", Fx_close_current_connection
,
4229 Sx_close_current_connection
,
4230 0, 0, 0, "Close the connection to the current X server.")
4233 /* Note: If we're going to call check_x here, then the fatal error
4234 can't happen. For the moment, this check is just for safety,
4235 so a user won't try out the function and get a crash. If it's
4236 really intended only to be called when killing emacs, then there's
4237 no reason for it to have a lisp interface at all. */
4240 /* This is ONLY used when killing emacs; For switching displays
4241 we'll have to take care of setting CloseDownMode elsewhere. */
4243 if (x_current_display
)
4246 XSetCloseDownMode (x_current_display
, DestroyAll
);
4247 XCloseDisplay (x_current_display
);
4248 x_current_display
= 0;
4251 fatal ("No current X display connection to close\n");
4256 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
,
4257 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4258 If ON is nil, allow buffering of requests.\n\
4259 Turning on synchronization prohibits the Xlib routines from buffering\n\
4260 requests and seriously degrades performance, but makes debugging much\n\
4267 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
4272 /* Wait for responses to all X commands issued so far for FRAME. */
4279 XSync (x_current_display
, False
);
4285 /* This is zero if not using X windows. */
4286 x_current_display
= 0;
4288 /* The section below is built by the lisp expression at the top of the file,
4289 just above where these variables are declared. */
4290 /*&&& init symbols here &&&*/
4291 Qauto_raise
= intern ("auto-raise");
4292 staticpro (&Qauto_raise
);
4293 Qauto_lower
= intern ("auto-lower");
4294 staticpro (&Qauto_lower
);
4295 Qbackground_color
= intern ("background-color");
4296 staticpro (&Qbackground_color
);
4297 Qbar
= intern ("bar");
4299 Qborder_color
= intern ("border-color");
4300 staticpro (&Qborder_color
);
4301 Qborder_width
= intern ("border-width");
4302 staticpro (&Qborder_width
);
4303 Qbox
= intern ("box");
4305 Qcursor_color
= intern ("cursor-color");
4306 staticpro (&Qcursor_color
);
4307 Qcursor_type
= intern ("cursor-type");
4308 staticpro (&Qcursor_type
);
4309 Qfont
= intern ("font");
4311 Qforeground_color
= intern ("foreground-color");
4312 staticpro (&Qforeground_color
);
4313 Qgeometry
= intern ("geometry");
4314 staticpro (&Qgeometry
);
4315 Qicon_left
= intern ("icon-left");
4316 staticpro (&Qicon_left
);
4317 Qicon_top
= intern ("icon-top");
4318 staticpro (&Qicon_top
);
4319 Qicon_type
= intern ("icon-type");
4320 staticpro (&Qicon_type
);
4321 Qinternal_border_width
= intern ("internal-border-width");
4322 staticpro (&Qinternal_border_width
);
4323 Qleft
= intern ("left");
4325 Qmouse_color
= intern ("mouse-color");
4326 staticpro (&Qmouse_color
);
4327 Qnone
= intern ("none");
4329 Qparent_id
= intern ("parent-id");
4330 staticpro (&Qparent_id
);
4331 Qsuppress_icon
= intern ("suppress-icon");
4332 staticpro (&Qsuppress_icon
);
4333 Qtop
= intern ("top");
4335 Qundefined_color
= intern ("undefined-color");
4336 staticpro (&Qundefined_color
);
4337 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
4338 staticpro (&Qvertical_scroll_bars
);
4339 Qvisibility
= intern ("visibility");
4340 staticpro (&Qvisibility
);
4341 Qwindow_id
= intern ("window-id");
4342 staticpro (&Qwindow_id
);
4343 Qx_frame_parameter
= intern ("x-frame-parameter");
4344 staticpro (&Qx_frame_parameter
);
4345 Qx_resource_name
= intern ("x-resource-name");
4346 staticpro (&Qx_resource_name
);
4347 Quser_position
= intern ("user-position");
4348 staticpro (&Quser_position
);
4349 Quser_size
= intern ("user-size");
4350 staticpro (&Quser_size
);
4351 /* This is the end of symbol initialization. */
4353 Fput (Qundefined_color
, Qerror_conditions
,
4354 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
4355 Fput (Qundefined_color
, Qerror_message
,
4356 build_string ("Undefined color"));
4358 init_x_parm_symbols ();
4360 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset
,
4361 "The buffer offset of the character under the pointer.");
4362 mouse_buffer_offset
= 0;
4364 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
4365 "The shape of the pointer when over text.\n\
4366 Changing the value does not affect existing frames\n\
4367 unless you set the mouse color.");
4368 Vx_pointer_shape
= Qnil
;
4370 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
4371 "The name Emacs uses to look up X resources; for internal use only.\n\
4372 `x-get-resource' uses this as the first component of the instance name\n\
4373 when requesting resource values.\n\
4374 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4375 was invoked, or to the value specified with the `-name' or `-rn'\n\
4376 switches, if present.");
4377 Vx_resource_name
= Qnil
;
4379 #if 0 /* This doesn't really do anything. */
4380 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
4381 "The shape of the pointer when not over text.\n\
4382 This variable takes effect when you create a new frame\n\
4383 or when you set the mouse color.");
4385 Vx_nontext_pointer_shape
= Qnil
;
4387 #if 0 /* This doesn't really do anything. */
4388 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
4389 "The shape of the pointer when over the mode line.\n\
4390 This variable takes effect when you create a new frame\n\
4391 or when you set the mouse color.");
4393 Vx_mode_pointer_shape
= Qnil
;
4395 DEFVAR_INT ("x-sensitive-text-pointer-shape",
4396 &Vx_sensitive_text_pointer_shape
,
4397 "The shape of the pointer when over mouse-sensitive text.\n\
4398 This variable takes effect when you create a new frame\n\
4399 or when you set the mouse color.");
4400 Vx_sensitive_text_pointer_shape
= Qnil
;
4402 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
4403 "A string indicating the foreground color of the cursor box.");
4404 Vx_cursor_fore_pixel
= Qnil
;
4406 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed
,
4407 "Non-nil if a mouse button is currently depressed.");
4408 Vmouse_depressed
= Qnil
;
4410 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
4411 "t if no X window manager is in use.");
4414 defsubr (&Sx_get_resource
);
4416 defsubr (&Sx_draw_rectangle
);
4417 defsubr (&Sx_erase_rectangle
);
4418 defsubr (&Sx_contour_region
);
4419 defsubr (&Sx_uncontour_region
);
4421 defsubr (&Sx_display_color_p
);
4422 defsubr (&Sx_list_fonts
);
4423 defsubr (&Sx_color_defined_p
);
4424 defsubr (&Sx_server_max_request_size
);
4425 defsubr (&Sx_server_vendor
);
4426 defsubr (&Sx_server_version
);
4427 defsubr (&Sx_display_pixel_width
);
4428 defsubr (&Sx_display_pixel_height
);
4429 defsubr (&Sx_display_mm_width
);
4430 defsubr (&Sx_display_mm_height
);
4431 defsubr (&Sx_display_screens
);
4432 defsubr (&Sx_display_planes
);
4433 defsubr (&Sx_display_color_cells
);
4434 defsubr (&Sx_display_visual_class
);
4435 defsubr (&Sx_display_backing_store
);
4436 defsubr (&Sx_display_save_under
);
4438 defsubr (&Sx_rebind_key
);
4439 defsubr (&Sx_rebind_keys
);
4440 defsubr (&Sx_track_pointer
);
4441 defsubr (&Sx_grab_pointer
);
4442 defsubr (&Sx_ungrab_pointer
);
4445 defsubr (&Sx_get_default
);
4446 defsubr (&Sx_store_cut_buffer
);
4447 defsubr (&Sx_get_cut_buffer
);
4449 defsubr (&Sx_parse_geometry
);
4450 defsubr (&Sx_create_frame
);
4451 defsubr (&Sfocus_frame
);
4452 defsubr (&Sunfocus_frame
);
4454 defsubr (&Sx_horizontal_line
);
4456 defsubr (&Sx_open_connection
);
4457 defsubr (&Sx_close_current_connection
);
4458 defsubr (&Sx_synchronize
);
4461 #endif /* HAVE_X_WINDOWS */