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 */
34 #include "dispextern.h"
36 #include "blockinput.h"
42 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
43 #include "bitmaps/gray.xbm"
45 #include <X11/bitmaps/gray>
48 #include "[.bitmaps]gray.xbm"
52 #include <X11/Shell.h>
54 #include <X11/Xaw/Paned.h>
55 #include <X11/Xaw/Label.h>
58 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
67 #include "../lwlib/lwlib.h"
69 /* The one and only application context associated with the connection
70 to the one and only X display that Emacs uses. */
71 XtAppContext Xt_app_con
;
73 /* The one and only application shell. Emacs screens are popup shells of this
77 extern void free_frame_menubar ();
78 extern void free_frame_menubar ();
79 #endif /* USE_X_TOOLKIT */
81 #define min(a,b) ((a) < (b) ? (a) : (b))
82 #define max(a,b) ((a) > (b) ? (a) : (b))
85 /* X Resource data base */
86 static XrmDatabase xrdb
;
88 /* The class of this X application. */
89 #define EMACS_CLASS "Emacs"
92 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
94 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
97 /* The name we're using in resource queries. */
98 Lisp_Object Vx_resource_name
;
100 /* Title name and application name for X stuff. */
101 extern char *x_id_name
;
103 /* The background and shape of the mouse pointer, and shape when not
104 over text or in the modeline. */
105 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
106 Lisp_Object Vx_cross_pointer_shape
;
108 /* Color of chars displayed in cursor box. */
109 Lisp_Object Vx_cursor_fore_pixel
;
111 /* The screen being used. */
112 static Screen
*x_screen
;
114 /* The X Visual we are using for X windows (the default) */
115 Visual
*screen_visual
;
117 /* Height of this X screen in pixels. */
120 /* Width of this X screen in pixels. */
123 /* Number of planes for this screen. */
126 /* Non nil if no window manager is in use. */
127 Lisp_Object Vx_no_window_manager
;
129 /* `t' if a mouse button is depressed. */
131 Lisp_Object Vmouse_depressed
;
133 extern unsigned int x_mouse_x
, x_mouse_y
, x_mouse_grabbed
;
135 /* Atom for indicating window state to the window manager. */
136 extern Atom Xatom_wm_change_state
;
138 /* Communication with window managers. */
139 extern Atom Xatom_wm_protocols
;
141 /* Kinds of protocol things we may receive. */
142 extern Atom Xatom_wm_take_focus
;
143 extern Atom Xatom_wm_save_yourself
;
144 extern Atom Xatom_wm_delete_window
;
146 /* Other WM communication */
147 extern Atom Xatom_wm_configure_denied
; /* When our config request is denied */
148 extern Atom Xatom_wm_window_moved
; /* When the WM moves us. */
150 /* EditRes protocol */
151 extern Atom Xatom_editres_name
;
155 /* Default size of an Emacs window. */
156 static char *default_window
= "=80x24+0+0";
159 char iconidentity
[MAXICID
];
160 #define ICONTAG "emacs@"
161 char minibuffer_iconidentity
[MAXICID
];
162 #define MINIBUFFER_ICONTAG "minibuffer@"
166 /* The last 23 bits of the timestamp of the last mouse button event. */
167 Time mouse_timestamp
;
169 /* Evaluate this expression to rebuild the section of syms_of_xfns
170 that initializes and staticpros the symbols declared below. Note
171 that Emacs 18 has a bug that keeps C-x C-e from being able to
172 evaluate this expression.
175 ;; Accumulate a list of the symbols we want to initialize from the
176 ;; declarations at the top of the file.
177 (goto-char (point-min))
178 (search-forward "/\*&&& symbols declared here &&&*\/\n")
180 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
182 (cons (buffer-substring (match-beginning 1) (match-end 1))
185 (setq symbol-list (nreverse symbol-list))
186 ;; Delete the section of syms_of_... where we initialize the symbols.
187 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
188 (let ((start (point)))
189 (while (looking-at "^ Q")
191 (kill-region start (point)))
192 ;; Write a new symbol initialization section.
194 (insert (format " %s = intern (\"" (car symbol-list)))
195 (let ((start (point)))
196 (insert (substring (car symbol-list) 1))
197 (subst-char-in-region start (point) ?_ ?-))
198 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
199 (setq symbol-list (cdr symbol-list)))))
203 /*&&& symbols declared here &&&*/
204 Lisp_Object Qauto_raise
;
205 Lisp_Object Qauto_lower
;
206 Lisp_Object Qbackground_color
;
208 Lisp_Object Qborder_color
;
209 Lisp_Object Qborder_width
;
211 Lisp_Object Qcursor_color
;
212 Lisp_Object Qcursor_type
;
214 Lisp_Object Qforeground_color
;
215 Lisp_Object Qgeometry
;
216 /* Lisp_Object Qicon; */
217 Lisp_Object Qicon_left
;
218 Lisp_Object Qicon_top
;
219 Lisp_Object Qicon_type
;
220 Lisp_Object Qinternal_border_width
;
222 Lisp_Object Qmouse_color
;
224 Lisp_Object Qparent_id
;
225 Lisp_Object Qsuppress_icon
;
227 Lisp_Object Qundefined_color
;
228 Lisp_Object Qvertical_scroll_bars
;
229 Lisp_Object Qvisibility
;
230 Lisp_Object Qwindow_id
;
231 Lisp_Object Qx_frame_parameter
;
232 Lisp_Object Qx_resource_name
;
233 Lisp_Object Quser_position
;
234 Lisp_Object Quser_size
;
236 /* The below are defined in frame.c. */
237 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
238 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
;
240 extern Lisp_Object Vwindow_system_version
;
243 /* Error if we are not connected to X. */
247 if (x_current_display
== 0)
248 error ("X windows are not in use or not initialized");
251 /* Return the Emacs frame-object corresponding to an X window.
252 It could be the frame's main window or an icon window. */
254 /* This function can be called during GC, so use XGCTYPE. */
257 x_window_to_frame (wdesc
)
260 Lisp_Object tail
, frame
;
263 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
264 tail
= XCONS (tail
)->cdr
)
266 frame
= XCONS (tail
)->car
;
267 if (XGCTYPE (frame
) != Lisp_Frame
)
271 if (f
->display
.nothing
== 1)
273 if ((f
->display
.x
->edit_widget
274 && XtWindow (f
->display
.x
->edit_widget
) == wdesc
)
275 || f
->display
.x
->icon_desc
== wdesc
)
277 #else /* not USE_X_TOOLKIT */
278 if (FRAME_X_WINDOW (f
) == wdesc
279 || f
->display
.x
->icon_desc
== wdesc
)
281 #endif /* not USE_X_TOOLKIT */
287 /* Like x_window_to_frame but also compares the window with the widget's
291 x_any_window_to_frame (wdesc
)
294 Lisp_Object tail
, frame
;
298 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
299 tail
= XCONS (tail
)->cdr
)
301 frame
= XCONS (tail
)->car
;
302 if (XGCTYPE (frame
) != Lisp_Frame
)
305 if (f
->display
.nothing
== 1)
308 /* This frame matches if the window is any of its widgets. */
309 if (wdesc
== XtWindow (x
->widget
)
310 || wdesc
== XtWindow (x
->column_widget
)
311 || wdesc
== XtWindow (x
->edit_widget
))
313 /* Match if the window is this frame's menubar. */
314 if (x
->menubar_widget
315 && wdesc
== XtWindow (x
->menubar_widget
))
321 /* Return the frame whose principal (outermost) window is WDESC.
322 If WDESC is some other (smaller) window, we return 0. */
325 x_top_window_to_frame (wdesc
)
328 Lisp_Object tail
, frame
;
332 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
333 tail
= XCONS (tail
)->cdr
)
335 frame
= XCONS (tail
)->car
;
336 if (XGCTYPE (frame
) != Lisp_Frame
)
339 if (f
->display
.nothing
== 1)
342 /* This frame matches if the window is its topmost widget. */
343 if (wdesc
== XtWindow (x
->widget
))
345 /* Match if the window is this frame's menubar. */
346 if (x
->menubar_widget
347 && wdesc
== XtWindow (x
->menubar_widget
))
352 #endif /* USE_X_TOOLKIT */
355 /* Connect the frame-parameter names for X frames
356 to the ways of passing the parameter values to the window system.
358 The name of a parameter, as a Lisp symbol,
359 has an `x-frame-parameter' property which is an integer in Lisp
360 but can be interpreted as an `enum x_frame_parm' in C. */
364 X_PARM_FOREGROUND_COLOR
,
365 X_PARM_BACKGROUND_COLOR
,
372 X_PARM_INTERNAL_BORDER_WIDTH
,
376 X_PARM_VERT_SCROLL_BAR
,
378 X_PARM_MENU_BAR_LINES
382 struct x_frame_parm_table
385 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
388 void x_set_foreground_color ();
389 void x_set_background_color ();
390 void x_set_mouse_color ();
391 void x_set_cursor_color ();
392 void x_set_border_color ();
393 void x_set_cursor_type ();
394 void x_set_icon_type ();
396 void x_set_border_width ();
397 void x_set_internal_border_width ();
398 void x_explicitly_set_name ();
399 void x_set_autoraise ();
400 void x_set_autolower ();
401 void x_set_vertical_scroll_bars ();
402 void x_set_visibility ();
403 void x_set_menu_bar_lines ();
405 static struct x_frame_parm_table x_frame_parms
[] =
407 "foreground-color", x_set_foreground_color
,
408 "background-color", x_set_background_color
,
409 "mouse-color", x_set_mouse_color
,
410 "cursor-color", x_set_cursor_color
,
411 "border-color", x_set_border_color
,
412 "cursor-type", x_set_cursor_type
,
413 "icon-type", x_set_icon_type
,
415 "border-width", x_set_border_width
,
416 "internal-border-width", x_set_internal_border_width
,
417 "name", x_explicitly_set_name
,
418 "auto-raise", x_set_autoraise
,
419 "auto-lower", x_set_autolower
,
420 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
421 "visibility", x_set_visibility
,
422 "menu-bar-lines", x_set_menu_bar_lines
,
425 /* Attach the `x-frame-parameter' properties to
426 the Lisp symbol names of parameters relevant to X. */
428 init_x_parm_symbols ()
432 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
433 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
437 /* Change the parameters of FRAME as specified by ALIST.
438 If a parameter is not specially recognized, do nothing;
439 otherwise call the `x_set_...' function for that parameter. */
442 x_set_frame_parameters (f
, alist
)
448 /* If both of these parameters are present, it's more efficient to
449 set them both at once. So we wait until we've looked at the
450 entire list before we set them. */
451 Lisp_Object width
, height
;
454 Lisp_Object left
, top
;
456 /* Record in these vectors all the parms specified. */
462 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
465 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
466 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
468 /* Extract parm names and values into those vectors. */
471 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
473 Lisp_Object elt
, prop
, val
;
476 parms
[i
] = Fcar (elt
);
477 values
[i
] = Fcdr (elt
);
481 width
= height
= top
= left
= Qunbound
;
483 /* Now process them in reverse of specified order. */
484 for (i
--; i
>= 0; i
--)
486 Lisp_Object prop
, val
;
491 if (EQ (prop
, Qwidth
))
493 else if (EQ (prop
, Qheight
))
495 else if (EQ (prop
, Qtop
))
497 else if (EQ (prop
, Qleft
))
501 register Lisp_Object param_index
, old_value
;
503 param_index
= Fget (prop
, Qx_frame_parameter
);
504 old_value
= get_frame_param (f
, prop
);
505 store_frame_param (f
, prop
, val
);
506 if (XTYPE (param_index
) == Lisp_Int
507 && XINT (param_index
) >= 0
508 && (XINT (param_index
)
509 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
510 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
514 /* Don't die if just one of these was set. */
515 if (EQ (left
, Qunbound
))
516 XSET (left
, Lisp_Int
, f
->display
.x
->left_pos
);
517 if (EQ (top
, Qunbound
))
518 XSET (top
, Lisp_Int
, f
->display
.x
->top_pos
);
520 /* Don't die if just one of these was set. */
521 if (EQ (width
, Qunbound
))
522 XSET (width
, Lisp_Int
, FRAME_WIDTH (f
));
523 if (EQ (height
, Qunbound
))
524 XSET (height
, Lisp_Int
, FRAME_HEIGHT (f
));
526 /* Don't set these parameters these unless they've been explicitly
527 specified. The window might be mapped or resized while we're in
528 this function, and we don't want to override that unless the lisp
529 code has asked for it.
531 Don't set these parameters unless they actually differ from the
532 window's current parameters; the window may not actually exist
537 check_frame_size (f
, &height
, &width
);
539 XSET (frame
, Lisp_Frame
, f
);
541 if ((NUMBERP (width
) && XINT (width
) != FRAME_WIDTH (f
))
542 || (NUMBERP (height
) && XINT (height
) != FRAME_HEIGHT (f
)))
543 Fset_frame_size (frame
, width
, height
);
544 if ((NUMBERP (left
) && XINT (left
) != f
->display
.x
->left_pos
)
545 || (NUMBERP (top
) && XINT (top
) != f
->display
.x
->top_pos
))
546 Fset_frame_position (frame
, left
, top
);
550 /* Store the positions of frame F into XPTR and YPTR.
551 These are the positions of the containing window manager window,
552 not Emacs's own window. */
555 x_real_positions (f
, xptr
, yptr
)
559 int win_x
= 0, win_y
= 0;
562 /* Find the position of the outside upper-left corner of
563 the inner window, with respect to the outer window. */
564 if (f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
567 XTranslateCoordinates (x_current_display
,
569 /* From-window, to-window. */
571 XtWindow (f
->display
.x
->widget
),
573 f
->display
.x
->window_desc
,
575 f
->display
.x
->parent_desc
,
577 /* From-position, to-position. */
578 0, 0, &win_x
, &win_y
,
584 win_x
+= f
->display
.x
->border_width
;
585 win_y
+= f
->display
.x
->border_width
;
587 *xptr
= f
->display
.x
->left_pos
- win_x
;
588 *yptr
= f
->display
.x
->top_pos
- win_y
;
591 /* Insert a description of internally-recorded parameters of frame X
592 into the parameter alist *ALISTPTR that is to be given to the user.
593 Only parameters that are specific to the X window system
594 and whose values are not correctly recorded in the frame's
595 param_alist need to be considered here. */
597 x_report_frame_params (f
, alistptr
)
599 Lisp_Object
*alistptr
;
603 store_in_alist (alistptr
, Qleft
, make_number (f
->display
.x
->left_pos
));
604 store_in_alist (alistptr
, Qtop
, make_number (f
->display
.x
->top_pos
));
605 store_in_alist (alistptr
, Qborder_width
,
606 make_number (f
->display
.x
->border_width
));
607 store_in_alist (alistptr
, Qinternal_border_width
,
608 make_number (f
->display
.x
->internal_border_width
));
609 sprintf (buf
, "%d", FRAME_X_WINDOW (f
));
610 store_in_alist (alistptr
, Qwindow_id
,
612 FRAME_SAMPLE_VISIBILITY (f
);
613 store_in_alist (alistptr
, Qvisibility
,
614 (FRAME_VISIBLE_P (f
) ? Qt
615 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
618 /* Decide if color named COLOR is valid for the display
619 associated with the selected frame. */
621 defined_color (color
, color_def
)
626 Colormap screen_colormap
;
631 = DefaultColormap (x_current_display
, XDefaultScreen (x_current_display
));
633 foo
= XParseColor (x_current_display
, screen_colormap
,
635 && XAllocColor (x_current_display
, screen_colormap
, color_def
);
637 foo
= XParseColor (color
, color_def
) && XGetHardwareColor (color_def
);
638 #endif /* not HAVE_X11 */
647 /* Given a string ARG naming a color, compute a pixel value from it
648 suitable for screen F.
649 If F is not a color screen, return DEF (default) regardless of what
653 x_decode_color (arg
, def
)
659 CHECK_STRING (arg
, 0);
661 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
662 return BLACK_PIX_DEFAULT
;
663 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
664 return WHITE_PIX_DEFAULT
;
667 if (x_screen_planes
== 1)
670 if (DISPLAY_CELLS
== 1)
674 if (defined_color (XSTRING (arg
)->data
, &cdef
))
677 Fsignal (Qundefined_color
, Fcons (arg
, Qnil
));
680 /* Functions called only from `x_set_frame_param'
681 to set individual parameters.
683 If FRAME_X_WINDOW (f) is 0,
684 the frame is being created and its X-window does not exist yet.
685 In that case, just record the parameter's new value
686 in the standard place; do not attempt to change the window. */
689 x_set_foreground_color (f
, arg
, oldval
)
691 Lisp_Object arg
, oldval
;
693 f
->display
.x
->foreground_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
694 if (FRAME_X_WINDOW (f
) != 0)
698 XSetForeground (x_current_display
, f
->display
.x
->normal_gc
,
699 f
->display
.x
->foreground_pixel
);
700 XSetBackground (x_current_display
, f
->display
.x
->reverse_gc
,
701 f
->display
.x
->foreground_pixel
);
703 #endif /* HAVE_X11 */
704 recompute_basic_faces (f
);
705 if (FRAME_VISIBLE_P (f
))
711 x_set_background_color (f
, arg
, oldval
)
713 Lisp_Object arg
, oldval
;
718 f
->display
.x
->background_pixel
= x_decode_color (arg
, WHITE_PIX_DEFAULT
);
720 if (FRAME_X_WINDOW (f
) != 0)
724 /* The main frame area. */
725 XSetBackground (x_current_display
, f
->display
.x
->normal_gc
,
726 f
->display
.x
->background_pixel
);
727 XSetForeground (x_current_display
, f
->display
.x
->reverse_gc
,
728 f
->display
.x
->background_pixel
);
729 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
730 f
->display
.x
->background_pixel
);
731 XSetWindowBackground (x_current_display
, FRAME_X_WINDOW (f
),
732 f
->display
.x
->background_pixel
);
735 temp
= XMakeTile (f
->display
.x
->background_pixel
);
736 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
738 #endif /* not HAVE_X11 */
741 recompute_basic_faces (f
);
743 if (FRAME_VISIBLE_P (f
))
749 x_set_mouse_color (f
, arg
, oldval
)
751 Lisp_Object arg
, oldval
;
753 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
757 f
->display
.x
->mouse_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
758 mask_color
= f
->display
.x
->background_pixel
;
759 /* No invisible pointers. */
760 if (mask_color
== f
->display
.x
->mouse_pixel
761 && mask_color
== f
->display
.x
->background_pixel
)
762 f
->display
.x
->mouse_pixel
= f
->display
.x
->foreground_pixel
;
767 /* It's not okay to crash if the user selects a screwy cursor. */
770 if (!EQ (Qnil
, Vx_pointer_shape
))
772 CHECK_NUMBER (Vx_pointer_shape
, 0);
773 cursor
= XCreateFontCursor (x_current_display
, XINT (Vx_pointer_shape
));
776 cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
777 x_check_errors ("bad text pointer cursor: %s");
779 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
781 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
782 nontext_cursor
= XCreateFontCursor (x_current_display
,
783 XINT (Vx_nontext_pointer_shape
));
786 nontext_cursor
= XCreateFontCursor (x_current_display
, XC_left_ptr
);
787 x_check_errors ("bad nontext pointer cursor: %s");
789 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
791 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
792 mode_cursor
= XCreateFontCursor (x_current_display
,
793 XINT (Vx_mode_pointer_shape
));
796 mode_cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
797 x_check_errors ("bad modeline pointer cursor: %s");
799 if (!EQ (Qnil
, Vx_cross_pointer_shape
))
801 CHECK_NUMBER (Vx_cross_pointer_shape
, 0);
802 cross_cursor
= XCreateFontCursor (x_current_display
,
803 XINT (Vx_cross_pointer_shape
));
806 cross_cursor
= XCreateFontCursor (x_current_display
, XC_crosshair
);
808 /* Check and report errors with the above calls. */
809 x_check_errors ("can't set cursor shape: %s");
813 XColor fore_color
, back_color
;
815 fore_color
.pixel
= f
->display
.x
->mouse_pixel
;
816 back_color
.pixel
= mask_color
;
817 XQueryColor (x_current_display
,
818 DefaultColormap (x_current_display
,
819 DefaultScreen (x_current_display
)),
821 XQueryColor (x_current_display
,
822 DefaultColormap (x_current_display
,
823 DefaultScreen (x_current_display
)),
825 XRecolorCursor (x_current_display
, cursor
,
826 &fore_color
, &back_color
);
827 XRecolorCursor (x_current_display
, nontext_cursor
,
828 &fore_color
, &back_color
);
829 XRecolorCursor (x_current_display
, mode_cursor
,
830 &fore_color
, &back_color
);
831 XRecolorCursor (x_current_display
, cross_cursor
,
832 &fore_color
, &back_color
);
835 cursor
= XCreateCursor (16, 16, MouseCursor
, MouseMask
,
837 f
->display
.x
->mouse_pixel
,
838 f
->display
.x
->background_pixel
,
842 if (FRAME_X_WINDOW (f
) != 0)
844 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
), cursor
);
847 if (cursor
!= f
->display
.x
->text_cursor
&& f
->display
.x
->text_cursor
!= 0)
848 XFreeCursor (XDISPLAY f
->display
.x
->text_cursor
);
849 f
->display
.x
->text_cursor
= cursor
;
851 if (nontext_cursor
!= f
->display
.x
->nontext_cursor
852 && f
->display
.x
->nontext_cursor
!= 0)
853 XFreeCursor (XDISPLAY f
->display
.x
->nontext_cursor
);
854 f
->display
.x
->nontext_cursor
= nontext_cursor
;
856 if (mode_cursor
!= f
->display
.x
->modeline_cursor
857 && f
->display
.x
->modeline_cursor
!= 0)
858 XFreeCursor (XDISPLAY f
->display
.x
->modeline_cursor
);
859 f
->display
.x
->modeline_cursor
= mode_cursor
;
860 if (cross_cursor
!= f
->display
.x
->cross_cursor
861 && f
->display
.x
->cross_cursor
!= 0)
862 XFreeCursor (XDISPLAY f
->display
.x
->cross_cursor
);
863 f
->display
.x
->cross_cursor
= cross_cursor
;
864 #endif /* HAVE_X11 */
871 x_set_cursor_color (f
, arg
, oldval
)
873 Lisp_Object arg
, oldval
;
875 unsigned long fore_pixel
;
877 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
878 fore_pixel
= x_decode_color (Vx_cursor_fore_pixel
, WHITE_PIX_DEFAULT
);
880 fore_pixel
= f
->display
.x
->background_pixel
;
881 f
->display
.x
->cursor_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
883 /* Make sure that the cursor color differs from the background color. */
884 if (f
->display
.x
->cursor_pixel
== f
->display
.x
->background_pixel
)
886 f
->display
.x
->cursor_pixel
= f
->display
.x
->mouse_pixel
;
887 if (f
->display
.x
->cursor_pixel
== fore_pixel
)
888 fore_pixel
= f
->display
.x
->background_pixel
;
890 f
->display
.x
->cursor_foreground_pixel
= fore_pixel
;
892 if (FRAME_X_WINDOW (f
) != 0)
896 XSetBackground (x_current_display
, f
->display
.x
->cursor_gc
,
897 f
->display
.x
->cursor_pixel
);
898 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
901 #endif /* HAVE_X11 */
903 if (FRAME_VISIBLE_P (f
))
905 x_display_cursor (f
, 0);
906 x_display_cursor (f
, 1);
911 /* Set the border-color of frame F to value described by ARG.
912 ARG can be a string naming a color.
913 The border-color is used for the border that is drawn by the X server.
914 Note that this does not fully take effect if done before
915 F has an x-window; it must be redone when the window is created.
917 Note: this is done in two routines because of the way X10 works.
919 Note: under X11, this is normally the province of the window manager,
920 and so emacs' border colors may be overridden. */
923 x_set_border_color (f
, arg
, oldval
)
925 Lisp_Object arg
, oldval
;
930 CHECK_STRING (arg
, 0);
931 str
= XSTRING (arg
)->data
;
934 if (!strcmp (str
, "grey") || !strcmp (str
, "Grey")
935 || !strcmp (str
, "gray") || !strcmp (str
, "Gray"))
940 pix
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
942 x_set_border_pixel (f
, pix
);
945 /* Set the border-color of frame F to pixel value PIX.
946 Note that this does not fully take effect if done before
947 F has an x-window. */
949 x_set_border_pixel (f
, pix
)
953 f
->display
.x
->border_pixel
= pix
;
955 if (FRAME_X_WINDOW (f
) != 0 && f
->display
.x
->border_width
> 0)
962 XSetWindowBorder (x_current_display
, FRAME_X_WINDOW (f
),
966 temp
= XMakePixmap ((Bitmap
) XStoreBitmap (gray_width
, gray_height
,
968 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
970 temp
= XMakeTile (pix
);
971 XChangeBorder (FRAME_X_WINDOW (f
), temp
);
972 XFreePixmap (XDISPLAY temp
);
973 #endif /* not HAVE_X11 */
976 if (FRAME_VISIBLE_P (f
))
982 x_set_cursor_type (f
, arg
, oldval
)
984 Lisp_Object arg
, oldval
;
987 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
992 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
993 /* Error messages commented out because people have trouble fixing
994 .Xdefaults with Emacs, when it has something bad in it. */
998 ("the `cursor-type' frame parameter should be either `bar' or `box'");
1001 /* Make sure the cursor gets redrawn. This is overkill, but how
1002 often do people change cursor types? */
1003 update_mode_lines
++;
1007 x_set_icon_type (f
, arg
, oldval
)
1009 Lisp_Object arg
, oldval
;
1014 if (EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1019 result
= x_text_icon (f
, 0);
1021 result
= x_bitmap_icon (f
);
1026 error ("No icon window available.");
1029 /* If the window was unmapped (and its icon was mapped),
1030 the new icon is not mapped, so map the window in its stead. */
1031 if (FRAME_VISIBLE_P (f
))
1032 #ifdef USE_X_TOOLKIT
1033 XtPopup (f
->display
.x
->widget
, XtGrabNone
);
1035 XMapWindow (XDISPLAY
FRAME_X_WINDOW (f
));
1041 extern Lisp_Object
x_new_font ();
1044 x_set_font (f
, arg
, oldval
)
1046 Lisp_Object arg
, oldval
;
1050 CHECK_STRING (arg
, 1);
1053 result
= x_new_font (f
, XSTRING (arg
)->data
);
1056 if (EQ (result
, Qnil
))
1057 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
1058 else if (EQ (result
, Qt
))
1059 error ("the characters of the given font have varying widths");
1060 else if (STRINGP (result
))
1062 recompute_basic_faces (f
);
1063 store_frame_param (f
, Qfont
, result
);
1070 x_set_border_width (f
, arg
, oldval
)
1072 Lisp_Object arg
, oldval
;
1074 CHECK_NUMBER (arg
, 0);
1076 if (XINT (arg
) == f
->display
.x
->border_width
)
1079 if (FRAME_X_WINDOW (f
) != 0)
1080 error ("Cannot change the border width of a window");
1082 f
->display
.x
->border_width
= XINT (arg
);
1086 x_set_internal_border_width (f
, arg
, oldval
)
1088 Lisp_Object arg
, oldval
;
1091 int old
= f
->display
.x
->internal_border_width
;
1093 CHECK_NUMBER (arg
, 0);
1094 f
->display
.x
->internal_border_width
= XINT (arg
);
1095 if (f
->display
.x
->internal_border_width
< 0)
1096 f
->display
.x
->internal_border_width
= 0;
1098 if (f
->display
.x
->internal_border_width
== old
)
1101 if (FRAME_X_WINDOW (f
) != 0)
1104 x_set_window_size (f
, 0, f
->width
, f
->height
);
1106 x_set_resize_hint (f
);
1110 SET_FRAME_GARBAGED (f
);
1115 x_set_visibility (f
, value
, oldval
)
1117 Lisp_Object value
, oldval
;
1120 XSET (frame
, Lisp_Frame
, f
);
1123 Fmake_frame_invisible (frame
, Qt
);
1124 else if (EQ (value
, Qicon
))
1125 Ficonify_frame (frame
);
1127 Fmake_frame_visible (frame
);
1131 x_set_menu_bar_lines_1 (window
, n
)
1135 struct window
*w
= XWINDOW (window
);
1137 XFASTINT (w
->top
) += n
;
1138 XFASTINT (w
->height
) -= n
;
1140 /* Handle just the top child in a vertical split. */
1141 if (!NILP (w
->vchild
))
1142 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1144 /* Adjust all children in a horizontal split. */
1145 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1147 w
= XWINDOW (window
);
1148 x_set_menu_bar_lines_1 (window
, n
);
1153 x_set_menu_bar_lines (f
, value
, oldval
)
1155 Lisp_Object value
, oldval
;
1158 int olines
= FRAME_MENU_BAR_LINES (f
);
1160 /* Right now, menu bars don't work properly in minibuf-only frames;
1161 most of the commands try to apply themselves to the minibuffer
1162 frame itslef, and get an error because you can't switch buffers
1163 in or split the minibuffer window. */
1164 if (FRAME_MINIBUF_ONLY_P (f
))
1167 if (XTYPE (value
) == Lisp_Int
)
1168 nlines
= XINT (value
);
1172 #ifdef USE_X_TOOLKIT
1173 FRAME_MENU_BAR_LINES (f
) = 0;
1175 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1178 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1179 free_frame_menubar (f
);
1180 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1181 f
->display
.x
->menubar_widget
= 0;
1183 #else /* not USE_X_TOOLKIT */
1184 FRAME_MENU_BAR_LINES (f
) = nlines
;
1185 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1186 #endif /* not USE_X_TOOLKIT */
1189 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1192 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1193 name; if NAME is a string, set F's name to NAME and set
1194 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1196 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1197 suggesting a new name, which lisp code should override; if
1198 F->explicit_name is set, ignore the new name; otherwise, set it. */
1201 x_set_name (f
, name
, explicit)
1206 /* Make sure that requests from lisp code override requests from
1207 Emacs redisplay code. */
1210 /* If we're switching from explicit to implicit, we had better
1211 update the mode lines and thereby update the title. */
1212 if (f
->explicit_name
&& NILP (name
))
1213 update_mode_lines
= 1;
1215 f
->explicit_name
= ! NILP (name
);
1217 else if (f
->explicit_name
)
1220 /* If NAME is nil, set the name to the x_id_name. */
1222 name
= build_string (x_id_name
);
1224 CHECK_STRING (name
, 0);
1226 /* Don't change the name if it's already NAME. */
1227 if (! NILP (Fstring_equal (name
, f
->name
)))
1230 if (FRAME_X_WINDOW (f
))
1236 text
.value
= XSTRING (name
)->data
;
1237 text
.encoding
= XA_STRING
;
1239 text
.nitems
= XSTRING (name
)->size
;
1240 #ifdef USE_X_TOOLKIT
1241 XSetWMName (x_current_display
, XtWindow (f
->display
.x
->widget
), &text
);
1242 XSetWMIconName (x_current_display
, XtWindow (f
->display
.x
->widget
),
1244 #else /* not USE_X_TOOLKIT */
1245 XSetWMName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1246 XSetWMIconName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1247 #endif /* not USE_X_TOOLKIT */
1249 #else /* not HAVE_X11R4 */
1250 XSetIconName (XDISPLAY
FRAME_X_WINDOW (f
),
1251 XSTRING (name
)->data
);
1252 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
),
1253 XSTRING (name
)->data
);
1254 #endif /* not HAVE_X11R4 */
1261 /* This function should be called when the user's lisp code has
1262 specified a name for the frame; the name will override any set by the
1265 x_explicitly_set_name (f
, arg
, oldval
)
1267 Lisp_Object arg
, oldval
;
1269 x_set_name (f
, arg
, 1);
1272 /* This function should be called by Emacs redisplay code to set the
1273 name; names set this way will never override names set by the user's
1276 x_implicitly_set_name (f
, arg
, oldval
)
1278 Lisp_Object arg
, oldval
;
1280 x_set_name (f
, arg
, 0);
1284 x_set_autoraise (f
, arg
, oldval
)
1286 Lisp_Object arg
, oldval
;
1288 f
->auto_raise
= !EQ (Qnil
, arg
);
1292 x_set_autolower (f
, arg
, oldval
)
1294 Lisp_Object arg
, oldval
;
1296 f
->auto_lower
= !EQ (Qnil
, arg
);
1300 x_set_vertical_scroll_bars (f
, arg
, oldval
)
1302 Lisp_Object arg
, oldval
;
1304 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
1306 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
1308 /* We set this parameter before creating the X window for the
1309 frame, so we can get the geometry right from the start.
1310 However, if the window hasn't been created yet, we shouldn't
1311 call x_set_window_size. */
1312 if (FRAME_X_WINDOW (f
))
1313 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1317 /* Subroutines of creating an X frame. */
1321 /* Make sure that Vx_resource_name is set to a reasonable value. */
1323 validate_x_resource_name ()
1325 if (! STRINGP (Vx_resource_name
))
1326 Vx_resource_name
= make_string ("emacs", 5);
1330 extern char *x_get_string_resource ();
1331 extern XrmDatabase
x_load_resources ();
1333 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
1334 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1335 This uses `NAME.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1336 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1337 the name specified by the `-name' or `-rn' command-line arguments.\n\
1339 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1340 class, respectively. You must specify both of them or neither.\n\
1341 If you specify them, the key is `NAME.COMPONENT.ATTRIBUTE'\n\
1342 and the class is `Emacs.CLASS.SUBCLASS'.")
1343 (attribute
, class, component
, subclass
)
1344 Lisp_Object attribute
, class, component
, subclass
;
1346 register char *value
;
1349 Lisp_Object resname
;
1353 CHECK_STRING (attribute
, 0);
1354 CHECK_STRING (class, 0);
1356 if (!NILP (component
))
1357 CHECK_STRING (component
, 1);
1358 if (!NILP (subclass
))
1359 CHECK_STRING (subclass
, 2);
1360 if (NILP (component
) != NILP (subclass
))
1361 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1363 validate_x_resource_name ();
1364 resname
= Vx_resource_name
;
1366 if (NILP (component
))
1368 /* Allocate space for the components, the dots which separate them,
1369 and the final '\0'. */
1370 name_key
= (char *) alloca (XSTRING (resname
)->size
1371 + XSTRING (attribute
)->size
1373 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1374 + XSTRING (class)->size
1377 sprintf (name_key
, "%s.%s",
1378 XSTRING (resname
)->data
,
1379 XSTRING (attribute
)->data
);
1380 sprintf (class_key
, "%s.%s",
1382 XSTRING (class)->data
);
1386 name_key
= (char *) alloca (XSTRING (resname
)->size
1387 + XSTRING (component
)->size
1388 + XSTRING (attribute
)->size
1391 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1392 + XSTRING (class)->size
1393 + XSTRING (subclass
)->size
1396 sprintf (name_key
, "%s.%s.%s",
1397 XSTRING (resname
)->data
,
1398 XSTRING (component
)->data
,
1399 XSTRING (attribute
)->data
);
1400 sprintf (class_key
, "%s.%s.%s",
1402 XSTRING (class)->data
,
1403 XSTRING (subclass
)->data
);
1406 value
= x_get_string_resource (xrdb
, name_key
, class_key
);
1408 if (value
!= (char *) 0)
1409 return build_string (value
);
1414 /* Used when C code wants a resource value. */
1417 x_get_resource_string (attribute
, class)
1418 char *attribute
, *class;
1420 register char *value
;
1424 /* Allocate space for the components, the dots which separate them,
1425 and the final '\0'. */
1426 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
1427 + strlen (attribute
) + 2);
1428 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1429 + strlen (class) + 2);
1431 sprintf (name_key
, "%s.%s",
1432 XSTRING (Vinvocation_name
)->data
,
1434 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
1436 return x_get_string_resource (xrdb
, name_key
, class_key
);
1441 DEFUN ("x-get-default", Fx_get_default
, Sx_get_default
, 1, 1, 0,
1442 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1443 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1444 The defaults are specified in the file `~/.Xdefaults'.")
1448 register unsigned char *value
;
1450 CHECK_STRING (arg
, 1);
1452 value
= (unsigned char *) XGetDefault (XDISPLAY
1453 XSTRING (Vinvocation_name
)->data
,
1454 XSTRING (arg
)->data
);
1456 /* Try reversing last two args, in case this is the buggy version of X. */
1457 value
= (unsigned char *) XGetDefault (XDISPLAY
1458 XSTRING (arg
)->data
,
1459 XSTRING (Vinvocation_name
)->data
);
1461 return build_string (value
);
1466 #define Fx_get_resource(attribute, class, component, subclass) \
1467 Fx_get_default (attribute)
1471 /* Types we might convert a resource string into. */
1474 number
, boolean
, string
, symbol
1477 /* Return the value of parameter PARAM.
1479 First search ALIST, then Vdefault_frame_alist, then the X defaults
1480 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1482 Convert the resource to the type specified by desired_type.
1484 If no default is specified, return Qunbound. If you call
1485 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1486 and don't let it get stored in any lisp-visible variables! */
1489 x_get_arg (alist
, param
, attribute
, class, type
)
1490 Lisp_Object alist
, param
;
1493 enum resource_types type
;
1495 register Lisp_Object tem
;
1497 tem
= Fassq (param
, alist
);
1499 tem
= Fassq (param
, Vdefault_frame_alist
);
1505 tem
= Fx_get_resource (build_string (attribute
),
1506 build_string (class),
1515 return make_number (atoi (XSTRING (tem
)->data
));
1518 tem
= Fdowncase (tem
);
1519 if (!strcmp (XSTRING (tem
)->data
, "on")
1520 || !strcmp (XSTRING (tem
)->data
, "true"))
1529 /* As a special case, we map the values `true' and `on'
1530 to Qt, and `false' and `off' to Qnil. */
1533 lower
= Fdowncase (tem
);
1534 if (!strcmp (XSTRING (lower
)->data
, "on")
1535 || !strcmp (XSTRING (lower
)->data
, "true"))
1537 else if (!strcmp (XSTRING (lower
)->data
, "off")
1538 || !strcmp (XSTRING (lower
)->data
, "false"))
1541 return Fintern (tem
, Qnil
);
1554 /* Record in frame F the specified or default value according to ALIST
1555 of the parameter named PARAM (a Lisp symbol).
1556 If no value is specified for PARAM, look for an X default for XPROP
1557 on the frame named NAME.
1558 If that is not found either, use the value DEFLT. */
1561 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
1568 enum resource_types type
;
1572 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
1573 if (EQ (tem
, Qunbound
))
1575 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
1579 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
1580 "Parse an X-style geometry string STRING.\n\
1581 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
1582 The properties returned may include `top', `left', `height', and `width'.\n\
1583 The value of `left' or `top' may be an integer or `-'.\n\
1584 `-' means \"minus zero\".")
1589 unsigned int width
, height
;
1592 CHECK_STRING (string
, 0);
1594 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
1595 &x
, &y
, &width
, &height
);
1598 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
1599 error ("Must specify both x and y position, or neither");
1603 if (geometry
& XValue
)
1605 Lisp_Object element
;
1607 if (x
== 0 && (geometry
& XNegative
))
1608 element
= Fcons (Qleft
, Qminus
);
1610 element
= Fcons (Qleft
, make_number (x
));
1611 result
= Fcons (element
, result
);
1614 if (geometry
& YValue
)
1616 Lisp_Object element
;
1618 if (y
== 0 && (geometry
& YNegative
))
1619 element
= Fcons (Qtop
, Qminus
);
1621 element
= Fcons (Qtop
, make_number (y
));
1622 result
= Fcons (element
, result
);
1625 if (geometry
& WidthValue
)
1626 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
1627 if (geometry
& HeightValue
)
1628 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
1634 /* Calculate the desired size and position of this window,
1635 and return the flags saying which aspects were specified.
1637 This function does not make the coordinates positive. */
1639 #define DEFAULT_ROWS 40
1640 #define DEFAULT_COLS 80
1643 x_figure_window_size (f
, parms
)
1647 register Lisp_Object tem0
, tem1
, tem2
;
1648 int height
, width
, left
, top
;
1649 register int geometry
;
1650 long window_prompting
= 0;
1652 /* Default values if we fall through.
1653 Actually, if that happens we should get
1654 window manager prompting. */
1655 f
->width
= DEFAULT_COLS
;
1656 f
->height
= DEFAULT_ROWS
;
1657 /* Window managers expect that if program-specified
1658 positions are not (0,0), they're intentional, not defaults. */
1659 f
->display
.x
->top_pos
= 0;
1660 f
->display
.x
->left_pos
= 0;
1662 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
1663 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
1664 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
1665 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1667 if (!EQ (tem0
, Qunbound
))
1669 CHECK_NUMBER (tem0
, 0);
1670 f
->height
= XINT (tem0
);
1672 if (!EQ (tem1
, Qunbound
))
1674 CHECK_NUMBER (tem1
, 0);
1675 f
->width
= XINT (tem1
);
1677 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
1678 window_prompting
|= USSize
;
1680 window_prompting
|= PSize
;
1683 f
->display
.x
->vertical_scroll_bar_extra
1684 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1685 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f
)
1687 f
->display
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
1688 f
->display
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
1690 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1691 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1692 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
1693 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1695 if (EQ (tem0
, Qminus
))
1697 f
->display
.x
->top_pos
= 0;
1698 window_prompting
|= YNegative
;
1700 else if (EQ (tem0
, Qunbound
))
1701 f
->display
.x
->top_pos
= 0;
1704 CHECK_NUMBER (tem0
, 0);
1705 f
->display
.x
->top_pos
= XINT (tem0
);
1706 if (f
->display
.x
->top_pos
< 0)
1707 window_prompting
|= YNegative
;
1710 if (EQ (tem1
, Qminus
))
1712 f
->display
.x
->left_pos
= 0;
1713 window_prompting
|= XNegative
;
1715 else if (EQ (tem1
, Qunbound
))
1716 f
->display
.x
->left_pos
= 0;
1719 CHECK_NUMBER (tem1
, 0);
1720 f
->display
.x
->left_pos
= XINT (tem1
);
1721 if (f
->display
.x
->left_pos
< 0)
1722 window_prompting
|= XNegative
;
1726 window_prompting
|= USPosition
;
1728 window_prompting
|= PPosition
;
1731 return window_prompting
;
1734 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
1737 XSetWMProtocols (dpy
, w
, protocols
, count
)
1744 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
1745 if (prop
== None
) return False
;
1746 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
1747 (unsigned char *) protocols
, count
);
1750 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
1752 #ifdef USE_X_TOOLKIT
1754 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS
1755 and WM_DELETE_WINDOW, then add them. (They may already be present
1756 because of the toolkit (Motif adds them, for example, but Xt doesn't). */
1759 hack_wm_protocols (widget
)
1762 Display
*dpy
= XtDisplay (widget
);
1763 Window w
= XtWindow (widget
);
1764 int need_delete
= 1;
1769 Atom type
, *atoms
= 0;
1771 unsigned long nitems
= 0;
1772 unsigned long bytes_after
;
1774 if (Success
== XGetWindowProperty (dpy
, w
, Xatom_wm_protocols
,
1775 0, 100, False
, XA_ATOM
,
1776 &type
, &format
, &nitems
, &bytes_after
,
1777 (unsigned char **) &atoms
)
1778 && format
== 32 && type
== XA_ATOM
)
1782 if (atoms
[nitems
] == Xatom_wm_delete_window
) need_delete
= 0;
1783 else if (atoms
[nitems
] == Xatom_wm_take_focus
) need_focus
= 0;
1785 if (atoms
) XFree ((char *) atoms
);
1790 if (need_delete
) props
[count
++] = Xatom_wm_delete_window
;
1791 if (need_focus
) props
[count
++] = Xatom_wm_take_focus
;
1793 XChangeProperty (dpy
, w
, Xatom_wm_protocols
, XA_ATOM
, 32, PropModeAppend
,
1794 (unsigned char *) props
, count
);
1800 #ifdef USE_X_TOOLKIT
1802 /* Create and set up the X widget for frame F. */
1805 x_window (f
, window_prompting
, minibuffer_only
)
1807 long window_prompting
;
1808 int minibuffer_only
;
1810 XClassHint class_hints
;
1811 XSetWindowAttributes attributes
;
1812 unsigned long attribute_mask
;
1814 Widget shell_widget
;
1816 Widget screen_widget
;
1823 if (STRINGP (f
->name
))
1824 name
= (char*) XSTRING (f
->name
)->data
;
1829 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
1830 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
1831 shell_widget
= XtCreatePopupShell ("shell",
1832 topLevelShellWidgetClass
,
1833 Xt_app_shell
, al
, ac
);
1835 f
->display
.x
->widget
= shell_widget
;
1836 /* maybe_set_screen_title_format (shell_widget); */
1840 XtSetArg (al
[ac
], XtNborderWidth
, 0); ac
++;
1841 pane_widget
= XtCreateWidget ("pane",
1843 shell_widget
, al
, ac
);
1845 f
->display
.x
->column_widget
= pane_widget
;
1847 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
1848 initialize_frame_menubar (f
);
1850 /* mappedWhenManaged to false tells to the paned window to not map/unmap
1851 the emacs screen when changing menubar. This reduces flickering. */
1854 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
1855 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
1856 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
1857 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
1858 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
1859 screen_widget
= XtCreateWidget (name
,
1861 pane_widget
, al
, ac
);
1863 f
->display
.x
->edit_widget
= screen_widget
;
1865 if (f
->display
.x
->menubar_widget
)
1866 XtManageChild (f
->display
.x
->menubar_widget
);
1867 XtManageChild (screen_widget
);
1869 /* Do some needed geometry management. */
1872 char *tem
, shell_position
[32];
1876 = (f
->display
.x
->menubar_widget
1877 ? (f
->display
.x
->menubar_widget
->core
.height
1878 + f
->display
.x
->menubar_widget
->core
.border_width
)
1881 if (window_prompting
& USPosition
)
1883 int left
= f
->display
.x
->left_pos
;
1884 int xneg
= window_prompting
& XNegative
;
1885 int top
= f
->display
.x
->top_pos
;
1886 int yneg
= window_prompting
& YNegative
;
1891 sprintf (shell_position
, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f
),
1892 PIXEL_HEIGHT (f
) + menubar_size
,
1893 (xneg
? '-' : '+'), left
,
1894 (yneg
? '-' : '+'), top
);
1897 sprintf (shell_position
, "=%dx%d", PIXEL_WIDTH (f
),
1898 PIXEL_HEIGHT (f
) + menubar_size
);
1899 len
= strlen (shell_position
) + 1;
1900 tem
= (char *) xmalloc (len
);
1901 strncpy (tem
, shell_position
, len
);
1902 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
1903 XtSetValues (shell_widget
, al
, ac
);
1906 x_calc_absolute_position (f
);
1908 XtManageChild (pane_widget
);
1909 XtRealizeWidget (shell_widget
);
1911 FRAME_X_WINDOW (f
) = XtWindow (screen_widget
);
1913 validate_x_resource_name ();
1914 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
1915 class_hints
.res_class
= EMACS_CLASS
;
1916 XSetClassHint (x_current_display
, XtWindow (shell_widget
), &class_hints
);
1918 f
->display
.x
->wm_hints
.input
= True
;
1919 f
->display
.x
->wm_hints
.flags
|= InputHint
;
1920 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
1922 hack_wm_protocols (shell_widget
);
1924 /* Do a stupid property change to force the server to generate a
1925 propertyNotify event so that the event_stream server timestamp will
1926 be initialized to something relevant to the time we created the window.
1928 XChangeProperty (XtDisplay (screen_widget
), XtWindow (screen_widget
),
1929 Xatom_wm_protocols
, XA_ATOM
, 32, PropModeAppend
,
1930 (unsigned char*) NULL
, 0);
1932 /* Make all the standard events reach the Emacs frame. */
1933 attributes
.event_mask
= STANDARD_EVENT_SET
;
1934 attribute_mask
= CWEventMask
;
1935 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
1936 attribute_mask
, &attributes
);
1938 XtMapWidget (screen_widget
);
1940 /* x_set_name normally ignores requests to set the name if the
1941 requested name is the same as the current name. This is the one
1942 place where that assumption isn't correct; f->name is set, but
1943 the X server hasn't been told. */
1946 int explicit = f
->explicit_name
;
1948 f
->explicit_name
= 0;
1951 x_set_name (f
, name
, explicit);
1954 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
1955 f
->display
.x
->text_cursor
);
1959 if (FRAME_X_WINDOW (f
) == 0)
1960 error ("Unable to create window");
1963 #else /* not USE_X_TOOLKIT */
1965 /* Create and set up the X window for frame F. */
1971 XClassHint class_hints
;
1972 XSetWindowAttributes attributes
;
1973 unsigned long attribute_mask
;
1975 attributes
.background_pixel
= f
->display
.x
->background_pixel
;
1976 attributes
.border_pixel
= f
->display
.x
->border_pixel
;
1977 attributes
.bit_gravity
= StaticGravity
;
1978 attributes
.backing_store
= NotUseful
;
1979 attributes
.save_under
= True
;
1980 attributes
.event_mask
= STANDARD_EVENT_SET
;
1981 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
1983 | CWBackingStore
| CWSaveUnder
1989 = XCreateWindow (x_current_display
, ROOT_WINDOW
,
1990 f
->display
.x
->left_pos
,
1991 f
->display
.x
->top_pos
,
1992 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
1993 f
->display
.x
->border_width
,
1994 CopyFromParent
, /* depth */
1995 InputOutput
, /* class */
1996 screen_visual
, /* set in Fx_open_connection */
1997 attribute_mask
, &attributes
);
1999 validate_x_resource_name ();
2000 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2001 class_hints
.res_class
= EMACS_CLASS
;
2002 XSetClassHint (x_current_display
, FRAME_X_WINDOW (f
), &class_hints
);
2004 /* This indicates that we use the "Passive Input" input model.
2005 Unless we do this, we don't get the Focus{In,Out} events that we
2006 need to draw the cursor correctly. Accursed bureaucrats.
2007 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
2009 f
->display
.x
->wm_hints
.input
= True
;
2010 f
->display
.x
->wm_hints
.flags
|= InputHint
;
2011 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
2012 XSetWMProtocols (x_current_display
, FRAME_X_WINDOW (f
),
2013 &Xatom_wm_delete_window
, 1);
2016 /* x_set_name normally ignores requests to set the name if the
2017 requested name is the same as the current name. This is the one
2018 place where that assumption isn't correct; f->name is set, but
2019 the X server hasn't been told. */
2022 int explicit = f
->explicit_name
;
2024 f
->explicit_name
= 0;
2027 x_set_name (f
, name
, explicit);
2030 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
2031 f
->display
.x
->text_cursor
);
2035 if (FRAME_X_WINDOW (f
) == 0)
2036 error ("Unable to create window");
2039 #endif /* not USE_X_TOOLKIT */
2041 /* Handle the icon stuff for this window. Perhaps later we might
2042 want an x_set_icon_position which can be called interactively as
2050 Lisp_Object icon_x
, icon_y
;
2052 /* Set the position of the icon. Note that twm groups all
2053 icons in an icon window. */
2054 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
2055 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
2056 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
2058 CHECK_NUMBER (icon_x
, 0);
2059 CHECK_NUMBER (icon_y
, 0);
2061 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
2062 error ("Both left and top icon corners of icon must be specified");
2066 if (! EQ (icon_x
, Qunbound
))
2067 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
2069 /* Start up iconic or window? */
2070 x_wm_set_window_state
2071 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
2078 /* Make the GC's needed for this window, setting the
2079 background, border and mouse colors; also create the
2080 mouse cursor and the gray border tile. */
2082 static char cursor_bits
[] =
2084 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2085 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2086 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2087 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2094 XGCValues gc_values
;
2100 /* Create the GC's of this frame.
2101 Note that many default values are used. */
2104 gc_values
.font
= f
->display
.x
->font
->fid
;
2105 gc_values
.foreground
= f
->display
.x
->foreground_pixel
;
2106 gc_values
.background
= f
->display
.x
->background_pixel
;
2107 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
2108 f
->display
.x
->normal_gc
= XCreateGC (x_current_display
,
2110 GCLineWidth
| GCFont
2111 | GCForeground
| GCBackground
,
2114 /* Reverse video style. */
2115 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2116 gc_values
.background
= f
->display
.x
->foreground_pixel
;
2117 f
->display
.x
->reverse_gc
= XCreateGC (x_current_display
,
2119 GCFont
| GCForeground
| GCBackground
2123 /* Cursor has cursor-color background, background-color foreground. */
2124 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2125 gc_values
.background
= f
->display
.x
->cursor_pixel
;
2126 gc_values
.fill_style
= FillOpaqueStippled
;
2128 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
2129 cursor_bits
, 16, 16);
2130 f
->display
.x
->cursor_gc
2131 = XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
2132 (GCFont
| GCForeground
| GCBackground
2133 | GCFillStyle
| GCStipple
| GCLineWidth
),
2136 /* Create the gray border tile used when the pointer is not in
2137 the frame. Since this depends on the frame's pixel values,
2138 this must be done on a per-frame basis. */
2139 f
->display
.x
->border_tile
2140 = (XCreatePixmapFromBitmapData
2141 (x_current_display
, ROOT_WINDOW
,
2142 gray_bits
, gray_width
, gray_height
,
2143 f
->display
.x
->foreground_pixel
,
2144 f
->display
.x
->background_pixel
,
2145 DefaultDepth (x_current_display
, XDefaultScreen (x_current_display
))));
2149 #endif /* HAVE_X11 */
2151 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
2153 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2154 Return an Emacs frame object representing the X window.\n\
2155 ALIST is an alist of frame parameters.\n\
2156 If the parameters specify that the frame should not have a minibuffer,\n\
2157 and do not specify a specific minibuffer window to use,\n\
2158 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2159 be shared by the new frame.")
2165 Lisp_Object frame
, tem
;
2167 int minibuffer_only
= 0;
2168 long window_prompting
= 0;
2170 int count
= specpdl_ptr
- specpdl
;
2174 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
2175 if (XTYPE (name
) != Lisp_String
2176 && ! EQ (name
, Qunbound
)
2178 error ("x-create-frame: name parameter must be a string");
2180 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2181 if (EQ (tem
, Qnone
) || NILP (tem
))
2182 f
= make_frame_without_minibuffer (Qnil
);
2183 else if (EQ (tem
, Qonly
))
2185 f
= make_minibuffer_frame ();
2186 minibuffer_only
= 1;
2188 else if (XTYPE (tem
) == Lisp_Window
)
2189 f
= make_frame_without_minibuffer (tem
);
2193 /* Note that X Windows does support scroll bars. */
2194 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
2196 /* Set the name; the functions to which we pass f expect the name to
2198 if (EQ (name
, Qunbound
) || NILP (name
))
2200 f
->name
= build_string (x_id_name
);
2201 f
->explicit_name
= 0;
2206 f
->explicit_name
= 1;
2207 /* use the frame's title when getting resources for this frame. */
2208 specbind (Qx_resource_name
, name
);
2211 XSET (frame
, Lisp_Frame
, f
);
2212 f
->output_method
= output_x_window
;
2213 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2214 bzero (f
->display
.x
, sizeof (struct x_display
));
2216 /* Note that the frame has no physical cursor right now. */
2217 f
->phys_cursor_x
= -1;
2219 /* Extract the window parameters from the supplied values
2220 that are needed to determine window geometry. */
2224 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
2226 /* First, try whatever font the caller has specified. */
2228 font
= x_new_font (f
, XSTRING (font
)->data
);
2229 /* Try out a font which we hope has bold and italic variations. */
2230 if (!STRINGP (font
))
2231 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2232 if (! STRINGP (font
))
2233 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2234 if (! STRINGP (font
))
2235 /* This was formerly the first thing tried, but it finds too many fonts
2236 and takes too long. */
2237 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
2238 /* If those didn't work, look for something which will at least work. */
2239 if (! STRINGP (font
))
2240 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1");
2242 if (! STRINGP (font
))
2243 font
= build_string ("fixed");
2245 x_default_parameter (f
, parms
, Qfont
, font
,
2246 "font", "Font", string
);
2249 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
2250 "borderwidth", "BorderWidth", number
);
2251 /* This defaults to 2 in order to match xterm. We recognize either
2252 internalBorderWidth or internalBorder (which is what xterm calls
2254 if (NILP (Fassq (Qinternal_border_width
, parms
)))
2258 value
= x_get_arg (parms
, Qinternal_border_width
,
2259 "internalBorder", "BorderWidth", number
);
2260 if (! EQ (value
, Qunbound
))
2261 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
2264 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
2265 "internalBorderWidth", "BorderWidth", number
);
2266 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
2267 "verticalScrollBars", "ScrollBars", boolean
);
2269 /* Also do the stuff which must be set before the window exists. */
2270 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
2271 "foreground", "Foreground", string
);
2272 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
2273 "background", "Background", string
);
2274 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
2275 "pointerColor", "Foreground", string
);
2276 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
2277 "cursorColor", "Foreground", string
);
2278 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
2279 "borderColor", "BorderColor", string
);
2281 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (0),
2282 "menuBarLines", "MenuBarLines", number
);
2284 f
->display
.x
->parent_desc
= ROOT_WINDOW
;
2285 window_prompting
= x_figure_window_size (f
, parms
);
2287 if (window_prompting
& XNegative
)
2289 if (window_prompting
& YNegative
)
2290 f
->display
.x
->win_gravity
= SouthEastGravity
;
2292 f
->display
.x
->win_gravity
= NorthEastGravity
;
2296 if (window_prompting
& YNegative
)
2297 f
->display
.x
->win_gravity
= SouthWestGravity
;
2299 f
->display
.x
->win_gravity
= NorthWestGravity
;
2302 f
->display
.x
->size_hint_flags
= window_prompting
;
2304 #ifdef USE_X_TOOLKIT
2305 x_window (f
, window_prompting
, minibuffer_only
);
2311 init_frame_faces (f
);
2313 /* We need to do this after creating the X window, so that the
2314 icon-creation functions can say whose icon they're describing. */
2315 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2316 "bitmapIcon", "BitmapIcon", symbol
);
2318 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
2319 "autoRaise", "AutoRaiseLower", boolean
);
2320 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
2321 "autoLower", "AutoRaiseLower", boolean
);
2322 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
2323 "cursorType", "CursorType", symbol
);
2325 /* Dimensions, especially f->height, must be done via change_frame_size.
2326 Change will not be effected unless different from the current
2330 f
->height
= f
->width
= 0;
2331 change_frame_size (f
, height
, width
, 1, 0);
2333 /* With the toolkit, the geometry management is done in x_window. */
2334 #ifndef USE_X_TOOLKIT
2336 x_wm_set_size_hint (f
, window_prompting
, 0);
2338 #endif /* USE_X_TOOLKIT */
2340 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2341 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2343 /* It is now ok to make the frame official
2344 even if we get an error below.
2345 And the frame needs to be on Vframe_list
2346 or making it visible won't work. */
2347 Vframe_list
= Fcons (frame
, Vframe_list
);
2349 /* Make the window appear on the frame and enable display,
2350 unless the caller says not to. */
2352 Lisp_Object visibility
;
2354 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2355 if (EQ (visibility
, Qunbound
))
2358 if (EQ (visibility
, Qicon
))
2359 x_iconify_frame (f
);
2360 else if (! NILP (visibility
))
2361 x_make_frame_visible (f
);
2363 /* Must have been Qnil. */
2367 return unbind_to (count
, frame
);
2370 Lisp_Object frame
, tem
;
2372 int pixelwidth
, pixelheight
;
2377 int minibuffer_only
= 0;
2378 Lisp_Object vscroll
, hscroll
;
2380 if (x_current_display
== 0)
2381 error ("X windows are not in use or not initialized");
2383 name
= Fassq (Qname
, parms
);
2385 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2386 if (EQ (tem
, Qnone
))
2387 f
= make_frame_without_minibuffer (Qnil
);
2388 else if (EQ (tem
, Qonly
))
2390 f
= make_minibuffer_frame ();
2391 minibuffer_only
= 1;
2393 else if (EQ (tem
, Qnil
) || EQ (tem
, Qunbound
))
2396 f
= make_frame_without_minibuffer (tem
);
2398 parent
= ROOT_WINDOW
;
2400 XSET (frame
, Lisp_Frame
, f
);
2401 f
->output_method
= output_x_window
;
2402 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2403 bzero (f
->display
.x
, sizeof (struct x_display
));
2405 /* Some temporary default values for height and width. */
2408 f
->display
.x
->left_pos
= -1;
2409 f
->display
.x
->top_pos
= -1;
2411 /* Give the frame a default name (which may be overridden with PARMS). */
2413 strncpy (iconidentity
, ICONTAG
, MAXICID
);
2414 if (gethostname (&iconidentity
[sizeof (ICONTAG
) - 1],
2415 (MAXICID
- 1) - sizeof (ICONTAG
)))
2416 iconidentity
[sizeof (ICONTAG
) - 2] = '\0';
2417 f
->name
= build_string (iconidentity
);
2419 /* Extract some window parameters from the supplied values.
2420 These are the parameters that affect window geometry. */
2422 tem
= x_get_arg (parms
, Qfont
, "BodyFont", 0, string
);
2423 if (EQ (tem
, Qunbound
))
2424 tem
= build_string ("9x15");
2425 x_set_font (f
, tem
, Qnil
);
2426 x_default_parameter (f
, parms
, Qborder_color
,
2427 build_string ("black"), "Border", 0, string
);
2428 x_default_parameter (f
, parms
, Qbackground_color
,
2429 build_string ("white"), "Background", 0, string
);
2430 x_default_parameter (f
, parms
, Qforeground_color
,
2431 build_string ("black"), "Foreground", 0, string
);
2432 x_default_parameter (f
, parms
, Qmouse_color
,
2433 build_string ("black"), "Mouse", 0, string
);
2434 x_default_parameter (f
, parms
, Qcursor_color
,
2435 build_string ("black"), "Cursor", 0, string
);
2436 x_default_parameter (f
, parms
, Qborder_width
,
2437 make_number (2), "BorderWidth", 0, number
);
2438 x_default_parameter (f
, parms
, Qinternal_border_width
,
2439 make_number (4), "InternalBorderWidth", 0, number
);
2440 x_default_parameter (f
, parms
, Qauto_raise
,
2441 Qnil
, "AutoRaise", 0, boolean
);
2443 hscroll
= EQ (x_get_arg (parms
, Qhorizontal_scroll_bar
, 0, 0, boolean
), Qt
);
2444 vscroll
= EQ (x_get_arg (parms
, Qvertical_scroll_bar
, 0, 0, boolean
), Qt
);
2446 if (f
->display
.x
->internal_border_width
< 0)
2447 f
->display
.x
->internal_border_width
= 0;
2449 tem
= x_get_arg (parms
, Qwindow_id
, 0, 0, number
);
2450 if (!EQ (tem
, Qunbound
))
2452 WINDOWINFO_TYPE wininfo
;
2454 Window
*children
, root
;
2456 CHECK_NUMBER (tem
, 0);
2457 FRAME_X_WINDOW (f
) = (Window
) XINT (tem
);
2460 XGetWindowInfo (FRAME_X_WINDOW (f
), &wininfo
);
2461 XQueryTree (FRAME_X_WINDOW (f
), &parent
, &nchildren
, &children
);
2465 height
= PIXEL_TO_CHAR_HEIGHT (f
, wininfo
.height
);
2466 width
= PIXEL_TO_CHAR_WIDTH (f
, wininfo
.width
);
2467 f
->display
.x
->left_pos
= wininfo
.x
;
2468 f
->display
.x
->top_pos
= wininfo
.y
;
2469 FRAME_SET_VISIBILITY (f
, wininfo
.mapped
!= 0);
2470 f
->display
.x
->border_width
= wininfo
.bdrwidth
;
2471 f
->display
.x
->parent_desc
= parent
;
2475 tem
= x_get_arg (parms
, Qparent_id
, 0, 0, number
);
2476 if (!EQ (tem
, Qunbound
))
2478 CHECK_NUMBER (tem
, 0);
2479 parent
= (Window
) XINT (tem
);
2481 f
->display
.x
->parent_desc
= parent
;
2482 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2483 if (EQ (tem
, Qunbound
))
2485 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2486 if (EQ (tem
, Qunbound
))
2488 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2489 if (EQ (tem
, Qunbound
))
2490 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2493 /* Now TEM is Qunbound if no edge or size was specified.
2494 In that case, we must do rubber-banding. */
2495 if (EQ (tem
, Qunbound
))
2497 tem
= x_get_arg (parms
, Qgeometry
, 0, 0, number
);
2499 &f
->display
.x
->left_pos
, &f
->display
.x
->top_pos
,
2501 (XTYPE (tem
) == Lisp_String
2502 ? (char *) XSTRING (tem
)->data
: ""),
2503 XSTRING (f
->name
)->data
,
2504 !NILP (hscroll
), !NILP (vscroll
));
2508 /* Here if at least one edge or size was specified.
2509 Demand that they all were specified, and use them. */
2510 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2511 if (EQ (tem
, Qunbound
))
2512 error ("Height not specified");
2513 CHECK_NUMBER (tem
, 0);
2514 height
= XINT (tem
);
2516 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2517 if (EQ (tem
, Qunbound
))
2518 error ("Width not specified");
2519 CHECK_NUMBER (tem
, 0);
2522 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2523 if (EQ (tem
, Qunbound
))
2524 error ("Top position not specified");
2525 CHECK_NUMBER (tem
, 0);
2526 f
->display
.x
->left_pos
= XINT (tem
);
2528 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2529 if (EQ (tem
, Qunbound
))
2530 error ("Left position not specified");
2531 CHECK_NUMBER (tem
, 0);
2532 f
->display
.x
->top_pos
= XINT (tem
);
2535 pixelwidth
= CHAR_TO_PIXEL_WIDTH (f
, width
);
2536 pixelheight
= CHAR_TO_PIXEL_HEIGHT (f
, height
);
2540 = XCreateWindow (parent
,
2541 f
->display
.x
->left_pos
, /* Absolute horizontal offset */
2542 f
->display
.x
->top_pos
, /* Absolute Vertical offset */
2543 pixelwidth
, pixelheight
,
2544 f
->display
.x
->border_width
,
2545 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
2547 if (FRAME_X_WINDOW (f
) == 0)
2548 error ("Unable to create window.");
2551 /* Install the now determined height and width
2552 in the windows and in phys_lines and desired_lines. */
2553 change_frame_size (f
, height
, width
, 1, 0);
2554 XSelectInput (FRAME_X_WINDOW (f
), KeyPressed
| ExposeWindow
2555 | ButtonPressed
| ButtonReleased
| ExposeRegion
| ExposeCopy
2556 | EnterWindow
| LeaveWindow
| UnmapWindow
);
2557 x_set_resize_hint (f
);
2559 /* Tell the server the window's default name. */
2560 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
), XSTRING (f
->name
)->data
);
2562 /* Now override the defaults with all the rest of the specified
2564 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2565 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2567 /* Do not create an icon window if the caller says not to */
2568 if (!EQ (x_get_arg (parms
, Qsuppress_icon
, 0, 0, boolean
), Qt
)
2569 || f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2571 x_text_icon (f
, iconidentity
);
2572 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2573 "BitmapIcon", 0, symbol
);
2576 /* Tell the X server the previously set values of the
2577 background, border and mouse colors; also create the mouse cursor. */
2579 temp
= XMakeTile (f
->display
.x
->background_pixel
);
2580 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
2583 x_set_border_pixel (f
, f
->display
.x
->border_pixel
);
2585 x_set_mouse_color (f
, Qnil
, Qnil
);
2587 /* Now override the defaults with all the rest of the specified parms. */
2589 Fmodify_frame_parameters (frame
, parms
);
2591 /* Make the window appear on the frame and enable display. */
2593 Lisp_Object visibility
;
2595 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2596 if (EQ (visibility
, Qunbound
))
2599 if (! EQ (visibility
, Qicon
)
2600 && ! NILP (visibility
))
2601 x_make_window_visible (f
);
2604 SET_FRAME_GARBAGED (f
);
2606 Vframe_list
= Fcons (frame
, Vframe_list
);
2612 x_get_focus_frame ()
2615 if (! x_focus_frame
)
2618 XSET (xfocus
, Lisp_Frame
, x_focus_frame
);
2622 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
2623 "Set the focus on FRAME.")
2627 CHECK_LIVE_FRAME (frame
, 0);
2629 if (FRAME_X_P (XFRAME (frame
)))
2632 x_focus_on_frame (XFRAME (frame
));
2640 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
2641 "If a frame has been focused, release it.")
2647 x_unfocus_frame (x_focus_frame
);
2655 /* Computes an X-window size and position either from geometry GEO
2658 F is a frame. It specifies an X window which is used to
2659 determine which display to compute for. Its font, borders
2660 and colors control how the rectangle will be displayed.
2662 X and Y are where to store the positions chosen.
2663 WIDTH and HEIGHT are where to store the sizes chosen.
2665 GEO is the geometry that may specify some of the info.
2666 STR is a prompt to display.
2667 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2670 x_rubber_band (f
, x
, y
, width
, height
, geo
, str
, hscroll
, vscroll
)
2672 int *x
, *y
, *width
, *height
;
2675 int hscroll
, vscroll
;
2681 int background_color
;
2687 background_color
= f
->display
.x
->background_pixel
;
2688 border_color
= f
->display
.x
->border_pixel
;
2690 frame
.bdrwidth
= f
->display
.x
->border_width
;
2691 frame
.border
= XMakeTile (border_color
);
2692 frame
.background
= XMakeTile (background_color
);
2693 tempwindow
= XCreateTerm (str
, "emacs", geo
, default_window
, &frame
, 10, 5,
2694 (2 * f
->display
.x
->internal_border_width
2695 + (vscroll
? VSCROLL_WIDTH
: 0)),
2696 (2 * f
->display
.x
->internal_border_width
2697 + (hscroll
? HSCROLL_HEIGHT
: 0)),
2698 width
, height
, f
->display
.x
->font
,
2699 FONT_WIDTH (f
->display
.x
->font
),
2700 f
->display
.x
->line_height
);
2701 XFreePixmap (frame
.border
);
2702 XFreePixmap (frame
.background
);
2704 if (tempwindow
!= 0)
2706 XQueryWindow (tempwindow
, &wininfo
);
2707 XDestroyWindow (tempwindow
);
2712 /* Coordinates we got are relative to the root window.
2713 Convert them to coordinates relative to desired parent window
2714 by scanning from there up to the root. */
2715 tempwindow
= f
->display
.x
->parent_desc
;
2716 while (tempwindow
!= ROOT_WINDOW
)
2720 XQueryWindow (tempwindow
, &wininfo
);
2723 XQueryTree (tempwindow
, &tempwindow
, &nchildren
, &children
);
2728 return tempwindow
!= 0;
2730 #endif /* not HAVE_X11 */
2732 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
2733 "Return a list of the names of available fonts matching PATTERN.\n\
2734 If optional arguments FACE and FRAME are specified, return only fonts\n\
2735 the same size as FACE on FRAME.\n\
2737 PATTERN is a string, perhaps with wildcard characters;\n\
2738 the * character matches any substring, and\n\
2739 the ? character matches any single character.\n\
2740 PATTERN is case-insensitive.\n\
2741 FACE is a face name - a symbol.\n\
2743 The return value is a list of strings, suitable as arguments to\n\
2746 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
2747 even if they match PATTERN and FACE.")
2748 (pattern
, face
, frame
)
2749 Lisp_Object pattern
, face
, frame
;
2754 XFontStruct
*size_ref
;
2758 CHECK_STRING (pattern
, 0);
2760 CHECK_SYMBOL (face
, 1);
2762 CHECK_LIVE_FRAME (frame
, 2);
2768 FRAME_PTR f
= NILP (frame
) ? selected_frame
: XFRAME (frame
);
2771 /* Don't die if we get called with a terminal frame. */
2772 if (! FRAME_X_P (f
))
2773 error ("non-X frame used in `x-list-fonts'");
2775 face_id
= face_name_id_number (f
, face
);
2777 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
2778 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
2779 size_ref
= f
->display
.x
->font
;
2782 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
2783 if (size_ref
== (XFontStruct
*) (~0))
2784 size_ref
= f
->display
.x
->font
;
2790 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
2791 #ifdef BROKEN_XLISTFONTSWITHINFO
2792 names
= XListFonts (x_current_display
,
2793 XSTRING (pattern
)->data
,
2794 2000, /* maxnames */
2795 &num_fonts
); /* count_return */
2797 names
= XListFontsWithInfo (x_current_display
,
2798 XSTRING (pattern
)->data
,
2799 2000, /* maxnames */
2800 &num_fonts
, /* count_return */
2801 &info
); /* info_return */
2813 for (i
= 0; i
< num_fonts
; i
++)
2815 XFontStruct
*thisinfo
;
2817 #ifdef BROKEN_XLISTFONTSWITHINFO
2819 thisinfo
= XLoadQueryFont (x_current_display
, names
[i
]);
2822 thisinfo
= &info
[i
];
2824 if (thisinfo
&& (! size_ref
2825 || same_size_fonts (thisinfo
, size_ref
)))
2827 *tail
= Fcons (build_string (names
[i
]), Qnil
);
2828 tail
= &XCONS (*tail
)->cdr
;
2833 #ifdef BROKEN_XLISTFONTSWITHINFO
2834 XFreeFontNames (names
);
2836 XFreeFontInfo (names
, info
, num_fonts
);
2845 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 1, 0,
2846 "Return t if the current X display supports the color named COLOR.")
2853 CHECK_STRING (color
, 0);
2855 if (defined_color (XSTRING (color
)->data
, &foo
))
2861 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 0, 0,
2862 "Return t if the X screen currently in use supports color.")
2867 if (x_screen_planes
<= 2)
2870 switch (screen_visual
->class)
2883 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
2885 "Returns the width in pixels of the display FRAME is on.")
2889 Display
*dpy
= x_current_display
;
2891 return make_number (DisplayWidth (dpy
, DefaultScreen (dpy
)));
2894 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
2895 Sx_display_pixel_height
, 0, 1, 0,
2896 "Returns the height in pixels of the display FRAME is on.")
2900 Display
*dpy
= x_current_display
;
2902 return make_number (DisplayHeight (dpy
, DefaultScreen (dpy
)));
2905 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
2907 "Returns the number of bitplanes of the display FRAME is on.")
2911 Display
*dpy
= x_current_display
;
2913 return make_number (DisplayPlanes (dpy
, DefaultScreen (dpy
)));
2916 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
2918 "Returns the number of color cells of the display FRAME is on.")
2922 Display
*dpy
= x_current_display
;
2924 return make_number (DisplayCells (dpy
, DefaultScreen (dpy
)));
2927 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
2928 Sx_server_max_request_size
,
2930 "Returns the maximum request size of the X server FRAME is using.")
2934 Display
*dpy
= x_current_display
;
2936 return make_number (MAXREQUEST (dpy
));
2939 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
2940 "Returns the vendor ID string of the X server FRAME is on.")
2944 Display
*dpy
= x_current_display
;
2947 vendor
= ServerVendor (dpy
);
2948 if (! vendor
) vendor
= "";
2949 return build_string (vendor
);
2952 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
2953 "Returns the version numbers of the X server in use.\n\
2954 The value is a list of three integers: the major and minor\n\
2955 version numbers of the X Protocol in use, and the vendor-specific release\n\
2956 number. See also the variable `x-server-vendor'.")
2960 Display
*dpy
= x_current_display
;
2963 return Fcons (make_number (ProtocolVersion (dpy
)),
2964 Fcons (make_number (ProtocolRevision (dpy
)),
2965 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
2968 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
2969 "Returns the number of screens on the X server FRAME is on.")
2974 return make_number (ScreenCount (x_current_display
));
2977 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
2978 "Returns the height in millimeters of the X screen FRAME is on.")
2983 return make_number (HeightMMOfScreen (x_screen
));
2986 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
2987 "Returns the width in millimeters of the X screen FRAME is on.")
2992 return make_number (WidthMMOfScreen (x_screen
));
2995 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
2996 Sx_display_backing_store
, 0, 1, 0,
2997 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2998 The value may be `always', `when-mapped', or `not-useful'.")
3004 switch (DoesBackingStore (x_screen
))
3007 return intern ("always");
3010 return intern ("when-mapped");
3013 return intern ("not-useful");
3016 error ("Strange value for BackingStore parameter of screen");
3020 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
3021 Sx_display_visual_class
, 0, 1, 0,
3022 "Returns the visual class of the display `screen' is on.\n\
3023 The value is one of the symbols `static-gray', `gray-scale',\n\
3024 `static-color', `pseudo-color', `true-color', or `direct-color'.")
3030 switch (screen_visual
->class)
3032 case StaticGray
: return (intern ("static-gray"));
3033 case GrayScale
: return (intern ("gray-scale"));
3034 case StaticColor
: return (intern ("static-color"));
3035 case PseudoColor
: return (intern ("pseudo-color"));
3036 case TrueColor
: return (intern ("true-color"));
3037 case DirectColor
: return (intern ("direct-color"));
3039 error ("Display has an unknown visual class");
3043 DEFUN ("x-display-save-under", Fx_display_save_under
,
3044 Sx_display_save_under
, 0, 1, 0,
3045 "Returns t if the X screen FRAME is on supports the save-under feature.")
3051 if (DoesSaveUnders (x_screen
) == True
)
3058 register struct frame
*f
;
3060 return PIXEL_WIDTH (f
);
3064 register struct frame
*f
;
3066 return PIXEL_HEIGHT (f
);
3070 register struct frame
*f
;
3072 return FONT_WIDTH (f
->display
.x
->font
);
3076 register struct frame
*f
;
3078 return f
->display
.x
->line_height
;
3081 #if 0 /* These no longer seem like the right way to do things. */
3083 /* Draw a rectangle on the frame with left top corner including
3084 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3085 CHARS by LINES wide and long and is the color of the cursor. */
3088 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
3089 register struct frame
*f
;
3091 register int top_char
, left_char
, chars
, lines
;
3095 int left
= (left_char
* FONT_WIDTH (f
->display
.x
->font
)
3096 + f
->display
.x
->internal_border_width
);
3097 int top
= (top_char
* f
->display
.x
->line_height
3098 + f
->display
.x
->internal_border_width
);
3101 width
= FONT_WIDTH (f
->display
.x
->font
) / 2;
3103 width
= FONT_WIDTH (f
->display
.x
->font
) * chars
;
3105 height
= f
->display
.x
->line_height
/ 2;
3107 height
= f
->display
.x
->line_height
* lines
;
3109 XDrawRectangle (x_current_display
, FRAME_X_WINDOW (f
),
3110 gc
, left
, top
, width
, height
);
3113 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
3114 "Draw a rectangle on FRAME between coordinates specified by\n\
3115 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3116 (frame
, X0
, Y0
, X1
, Y1
)
3117 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
3119 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3121 CHECK_LIVE_FRAME (frame
, 0);
3122 CHECK_NUMBER (X0
, 0);
3123 CHECK_NUMBER (Y0
, 1);
3124 CHECK_NUMBER (X1
, 2);
3125 CHECK_NUMBER (Y1
, 3);
3135 n_lines
= y1
- y0
+ 1;
3140 n_lines
= y0
- y1
+ 1;
3146 n_chars
= x1
- x0
+ 1;
3151 n_chars
= x0
- x1
+ 1;
3155 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->cursor_gc
,
3156 left
, top
, n_chars
, n_lines
);
3162 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
3163 "Draw a rectangle drawn on FRAME between coordinates\n\
3164 X0, Y0, X1, Y1 in the regular background-pixel.")
3165 (frame
, X0
, Y0
, X1
, Y1
)
3166 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
3168 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3170 CHECK_FRAME (frame
, 0);
3171 CHECK_NUMBER (X0
, 0);
3172 CHECK_NUMBER (Y0
, 1);
3173 CHECK_NUMBER (X1
, 2);
3174 CHECK_NUMBER (Y1
, 3);
3184 n_lines
= y1
- y0
+ 1;
3189 n_lines
= y0
- y1
+ 1;
3195 n_chars
= x1
- x0
+ 1;
3200 n_chars
= x0
- x1
+ 1;
3204 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->reverse_gc
,
3205 left
, top
, n_chars
, n_lines
);
3211 /* Draw lines around the text region beginning at the character position
3212 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3213 pixel and line characteristics. */
3215 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3218 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
3219 register struct frame
*f
;
3221 int top_x
, top_y
, bottom_x
, bottom_y
;
3223 register int ibw
= f
->display
.x
->internal_border_width
;
3224 register int font_w
= FONT_WIDTH (f
->display
.x
->font
);
3225 register int font_h
= f
->display
.x
->line_height
;
3227 int x
= line_len (y
);
3228 XPoint
*pixel_points
3229 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
3230 register XPoint
*this_point
= pixel_points
;
3232 /* Do the horizontal top line/lines */
3235 this_point
->x
= ibw
;
3236 this_point
->y
= ibw
+ (font_h
* top_y
);
3239 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
3241 this_point
->x
= ibw
+ (font_w
* x
);
3242 this_point
->y
= (this_point
- 1)->y
;
3246 this_point
->x
= ibw
;
3247 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
3249 this_point
->x
= ibw
+ (font_w
* top_x
);
3250 this_point
->y
= (this_point
- 1)->y
;
3252 this_point
->x
= (this_point
- 1)->x
;
3253 this_point
->y
= ibw
+ (font_h
* top_y
);
3255 this_point
->x
= ibw
+ (font_w
* x
);
3256 this_point
->y
= (this_point
- 1)->y
;
3259 /* Now do the right side. */
3260 while (y
< bottom_y
)
3261 { /* Right vertical edge */
3263 this_point
->x
= (this_point
- 1)->x
;
3264 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
3267 y
++; /* Horizontal connection to next line */
3270 this_point
->x
= ibw
+ (font_w
/ 2);
3272 this_point
->x
= ibw
+ (font_w
* x
);
3274 this_point
->y
= (this_point
- 1)->y
;
3277 /* Now do the bottom and connect to the top left point. */
3278 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
3281 this_point
->x
= (this_point
- 1)->x
;
3282 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
3284 this_point
->x
= ibw
;
3285 this_point
->y
= (this_point
- 1)->y
;
3287 this_point
->x
= pixel_points
->x
;
3288 this_point
->y
= pixel_points
->y
;
3290 XDrawLines (x_current_display
, FRAME_X_WINDOW (f
),
3292 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
3295 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
3296 "Highlight the region between point and the character under the mouse\n\
3299 register Lisp_Object event
;
3301 register int x0
, y0
, x1
, y1
;
3302 register struct frame
*f
= selected_frame
;
3303 register int p1
, p2
;
3305 CHECK_CONS (event
, 0);
3308 x0
= XINT (Fcar (Fcar (event
)));
3309 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3311 /* If the mouse is past the end of the line, don't that area. */
3312 /* ReWrite this... */
3317 if (y1
> y0
) /* point below mouse */
3318 outline_region (f
, f
->display
.x
->cursor_gc
,
3320 else if (y1
< y0
) /* point above mouse */
3321 outline_region (f
, f
->display
.x
->cursor_gc
,
3323 else /* same line: draw horizontal rectangle */
3326 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3327 x0
, y0
, (x1
- x0
+ 1), 1);
3329 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3330 x1
, y1
, (x0
- x1
+ 1), 1);
3333 XFlush (x_current_display
);
3339 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
3340 "Erase any highlighting of the region between point and the character\n\
3341 at X, Y on the selected frame.")
3343 register Lisp_Object event
;
3345 register int x0
, y0
, x1
, y1
;
3346 register struct frame
*f
= selected_frame
;
3349 x0
= XINT (Fcar (Fcar (event
)));
3350 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3354 if (y1
> y0
) /* point below mouse */
3355 outline_region (f
, f
->display
.x
->reverse_gc
,
3357 else if (y1
< y0
) /* point above mouse */
3358 outline_region (f
, f
->display
.x
->reverse_gc
,
3360 else /* same line: draw horizontal rectangle */
3363 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3364 x0
, y0
, (x1
- x0
+ 1), 1);
3366 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3367 x1
, y1
, (x0
- x1
+ 1), 1);
3375 int contour_begin_x
, contour_begin_y
;
3376 int contour_end_x
, contour_end_y
;
3377 int contour_npoints
;
3379 /* Clip the top part of the contour lines down (and including) line Y_POS.
3380 If X_POS is in the middle (rather than at the end) of the line, drop
3381 down a line at that character. */
3384 clip_contour_top (y_pos
, x_pos
)
3386 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
3387 register XPoint
*end
;
3388 register int npoints
;
3389 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
3391 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
3393 end
= contour_lines
[y_pos
].top_right
;
3394 npoints
= (end
- begin
+ 1);
3395 XDrawLines (x_current_display
, contour_window
,
3396 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3398 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
3399 contour_last_point
-= (npoints
- 2);
3400 XDrawLines (x_current_display
, contour_window
,
3401 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
3402 XFlush (x_current_display
);
3404 /* Now, update contour_lines structure. */
3409 register XPoint
*p
= begin
+ 1;
3410 end
= contour_lines
[y_pos
].bottom_right
;
3411 npoints
= (end
- begin
+ 1);
3412 XDrawLines (x_current_display
, contour_window
,
3413 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3416 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
3418 p
->y
= begin
->y
+ font_h
;
3420 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
3421 contour_last_point
-= (npoints
- 5);
3422 XDrawLines (x_current_display
, contour_window
,
3423 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
3424 XFlush (x_current_display
);
3426 /* Now, update contour_lines structure. */
3430 /* Erase the top horizontal lines of the contour, and then extend
3431 the contour upwards. */
3434 extend_contour_top (line
)
3439 clip_contour_bottom (x_pos
, y_pos
)
3445 extend_contour_bottom (x_pos
, y_pos
)
3449 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
3454 register struct frame
*f
= selected_frame
;
3455 register int point_x
= f
->cursor_x
;
3456 register int point_y
= f
->cursor_y
;
3457 register int mouse_below_point
;
3458 register Lisp_Object obj
;
3459 register int x_contour_x
, x_contour_y
;
3461 x_contour_x
= x_mouse_x
;
3462 x_contour_y
= x_mouse_y
;
3463 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
3464 && x_contour_x
> point_x
))
3466 mouse_below_point
= 1;
3467 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3468 x_contour_x
, x_contour_y
);
3472 mouse_below_point
= 0;
3473 outline_region (f
, f
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
3479 obj
= read_char (-1, 0, 0, Qnil
, 0);
3480 if (XTYPE (obj
) != Lisp_Cons
)
3483 if (mouse_below_point
)
3485 if (x_mouse_y
<= point_y
) /* Flipped. */
3487 mouse_below_point
= 0;
3489 outline_region (f
, f
->display
.x
->reverse_gc
, point_x
, point_y
,
3490 x_contour_x
, x_contour_y
);
3491 outline_region (f
, f
->display
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
3494 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
3496 clip_contour_bottom (x_mouse_y
);
3498 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
3500 extend_bottom_contour (x_mouse_y
);
3503 x_contour_x
= x_mouse_x
;
3504 x_contour_y
= x_mouse_y
;
3506 else /* mouse above or same line as point */
3508 if (x_mouse_y
>= point_y
) /* Flipped. */
3510 mouse_below_point
= 1;
3512 outline_region (f
, f
->display
.x
->reverse_gc
,
3513 x_contour_x
, x_contour_y
, point_x
, point_y
);
3514 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3515 x_mouse_x
, x_mouse_y
);
3517 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
3519 clip_contour_top (x_mouse_y
);
3521 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
3523 extend_contour_top (x_mouse_y
);
3528 unread_command_event
= obj
;
3529 if (mouse_below_point
)
3531 contour_begin_x
= point_x
;
3532 contour_begin_y
= point_y
;
3533 contour_end_x
= x_contour_x
;
3534 contour_end_y
= x_contour_y
;
3538 contour_begin_x
= x_contour_x
;
3539 contour_begin_y
= x_contour_y
;
3540 contour_end_x
= point_x
;
3541 contour_end_y
= point_y
;
3546 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
3551 register Lisp_Object obj
;
3552 struct frame
*f
= selected_frame
;
3553 register struct window
*w
= XWINDOW (selected_window
);
3554 register GC line_gc
= f
->display
.x
->cursor_gc
;
3555 register GC erase_gc
= f
->display
.x
->reverse_gc
;
3557 char dash_list
[] = {6, 4, 6, 4};
3559 XGCValues gc_values
;
3561 register int previous_y
;
3562 register int line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3563 + f
->display
.x
->internal_border_width
;
3564 register int left
= f
->display
.x
->internal_border_width
3566 * FONT_WIDTH (f
->display
.x
->font
));
3567 register int right
= left
+ (w
->width
3568 * FONT_WIDTH (f
->display
.x
->font
))
3569 - f
->display
.x
->internal_border_width
;
3573 gc_values
.foreground
= f
->display
.x
->cursor_pixel
;
3574 gc_values
.background
= f
->display
.x
->background_pixel
;
3575 gc_values
.line_width
= 1;
3576 gc_values
.line_style
= LineOnOffDash
;
3577 gc_values
.cap_style
= CapRound
;
3578 gc_values
.join_style
= JoinRound
;
3580 line_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3581 GCLineStyle
| GCJoinStyle
| GCCapStyle
3582 | GCLineWidth
| GCForeground
| GCBackground
,
3584 XSetDashes (x_current_display
, line_gc
, 0, dash_list
, dashes
);
3585 gc_values
.foreground
= f
->display
.x
->background_pixel
;
3586 gc_values
.background
= f
->display
.x
->foreground_pixel
;
3587 erase_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3588 GCLineStyle
| GCJoinStyle
| GCCapStyle
3589 | GCLineWidth
| GCForeground
| GCBackground
,
3591 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
3597 if (x_mouse_y
>= XINT (w
->top
)
3598 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
3600 previous_y
= x_mouse_y
;
3601 line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3602 + f
->display
.x
->internal_border_width
;
3603 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3604 line_gc
, left
, line
, right
, line
);
3611 obj
= read_char (-1, 0, 0, Qnil
, 0);
3612 if ((XTYPE (obj
) != Lisp_Cons
)
3613 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3614 Qvertical_scroll_bar
))
3618 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3619 erase_gc
, left
, line
, right
, line
);
3621 unread_command_event
= obj
;
3623 XFreeGC (x_current_display
, line_gc
);
3624 XFreeGC (x_current_display
, erase_gc
);
3629 while (x_mouse_y
== previous_y
);
3632 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3633 erase_gc
, left
, line
, right
, line
);
3639 /* Offset in buffer of character under the pointer, or 0. */
3640 int mouse_buffer_offset
;
3643 /* These keep track of the rectangle following the pointer. */
3644 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
3646 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
3647 "Track the pointer.")
3650 static Cursor current_pointer_shape
;
3651 FRAME_PTR f
= x_mouse_frame
;
3654 if (EQ (Vmouse_frame_part
, Qtext_part
)
3655 && (current_pointer_shape
!= f
->display
.x
->nontext_cursor
))
3660 current_pointer_shape
= f
->display
.x
->nontext_cursor
;
3661 XDefineCursor (x_current_display
,
3663 current_pointer_shape
);
3665 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
3666 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
3668 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
3669 && (current_pointer_shape
!= f
->display
.x
->modeline_cursor
))
3671 current_pointer_shape
= f
->display
.x
->modeline_cursor
;
3672 XDefineCursor (x_current_display
,
3674 current_pointer_shape
);
3683 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
3684 "Draw rectangle around character under mouse pointer, if there is one.")
3688 struct window
*w
= XWINDOW (Vmouse_window
);
3689 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
3690 struct buffer
*b
= XBUFFER (w
->buffer
);
3693 if (! EQ (Vmouse_window
, selected_window
))
3696 if (EQ (event
, Qnil
))
3700 x_read_mouse_position (selected_frame
, &x
, &y
);
3704 mouse_track_width
= 0;
3705 mouse_track_left
= mouse_track_top
= -1;
3709 if ((x_mouse_x
!= mouse_track_left
3710 && (x_mouse_x
< mouse_track_left
3711 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
3712 || x_mouse_y
!= mouse_track_top
)
3714 int hp
= 0; /* Horizontal position */
3715 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
3716 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
3717 int tab_width
= XINT (b
->tab_width
);
3718 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
3720 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
3721 int in_mode_line
= 0;
3723 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
3726 /* Erase previous rectangle. */
3727 if (mouse_track_width
)
3729 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3730 mouse_track_left
, mouse_track_top
,
3731 mouse_track_width
, 1);
3733 if ((mouse_track_left
== f
->phys_cursor_x
3734 || mouse_track_left
== f
->phys_cursor_x
- 1)
3735 && mouse_track_top
== f
->phys_cursor_y
)
3737 x_display_cursor (f
, 1);
3741 mouse_track_left
= x_mouse_x
;
3742 mouse_track_top
= x_mouse_y
;
3743 mouse_track_width
= 0;
3745 if (mouse_track_left
> len
) /* Past the end of line. */
3748 if (mouse_track_top
== mode_line_vpos
)
3754 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3758 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
3764 mouse_track_width
= tab_width
- (hp
% tab_width
);
3766 hp
+= mouse_track_width
;
3769 mouse_track_left
= hp
- mouse_track_width
;
3775 mouse_track_width
= -1;
3779 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3784 mouse_track_width
= 2;
3789 mouse_track_left
= hp
- mouse_track_width
;
3795 mouse_track_width
= 1;
3802 while (hp
<= x_mouse_x
);
3805 if (mouse_track_width
) /* Over text; use text pointer shape. */
3807 XDefineCursor (x_current_display
,
3809 f
->display
.x
->text_cursor
);
3810 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3811 mouse_track_left
, mouse_track_top
,
3812 mouse_track_width
, 1);
3814 else if (in_mode_line
)
3815 XDefineCursor (x_current_display
,
3817 f
->display
.x
->modeline_cursor
);
3819 XDefineCursor (x_current_display
,
3821 f
->display
.x
->nontext_cursor
);
3824 XFlush (x_current_display
);
3827 obj
= read_char (-1, 0, 0, Qnil
, 0);
3830 while (XTYPE (obj
) == Lisp_Cons
/* Mouse event */
3831 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
3832 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
3833 && EQ (Vmouse_window
, selected_window
) /* In this window */
3836 unread_command_event
= obj
;
3838 if (mouse_track_width
)
3840 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3841 mouse_track_left
, mouse_track_top
,
3842 mouse_track_width
, 1);
3843 mouse_track_width
= 0;
3844 if ((mouse_track_left
== f
->phys_cursor_x
3845 || mouse_track_left
- 1 == f
->phys_cursor_x
)
3846 && mouse_track_top
== f
->phys_cursor_y
)
3848 x_display_cursor (f
, 1);
3851 XDefineCursor (x_current_display
,
3853 f
->display
.x
->nontext_cursor
);
3854 XFlush (x_current_display
);
3864 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3865 on the frame F at position X, Y. */
3867 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
3869 int x
, y
, width
, height
;
3874 image
= XCreateBitmapFromData (x_current_display
,
3875 FRAME_X_WINDOW (f
), image_data
,
3877 XCopyPlane (x_current_display
, image
, FRAME_X_WINDOW (f
),
3878 f
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
3883 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer
, Sx_store_cut_buffer
,
3884 1, 1, "sStore text in cut buffer: ",
3885 "Store contents of STRING into the cut buffer of the X window system.")
3887 register Lisp_Object string
;
3891 CHECK_STRING (string
, 1);
3892 if (! FRAME_X_P (selected_frame
))
3893 error ("Selected frame does not understand X protocol.");
3896 XStoreBytes ((char *) XSTRING (string
)->data
, XSTRING (string
)->size
);
3902 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer
, Sx_get_cut_buffer
, 0, 0, 0,
3903 "Return contents of cut buffer of the X window system, as a string.")
3907 register Lisp_Object string
;
3912 d
= XFetchBytes (&len
);
3913 string
= make_string (d
, len
);
3920 #if 0 /* I'm told these functions are superfluous
3921 given the ability to bind function keys. */
3924 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3925 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3926 KEYSYM is a string which conforms to the X keysym definitions found\n\
3927 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3928 list of strings specifying modifier keys such as Control_L, which must\n\
3929 also be depressed for NEWSTRING to appear.")
3930 (x_keysym
, modifiers
, newstring
)
3931 register Lisp_Object x_keysym
;
3932 register Lisp_Object modifiers
;
3933 register Lisp_Object newstring
;
3936 register KeySym keysym
;
3937 KeySym modifier_list
[16];
3940 CHECK_STRING (x_keysym
, 1);
3941 CHECK_STRING (newstring
, 3);
3943 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
3944 if (keysym
== NoSymbol
)
3945 error ("Keysym does not exist");
3947 if (NILP (modifiers
))
3948 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
3949 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3952 register Lisp_Object rest
, mod
;
3955 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
3958 error ("Can't have more than 16 modifiers");
3961 CHECK_STRING (mod
, 3);
3962 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
3964 if (modifier_list
[i
] == NoSymbol
3965 || !(IsModifierKey (modifier_list
[i
])
3966 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
3967 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
3969 if (modifier_list
[i
] == NoSymbol
3970 || !IsModifierKey (modifier_list
[i
]))
3972 error ("Element is not a modifier keysym");
3976 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
3977 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3983 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
3984 "Rebind KEYCODE to list of strings STRINGS.\n\
3985 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3986 nil as element means don't change.\n\
3987 See the documentation of `x-rebind-key' for more information.")
3989 register Lisp_Object keycode
;
3990 register Lisp_Object strings
;
3992 register Lisp_Object item
;
3993 register unsigned char *rawstring
;
3994 KeySym rawkey
, modifier
[1];
3996 register unsigned i
;
3999 CHECK_NUMBER (keycode
, 1);
4000 CHECK_CONS (strings
, 2);
4001 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
4002 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
4004 item
= Fcar (strings
);
4007 CHECK_STRING (item
, 2);
4008 strsize
= XSTRING (item
)->size
;
4009 rawstring
= (unsigned char *) xmalloc (strsize
);
4010 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
4011 modifier
[1] = 1 << i
;
4012 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
4013 rawstring
, strsize
);
4018 #endif /* HAVE_X11 */
4023 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4025 XScreenNumberOfScreen (scr
)
4026 register Screen
*scr
;
4028 register Display
*dpy
;
4029 register Screen
*dpyscr
;
4033 dpyscr
= dpy
->screens
;
4035 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
4041 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4044 select_visual (screen
, depth
)
4046 unsigned int *depth
;
4049 XVisualInfo
*vinfo
, vinfo_template
;
4052 v
= DefaultVisualOfScreen (screen
);
4055 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
4057 vinfo_template
.visualid
= v
->visualid
;
4060 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4062 vinfo
= XGetVisualInfo (x_current_display
,
4063 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
4066 fatal ("Can't get proper X visual info");
4068 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
4069 *depth
= vinfo
->depth
;
4073 int n
= vinfo
->colormap_size
- 1;
4082 XFree ((char *) vinfo
);
4085 #endif /* HAVE_X11 */
4087 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4088 1, 2, 0, "Open a connection to an X server.\n\
4089 DISPLAY is the name of the display to connect to.\n\
4090 Optional second arg XRM_STRING is a string of resources in xrdb format.")
4091 (display
, xrm_string
)
4092 Lisp_Object display
, xrm_string
;
4094 unsigned int n_planes
;
4095 unsigned char *xrm_option
;
4097 CHECK_STRING (display
, 0);
4098 if (x_current_display
!= 0)
4099 error ("X server connection is already initialized");
4100 if (! NILP (xrm_string
))
4101 CHECK_STRING (xrm_string
, 1);
4103 /* This is what opens the connection and sets x_current_display.
4104 This also initializes many symbols, such as those used for input. */
4105 x_term_init (XSTRING (display
)->data
);
4108 XFASTINT (Vwindow_system_version
) = 11;
4110 if (! NILP (xrm_string
))
4111 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4113 xrm_option
= (unsigned char *) 0;
4115 validate_x_resource_name ();
4118 xrdb
= x_load_resources (x_current_display
, xrm_option
,
4119 (char *) XSTRING (Vx_resource_name
)->data
,
4122 #ifdef HAVE_XRMSETDATABASE
4123 XrmSetDatabase (x_current_display
, xrdb
);
4125 x_current_display
->db
= xrdb
;
4128 x_screen
= DefaultScreenOfDisplay (x_current_display
);
4130 screen_visual
= select_visual (x_screen
, &n_planes
);
4131 x_screen_planes
= n_planes
;
4132 x_screen_height
= HeightOfScreen (x_screen
);
4133 x_screen_width
= WidthOfScreen (x_screen
);
4135 /* X Atoms used by emacs. */
4136 Xatoms_of_xselect ();
4138 Xatom_wm_protocols
= XInternAtom (x_current_display
, "WM_PROTOCOLS",
4140 Xatom_wm_take_focus
= XInternAtom (x_current_display
, "WM_TAKE_FOCUS",
4142 Xatom_wm_save_yourself
= XInternAtom (x_current_display
, "WM_SAVE_YOURSELF",
4144 Xatom_wm_delete_window
= XInternAtom (x_current_display
, "WM_DELETE_WINDOW",
4146 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
4148 Xatom_wm_configure_denied
= XInternAtom (x_current_display
,
4149 "WM_CONFIGURE_DENIED", False
);
4150 Xatom_wm_window_moved
= XInternAtom (x_current_display
, "WM_MOVED",
4152 Xatom_editres_name
= XInternAtom (x_current_display
, "Editres", False
);
4154 #else /* not HAVE_X11 */
4155 XFASTINT (Vwindow_system_version
) = 10;
4156 #endif /* not HAVE_X11 */
4160 DEFUN ("x-close-current-connection", Fx_close_current_connection
,
4161 Sx_close_current_connection
,
4162 0, 0, 0, "Close the connection to the current X server.")
4165 /* Note: If we're going to call check_x here, then the fatal error
4166 can't happen. For the moment, this check is just for safety,
4167 so a user won't try out the function and get a crash. If it's
4168 really intended only to be called when killing emacs, then there's
4169 no reason for it to have a lisp interface at all. */
4172 /* This is ONLY used when killing emacs; For switching displays
4173 we'll have to take care of setting CloseDownMode elsewhere. */
4175 if (x_current_display
)
4178 XSetCloseDownMode (x_current_display
, DestroyAll
);
4179 XCloseDisplay (x_current_display
);
4180 x_current_display
= 0;
4183 fatal ("No current X display connection to close\n");
4188 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
,
4189 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4190 If ON is nil, allow buffering of requests.\n\
4191 Turning on synchronization prohibits the Xlib routines from buffering\n\
4192 requests and seriously degrades performance, but makes debugging much\n\
4199 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
4204 /* Wait for responses to all X commands issued so far for FRAME. */
4211 XSync (x_current_display
, False
);
4217 /* This is zero if not using X windows. */
4218 x_current_display
= 0;
4220 /* The section below is built by the lisp expression at the top of the file,
4221 just above where these variables are declared. */
4222 /*&&& init symbols here &&&*/
4223 Qauto_raise
= intern ("auto-raise");
4224 staticpro (&Qauto_raise
);
4225 Qauto_lower
= intern ("auto-lower");
4226 staticpro (&Qauto_lower
);
4227 Qbackground_color
= intern ("background-color");
4228 staticpro (&Qbackground_color
);
4229 Qbar
= intern ("bar");
4231 Qborder_color
= intern ("border-color");
4232 staticpro (&Qborder_color
);
4233 Qborder_width
= intern ("border-width");
4234 staticpro (&Qborder_width
);
4235 Qbox
= intern ("box");
4237 Qcursor_color
= intern ("cursor-color");
4238 staticpro (&Qcursor_color
);
4239 Qcursor_type
= intern ("cursor-type");
4240 staticpro (&Qcursor_type
);
4241 Qfont
= intern ("font");
4243 Qforeground_color
= intern ("foreground-color");
4244 staticpro (&Qforeground_color
);
4245 Qgeometry
= intern ("geometry");
4246 staticpro (&Qgeometry
);
4247 Qicon_left
= intern ("icon-left");
4248 staticpro (&Qicon_left
);
4249 Qicon_top
= intern ("icon-top");
4250 staticpro (&Qicon_top
);
4251 Qicon_type
= intern ("icon-type");
4252 staticpro (&Qicon_type
);
4253 Qinternal_border_width
= intern ("internal-border-width");
4254 staticpro (&Qinternal_border_width
);
4255 Qleft
= intern ("left");
4257 Qmouse_color
= intern ("mouse-color");
4258 staticpro (&Qmouse_color
);
4259 Qnone
= intern ("none");
4261 Qparent_id
= intern ("parent-id");
4262 staticpro (&Qparent_id
);
4263 Qsuppress_icon
= intern ("suppress-icon");
4264 staticpro (&Qsuppress_icon
);
4265 Qtop
= intern ("top");
4267 Qundefined_color
= intern ("undefined-color");
4268 staticpro (&Qundefined_color
);
4269 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
4270 staticpro (&Qvertical_scroll_bars
);
4271 Qvisibility
= intern ("visibility");
4272 staticpro (&Qvisibility
);
4273 Qwindow_id
= intern ("window-id");
4274 staticpro (&Qwindow_id
);
4275 Qx_frame_parameter
= intern ("x-frame-parameter");
4276 staticpro (&Qx_frame_parameter
);
4277 Qx_resource_name
= intern ("x-resource-name");
4278 staticpro (&Qx_resource_name
);
4279 Quser_position
= intern ("user-position");
4280 staticpro (&Quser_position
);
4281 Quser_size
= intern ("user-size");
4282 staticpro (&Quser_size
);
4283 /* This is the end of symbol initialization. */
4285 Fput (Qundefined_color
, Qerror_conditions
,
4286 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
4287 Fput (Qundefined_color
, Qerror_message
,
4288 build_string ("Undefined color"));
4290 init_x_parm_symbols ();
4292 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset
,
4293 "The buffer offset of the character under the pointer.");
4294 mouse_buffer_offset
= 0;
4296 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
4297 "The shape of the pointer when over text.\n\
4298 Changing the value does not affect existing frames\n\
4299 unless you set the mouse color.");
4300 Vx_pointer_shape
= Qnil
;
4302 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
4303 "The name Emacs uses to look up X resources; for internal use only.\n\
4304 `x-get-resource' uses this as the first component of the instance name\n\
4305 when requesting resource values.\n\
4306 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4307 was invoked, or to the value specified with the `-name' or `-rn'\n\
4308 switches, if present.");
4309 Vx_resource_name
= Qnil
;
4312 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
4313 "The shape of the pointer when not over text.");
4315 Vx_nontext_pointer_shape
= Qnil
;
4318 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
4319 "The shape of the pointer when over the mode line.");
4321 Vx_mode_pointer_shape
= Qnil
;
4323 Vx_cross_pointer_shape
= Qnil
;
4325 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
4326 "A string indicating the foreground color of the cursor box.");
4327 Vx_cursor_fore_pixel
= Qnil
;
4329 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed
,
4330 "Non-nil if a mouse button is currently depressed.");
4331 Vmouse_depressed
= Qnil
;
4333 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
4334 "t if no X window manager is in use.");
4337 defsubr (&Sx_get_resource
);
4339 defsubr (&Sx_draw_rectangle
);
4340 defsubr (&Sx_erase_rectangle
);
4341 defsubr (&Sx_contour_region
);
4342 defsubr (&Sx_uncontour_region
);
4344 defsubr (&Sx_display_color_p
);
4345 defsubr (&Sx_list_fonts
);
4346 defsubr (&Sx_color_defined_p
);
4347 defsubr (&Sx_server_max_request_size
);
4348 defsubr (&Sx_server_vendor
);
4349 defsubr (&Sx_server_version
);
4350 defsubr (&Sx_display_pixel_width
);
4351 defsubr (&Sx_display_pixel_height
);
4352 defsubr (&Sx_display_mm_width
);
4353 defsubr (&Sx_display_mm_height
);
4354 defsubr (&Sx_display_screens
);
4355 defsubr (&Sx_display_planes
);
4356 defsubr (&Sx_display_color_cells
);
4357 defsubr (&Sx_display_visual_class
);
4358 defsubr (&Sx_display_backing_store
);
4359 defsubr (&Sx_display_save_under
);
4361 defsubr (&Sx_rebind_key
);
4362 defsubr (&Sx_rebind_keys
);
4363 defsubr (&Sx_track_pointer
);
4364 defsubr (&Sx_grab_pointer
);
4365 defsubr (&Sx_ungrab_pointer
);
4368 defsubr (&Sx_get_default
);
4369 defsubr (&Sx_store_cut_buffer
);
4370 defsubr (&Sx_get_cut_buffer
);
4372 defsubr (&Sx_parse_geometry
);
4373 defsubr (&Sx_create_frame
);
4374 defsubr (&Sfocus_frame
);
4375 defsubr (&Sunfocus_frame
);
4377 defsubr (&Sx_horizontal_line
);
4379 defsubr (&Sx_open_connection
);
4380 defsubr (&Sx_close_current_connection
);
4381 defsubr (&Sx_synchronize
);
4384 #endif /* HAVE_X_WINDOWS */