1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993, 1994 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* Completely rewritten by Richard Stallman. */
22 /* Rewritten for X11 by Joseph Arceneaux */
36 #include "dispextern.h"
38 #include "blockinput.h"
44 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
45 #include "bitmaps/gray.xbm"
47 #include <X11/bitmaps/gray>
50 #include "[.bitmaps]gray.xbm"
54 #include <X11/Shell.h>
56 #include <X11/Xaw/Paned.h>
57 #include <X11/Xaw/Label.h>
60 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
69 #include "../lwlib/lwlib.h"
71 /* The one and only application context associated with the connection
72 to the one and only X display that Emacs uses. */
73 XtAppContext Xt_app_con
;
75 /* The one and only application shell. Emacs screens are popup shells of this
79 extern void free_frame_menubar ();
80 extern void free_frame_menubar ();
81 #endif /* USE_X_TOOLKIT */
83 #define min(a,b) ((a) < (b) ? (a) : (b))
84 #define max(a,b) ((a) > (b) ? (a) : (b))
87 /* X Resource data base */
88 static XrmDatabase xrdb
;
90 /* The class of this X application. */
91 #define EMACS_CLASS "Emacs"
94 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
96 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
99 /* The name we're using in resource queries. */
100 Lisp_Object Vx_resource_name
;
102 /* Title name and application name for X stuff. */
103 extern char *x_id_name
;
105 /* The background and shape of the mouse pointer, and shape when not
106 over text or in the modeline. */
107 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
108 /* The shape when over mouse-sensitive text. */
109 Lisp_Object Vx_sensitive_text_pointer_shape
;
111 /* Color of chars displayed in cursor box. */
112 Lisp_Object Vx_cursor_fore_pixel
;
114 /* The screen being used. */
115 static Screen
*x_screen
;
117 /* The X Visual we are using for X windows (the default) */
118 Visual
*screen_visual
;
120 /* Height of this X screen in pixels. */
123 /* Width of this X screen in pixels. */
126 /* Number of planes for this screen. */
129 /* Non nil if no window manager is in use. */
130 Lisp_Object Vx_no_window_manager
;
132 /* `t' if a mouse button is depressed. */
134 Lisp_Object Vmouse_depressed
;
136 extern unsigned int x_mouse_x
, x_mouse_y
, x_mouse_grabbed
;
138 /* Atom for indicating window state to the window manager. */
139 extern Atom Xatom_wm_change_state
;
141 /* Communication with window managers. */
142 extern Atom Xatom_wm_protocols
;
144 /* Kinds of protocol things we may receive. */
145 extern Atom Xatom_wm_take_focus
;
146 extern Atom Xatom_wm_save_yourself
;
147 extern Atom Xatom_wm_delete_window
;
149 /* Other WM communication */
150 extern Atom Xatom_wm_configure_denied
; /* When our config request is denied */
151 extern Atom Xatom_wm_window_moved
; /* When the WM moves us. */
153 /* EditRes protocol */
154 extern Atom Xatom_editres_name
;
158 /* Default size of an Emacs window. */
159 static char *default_window
= "=80x24+0+0";
162 char iconidentity
[MAXICID
];
163 #define ICONTAG "emacs@"
164 char minibuffer_iconidentity
[MAXICID
];
165 #define MINIBUFFER_ICONTAG "minibuffer@"
169 /* The last 23 bits of the timestamp of the last mouse button event. */
170 Time mouse_timestamp
;
172 /* Evaluate this expression to rebuild the section of syms_of_xfns
173 that initializes and staticpros the symbols declared below. Note
174 that Emacs 18 has a bug that keeps C-x C-e from being able to
175 evaluate this expression.
178 ;; Accumulate a list of the symbols we want to initialize from the
179 ;; declarations at the top of the file.
180 (goto-char (point-min))
181 (search-forward "/\*&&& symbols declared here &&&*\/\n")
183 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
185 (cons (buffer-substring (match-beginning 1) (match-end 1))
188 (setq symbol-list (nreverse symbol-list))
189 ;; Delete the section of syms_of_... where we initialize the symbols.
190 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
191 (let ((start (point)))
192 (while (looking-at "^ Q")
194 (kill-region start (point)))
195 ;; Write a new symbol initialization section.
197 (insert (format " %s = intern (\"" (car symbol-list)))
198 (let ((start (point)))
199 (insert (substring (car symbol-list) 1))
200 (subst-char-in-region start (point) ?_ ?-))
201 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
202 (setq symbol-list (cdr symbol-list)))))
206 /*&&& symbols declared here &&&*/
207 Lisp_Object Qauto_raise
;
208 Lisp_Object Qauto_lower
;
209 Lisp_Object Qbackground_color
;
211 Lisp_Object Qborder_color
;
212 Lisp_Object Qborder_width
;
214 Lisp_Object Qcursor_color
;
215 Lisp_Object Qcursor_type
;
217 Lisp_Object Qforeground_color
;
218 Lisp_Object Qgeometry
;
219 /* Lisp_Object Qicon; */
220 Lisp_Object Qicon_left
;
221 Lisp_Object Qicon_top
;
222 Lisp_Object Qicon_type
;
223 Lisp_Object Qinternal_border_width
;
225 Lisp_Object Qmouse_color
;
227 Lisp_Object Qparent_id
;
228 Lisp_Object Qsuppress_icon
;
230 Lisp_Object Qundefined_color
;
231 Lisp_Object Qvertical_scroll_bars
;
232 Lisp_Object Qvisibility
;
233 Lisp_Object Qwindow_id
;
234 Lisp_Object Qx_frame_parameter
;
235 Lisp_Object Qx_resource_name
;
236 Lisp_Object Quser_position
;
237 Lisp_Object Quser_size
;
239 /* The below are defined in frame.c. */
240 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
241 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
;
243 extern Lisp_Object Vwindow_system_version
;
246 /* Error if we are not connected to X. */
250 if (x_current_display
== 0)
251 error ("X windows are not in use or not initialized");
254 /* Nonzero if using X for display. */
259 return x_current_display
!= 0;
262 /* Return the Emacs frame-object corresponding to an X window.
263 It could be the frame's main window or an icon window. */
265 /* This function can be called during GC, so use XGCTYPE. */
268 x_window_to_frame (wdesc
)
271 Lisp_Object tail
, frame
;
274 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
275 tail
= XCONS (tail
)->cdr
)
277 frame
= XCONS (tail
)->car
;
278 if (XGCTYPE (frame
) != Lisp_Frame
)
282 if (f
->display
.nothing
== 1)
284 if ((f
->display
.x
->edit_widget
285 && XtWindow (f
->display
.x
->edit_widget
) == wdesc
)
286 || f
->display
.x
->icon_desc
== wdesc
)
288 #else /* not USE_X_TOOLKIT */
289 if (FRAME_X_WINDOW (f
) == wdesc
290 || f
->display
.x
->icon_desc
== wdesc
)
292 #endif /* not USE_X_TOOLKIT */
298 /* Like x_window_to_frame but also compares the window with the widget's
302 x_any_window_to_frame (wdesc
)
305 Lisp_Object tail
, frame
;
309 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
310 tail
= XCONS (tail
)->cdr
)
312 frame
= XCONS (tail
)->car
;
313 if (XGCTYPE (frame
) != Lisp_Frame
)
316 if (f
->display
.nothing
== 1)
319 /* This frame matches if the window is any of its widgets. */
320 if (wdesc
== XtWindow (x
->widget
)
321 || wdesc
== XtWindow (x
->column_widget
)
322 || wdesc
== XtWindow (x
->edit_widget
))
324 /* Match if the window is this frame's menubar. */
325 if (x
->menubar_widget
326 && wdesc
== XtWindow (x
->menubar_widget
))
332 /* Return the frame whose principal (outermost) window is WDESC.
333 If WDESC is some other (smaller) window, we return 0. */
336 x_top_window_to_frame (wdesc
)
339 Lisp_Object tail
, frame
;
343 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
344 tail
= XCONS (tail
)->cdr
)
346 frame
= XCONS (tail
)->car
;
347 if (XGCTYPE (frame
) != Lisp_Frame
)
350 if (f
->display
.nothing
== 1)
353 /* This frame matches if the window is its topmost widget. */
354 if (wdesc
== XtWindow (x
->widget
))
356 /* Match if the window is this frame's menubar. */
357 if (x
->menubar_widget
358 && wdesc
== XtWindow (x
->menubar_widget
))
363 #endif /* USE_X_TOOLKIT */
366 /* Connect the frame-parameter names for X frames
367 to the ways of passing the parameter values to the window system.
369 The name of a parameter, as a Lisp symbol,
370 has an `x-frame-parameter' property which is an integer in Lisp
371 but can be interpreted as an `enum x_frame_parm' in C. */
375 X_PARM_FOREGROUND_COLOR
,
376 X_PARM_BACKGROUND_COLOR
,
383 X_PARM_INTERNAL_BORDER_WIDTH
,
387 X_PARM_VERT_SCROLL_BAR
,
389 X_PARM_MENU_BAR_LINES
393 struct x_frame_parm_table
396 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
399 void x_set_foreground_color ();
400 void x_set_background_color ();
401 void x_set_mouse_color ();
402 void x_set_cursor_color ();
403 void x_set_border_color ();
404 void x_set_cursor_type ();
405 void x_set_icon_type ();
407 void x_set_border_width ();
408 void x_set_internal_border_width ();
409 void x_explicitly_set_name ();
410 void x_set_autoraise ();
411 void x_set_autolower ();
412 void x_set_vertical_scroll_bars ();
413 void x_set_visibility ();
414 void x_set_menu_bar_lines ();
416 static struct x_frame_parm_table x_frame_parms
[] =
418 "foreground-color", x_set_foreground_color
,
419 "background-color", x_set_background_color
,
420 "mouse-color", x_set_mouse_color
,
421 "cursor-color", x_set_cursor_color
,
422 "border-color", x_set_border_color
,
423 "cursor-type", x_set_cursor_type
,
424 "icon-type", x_set_icon_type
,
426 "border-width", x_set_border_width
,
427 "internal-border-width", x_set_internal_border_width
,
428 "name", x_explicitly_set_name
,
429 "auto-raise", x_set_autoraise
,
430 "auto-lower", x_set_autolower
,
431 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
432 "visibility", x_set_visibility
,
433 "menu-bar-lines", x_set_menu_bar_lines
,
436 /* Attach the `x-frame-parameter' properties to
437 the Lisp symbol names of parameters relevant to X. */
439 init_x_parm_symbols ()
443 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
444 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
448 /* Change the parameters of FRAME as specified by ALIST.
449 If a parameter is not specially recognized, do nothing;
450 otherwise call the `x_set_...' function for that parameter. */
453 x_set_frame_parameters (f
, alist
)
459 /* If both of these parameters are present, it's more efficient to
460 set them both at once. So we wait until we've looked at the
461 entire list before we set them. */
462 Lisp_Object width
, height
;
465 Lisp_Object left
, top
;
467 /* Record in these vectors all the parms specified. */
473 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
476 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
477 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
479 /* Extract parm names and values into those vectors. */
482 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
484 Lisp_Object elt
, prop
, val
;
487 parms
[i
] = Fcar (elt
);
488 values
[i
] = Fcdr (elt
);
492 width
= height
= top
= left
= Qunbound
;
494 /* Now process them in reverse of specified order. */
495 for (i
--; i
>= 0; i
--)
497 Lisp_Object prop
, val
;
502 if (EQ (prop
, Qwidth
))
504 else if (EQ (prop
, Qheight
))
506 else if (EQ (prop
, Qtop
))
508 else if (EQ (prop
, Qleft
))
512 register Lisp_Object param_index
, old_value
;
514 param_index
= Fget (prop
, Qx_frame_parameter
);
515 old_value
= get_frame_param (f
, prop
);
516 store_frame_param (f
, prop
, val
);
517 if (XTYPE (param_index
) == Lisp_Int
518 && XINT (param_index
) >= 0
519 && (XINT (param_index
)
520 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
521 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
525 /* Don't die if just one of these was set. */
526 if (EQ (left
, Qunbound
))
527 XSET (left
, Lisp_Int
, f
->display
.x
->left_pos
);
528 if (EQ (top
, Qunbound
))
529 XSET (top
, Lisp_Int
, f
->display
.x
->top_pos
);
531 /* Don't die if just one of these was set. */
532 if (EQ (width
, Qunbound
))
533 XSET (width
, Lisp_Int
, FRAME_WIDTH (f
));
534 if (EQ (height
, Qunbound
))
535 XSET (height
, Lisp_Int
, FRAME_HEIGHT (f
));
537 /* Don't set these parameters these unless they've been explicitly
538 specified. The window might be mapped or resized while we're in
539 this function, and we don't want to override that unless the lisp
540 code has asked for it.
542 Don't set these parameters unless they actually differ from the
543 window's current parameters; the window may not actually exist
548 check_frame_size (f
, &height
, &width
);
550 XSET (frame
, Lisp_Frame
, f
);
552 if ((NUMBERP (width
) && XINT (width
) != FRAME_WIDTH (f
))
553 || (NUMBERP (height
) && XINT (height
) != FRAME_HEIGHT (f
)))
554 Fset_frame_size (frame
, width
, height
);
555 if ((NUMBERP (left
) && XINT (left
) != f
->display
.x
->left_pos
)
556 || (NUMBERP (top
) && XINT (top
) != f
->display
.x
->top_pos
))
557 Fset_frame_position (frame
, left
, top
);
561 /* Store the positions of frame F into XPTR and YPTR.
562 These are the positions of the containing window manager window,
563 not Emacs's own window. */
566 x_real_positions (f
, xptr
, yptr
)
570 int win_x
= 0, win_y
= 0;
573 /* Find the position of the outside upper-left corner of
574 the inner window, with respect to the outer window. */
575 if (f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
578 XTranslateCoordinates (x_current_display
,
580 /* From-window, to-window. */
582 XtWindow (f
->display
.x
->widget
),
584 f
->display
.x
->window_desc
,
586 f
->display
.x
->parent_desc
,
588 /* From-position, to-position. */
589 0, 0, &win_x
, &win_y
,
595 win_x
+= f
->display
.x
->border_width
;
596 win_y
+= f
->display
.x
->border_width
;
598 *xptr
= f
->display
.x
->left_pos
- win_x
;
599 *yptr
= f
->display
.x
->top_pos
- win_y
;
602 /* Insert a description of internally-recorded parameters of frame X
603 into the parameter alist *ALISTPTR that is to be given to the user.
604 Only parameters that are specific to the X window system
605 and whose values are not correctly recorded in the frame's
606 param_alist need to be considered here. */
608 x_report_frame_params (f
, alistptr
)
610 Lisp_Object
*alistptr
;
614 store_in_alist (alistptr
, Qleft
, make_number (f
->display
.x
->left_pos
));
615 store_in_alist (alistptr
, Qtop
, make_number (f
->display
.x
->top_pos
));
616 store_in_alist (alistptr
, Qborder_width
,
617 make_number (f
->display
.x
->border_width
));
618 store_in_alist (alistptr
, Qinternal_border_width
,
619 make_number (f
->display
.x
->internal_border_width
));
620 sprintf (buf
, "%d", FRAME_X_WINDOW (f
));
621 store_in_alist (alistptr
, Qwindow_id
,
623 FRAME_SAMPLE_VISIBILITY (f
);
624 store_in_alist (alistptr
, Qvisibility
,
625 (FRAME_VISIBLE_P (f
) ? Qt
626 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
629 /* Decide if color named COLOR is valid for the display
630 associated with the selected frame. */
632 defined_color (color
, color_def
)
637 Colormap screen_colormap
;
642 = DefaultColormap (x_current_display
, XDefaultScreen (x_current_display
));
644 foo
= XParseColor (x_current_display
, screen_colormap
,
646 && XAllocColor (x_current_display
, screen_colormap
, color_def
);
648 foo
= XParseColor (color
, color_def
) && XGetHardwareColor (color_def
);
649 #endif /* not HAVE_X11 */
658 /* Given a string ARG naming a color, compute a pixel value from it
659 suitable for screen F.
660 If F is not a color screen, return DEF (default) regardless of what
664 x_decode_color (arg
, def
)
670 CHECK_STRING (arg
, 0);
672 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
673 return BLACK_PIX_DEFAULT
;
674 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
675 return WHITE_PIX_DEFAULT
;
678 if (x_screen_planes
== 1)
681 if (DISPLAY_CELLS
== 1)
685 if (defined_color (XSTRING (arg
)->data
, &cdef
))
688 Fsignal (Qundefined_color
, Fcons (arg
, Qnil
));
691 /* Functions called only from `x_set_frame_param'
692 to set individual parameters.
694 If FRAME_X_WINDOW (f) is 0,
695 the frame is being created and its X-window does not exist yet.
696 In that case, just record the parameter's new value
697 in the standard place; do not attempt to change the window. */
700 x_set_foreground_color (f
, arg
, oldval
)
702 Lisp_Object arg
, oldval
;
704 f
->display
.x
->foreground_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
705 if (FRAME_X_WINDOW (f
) != 0)
709 XSetForeground (x_current_display
, f
->display
.x
->normal_gc
,
710 f
->display
.x
->foreground_pixel
);
711 XSetBackground (x_current_display
, f
->display
.x
->reverse_gc
,
712 f
->display
.x
->foreground_pixel
);
714 #endif /* HAVE_X11 */
715 recompute_basic_faces (f
);
716 if (FRAME_VISIBLE_P (f
))
722 x_set_background_color (f
, arg
, oldval
)
724 Lisp_Object arg
, oldval
;
729 f
->display
.x
->background_pixel
= x_decode_color (arg
, WHITE_PIX_DEFAULT
);
731 if (FRAME_X_WINDOW (f
) != 0)
735 /* The main frame area. */
736 XSetBackground (x_current_display
, f
->display
.x
->normal_gc
,
737 f
->display
.x
->background_pixel
);
738 XSetForeground (x_current_display
, f
->display
.x
->reverse_gc
,
739 f
->display
.x
->background_pixel
);
740 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
741 f
->display
.x
->background_pixel
);
742 XSetWindowBackground (x_current_display
, FRAME_X_WINDOW (f
),
743 f
->display
.x
->background_pixel
);
746 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
747 bar
= XSCROLL_BAR (bar
)->next
)
748 XSetWindowBackground (x_current_display
,
749 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
750 f
->display
.x
->background_pixel
);
753 temp
= XMakeTile (f
->display
.x
->background_pixel
);
754 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
756 #endif /* not HAVE_X11 */
759 recompute_basic_faces (f
);
761 if (FRAME_VISIBLE_P (f
))
767 x_set_mouse_color (f
, arg
, oldval
)
769 Lisp_Object arg
, oldval
;
771 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
775 f
->display
.x
->mouse_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
776 mask_color
= f
->display
.x
->background_pixel
;
777 /* No invisible pointers. */
778 if (mask_color
== f
->display
.x
->mouse_pixel
779 && mask_color
== f
->display
.x
->background_pixel
)
780 f
->display
.x
->mouse_pixel
= f
->display
.x
->foreground_pixel
;
785 /* It's not okay to crash if the user selects a screwy cursor. */
788 if (!EQ (Qnil
, Vx_pointer_shape
))
790 CHECK_NUMBER (Vx_pointer_shape
, 0);
791 cursor
= XCreateFontCursor (x_current_display
, XINT (Vx_pointer_shape
));
794 cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
795 x_check_errors ("bad text pointer cursor: %s");
797 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
799 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
800 nontext_cursor
= XCreateFontCursor (x_current_display
,
801 XINT (Vx_nontext_pointer_shape
));
804 nontext_cursor
= XCreateFontCursor (x_current_display
, XC_left_ptr
);
805 x_check_errors ("bad nontext pointer cursor: %s");
807 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
809 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
810 mode_cursor
= XCreateFontCursor (x_current_display
,
811 XINT (Vx_mode_pointer_shape
));
814 mode_cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
815 x_check_errors ("bad modeline pointer cursor: %s");
817 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
819 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
821 = XCreateFontCursor (x_current_display
,
822 XINT (Vx_sensitive_text_pointer_shape
));
825 cross_cursor
= XCreateFontCursor (x_current_display
, XC_crosshair
);
827 /* Check and report errors with the above calls. */
828 x_check_errors ("can't set cursor shape: %s");
832 XColor fore_color
, back_color
;
834 fore_color
.pixel
= f
->display
.x
->mouse_pixel
;
835 back_color
.pixel
= mask_color
;
836 XQueryColor (x_current_display
,
837 DefaultColormap (x_current_display
,
838 DefaultScreen (x_current_display
)),
840 XQueryColor (x_current_display
,
841 DefaultColormap (x_current_display
,
842 DefaultScreen (x_current_display
)),
844 XRecolorCursor (x_current_display
, cursor
,
845 &fore_color
, &back_color
);
846 XRecolorCursor (x_current_display
, nontext_cursor
,
847 &fore_color
, &back_color
);
848 XRecolorCursor (x_current_display
, mode_cursor
,
849 &fore_color
, &back_color
);
850 XRecolorCursor (x_current_display
, cross_cursor
,
851 &fore_color
, &back_color
);
854 cursor
= XCreateCursor (16, 16, MouseCursor
, MouseMask
,
856 f
->display
.x
->mouse_pixel
,
857 f
->display
.x
->background_pixel
,
861 if (FRAME_X_WINDOW (f
) != 0)
863 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
), cursor
);
866 if (cursor
!= f
->display
.x
->text_cursor
&& f
->display
.x
->text_cursor
!= 0)
867 XFreeCursor (XDISPLAY f
->display
.x
->text_cursor
);
868 f
->display
.x
->text_cursor
= cursor
;
870 if (nontext_cursor
!= f
->display
.x
->nontext_cursor
871 && f
->display
.x
->nontext_cursor
!= 0)
872 XFreeCursor (XDISPLAY f
->display
.x
->nontext_cursor
);
873 f
->display
.x
->nontext_cursor
= nontext_cursor
;
875 if (mode_cursor
!= f
->display
.x
->modeline_cursor
876 && f
->display
.x
->modeline_cursor
!= 0)
877 XFreeCursor (XDISPLAY f
->display
.x
->modeline_cursor
);
878 f
->display
.x
->modeline_cursor
= mode_cursor
;
879 if (cross_cursor
!= f
->display
.x
->cross_cursor
880 && f
->display
.x
->cross_cursor
!= 0)
881 XFreeCursor (XDISPLAY f
->display
.x
->cross_cursor
);
882 f
->display
.x
->cross_cursor
= cross_cursor
;
883 #endif /* HAVE_X11 */
890 x_set_cursor_color (f
, arg
, oldval
)
892 Lisp_Object arg
, oldval
;
894 unsigned long fore_pixel
;
896 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
897 fore_pixel
= x_decode_color (Vx_cursor_fore_pixel
, WHITE_PIX_DEFAULT
);
899 fore_pixel
= f
->display
.x
->background_pixel
;
900 f
->display
.x
->cursor_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
902 /* Make sure that the cursor color differs from the background color. */
903 if (f
->display
.x
->cursor_pixel
== f
->display
.x
->background_pixel
)
905 f
->display
.x
->cursor_pixel
= f
->display
.x
->mouse_pixel
;
906 if (f
->display
.x
->cursor_pixel
== fore_pixel
)
907 fore_pixel
= f
->display
.x
->background_pixel
;
909 f
->display
.x
->cursor_foreground_pixel
= fore_pixel
;
911 if (FRAME_X_WINDOW (f
) != 0)
915 XSetBackground (x_current_display
, f
->display
.x
->cursor_gc
,
916 f
->display
.x
->cursor_pixel
);
917 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
920 #endif /* HAVE_X11 */
922 if (FRAME_VISIBLE_P (f
))
924 x_display_cursor (f
, 0);
925 x_display_cursor (f
, 1);
930 /* Set the border-color of frame F to value described by ARG.
931 ARG can be a string naming a color.
932 The border-color is used for the border that is drawn by the X server.
933 Note that this does not fully take effect if done before
934 F has an x-window; it must be redone when the window is created.
936 Note: this is done in two routines because of the way X10 works.
938 Note: under X11, this is normally the province of the window manager,
939 and so emacs' border colors may be overridden. */
942 x_set_border_color (f
, arg
, oldval
)
944 Lisp_Object arg
, oldval
;
949 CHECK_STRING (arg
, 0);
950 str
= XSTRING (arg
)->data
;
953 if (!strcmp (str
, "grey") || !strcmp (str
, "Grey")
954 || !strcmp (str
, "gray") || !strcmp (str
, "Gray"))
959 pix
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
961 x_set_border_pixel (f
, pix
);
964 /* Set the border-color of frame F to pixel value PIX.
965 Note that this does not fully take effect if done before
966 F has an x-window. */
968 x_set_border_pixel (f
, pix
)
972 f
->display
.x
->border_pixel
= pix
;
974 if (FRAME_X_WINDOW (f
) != 0 && f
->display
.x
->border_width
> 0)
981 XSetWindowBorder (x_current_display
, FRAME_X_WINDOW (f
),
985 temp
= XMakePixmap ((Bitmap
) XStoreBitmap (gray_width
, gray_height
,
987 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
989 temp
= XMakeTile (pix
);
990 XChangeBorder (FRAME_X_WINDOW (f
), temp
);
991 XFreePixmap (XDISPLAY temp
);
992 #endif /* not HAVE_X11 */
995 if (FRAME_VISIBLE_P (f
))
1001 x_set_cursor_type (f
, arg
, oldval
)
1003 Lisp_Object arg
, oldval
;
1006 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1011 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
1012 /* Error messages commented out because people have trouble fixing
1013 .Xdefaults with Emacs, when it has something bad in it. */
1017 ("the `cursor-type' frame parameter should be either `bar' or `box'");
1020 /* Make sure the cursor gets redrawn. This is overkill, but how
1021 often do people change cursor types? */
1022 update_mode_lines
++;
1026 x_set_icon_type (f
, arg
, oldval
)
1028 Lisp_Object arg
, oldval
;
1033 if (EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1038 result
= x_text_icon (f
, 0);
1040 result
= x_bitmap_icon (f
);
1045 error ("No icon window available.");
1048 /* If the window was unmapped (and its icon was mapped),
1049 the new icon is not mapped, so map the window in its stead. */
1050 if (FRAME_VISIBLE_P (f
))
1051 #ifdef USE_X_TOOLKIT
1052 XtPopup (f
->display
.x
->widget
, XtGrabNone
);
1054 XMapWindow (XDISPLAY
FRAME_X_WINDOW (f
));
1060 extern Lisp_Object
x_new_font ();
1063 x_set_font (f
, arg
, oldval
)
1065 Lisp_Object arg
, oldval
;
1069 CHECK_STRING (arg
, 1);
1072 result
= x_new_font (f
, XSTRING (arg
)->data
);
1075 if (EQ (result
, Qnil
))
1076 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
1077 else if (EQ (result
, Qt
))
1078 error ("the characters of the given font have varying widths");
1079 else if (STRINGP (result
))
1081 recompute_basic_faces (f
);
1082 store_frame_param (f
, Qfont
, result
);
1089 x_set_border_width (f
, arg
, oldval
)
1091 Lisp_Object arg
, oldval
;
1093 CHECK_NUMBER (arg
, 0);
1095 if (XINT (arg
) == f
->display
.x
->border_width
)
1098 if (FRAME_X_WINDOW (f
) != 0)
1099 error ("Cannot change the border width of a window");
1101 f
->display
.x
->border_width
= XINT (arg
);
1105 x_set_internal_border_width (f
, arg
, oldval
)
1107 Lisp_Object arg
, oldval
;
1110 int old
= f
->display
.x
->internal_border_width
;
1112 CHECK_NUMBER (arg
, 0);
1113 f
->display
.x
->internal_border_width
= XINT (arg
);
1114 if (f
->display
.x
->internal_border_width
< 0)
1115 f
->display
.x
->internal_border_width
= 0;
1117 if (f
->display
.x
->internal_border_width
== old
)
1120 if (FRAME_X_WINDOW (f
) != 0)
1123 x_set_window_size (f
, 0, f
->width
, f
->height
);
1125 x_set_resize_hint (f
);
1129 SET_FRAME_GARBAGED (f
);
1134 x_set_visibility (f
, value
, oldval
)
1136 Lisp_Object value
, oldval
;
1139 XSET (frame
, Lisp_Frame
, f
);
1142 Fmake_frame_invisible (frame
, Qt
);
1143 else if (EQ (value
, Qicon
))
1144 Ficonify_frame (frame
);
1146 Fmake_frame_visible (frame
);
1150 x_set_menu_bar_lines_1 (window
, n
)
1154 struct window
*w
= XWINDOW (window
);
1156 XFASTINT (w
->top
) += n
;
1157 XFASTINT (w
->height
) -= n
;
1159 /* Handle just the top child in a vertical split. */
1160 if (!NILP (w
->vchild
))
1161 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1163 /* Adjust all children in a horizontal split. */
1164 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1166 w
= XWINDOW (window
);
1167 x_set_menu_bar_lines_1 (window
, n
);
1172 x_set_menu_bar_lines (f
, value
, oldval
)
1174 Lisp_Object value
, oldval
;
1177 int olines
= FRAME_MENU_BAR_LINES (f
);
1179 /* Right now, menu bars don't work properly in minibuf-only frames;
1180 most of the commands try to apply themselves to the minibuffer
1181 frame itslef, and get an error because you can't switch buffers
1182 in or split the minibuffer window. */
1183 if (FRAME_MINIBUF_ONLY_P (f
))
1186 if (XTYPE (value
) == Lisp_Int
)
1187 nlines
= XINT (value
);
1191 #ifdef USE_X_TOOLKIT
1192 FRAME_MENU_BAR_LINES (f
) = 0;
1194 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1197 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1198 free_frame_menubar (f
);
1199 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1200 f
->display
.x
->menubar_widget
= 0;
1202 #else /* not USE_X_TOOLKIT */
1203 FRAME_MENU_BAR_LINES (f
) = nlines
;
1204 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1205 #endif /* not USE_X_TOOLKIT */
1208 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1211 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1212 name; if NAME is a string, set F's name to NAME and set
1213 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1215 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1216 suggesting a new name, which lisp code should override; if
1217 F->explicit_name is set, ignore the new name; otherwise, set it. */
1220 x_set_name (f
, name
, explicit)
1225 /* Make sure that requests from lisp code override requests from
1226 Emacs redisplay code. */
1229 /* If we're switching from explicit to implicit, we had better
1230 update the mode lines and thereby update the title. */
1231 if (f
->explicit_name
&& NILP (name
))
1232 update_mode_lines
= 1;
1234 f
->explicit_name
= ! NILP (name
);
1236 else if (f
->explicit_name
)
1239 /* If NAME is nil, set the name to the x_id_name. */
1241 name
= build_string (x_id_name
);
1243 CHECK_STRING (name
, 0);
1245 /* Don't change the name if it's already NAME. */
1246 if (! NILP (Fstring_equal (name
, f
->name
)))
1249 if (FRAME_X_WINDOW (f
))
1255 text
.value
= XSTRING (name
)->data
;
1256 text
.encoding
= XA_STRING
;
1258 text
.nitems
= XSTRING (name
)->size
;
1259 #ifdef USE_X_TOOLKIT
1260 XSetWMName (x_current_display
, XtWindow (f
->display
.x
->widget
), &text
);
1261 XSetWMIconName (x_current_display
, XtWindow (f
->display
.x
->widget
),
1263 #else /* not USE_X_TOOLKIT */
1264 XSetWMName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1265 XSetWMIconName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1266 #endif /* not USE_X_TOOLKIT */
1268 #else /* not HAVE_X11R4 */
1269 XSetIconName (XDISPLAY
FRAME_X_WINDOW (f
),
1270 XSTRING (name
)->data
);
1271 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
),
1272 XSTRING (name
)->data
);
1273 #endif /* not HAVE_X11R4 */
1280 /* This function should be called when the user's lisp code has
1281 specified a name for the frame; the name will override any set by the
1284 x_explicitly_set_name (f
, arg
, oldval
)
1286 Lisp_Object arg
, oldval
;
1288 x_set_name (f
, arg
, 1);
1291 /* This function should be called by Emacs redisplay code to set the
1292 name; names set this way will never override names set by the user's
1295 x_implicitly_set_name (f
, arg
, oldval
)
1297 Lisp_Object arg
, oldval
;
1299 x_set_name (f
, arg
, 0);
1303 x_set_autoraise (f
, arg
, oldval
)
1305 Lisp_Object arg
, oldval
;
1307 f
->auto_raise
= !EQ (Qnil
, arg
);
1311 x_set_autolower (f
, arg
, oldval
)
1313 Lisp_Object arg
, oldval
;
1315 f
->auto_lower
= !EQ (Qnil
, arg
);
1319 x_set_vertical_scroll_bars (f
, arg
, oldval
)
1321 Lisp_Object arg
, oldval
;
1323 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
1325 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
1327 /* We set this parameter before creating the X window for the
1328 frame, so we can get the geometry right from the start.
1329 However, if the window hasn't been created yet, we shouldn't
1330 call x_set_window_size. */
1331 if (FRAME_X_WINDOW (f
))
1332 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1336 /* Subroutines of creating an X frame. */
1340 /* Make sure that Vx_resource_name is set to a reasonable value. */
1342 validate_x_resource_name ()
1344 if (STRINGP (Vx_resource_name
))
1346 int len
= XSTRING (Vx_resource_name
)->size
;
1347 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
1350 /* Allow only letters, digits, - and _,
1351 because those are all that X allows. */
1352 for (i
= 0; i
< len
; i
++)
1355 if (! ((c
>= 'a' && c
<= 'z')
1356 || (c
>= 'A' && c
<= 'Z')
1357 || (c
>= '0' && c
<= '9')
1358 || c
== '-' || c
== '_'))
1364 Vx_resource_name
= make_string ("emacs", 5);
1368 extern char *x_get_string_resource ();
1369 extern XrmDatabase
x_load_resources ();
1371 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
1372 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1373 This uses `NAME.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1374 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1375 the name specified by the `-name' or `-rn' command-line arguments.\n\
1377 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1378 class, respectively. You must specify both of them or neither.\n\
1379 If you specify them, the key is `NAME.COMPONENT.ATTRIBUTE'\n\
1380 and the class is `Emacs.CLASS.SUBCLASS'.")
1381 (attribute
, class, component
, subclass
)
1382 Lisp_Object attribute
, class, component
, subclass
;
1384 register char *value
;
1387 Lisp_Object resname
;
1391 CHECK_STRING (attribute
, 0);
1392 CHECK_STRING (class, 0);
1394 if (!NILP (component
))
1395 CHECK_STRING (component
, 1);
1396 if (!NILP (subclass
))
1397 CHECK_STRING (subclass
, 2);
1398 if (NILP (component
) != NILP (subclass
))
1399 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1401 validate_x_resource_name ();
1402 resname
= Vx_resource_name
;
1404 if (NILP (component
))
1406 /* Allocate space for the components, the dots which separate them,
1407 and the final '\0'. */
1408 name_key
= (char *) alloca (XSTRING (resname
)->size
1409 + XSTRING (attribute
)->size
1411 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1412 + XSTRING (class)->size
1415 sprintf (name_key
, "%s.%s",
1416 XSTRING (resname
)->data
,
1417 XSTRING (attribute
)->data
);
1418 sprintf (class_key
, "%s.%s",
1420 XSTRING (class)->data
);
1424 name_key
= (char *) alloca (XSTRING (resname
)->size
1425 + XSTRING (component
)->size
1426 + XSTRING (attribute
)->size
1429 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1430 + XSTRING (class)->size
1431 + XSTRING (subclass
)->size
1434 sprintf (name_key
, "%s.%s.%s",
1435 XSTRING (resname
)->data
,
1436 XSTRING (component
)->data
,
1437 XSTRING (attribute
)->data
);
1438 sprintf (class_key
, "%s.%s.%s",
1440 XSTRING (class)->data
,
1441 XSTRING (subclass
)->data
);
1444 value
= x_get_string_resource (xrdb
, name_key
, class_key
);
1446 if (value
!= (char *) 0)
1447 return build_string (value
);
1452 /* Used when C code wants a resource value. */
1455 x_get_resource_string (attribute
, class)
1456 char *attribute
, *class;
1458 register char *value
;
1462 /* Allocate space for the components, the dots which separate them,
1463 and the final '\0'. */
1464 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
1465 + strlen (attribute
) + 2);
1466 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1467 + strlen (class) + 2);
1469 sprintf (name_key
, "%s.%s",
1470 XSTRING (Vinvocation_name
)->data
,
1472 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
1474 return x_get_string_resource (xrdb
, name_key
, class_key
);
1479 DEFUN ("x-get-default", Fx_get_default
, Sx_get_default
, 1, 1, 0,
1480 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1481 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1482 The defaults are specified in the file `~/.Xdefaults'.")
1486 register unsigned char *value
;
1488 CHECK_STRING (arg
, 1);
1490 value
= (unsigned char *) XGetDefault (XDISPLAY
1491 XSTRING (Vinvocation_name
)->data
,
1492 XSTRING (arg
)->data
);
1494 /* Try reversing last two args, in case this is the buggy version of X. */
1495 value
= (unsigned char *) XGetDefault (XDISPLAY
1496 XSTRING (arg
)->data
,
1497 XSTRING (Vinvocation_name
)->data
);
1499 return build_string (value
);
1504 #define Fx_get_resource(attribute, class, component, subclass) \
1505 Fx_get_default (attribute)
1509 /* Types we might convert a resource string into. */
1512 number
, boolean
, string
, symbol
1515 /* Return the value of parameter PARAM.
1517 First search ALIST, then Vdefault_frame_alist, then the X defaults
1518 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1520 Convert the resource to the type specified by desired_type.
1522 If no default is specified, return Qunbound. If you call
1523 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1524 and don't let it get stored in any lisp-visible variables! */
1527 x_get_arg (alist
, param
, attribute
, class, type
)
1528 Lisp_Object alist
, param
;
1531 enum resource_types type
;
1533 register Lisp_Object tem
;
1535 tem
= Fassq (param
, alist
);
1537 tem
= Fassq (param
, Vdefault_frame_alist
);
1543 tem
= Fx_get_resource (build_string (attribute
),
1544 build_string (class),
1553 return make_number (atoi (XSTRING (tem
)->data
));
1556 tem
= Fdowncase (tem
);
1557 if (!strcmp (XSTRING (tem
)->data
, "on")
1558 || !strcmp (XSTRING (tem
)->data
, "true"))
1567 /* As a special case, we map the values `true' and `on'
1568 to Qt, and `false' and `off' to Qnil. */
1571 lower
= Fdowncase (tem
);
1572 if (!strcmp (XSTRING (lower
)->data
, "on")
1573 || !strcmp (XSTRING (lower
)->data
, "true"))
1575 else if (!strcmp (XSTRING (lower
)->data
, "off")
1576 || !strcmp (XSTRING (lower
)->data
, "false"))
1579 return Fintern (tem
, Qnil
);
1592 /* Record in frame F the specified or default value according to ALIST
1593 of the parameter named PARAM (a Lisp symbol).
1594 If no value is specified for PARAM, look for an X default for XPROP
1595 on the frame named NAME.
1596 If that is not found either, use the value DEFLT. */
1599 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
1606 enum resource_types type
;
1610 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
1611 if (EQ (tem
, Qunbound
))
1613 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
1617 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
1618 "Parse an X-style geometry string STRING.\n\
1619 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
1620 The properties returned may include `top', `left', `height', and `width'.\n\
1621 The value of `left' or `top' may be an integer or `-'.\n\
1622 `-' means \"minus zero\".")
1627 unsigned int width
, height
;
1630 CHECK_STRING (string
, 0);
1632 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
1633 &x
, &y
, &width
, &height
);
1636 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
1637 error ("Must specify both x and y position, or neither");
1641 if (geometry
& XValue
)
1643 Lisp_Object element
;
1645 if (x
== 0 && (geometry
& XNegative
))
1646 element
= Fcons (Qleft
, Qminus
);
1648 element
= Fcons (Qleft
, make_number (x
));
1649 result
= Fcons (element
, result
);
1652 if (geometry
& YValue
)
1654 Lisp_Object element
;
1656 if (y
== 0 && (geometry
& YNegative
))
1657 element
= Fcons (Qtop
, Qminus
);
1659 element
= Fcons (Qtop
, make_number (y
));
1660 result
= Fcons (element
, result
);
1663 if (geometry
& WidthValue
)
1664 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
1665 if (geometry
& HeightValue
)
1666 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
1672 /* Calculate the desired size and position of this window,
1673 and return the flags saying which aspects were specified.
1675 This function does not make the coordinates positive. */
1677 #define DEFAULT_ROWS 40
1678 #define DEFAULT_COLS 80
1681 x_figure_window_size (f
, parms
)
1685 register Lisp_Object tem0
, tem1
, tem2
;
1686 int height
, width
, left
, top
;
1687 register int geometry
;
1688 long window_prompting
= 0;
1690 /* Default values if we fall through.
1691 Actually, if that happens we should get
1692 window manager prompting. */
1693 f
->width
= DEFAULT_COLS
;
1694 f
->height
= DEFAULT_ROWS
;
1695 /* Window managers expect that if program-specified
1696 positions are not (0,0), they're intentional, not defaults. */
1697 f
->display
.x
->top_pos
= 0;
1698 f
->display
.x
->left_pos
= 0;
1700 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
1701 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
1702 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
1703 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1705 if (!EQ (tem0
, Qunbound
))
1707 CHECK_NUMBER (tem0
, 0);
1708 f
->height
= XINT (tem0
);
1710 if (!EQ (tem1
, Qunbound
))
1712 CHECK_NUMBER (tem1
, 0);
1713 f
->width
= XINT (tem1
);
1715 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
1716 window_prompting
|= USSize
;
1718 window_prompting
|= PSize
;
1721 f
->display
.x
->vertical_scroll_bar_extra
1722 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1723 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f
)
1725 f
->display
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
1726 f
->display
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
1728 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1729 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1730 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
1731 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1733 if (EQ (tem0
, Qminus
))
1735 f
->display
.x
->top_pos
= 0;
1736 window_prompting
|= YNegative
;
1738 else if (EQ (tem0
, Qunbound
))
1739 f
->display
.x
->top_pos
= 0;
1742 CHECK_NUMBER (tem0
, 0);
1743 f
->display
.x
->top_pos
= XINT (tem0
);
1744 if (f
->display
.x
->top_pos
< 0)
1745 window_prompting
|= YNegative
;
1748 if (EQ (tem1
, Qminus
))
1750 f
->display
.x
->left_pos
= 0;
1751 window_prompting
|= XNegative
;
1753 else if (EQ (tem1
, Qunbound
))
1754 f
->display
.x
->left_pos
= 0;
1757 CHECK_NUMBER (tem1
, 0);
1758 f
->display
.x
->left_pos
= XINT (tem1
);
1759 if (f
->display
.x
->left_pos
< 0)
1760 window_prompting
|= XNegative
;
1764 window_prompting
|= USPosition
;
1766 window_prompting
|= PPosition
;
1769 return window_prompting
;
1772 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
1775 XSetWMProtocols (dpy
, w
, protocols
, count
)
1782 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
1783 if (prop
== None
) return False
;
1784 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
1785 (unsigned char *) protocols
, count
);
1788 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
1790 #ifdef USE_X_TOOLKIT
1792 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS
1793 and WM_DELETE_WINDOW, then add them. (They may already be present
1794 because of the toolkit (Motif adds them, for example, but Xt doesn't). */
1797 hack_wm_protocols (widget
)
1800 Display
*dpy
= XtDisplay (widget
);
1801 Window w
= XtWindow (widget
);
1802 int need_delete
= 1;
1807 Atom type
, *atoms
= 0;
1809 unsigned long nitems
= 0;
1810 unsigned long bytes_after
;
1812 if (Success
== XGetWindowProperty (dpy
, w
, Xatom_wm_protocols
,
1813 0, 100, False
, XA_ATOM
,
1814 &type
, &format
, &nitems
, &bytes_after
,
1815 (unsigned char **) &atoms
)
1816 && format
== 32 && type
== XA_ATOM
)
1820 if (atoms
[nitems
] == Xatom_wm_delete_window
) need_delete
= 0;
1821 else if (atoms
[nitems
] == Xatom_wm_take_focus
) need_focus
= 0;
1823 if (atoms
) XFree ((char *) atoms
);
1828 if (need_delete
) props
[count
++] = Xatom_wm_delete_window
;
1829 if (need_focus
) props
[count
++] = Xatom_wm_take_focus
;
1831 XChangeProperty (dpy
, w
, Xatom_wm_protocols
, XA_ATOM
, 32, PropModeAppend
,
1832 (unsigned char *) props
, count
);
1838 #ifdef USE_X_TOOLKIT
1840 /* Create and set up the X widget for frame F. */
1843 x_window (f
, window_prompting
, minibuffer_only
)
1845 long window_prompting
;
1846 int minibuffer_only
;
1848 XClassHint class_hints
;
1849 XSetWindowAttributes attributes
;
1850 unsigned long attribute_mask
;
1852 Widget shell_widget
;
1854 Widget screen_widget
;
1861 if (STRINGP (f
->name
))
1862 name
= (char*) XSTRING (f
->name
)->data
;
1867 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
1868 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
1869 shell_widget
= XtCreatePopupShell ("shell",
1870 topLevelShellWidgetClass
,
1871 Xt_app_shell
, al
, ac
);
1873 f
->display
.x
->widget
= shell_widget
;
1874 /* maybe_set_screen_title_format (shell_widget); */
1878 XtSetArg (al
[ac
], XtNborderWidth
, 0); ac
++;
1879 pane_widget
= XtCreateWidget ("pane",
1881 shell_widget
, al
, ac
);
1883 f
->display
.x
->column_widget
= pane_widget
;
1885 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
1886 initialize_frame_menubar (f
);
1888 /* mappedWhenManaged to false tells to the paned window to not map/unmap
1889 the emacs screen when changing menubar. This reduces flickering. */
1892 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
1893 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
1894 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
1895 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
1896 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
1897 screen_widget
= XtCreateWidget (name
,
1899 pane_widget
, al
, ac
);
1901 f
->display
.x
->edit_widget
= screen_widget
;
1903 if (f
->display
.x
->menubar_widget
)
1904 XtManageChild (f
->display
.x
->menubar_widget
);
1905 XtManageChild (screen_widget
);
1907 /* Do some needed geometry management. */
1910 char *tem
, shell_position
[32];
1915 = (f
->display
.x
->menubar_widget
1916 ? (f
->display
.x
->menubar_widget
->core
.height
1917 + f
->display
.x
->menubar_widget
->core
.border_width
)
1920 XtVaGetValues (pane_widget
,
1921 XtNinternalBorderWidth
, &ibw
,
1923 menubar_size
+= ibw
;
1925 if (window_prompting
& USPosition
)
1927 int left
= f
->display
.x
->left_pos
;
1928 int xneg
= window_prompting
& XNegative
;
1929 int top
= f
->display
.x
->top_pos
;
1930 int yneg
= window_prompting
& YNegative
;
1935 sprintf (shell_position
, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f
),
1936 PIXEL_HEIGHT (f
) + menubar_size
,
1937 (xneg
? '-' : '+'), left
,
1938 (yneg
? '-' : '+'), top
);
1941 sprintf (shell_position
, "=%dx%d", PIXEL_WIDTH (f
),
1942 PIXEL_HEIGHT (f
) + menubar_size
);
1943 len
= strlen (shell_position
) + 1;
1944 tem
= (char *) xmalloc (len
);
1945 strncpy (tem
, shell_position
, len
);
1946 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
1947 XtSetValues (shell_widget
, al
, ac
);
1950 x_calc_absolute_position (f
);
1952 XtManageChild (pane_widget
);
1953 XtRealizeWidget (shell_widget
);
1955 FRAME_X_WINDOW (f
) = XtWindow (screen_widget
);
1957 validate_x_resource_name ();
1958 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
1959 class_hints
.res_class
= EMACS_CLASS
;
1960 XSetClassHint (x_current_display
, XtWindow (shell_widget
), &class_hints
);
1962 f
->display
.x
->wm_hints
.input
= True
;
1963 f
->display
.x
->wm_hints
.flags
|= InputHint
;
1964 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
1966 hack_wm_protocols (shell_widget
);
1968 /* Do a stupid property change to force the server to generate a
1969 propertyNotify event so that the event_stream server timestamp will
1970 be initialized to something relevant to the time we created the window.
1972 XChangeProperty (XtDisplay (screen_widget
), XtWindow (screen_widget
),
1973 Xatom_wm_protocols
, XA_ATOM
, 32, PropModeAppend
,
1974 (unsigned char*) NULL
, 0);
1976 /* Make all the standard events reach the Emacs frame. */
1977 attributes
.event_mask
= STANDARD_EVENT_SET
;
1978 attribute_mask
= CWEventMask
;
1979 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
1980 attribute_mask
, &attributes
);
1982 XtMapWidget (screen_widget
);
1984 /* x_set_name normally ignores requests to set the name if the
1985 requested name is the same as the current name. This is the one
1986 place where that assumption isn't correct; f->name is set, but
1987 the X server hasn't been told. */
1990 int explicit = f
->explicit_name
;
1992 f
->explicit_name
= 0;
1995 x_set_name (f
, name
, explicit);
1998 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
1999 f
->display
.x
->text_cursor
);
2003 if (FRAME_X_WINDOW (f
) == 0)
2004 error ("Unable to create window");
2007 #else /* not USE_X_TOOLKIT */
2009 /* Create and set up the X window for frame F. */
2015 XClassHint class_hints
;
2016 XSetWindowAttributes attributes
;
2017 unsigned long attribute_mask
;
2019 attributes
.background_pixel
= f
->display
.x
->background_pixel
;
2020 attributes
.border_pixel
= f
->display
.x
->border_pixel
;
2021 attributes
.bit_gravity
= StaticGravity
;
2022 attributes
.backing_store
= NotUseful
;
2023 attributes
.save_under
= True
;
2024 attributes
.event_mask
= STANDARD_EVENT_SET
;
2025 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
2027 | CWBackingStore
| CWSaveUnder
2033 = XCreateWindow (x_current_display
, ROOT_WINDOW
,
2034 f
->display
.x
->left_pos
,
2035 f
->display
.x
->top_pos
,
2036 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
2037 f
->display
.x
->border_width
,
2038 CopyFromParent
, /* depth */
2039 InputOutput
, /* class */
2040 screen_visual
, /* set in Fx_open_connection */
2041 attribute_mask
, &attributes
);
2043 validate_x_resource_name ();
2044 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2045 class_hints
.res_class
= EMACS_CLASS
;
2046 XSetClassHint (x_current_display
, FRAME_X_WINDOW (f
), &class_hints
);
2048 /* This indicates that we use the "Passive Input" input model.
2049 Unless we do this, we don't get the Focus{In,Out} events that we
2050 need to draw the cursor correctly. Accursed bureaucrats.
2051 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
2053 f
->display
.x
->wm_hints
.input
= True
;
2054 f
->display
.x
->wm_hints
.flags
|= InputHint
;
2055 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
2057 /* Request "save yourself" and "delete window" commands from wm. */
2060 protocols
[0] = Xatom_wm_delete_window
;
2061 protocols
[1] = Xatom_wm_save_yourself
;
2062 XSetWMProtocols (x_current_display
, FRAME_X_WINDOW (f
), protocols
, 2);
2065 /* x_set_name normally ignores requests to set the name if the
2066 requested name is the same as the current name. This is the one
2067 place where that assumption isn't correct; f->name is set, but
2068 the X server hasn't been told. */
2071 int explicit = f
->explicit_name
;
2073 f
->explicit_name
= 0;
2076 x_set_name (f
, name
, explicit);
2079 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
2080 f
->display
.x
->text_cursor
);
2084 if (FRAME_X_WINDOW (f
) == 0)
2085 error ("Unable to create window");
2088 #endif /* not USE_X_TOOLKIT */
2090 /* Handle the icon stuff for this window. Perhaps later we might
2091 want an x_set_icon_position which can be called interactively as
2099 Lisp_Object icon_x
, icon_y
;
2101 /* Set the position of the icon. Note that twm groups all
2102 icons in an icon window. */
2103 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
2104 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
2105 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
2107 CHECK_NUMBER (icon_x
, 0);
2108 CHECK_NUMBER (icon_y
, 0);
2110 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
2111 error ("Both left and top icon corners of icon must be specified");
2115 if (! EQ (icon_x
, Qunbound
))
2116 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
2118 /* Start up iconic or window? */
2119 x_wm_set_window_state
2120 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
2127 /* Make the GC's needed for this window, setting the
2128 background, border and mouse colors; also create the
2129 mouse cursor and the gray border tile. */
2131 static char cursor_bits
[] =
2133 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2134 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2135 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2136 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2143 XGCValues gc_values
;
2149 /* Create the GC's of this frame.
2150 Note that many default values are used. */
2153 gc_values
.font
= f
->display
.x
->font
->fid
;
2154 gc_values
.foreground
= f
->display
.x
->foreground_pixel
;
2155 gc_values
.background
= f
->display
.x
->background_pixel
;
2156 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
2157 f
->display
.x
->normal_gc
= XCreateGC (x_current_display
,
2159 GCLineWidth
| GCFont
2160 | GCForeground
| GCBackground
,
2163 /* Reverse video style. */
2164 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2165 gc_values
.background
= f
->display
.x
->foreground_pixel
;
2166 f
->display
.x
->reverse_gc
= XCreateGC (x_current_display
,
2168 GCFont
| GCForeground
| GCBackground
2172 /* Cursor has cursor-color background, background-color foreground. */
2173 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2174 gc_values
.background
= f
->display
.x
->cursor_pixel
;
2175 gc_values
.fill_style
= FillOpaqueStippled
;
2177 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
2178 cursor_bits
, 16, 16);
2179 f
->display
.x
->cursor_gc
2180 = XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
2181 (GCFont
| GCForeground
| GCBackground
2182 | GCFillStyle
| GCStipple
| GCLineWidth
),
2185 /* Create the gray border tile used when the pointer is not in
2186 the frame. Since this depends on the frame's pixel values,
2187 this must be done on a per-frame basis. */
2188 f
->display
.x
->border_tile
2189 = (XCreatePixmapFromBitmapData
2190 (x_current_display
, ROOT_WINDOW
,
2191 gray_bits
, gray_width
, gray_height
,
2192 f
->display
.x
->foreground_pixel
,
2193 f
->display
.x
->background_pixel
,
2194 DefaultDepth (x_current_display
, XDefaultScreen (x_current_display
))));
2198 #endif /* HAVE_X11 */
2200 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
2202 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2203 Return an Emacs frame object representing the X window.\n\
2204 ALIST is an alist of frame parameters.\n\
2205 If the parameters specify that the frame should not have a minibuffer,\n\
2206 and do not specify a specific minibuffer window to use,\n\
2207 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2208 be shared by the new frame.")
2214 Lisp_Object frame
, tem
;
2216 int minibuffer_only
= 0;
2217 long window_prompting
= 0;
2219 int count
= specpdl_ptr
- specpdl
;
2223 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
2224 if (XTYPE (name
) != Lisp_String
2225 && ! EQ (name
, Qunbound
)
2227 error ("x-create-frame: name parameter must be a string");
2229 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2230 if (EQ (tem
, Qnone
) || NILP (tem
))
2231 f
= make_frame_without_minibuffer (Qnil
);
2232 else if (EQ (tem
, Qonly
))
2234 f
= make_minibuffer_frame ();
2235 minibuffer_only
= 1;
2237 else if (XTYPE (tem
) == Lisp_Window
)
2238 f
= make_frame_without_minibuffer (tem
);
2242 /* Note that X Windows does support scroll bars. */
2243 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
2245 /* Set the name; the functions to which we pass f expect the name to
2247 if (EQ (name
, Qunbound
) || NILP (name
))
2249 f
->name
= build_string (x_id_name
);
2250 f
->explicit_name
= 0;
2255 f
->explicit_name
= 1;
2256 /* use the frame's title when getting resources for this frame. */
2257 specbind (Qx_resource_name
, name
);
2260 XSET (frame
, Lisp_Frame
, f
);
2261 f
->output_method
= output_x_window
;
2262 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2263 bzero (f
->display
.x
, sizeof (struct x_display
));
2265 /* Note that the frame has no physical cursor right now. */
2266 f
->phys_cursor_x
= -1;
2268 /* Extract the window parameters from the supplied values
2269 that are needed to determine window geometry. */
2273 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
2275 /* First, try whatever font the caller has specified. */
2277 font
= x_new_font (f
, XSTRING (font
)->data
);
2278 /* Try out a font which we hope has bold and italic variations. */
2279 if (!STRINGP (font
))
2280 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2281 if (! STRINGP (font
))
2282 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2283 if (! STRINGP (font
))
2284 /* This was formerly the first thing tried, but it finds too many fonts
2285 and takes too long. */
2286 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
2287 /* If those didn't work, look for something which will at least work. */
2288 if (! STRINGP (font
))
2289 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1");
2291 if (! STRINGP (font
))
2292 font
= build_string ("fixed");
2294 x_default_parameter (f
, parms
, Qfont
, font
,
2295 "font", "Font", string
);
2298 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
2299 "borderwidth", "BorderWidth", number
);
2300 /* This defaults to 2 in order to match xterm. We recognize either
2301 internalBorderWidth or internalBorder (which is what xterm calls
2303 if (NILP (Fassq (Qinternal_border_width
, parms
)))
2307 value
= x_get_arg (parms
, Qinternal_border_width
,
2308 "internalBorder", "BorderWidth", number
);
2309 if (! EQ (value
, Qunbound
))
2310 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
2313 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
2314 "internalBorderWidth", "BorderWidth", number
);
2315 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
2316 "verticalScrollBars", "ScrollBars", boolean
);
2318 /* Also do the stuff which must be set before the window exists. */
2319 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
2320 "foreground", "Foreground", string
);
2321 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
2322 "background", "Background", string
);
2323 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
2324 "pointerColor", "Foreground", string
);
2325 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
2326 "cursorColor", "Foreground", string
);
2327 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
2328 "borderColor", "BorderColor", string
);
2330 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (0),
2331 "menuBarLines", "MenuBarLines", number
);
2333 f
->display
.x
->parent_desc
= ROOT_WINDOW
;
2334 window_prompting
= x_figure_window_size (f
, parms
);
2336 if (window_prompting
& XNegative
)
2338 if (window_prompting
& YNegative
)
2339 f
->display
.x
->win_gravity
= SouthEastGravity
;
2341 f
->display
.x
->win_gravity
= NorthEastGravity
;
2345 if (window_prompting
& YNegative
)
2346 f
->display
.x
->win_gravity
= SouthWestGravity
;
2348 f
->display
.x
->win_gravity
= NorthWestGravity
;
2351 f
->display
.x
->size_hint_flags
= window_prompting
;
2353 #ifdef USE_X_TOOLKIT
2354 x_window (f
, window_prompting
, minibuffer_only
);
2360 init_frame_faces (f
);
2362 /* We need to do this after creating the X window, so that the
2363 icon-creation functions can say whose icon they're describing. */
2364 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2365 "bitmapIcon", "BitmapIcon", symbol
);
2367 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
2368 "autoRaise", "AutoRaiseLower", boolean
);
2369 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
2370 "autoLower", "AutoRaiseLower", boolean
);
2371 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
2372 "cursorType", "CursorType", symbol
);
2374 /* Dimensions, especially f->height, must be done via change_frame_size.
2375 Change will not be effected unless different from the current
2379 f
->height
= f
->width
= 0;
2380 change_frame_size (f
, height
, width
, 1, 0);
2382 /* With the toolkit, the geometry management is done in x_window. */
2383 #ifndef USE_X_TOOLKIT
2385 x_wm_set_size_hint (f
, window_prompting
, 0);
2387 #endif /* USE_X_TOOLKIT */
2389 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2390 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2392 /* It is now ok to make the frame official
2393 even if we get an error below.
2394 And the frame needs to be on Vframe_list
2395 or making it visible won't work. */
2396 Vframe_list
= Fcons (frame
, Vframe_list
);
2398 /* Make the window appear on the frame and enable display,
2399 unless the caller says not to. */
2401 Lisp_Object visibility
;
2403 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2404 if (EQ (visibility
, Qunbound
))
2407 if (EQ (visibility
, Qicon
))
2408 x_iconify_frame (f
);
2409 else if (! NILP (visibility
))
2410 x_make_frame_visible (f
);
2412 /* Must have been Qnil. */
2416 return unbind_to (count
, frame
);
2419 Lisp_Object frame
, tem
;
2421 int pixelwidth
, pixelheight
;
2426 int minibuffer_only
= 0;
2427 Lisp_Object vscroll
, hscroll
;
2429 if (x_current_display
== 0)
2430 error ("X windows are not in use or not initialized");
2432 name
= Fassq (Qname
, parms
);
2434 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2435 if (EQ (tem
, Qnone
))
2436 f
= make_frame_without_minibuffer (Qnil
);
2437 else if (EQ (tem
, Qonly
))
2439 f
= make_minibuffer_frame ();
2440 minibuffer_only
= 1;
2442 else if (EQ (tem
, Qnil
) || EQ (tem
, Qunbound
))
2445 f
= make_frame_without_minibuffer (tem
);
2447 parent
= ROOT_WINDOW
;
2449 XSET (frame
, Lisp_Frame
, f
);
2450 f
->output_method
= output_x_window
;
2451 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2452 bzero (f
->display
.x
, sizeof (struct x_display
));
2454 /* Some temporary default values for height and width. */
2457 f
->display
.x
->left_pos
= -1;
2458 f
->display
.x
->top_pos
= -1;
2460 /* Give the frame a default name (which may be overridden with PARMS). */
2462 strncpy (iconidentity
, ICONTAG
, MAXICID
);
2463 if (gethostname (&iconidentity
[sizeof (ICONTAG
) - 1],
2464 (MAXICID
- 1) - sizeof (ICONTAG
)))
2465 iconidentity
[sizeof (ICONTAG
) - 2] = '\0';
2466 f
->name
= build_string (iconidentity
);
2468 /* Extract some window parameters from the supplied values.
2469 These are the parameters that affect window geometry. */
2471 tem
= x_get_arg (parms
, Qfont
, "BodyFont", 0, string
);
2472 if (EQ (tem
, Qunbound
))
2473 tem
= build_string ("9x15");
2474 x_set_font (f
, tem
, Qnil
);
2475 x_default_parameter (f
, parms
, Qborder_color
,
2476 build_string ("black"), "Border", 0, string
);
2477 x_default_parameter (f
, parms
, Qbackground_color
,
2478 build_string ("white"), "Background", 0, string
);
2479 x_default_parameter (f
, parms
, Qforeground_color
,
2480 build_string ("black"), "Foreground", 0, string
);
2481 x_default_parameter (f
, parms
, Qmouse_color
,
2482 build_string ("black"), "Mouse", 0, string
);
2483 x_default_parameter (f
, parms
, Qcursor_color
,
2484 build_string ("black"), "Cursor", 0, string
);
2485 x_default_parameter (f
, parms
, Qborder_width
,
2486 make_number (2), "BorderWidth", 0, number
);
2487 x_default_parameter (f
, parms
, Qinternal_border_width
,
2488 make_number (4), "InternalBorderWidth", 0, number
);
2489 x_default_parameter (f
, parms
, Qauto_raise
,
2490 Qnil
, "AutoRaise", 0, boolean
);
2492 hscroll
= EQ (x_get_arg (parms
, Qhorizontal_scroll_bar
, 0, 0, boolean
), Qt
);
2493 vscroll
= EQ (x_get_arg (parms
, Qvertical_scroll_bar
, 0, 0, boolean
), Qt
);
2495 if (f
->display
.x
->internal_border_width
< 0)
2496 f
->display
.x
->internal_border_width
= 0;
2498 tem
= x_get_arg (parms
, Qwindow_id
, 0, 0, number
);
2499 if (!EQ (tem
, Qunbound
))
2501 WINDOWINFO_TYPE wininfo
;
2503 Window
*children
, root
;
2505 CHECK_NUMBER (tem
, 0);
2506 FRAME_X_WINDOW (f
) = (Window
) XINT (tem
);
2509 XGetWindowInfo (FRAME_X_WINDOW (f
), &wininfo
);
2510 XQueryTree (FRAME_X_WINDOW (f
), &parent
, &nchildren
, &children
);
2514 height
= PIXEL_TO_CHAR_HEIGHT (f
, wininfo
.height
);
2515 width
= PIXEL_TO_CHAR_WIDTH (f
, wininfo
.width
);
2516 f
->display
.x
->left_pos
= wininfo
.x
;
2517 f
->display
.x
->top_pos
= wininfo
.y
;
2518 FRAME_SET_VISIBILITY (f
, wininfo
.mapped
!= 0);
2519 f
->display
.x
->border_width
= wininfo
.bdrwidth
;
2520 f
->display
.x
->parent_desc
= parent
;
2524 tem
= x_get_arg (parms
, Qparent_id
, 0, 0, number
);
2525 if (!EQ (tem
, Qunbound
))
2527 CHECK_NUMBER (tem
, 0);
2528 parent
= (Window
) XINT (tem
);
2530 f
->display
.x
->parent_desc
= parent
;
2531 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2532 if (EQ (tem
, Qunbound
))
2534 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2535 if (EQ (tem
, Qunbound
))
2537 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2538 if (EQ (tem
, Qunbound
))
2539 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2542 /* Now TEM is Qunbound if no edge or size was specified.
2543 In that case, we must do rubber-banding. */
2544 if (EQ (tem
, Qunbound
))
2546 tem
= x_get_arg (parms
, Qgeometry
, 0, 0, number
);
2548 &f
->display
.x
->left_pos
, &f
->display
.x
->top_pos
,
2550 (XTYPE (tem
) == Lisp_String
2551 ? (char *) XSTRING (tem
)->data
: ""),
2552 XSTRING (f
->name
)->data
,
2553 !NILP (hscroll
), !NILP (vscroll
));
2557 /* Here if at least one edge or size was specified.
2558 Demand that they all were specified, and use them. */
2559 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2560 if (EQ (tem
, Qunbound
))
2561 error ("Height not specified");
2562 CHECK_NUMBER (tem
, 0);
2563 height
= XINT (tem
);
2565 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2566 if (EQ (tem
, Qunbound
))
2567 error ("Width not specified");
2568 CHECK_NUMBER (tem
, 0);
2571 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2572 if (EQ (tem
, Qunbound
))
2573 error ("Top position not specified");
2574 CHECK_NUMBER (tem
, 0);
2575 f
->display
.x
->left_pos
= XINT (tem
);
2577 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2578 if (EQ (tem
, Qunbound
))
2579 error ("Left position not specified");
2580 CHECK_NUMBER (tem
, 0);
2581 f
->display
.x
->top_pos
= XINT (tem
);
2584 pixelwidth
= CHAR_TO_PIXEL_WIDTH (f
, width
);
2585 pixelheight
= CHAR_TO_PIXEL_HEIGHT (f
, height
);
2589 = XCreateWindow (parent
,
2590 f
->display
.x
->left_pos
, /* Absolute horizontal offset */
2591 f
->display
.x
->top_pos
, /* Absolute Vertical offset */
2592 pixelwidth
, pixelheight
,
2593 f
->display
.x
->border_width
,
2594 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
2596 if (FRAME_X_WINDOW (f
) == 0)
2597 error ("Unable to create window.");
2600 /* Install the now determined height and width
2601 in the windows and in phys_lines and desired_lines. */
2602 change_frame_size (f
, height
, width
, 1, 0);
2603 XSelectInput (FRAME_X_WINDOW (f
), KeyPressed
| ExposeWindow
2604 | ButtonPressed
| ButtonReleased
| ExposeRegion
| ExposeCopy
2605 | EnterWindow
| LeaveWindow
| UnmapWindow
);
2606 x_set_resize_hint (f
);
2608 /* Tell the server the window's default name. */
2609 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
), XSTRING (f
->name
)->data
);
2611 /* Now override the defaults with all the rest of the specified
2613 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2614 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2616 /* Do not create an icon window if the caller says not to */
2617 if (!EQ (x_get_arg (parms
, Qsuppress_icon
, 0, 0, boolean
), Qt
)
2618 || f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2620 x_text_icon (f
, iconidentity
);
2621 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2622 "BitmapIcon", 0, symbol
);
2625 /* Tell the X server the previously set values of the
2626 background, border and mouse colors; also create the mouse cursor. */
2628 temp
= XMakeTile (f
->display
.x
->background_pixel
);
2629 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
2632 x_set_border_pixel (f
, f
->display
.x
->border_pixel
);
2634 x_set_mouse_color (f
, Qnil
, Qnil
);
2636 /* Now override the defaults with all the rest of the specified parms. */
2638 Fmodify_frame_parameters (frame
, parms
);
2640 /* Make the window appear on the frame and enable display. */
2642 Lisp_Object visibility
;
2644 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2645 if (EQ (visibility
, Qunbound
))
2648 if (! EQ (visibility
, Qicon
)
2649 && ! NILP (visibility
))
2650 x_make_window_visible (f
);
2653 SET_FRAME_GARBAGED (f
);
2655 Vframe_list
= Fcons (frame
, Vframe_list
);
2661 x_get_focus_frame ()
2664 if (! x_focus_frame
)
2667 XSET (xfocus
, Lisp_Frame
, x_focus_frame
);
2671 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
2672 "Set the focus on FRAME.")
2676 CHECK_LIVE_FRAME (frame
, 0);
2678 if (FRAME_X_P (XFRAME (frame
)))
2681 x_focus_on_frame (XFRAME (frame
));
2689 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
2690 "If a frame has been focused, release it.")
2696 x_unfocus_frame (x_focus_frame
);
2704 /* Computes an X-window size and position either from geometry GEO
2707 F is a frame. It specifies an X window which is used to
2708 determine which display to compute for. Its font, borders
2709 and colors control how the rectangle will be displayed.
2711 X and Y are where to store the positions chosen.
2712 WIDTH and HEIGHT are where to store the sizes chosen.
2714 GEO is the geometry that may specify some of the info.
2715 STR is a prompt to display.
2716 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2719 x_rubber_band (f
, x
, y
, width
, height
, geo
, str
, hscroll
, vscroll
)
2721 int *x
, *y
, *width
, *height
;
2724 int hscroll
, vscroll
;
2730 int background_color
;
2736 background_color
= f
->display
.x
->background_pixel
;
2737 border_color
= f
->display
.x
->border_pixel
;
2739 frame
.bdrwidth
= f
->display
.x
->border_width
;
2740 frame
.border
= XMakeTile (border_color
);
2741 frame
.background
= XMakeTile (background_color
);
2742 tempwindow
= XCreateTerm (str
, "emacs", geo
, default_window
, &frame
, 10, 5,
2743 (2 * f
->display
.x
->internal_border_width
2744 + (vscroll
? VSCROLL_WIDTH
: 0)),
2745 (2 * f
->display
.x
->internal_border_width
2746 + (hscroll
? HSCROLL_HEIGHT
: 0)),
2747 width
, height
, f
->display
.x
->font
,
2748 FONT_WIDTH (f
->display
.x
->font
),
2749 f
->display
.x
->line_height
);
2750 XFreePixmap (frame
.border
);
2751 XFreePixmap (frame
.background
);
2753 if (tempwindow
!= 0)
2755 XQueryWindow (tempwindow
, &wininfo
);
2756 XDestroyWindow (tempwindow
);
2761 /* Coordinates we got are relative to the root window.
2762 Convert them to coordinates relative to desired parent window
2763 by scanning from there up to the root. */
2764 tempwindow
= f
->display
.x
->parent_desc
;
2765 while (tempwindow
!= ROOT_WINDOW
)
2769 XQueryWindow (tempwindow
, &wininfo
);
2772 XQueryTree (tempwindow
, &tempwindow
, &nchildren
, &children
);
2777 return tempwindow
!= 0;
2779 #endif /* not HAVE_X11 */
2781 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
2782 "Return a list of the names of available fonts matching PATTERN.\n\
2783 If optional arguments FACE and FRAME are specified, return only fonts\n\
2784 the same size as FACE on FRAME.\n\
2786 PATTERN is a string, perhaps with wildcard characters;\n\
2787 the * character matches any substring, and\n\
2788 the ? character matches any single character.\n\
2789 PATTERN is case-insensitive.\n\
2790 FACE is a face name - a symbol.\n\
2792 The return value is a list of strings, suitable as arguments to\n\
2795 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
2796 even if they match PATTERN and FACE.")
2797 (pattern
, face
, frame
)
2798 Lisp_Object pattern
, face
, frame
;
2803 XFontStruct
*size_ref
;
2807 CHECK_STRING (pattern
, 0);
2809 CHECK_SYMBOL (face
, 1);
2811 CHECK_LIVE_FRAME (frame
, 2);
2817 FRAME_PTR f
= NILP (frame
) ? selected_frame
: XFRAME (frame
);
2820 /* Don't die if we get called with a terminal frame. */
2821 if (! FRAME_X_P (f
))
2822 error ("non-X frame used in `x-list-fonts'");
2824 face_id
= face_name_id_number (f
, face
);
2826 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
2827 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
2828 size_ref
= f
->display
.x
->font
;
2831 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
2832 if (size_ref
== (XFontStruct
*) (~0))
2833 size_ref
= f
->display
.x
->font
;
2839 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
2840 #ifdef BROKEN_XLISTFONTSWITHINFO
2841 names
= XListFonts (x_current_display
,
2842 XSTRING (pattern
)->data
,
2843 2000, /* maxnames */
2844 &num_fonts
); /* count_return */
2846 names
= XListFontsWithInfo (x_current_display
,
2847 XSTRING (pattern
)->data
,
2848 2000, /* maxnames */
2849 &num_fonts
, /* count_return */
2850 &info
); /* info_return */
2862 for (i
= 0; i
< num_fonts
; i
++)
2864 XFontStruct
*thisinfo
;
2866 #ifdef BROKEN_XLISTFONTSWITHINFO
2868 thisinfo
= XLoadQueryFont (x_current_display
, names
[i
]);
2871 thisinfo
= &info
[i
];
2873 if (thisinfo
&& (! size_ref
2874 || same_size_fonts (thisinfo
, size_ref
)))
2876 *tail
= Fcons (build_string (names
[i
]), Qnil
);
2877 tail
= &XCONS (*tail
)->cdr
;
2882 #ifdef BROKEN_XLISTFONTSWITHINFO
2883 XFreeFontNames (names
);
2885 XFreeFontInfo (names
, info
, num_fonts
);
2894 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 1, 0,
2895 "Return t if the current X display supports the color named COLOR.")
2902 CHECK_STRING (color
, 0);
2904 if (defined_color (XSTRING (color
)->data
, &foo
))
2910 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 0, 0,
2911 "Return t if the X screen currently in use supports color.")
2916 if (x_screen_planes
<= 2)
2919 switch (screen_visual
->class)
2932 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
2934 "Returns the width in pixels of the display FRAME is on.")
2938 Display
*dpy
= x_current_display
;
2940 return make_number (DisplayWidth (dpy
, DefaultScreen (dpy
)));
2943 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
2944 Sx_display_pixel_height
, 0, 1, 0,
2945 "Returns the height in pixels of the display FRAME is on.")
2949 Display
*dpy
= x_current_display
;
2951 return make_number (DisplayHeight (dpy
, DefaultScreen (dpy
)));
2954 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
2956 "Returns the number of bitplanes of the display FRAME is on.")
2960 Display
*dpy
= x_current_display
;
2962 return make_number (DisplayPlanes (dpy
, DefaultScreen (dpy
)));
2965 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
2967 "Returns the number of color cells of the display FRAME is on.")
2971 Display
*dpy
= x_current_display
;
2973 return make_number (DisplayCells (dpy
, DefaultScreen (dpy
)));
2976 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
2977 Sx_server_max_request_size
,
2979 "Returns the maximum request size of the X server FRAME is using.")
2983 Display
*dpy
= x_current_display
;
2985 return make_number (MAXREQUEST (dpy
));
2988 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
2989 "Returns the vendor ID string of the X server FRAME is on.")
2993 Display
*dpy
= x_current_display
;
2996 vendor
= ServerVendor (dpy
);
2997 if (! vendor
) vendor
= "";
2998 return build_string (vendor
);
3001 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
3002 "Returns the version numbers of the X server in use.\n\
3003 The value is a list of three integers: the major and minor\n\
3004 version numbers of the X Protocol in use, and the vendor-specific release\n\
3005 number. See also the variable `x-server-vendor'.")
3009 Display
*dpy
= x_current_display
;
3012 return Fcons (make_number (ProtocolVersion (dpy
)),
3013 Fcons (make_number (ProtocolRevision (dpy
)),
3014 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
3017 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
3018 "Returns the number of screens on the X server FRAME is on.")
3023 return make_number (ScreenCount (x_current_display
));
3026 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
3027 "Returns the height in millimeters of the X screen FRAME is on.")
3032 return make_number (HeightMMOfScreen (x_screen
));
3035 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
3036 "Returns the width in millimeters of the X screen FRAME is on.")
3041 return make_number (WidthMMOfScreen (x_screen
));
3044 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
3045 Sx_display_backing_store
, 0, 1, 0,
3046 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
3047 The value may be `always', `when-mapped', or `not-useful'.")
3053 switch (DoesBackingStore (x_screen
))
3056 return intern ("always");
3059 return intern ("when-mapped");
3062 return intern ("not-useful");
3065 error ("Strange value for BackingStore parameter of screen");
3069 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
3070 Sx_display_visual_class
, 0, 1, 0,
3071 "Returns the visual class of the display `screen' is on.\n\
3072 The value is one of the symbols `static-gray', `gray-scale',\n\
3073 `static-color', `pseudo-color', `true-color', or `direct-color'.")
3079 switch (screen_visual
->class)
3081 case StaticGray
: return (intern ("static-gray"));
3082 case GrayScale
: return (intern ("gray-scale"));
3083 case StaticColor
: return (intern ("static-color"));
3084 case PseudoColor
: return (intern ("pseudo-color"));
3085 case TrueColor
: return (intern ("true-color"));
3086 case DirectColor
: return (intern ("direct-color"));
3088 error ("Display has an unknown visual class");
3092 DEFUN ("x-display-save-under", Fx_display_save_under
,
3093 Sx_display_save_under
, 0, 1, 0,
3094 "Returns t if the X screen FRAME is on supports the save-under feature.")
3100 if (DoesSaveUnders (x_screen
) == True
)
3107 register struct frame
*f
;
3109 return PIXEL_WIDTH (f
);
3113 register struct frame
*f
;
3115 return PIXEL_HEIGHT (f
);
3119 register struct frame
*f
;
3121 return FONT_WIDTH (f
->display
.x
->font
);
3125 register struct frame
*f
;
3127 return f
->display
.x
->line_height
;
3130 #if 0 /* These no longer seem like the right way to do things. */
3132 /* Draw a rectangle on the frame with left top corner including
3133 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3134 CHARS by LINES wide and long and is the color of the cursor. */
3137 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
3138 register struct frame
*f
;
3140 register int top_char
, left_char
, chars
, lines
;
3144 int left
= (left_char
* FONT_WIDTH (f
->display
.x
->font
)
3145 + f
->display
.x
->internal_border_width
);
3146 int top
= (top_char
* f
->display
.x
->line_height
3147 + f
->display
.x
->internal_border_width
);
3150 width
= FONT_WIDTH (f
->display
.x
->font
) / 2;
3152 width
= FONT_WIDTH (f
->display
.x
->font
) * chars
;
3154 height
= f
->display
.x
->line_height
/ 2;
3156 height
= f
->display
.x
->line_height
* lines
;
3158 XDrawRectangle (x_current_display
, FRAME_X_WINDOW (f
),
3159 gc
, left
, top
, width
, height
);
3162 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
3163 "Draw a rectangle on FRAME between coordinates specified by\n\
3164 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3165 (frame
, X0
, Y0
, X1
, Y1
)
3166 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
3168 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3170 CHECK_LIVE_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
->cursor_gc
,
3205 left
, top
, n_chars
, n_lines
);
3211 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
3212 "Draw a rectangle drawn on FRAME between coordinates\n\
3213 X0, Y0, X1, Y1 in the regular background-pixel.")
3214 (frame
, X0
, Y0
, X1
, Y1
)
3215 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
3217 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3219 CHECK_FRAME (frame
, 0);
3220 CHECK_NUMBER (X0
, 0);
3221 CHECK_NUMBER (Y0
, 1);
3222 CHECK_NUMBER (X1
, 2);
3223 CHECK_NUMBER (Y1
, 3);
3233 n_lines
= y1
- y0
+ 1;
3238 n_lines
= y0
- y1
+ 1;
3244 n_chars
= x1
- x0
+ 1;
3249 n_chars
= x0
- x1
+ 1;
3253 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->reverse_gc
,
3254 left
, top
, n_chars
, n_lines
);
3260 /* Draw lines around the text region beginning at the character position
3261 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3262 pixel and line characteristics. */
3264 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3267 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
3268 register struct frame
*f
;
3270 int top_x
, top_y
, bottom_x
, bottom_y
;
3272 register int ibw
= f
->display
.x
->internal_border_width
;
3273 register int font_w
= FONT_WIDTH (f
->display
.x
->font
);
3274 register int font_h
= f
->display
.x
->line_height
;
3276 int x
= line_len (y
);
3277 XPoint
*pixel_points
3278 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
3279 register XPoint
*this_point
= pixel_points
;
3281 /* Do the horizontal top line/lines */
3284 this_point
->x
= ibw
;
3285 this_point
->y
= ibw
+ (font_h
* top_y
);
3288 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
3290 this_point
->x
= ibw
+ (font_w
* x
);
3291 this_point
->y
= (this_point
- 1)->y
;
3295 this_point
->x
= ibw
;
3296 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
3298 this_point
->x
= ibw
+ (font_w
* top_x
);
3299 this_point
->y
= (this_point
- 1)->y
;
3301 this_point
->x
= (this_point
- 1)->x
;
3302 this_point
->y
= ibw
+ (font_h
* top_y
);
3304 this_point
->x
= ibw
+ (font_w
* x
);
3305 this_point
->y
= (this_point
- 1)->y
;
3308 /* Now do the right side. */
3309 while (y
< bottom_y
)
3310 { /* Right vertical edge */
3312 this_point
->x
= (this_point
- 1)->x
;
3313 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
3316 y
++; /* Horizontal connection to next line */
3319 this_point
->x
= ibw
+ (font_w
/ 2);
3321 this_point
->x
= ibw
+ (font_w
* x
);
3323 this_point
->y
= (this_point
- 1)->y
;
3326 /* Now do the bottom and connect to the top left point. */
3327 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
3330 this_point
->x
= (this_point
- 1)->x
;
3331 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
3333 this_point
->x
= ibw
;
3334 this_point
->y
= (this_point
- 1)->y
;
3336 this_point
->x
= pixel_points
->x
;
3337 this_point
->y
= pixel_points
->y
;
3339 XDrawLines (x_current_display
, FRAME_X_WINDOW (f
),
3341 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
3344 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
3345 "Highlight the region between point and the character under the mouse\n\
3348 register Lisp_Object event
;
3350 register int x0
, y0
, x1
, y1
;
3351 register struct frame
*f
= selected_frame
;
3352 register int p1
, p2
;
3354 CHECK_CONS (event
, 0);
3357 x0
= XINT (Fcar (Fcar (event
)));
3358 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3360 /* If the mouse is past the end of the line, don't that area. */
3361 /* ReWrite this... */
3366 if (y1
> y0
) /* point below mouse */
3367 outline_region (f
, f
->display
.x
->cursor_gc
,
3369 else if (y1
< y0
) /* point above mouse */
3370 outline_region (f
, f
->display
.x
->cursor_gc
,
3372 else /* same line: draw horizontal rectangle */
3375 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3376 x0
, y0
, (x1
- x0
+ 1), 1);
3378 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3379 x1
, y1
, (x0
- x1
+ 1), 1);
3382 XFlush (x_current_display
);
3388 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
3389 "Erase any highlighting of the region between point and the character\n\
3390 at X, Y on the selected frame.")
3392 register Lisp_Object event
;
3394 register int x0
, y0
, x1
, y1
;
3395 register struct frame
*f
= selected_frame
;
3398 x0
= XINT (Fcar (Fcar (event
)));
3399 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3403 if (y1
> y0
) /* point below mouse */
3404 outline_region (f
, f
->display
.x
->reverse_gc
,
3406 else if (y1
< y0
) /* point above mouse */
3407 outline_region (f
, f
->display
.x
->reverse_gc
,
3409 else /* same line: draw horizontal rectangle */
3412 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3413 x0
, y0
, (x1
- x0
+ 1), 1);
3415 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3416 x1
, y1
, (x0
- x1
+ 1), 1);
3424 int contour_begin_x
, contour_begin_y
;
3425 int contour_end_x
, contour_end_y
;
3426 int contour_npoints
;
3428 /* Clip the top part of the contour lines down (and including) line Y_POS.
3429 If X_POS is in the middle (rather than at the end) of the line, drop
3430 down a line at that character. */
3433 clip_contour_top (y_pos
, x_pos
)
3435 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
3436 register XPoint
*end
;
3437 register int npoints
;
3438 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
3440 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
3442 end
= contour_lines
[y_pos
].top_right
;
3443 npoints
= (end
- begin
+ 1);
3444 XDrawLines (x_current_display
, contour_window
,
3445 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3447 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
3448 contour_last_point
-= (npoints
- 2);
3449 XDrawLines (x_current_display
, contour_window
,
3450 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
3451 XFlush (x_current_display
);
3453 /* Now, update contour_lines structure. */
3458 register XPoint
*p
= begin
+ 1;
3459 end
= contour_lines
[y_pos
].bottom_right
;
3460 npoints
= (end
- begin
+ 1);
3461 XDrawLines (x_current_display
, contour_window
,
3462 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3465 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
3467 p
->y
= begin
->y
+ font_h
;
3469 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
3470 contour_last_point
-= (npoints
- 5);
3471 XDrawLines (x_current_display
, contour_window
,
3472 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
3473 XFlush (x_current_display
);
3475 /* Now, update contour_lines structure. */
3479 /* Erase the top horizontal lines of the contour, and then extend
3480 the contour upwards. */
3483 extend_contour_top (line
)
3488 clip_contour_bottom (x_pos
, y_pos
)
3494 extend_contour_bottom (x_pos
, y_pos
)
3498 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
3503 register struct frame
*f
= selected_frame
;
3504 register int point_x
= f
->cursor_x
;
3505 register int point_y
= f
->cursor_y
;
3506 register int mouse_below_point
;
3507 register Lisp_Object obj
;
3508 register int x_contour_x
, x_contour_y
;
3510 x_contour_x
= x_mouse_x
;
3511 x_contour_y
= x_mouse_y
;
3512 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
3513 && x_contour_x
> point_x
))
3515 mouse_below_point
= 1;
3516 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3517 x_contour_x
, x_contour_y
);
3521 mouse_below_point
= 0;
3522 outline_region (f
, f
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
3528 obj
= read_char (-1, 0, 0, Qnil
, 0);
3529 if (XTYPE (obj
) != Lisp_Cons
)
3532 if (mouse_below_point
)
3534 if (x_mouse_y
<= point_y
) /* Flipped. */
3536 mouse_below_point
= 0;
3538 outline_region (f
, f
->display
.x
->reverse_gc
, point_x
, point_y
,
3539 x_contour_x
, x_contour_y
);
3540 outline_region (f
, f
->display
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
3543 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
3545 clip_contour_bottom (x_mouse_y
);
3547 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
3549 extend_bottom_contour (x_mouse_y
);
3552 x_contour_x
= x_mouse_x
;
3553 x_contour_y
= x_mouse_y
;
3555 else /* mouse above or same line as point */
3557 if (x_mouse_y
>= point_y
) /* Flipped. */
3559 mouse_below_point
= 1;
3561 outline_region (f
, f
->display
.x
->reverse_gc
,
3562 x_contour_x
, x_contour_y
, point_x
, point_y
);
3563 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3564 x_mouse_x
, x_mouse_y
);
3566 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
3568 clip_contour_top (x_mouse_y
);
3570 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
3572 extend_contour_top (x_mouse_y
);
3577 unread_command_event
= obj
;
3578 if (mouse_below_point
)
3580 contour_begin_x
= point_x
;
3581 contour_begin_y
= point_y
;
3582 contour_end_x
= x_contour_x
;
3583 contour_end_y
= x_contour_y
;
3587 contour_begin_x
= x_contour_x
;
3588 contour_begin_y
= x_contour_y
;
3589 contour_end_x
= point_x
;
3590 contour_end_y
= point_y
;
3595 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
3600 register Lisp_Object obj
;
3601 struct frame
*f
= selected_frame
;
3602 register struct window
*w
= XWINDOW (selected_window
);
3603 register GC line_gc
= f
->display
.x
->cursor_gc
;
3604 register GC erase_gc
= f
->display
.x
->reverse_gc
;
3606 char dash_list
[] = {6, 4, 6, 4};
3608 XGCValues gc_values
;
3610 register int previous_y
;
3611 register int line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3612 + f
->display
.x
->internal_border_width
;
3613 register int left
= f
->display
.x
->internal_border_width
3615 * FONT_WIDTH (f
->display
.x
->font
));
3616 register int right
= left
+ (w
->width
3617 * FONT_WIDTH (f
->display
.x
->font
))
3618 - f
->display
.x
->internal_border_width
;
3622 gc_values
.foreground
= f
->display
.x
->cursor_pixel
;
3623 gc_values
.background
= f
->display
.x
->background_pixel
;
3624 gc_values
.line_width
= 1;
3625 gc_values
.line_style
= LineOnOffDash
;
3626 gc_values
.cap_style
= CapRound
;
3627 gc_values
.join_style
= JoinRound
;
3629 line_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3630 GCLineStyle
| GCJoinStyle
| GCCapStyle
3631 | GCLineWidth
| GCForeground
| GCBackground
,
3633 XSetDashes (x_current_display
, line_gc
, 0, dash_list
, dashes
);
3634 gc_values
.foreground
= f
->display
.x
->background_pixel
;
3635 gc_values
.background
= f
->display
.x
->foreground_pixel
;
3636 erase_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3637 GCLineStyle
| GCJoinStyle
| GCCapStyle
3638 | GCLineWidth
| GCForeground
| GCBackground
,
3640 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
3646 if (x_mouse_y
>= XINT (w
->top
)
3647 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
3649 previous_y
= x_mouse_y
;
3650 line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3651 + f
->display
.x
->internal_border_width
;
3652 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3653 line_gc
, left
, line
, right
, line
);
3660 obj
= read_char (-1, 0, 0, Qnil
, 0);
3661 if ((XTYPE (obj
) != Lisp_Cons
)
3662 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3663 Qvertical_scroll_bar
))
3667 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3668 erase_gc
, left
, line
, right
, line
);
3670 unread_command_event
= obj
;
3672 XFreeGC (x_current_display
, line_gc
);
3673 XFreeGC (x_current_display
, erase_gc
);
3678 while (x_mouse_y
== previous_y
);
3681 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3682 erase_gc
, left
, line
, right
, line
);
3688 /* Offset in buffer of character under the pointer, or 0. */
3689 int mouse_buffer_offset
;
3692 /* These keep track of the rectangle following the pointer. */
3693 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
3695 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
3696 "Track the pointer.")
3699 static Cursor current_pointer_shape
;
3700 FRAME_PTR f
= x_mouse_frame
;
3703 if (EQ (Vmouse_frame_part
, Qtext_part
)
3704 && (current_pointer_shape
!= f
->display
.x
->nontext_cursor
))
3709 current_pointer_shape
= f
->display
.x
->nontext_cursor
;
3710 XDefineCursor (x_current_display
,
3712 current_pointer_shape
);
3714 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
3715 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
3717 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
3718 && (current_pointer_shape
!= f
->display
.x
->modeline_cursor
))
3720 current_pointer_shape
= f
->display
.x
->modeline_cursor
;
3721 XDefineCursor (x_current_display
,
3723 current_pointer_shape
);
3732 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
3733 "Draw rectangle around character under mouse pointer, if there is one.")
3737 struct window
*w
= XWINDOW (Vmouse_window
);
3738 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
3739 struct buffer
*b
= XBUFFER (w
->buffer
);
3742 if (! EQ (Vmouse_window
, selected_window
))
3745 if (EQ (event
, Qnil
))
3749 x_read_mouse_position (selected_frame
, &x
, &y
);
3753 mouse_track_width
= 0;
3754 mouse_track_left
= mouse_track_top
= -1;
3758 if ((x_mouse_x
!= mouse_track_left
3759 && (x_mouse_x
< mouse_track_left
3760 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
3761 || x_mouse_y
!= mouse_track_top
)
3763 int hp
= 0; /* Horizontal position */
3764 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
3765 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
3766 int tab_width
= XINT (b
->tab_width
);
3767 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
3769 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
3770 int in_mode_line
= 0;
3772 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
3775 /* Erase previous rectangle. */
3776 if (mouse_track_width
)
3778 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3779 mouse_track_left
, mouse_track_top
,
3780 mouse_track_width
, 1);
3782 if ((mouse_track_left
== f
->phys_cursor_x
3783 || mouse_track_left
== f
->phys_cursor_x
- 1)
3784 && mouse_track_top
== f
->phys_cursor_y
)
3786 x_display_cursor (f
, 1);
3790 mouse_track_left
= x_mouse_x
;
3791 mouse_track_top
= x_mouse_y
;
3792 mouse_track_width
= 0;
3794 if (mouse_track_left
> len
) /* Past the end of line. */
3797 if (mouse_track_top
== mode_line_vpos
)
3803 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3807 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
3813 mouse_track_width
= tab_width
- (hp
% tab_width
);
3815 hp
+= mouse_track_width
;
3818 mouse_track_left
= hp
- mouse_track_width
;
3824 mouse_track_width
= -1;
3828 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3833 mouse_track_width
= 2;
3838 mouse_track_left
= hp
- mouse_track_width
;
3844 mouse_track_width
= 1;
3851 while (hp
<= x_mouse_x
);
3854 if (mouse_track_width
) /* Over text; use text pointer shape. */
3856 XDefineCursor (x_current_display
,
3858 f
->display
.x
->text_cursor
);
3859 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3860 mouse_track_left
, mouse_track_top
,
3861 mouse_track_width
, 1);
3863 else if (in_mode_line
)
3864 XDefineCursor (x_current_display
,
3866 f
->display
.x
->modeline_cursor
);
3868 XDefineCursor (x_current_display
,
3870 f
->display
.x
->nontext_cursor
);
3873 XFlush (x_current_display
);
3876 obj
= read_char (-1, 0, 0, Qnil
, 0);
3879 while (XTYPE (obj
) == Lisp_Cons
/* Mouse event */
3880 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
3881 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
3882 && EQ (Vmouse_window
, selected_window
) /* In this window */
3885 unread_command_event
= obj
;
3887 if (mouse_track_width
)
3889 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3890 mouse_track_left
, mouse_track_top
,
3891 mouse_track_width
, 1);
3892 mouse_track_width
= 0;
3893 if ((mouse_track_left
== f
->phys_cursor_x
3894 || mouse_track_left
- 1 == f
->phys_cursor_x
)
3895 && mouse_track_top
== f
->phys_cursor_y
)
3897 x_display_cursor (f
, 1);
3900 XDefineCursor (x_current_display
,
3902 f
->display
.x
->nontext_cursor
);
3903 XFlush (x_current_display
);
3913 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3914 on the frame F at position X, Y. */
3916 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
3918 int x
, y
, width
, height
;
3923 image
= XCreateBitmapFromData (x_current_display
,
3924 FRAME_X_WINDOW (f
), image_data
,
3926 XCopyPlane (x_current_display
, image
, FRAME_X_WINDOW (f
),
3927 f
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
3932 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer
, Sx_store_cut_buffer
,
3933 1, 1, "sStore text in cut buffer: ",
3934 "Store contents of STRING into the cut buffer of the X window system.")
3936 register Lisp_Object string
;
3940 CHECK_STRING (string
, 1);
3941 if (! FRAME_X_P (selected_frame
))
3942 error ("Selected frame does not understand X protocol.");
3945 XStoreBytes ((char *) XSTRING (string
)->data
, XSTRING (string
)->size
);
3951 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer
, Sx_get_cut_buffer
, 0, 0, 0,
3952 "Return contents of cut buffer of the X window system, as a string.")
3956 register Lisp_Object string
;
3961 d
= XFetchBytes (&len
);
3962 string
= make_string (d
, len
);
3969 #if 0 /* I'm told these functions are superfluous
3970 given the ability to bind function keys. */
3973 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3974 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3975 KEYSYM is a string which conforms to the X keysym definitions found\n\
3976 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3977 list of strings specifying modifier keys such as Control_L, which must\n\
3978 also be depressed for NEWSTRING to appear.")
3979 (x_keysym
, modifiers
, newstring
)
3980 register Lisp_Object x_keysym
;
3981 register Lisp_Object modifiers
;
3982 register Lisp_Object newstring
;
3985 register KeySym keysym
;
3986 KeySym modifier_list
[16];
3989 CHECK_STRING (x_keysym
, 1);
3990 CHECK_STRING (newstring
, 3);
3992 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
3993 if (keysym
== NoSymbol
)
3994 error ("Keysym does not exist");
3996 if (NILP (modifiers
))
3997 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
3998 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
4001 register Lisp_Object rest
, mod
;
4004 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
4007 error ("Can't have more than 16 modifiers");
4010 CHECK_STRING (mod
, 3);
4011 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
4013 if (modifier_list
[i
] == NoSymbol
4014 || !(IsModifierKey (modifier_list
[i
])
4015 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
4016 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
4018 if (modifier_list
[i
] == NoSymbol
4019 || !IsModifierKey (modifier_list
[i
]))
4021 error ("Element is not a modifier keysym");
4025 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
4026 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
4032 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
4033 "Rebind KEYCODE to list of strings STRINGS.\n\
4034 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4035 nil as element means don't change.\n\
4036 See the documentation of `x-rebind-key' for more information.")
4038 register Lisp_Object keycode
;
4039 register Lisp_Object strings
;
4041 register Lisp_Object item
;
4042 register unsigned char *rawstring
;
4043 KeySym rawkey
, modifier
[1];
4045 register unsigned i
;
4048 CHECK_NUMBER (keycode
, 1);
4049 CHECK_CONS (strings
, 2);
4050 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
4051 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
4053 item
= Fcar (strings
);
4056 CHECK_STRING (item
, 2);
4057 strsize
= XSTRING (item
)->size
;
4058 rawstring
= (unsigned char *) xmalloc (strsize
);
4059 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
4060 modifier
[1] = 1 << i
;
4061 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
4062 rawstring
, strsize
);
4067 #endif /* HAVE_X11 */
4072 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4074 XScreenNumberOfScreen (scr
)
4075 register Screen
*scr
;
4077 register Display
*dpy
;
4078 register Screen
*dpyscr
;
4082 dpyscr
= dpy
->screens
;
4084 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
4090 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4093 select_visual (screen
, depth
)
4095 unsigned int *depth
;
4098 XVisualInfo
*vinfo
, vinfo_template
;
4101 v
= DefaultVisualOfScreen (screen
);
4104 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
4106 vinfo_template
.visualid
= v
->visualid
;
4109 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4111 vinfo
= XGetVisualInfo (x_current_display
,
4112 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
4115 fatal ("Can't get proper X visual info");
4117 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
4118 *depth
= vinfo
->depth
;
4122 int n
= vinfo
->colormap_size
- 1;
4131 XFree ((char *) vinfo
);
4134 #endif /* HAVE_X11 */
4136 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4137 1, 2, 0, "Open a connection to an X server.\n\
4138 DISPLAY is the name of the display to connect to.\n\
4139 Optional second arg XRM_STRING is a string of resources in xrdb format.")
4140 (display
, xrm_string
)
4141 Lisp_Object display
, xrm_string
;
4143 unsigned int n_planes
;
4144 unsigned char *xrm_option
;
4146 CHECK_STRING (display
, 0);
4147 if (x_current_display
!= 0)
4148 error ("X server connection is already initialized");
4149 if (! NILP (xrm_string
))
4150 CHECK_STRING (xrm_string
, 1);
4152 if (! NILP (xrm_string
))
4153 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4155 xrm_option
= (unsigned char *) 0;
4157 validate_x_resource_name ();
4159 /* This is what opens the connection and sets x_current_display.
4160 This also initializes many symbols, such as those used for input. */
4161 x_term_init (XSTRING (display
)->data
, xrm_option
,
4162 XSTRING (Vx_resource_name
)->data
);
4165 XFASTINT (Vwindow_system_version
) = 11;
4168 xrdb
= x_load_resources (x_current_display
, xrm_option
,
4169 (char *) XSTRING (Vx_resource_name
)->data
,
4172 #ifdef HAVE_XRMSETDATABASE
4173 XrmSetDatabase (x_current_display
, xrdb
);
4175 x_current_display
->db
= xrdb
;
4178 x_screen
= DefaultScreenOfDisplay (x_current_display
);
4180 screen_visual
= select_visual (x_screen
, &n_planes
);
4181 x_screen_planes
= n_planes
;
4182 x_screen_height
= HeightOfScreen (x_screen
);
4183 x_screen_width
= WidthOfScreen (x_screen
);
4185 /* X Atoms used by emacs. */
4186 Xatoms_of_xselect ();
4188 Xatom_wm_protocols
= XInternAtom (x_current_display
, "WM_PROTOCOLS",
4190 Xatom_wm_take_focus
= XInternAtom (x_current_display
, "WM_TAKE_FOCUS",
4192 Xatom_wm_save_yourself
= XInternAtom (x_current_display
, "WM_SAVE_YOURSELF",
4194 Xatom_wm_delete_window
= XInternAtom (x_current_display
, "WM_DELETE_WINDOW",
4196 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
4198 Xatom_wm_configure_denied
= XInternAtom (x_current_display
,
4199 "WM_CONFIGURE_DENIED", False
);
4200 Xatom_wm_window_moved
= XInternAtom (x_current_display
, "WM_MOVED",
4202 Xatom_editres_name
= XInternAtom (x_current_display
, "Editres", False
);
4204 #else /* not HAVE_X11 */
4205 XFASTINT (Vwindow_system_version
) = 10;
4206 #endif /* not HAVE_X11 */
4210 DEFUN ("x-close-current-connection", Fx_close_current_connection
,
4211 Sx_close_current_connection
,
4212 0, 0, 0, "Close the connection to the current X server.")
4215 /* Note: If we're going to call check_x here, then the fatal error
4216 can't happen. For the moment, this check is just for safety,
4217 so a user won't try out the function and get a crash. If it's
4218 really intended only to be called when killing emacs, then there's
4219 no reason for it to have a lisp interface at all. */
4222 /* This is ONLY used when killing emacs; For switching displays
4223 we'll have to take care of setting CloseDownMode elsewhere. */
4225 if (x_current_display
)
4228 XSetCloseDownMode (x_current_display
, DestroyAll
);
4229 XCloseDisplay (x_current_display
);
4230 x_current_display
= 0;
4233 fatal ("No current X display connection to close\n");
4238 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
,
4239 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4240 If ON is nil, allow buffering of requests.\n\
4241 Turning on synchronization prohibits the Xlib routines from buffering\n\
4242 requests and seriously degrades performance, but makes debugging much\n\
4249 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
4254 /* Wait for responses to all X commands issued so far for FRAME. */
4261 XSync (x_current_display
, False
);
4267 /* This is zero if not using X windows. */
4268 x_current_display
= 0;
4270 /* The section below is built by the lisp expression at the top of the file,
4271 just above where these variables are declared. */
4272 /*&&& init symbols here &&&*/
4273 Qauto_raise
= intern ("auto-raise");
4274 staticpro (&Qauto_raise
);
4275 Qauto_lower
= intern ("auto-lower");
4276 staticpro (&Qauto_lower
);
4277 Qbackground_color
= intern ("background-color");
4278 staticpro (&Qbackground_color
);
4279 Qbar
= intern ("bar");
4281 Qborder_color
= intern ("border-color");
4282 staticpro (&Qborder_color
);
4283 Qborder_width
= intern ("border-width");
4284 staticpro (&Qborder_width
);
4285 Qbox
= intern ("box");
4287 Qcursor_color
= intern ("cursor-color");
4288 staticpro (&Qcursor_color
);
4289 Qcursor_type
= intern ("cursor-type");
4290 staticpro (&Qcursor_type
);
4291 Qfont
= intern ("font");
4293 Qforeground_color
= intern ("foreground-color");
4294 staticpro (&Qforeground_color
);
4295 Qgeometry
= intern ("geometry");
4296 staticpro (&Qgeometry
);
4297 Qicon_left
= intern ("icon-left");
4298 staticpro (&Qicon_left
);
4299 Qicon_top
= intern ("icon-top");
4300 staticpro (&Qicon_top
);
4301 Qicon_type
= intern ("icon-type");
4302 staticpro (&Qicon_type
);
4303 Qinternal_border_width
= intern ("internal-border-width");
4304 staticpro (&Qinternal_border_width
);
4305 Qleft
= intern ("left");
4307 Qmouse_color
= intern ("mouse-color");
4308 staticpro (&Qmouse_color
);
4309 Qnone
= intern ("none");
4311 Qparent_id
= intern ("parent-id");
4312 staticpro (&Qparent_id
);
4313 Qsuppress_icon
= intern ("suppress-icon");
4314 staticpro (&Qsuppress_icon
);
4315 Qtop
= intern ("top");
4317 Qundefined_color
= intern ("undefined-color");
4318 staticpro (&Qundefined_color
);
4319 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
4320 staticpro (&Qvertical_scroll_bars
);
4321 Qvisibility
= intern ("visibility");
4322 staticpro (&Qvisibility
);
4323 Qwindow_id
= intern ("window-id");
4324 staticpro (&Qwindow_id
);
4325 Qx_frame_parameter
= intern ("x-frame-parameter");
4326 staticpro (&Qx_frame_parameter
);
4327 Qx_resource_name
= intern ("x-resource-name");
4328 staticpro (&Qx_resource_name
);
4329 Quser_position
= intern ("user-position");
4330 staticpro (&Quser_position
);
4331 Quser_size
= intern ("user-size");
4332 staticpro (&Quser_size
);
4333 /* This is the end of symbol initialization. */
4335 Fput (Qundefined_color
, Qerror_conditions
,
4336 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
4337 Fput (Qundefined_color
, Qerror_message
,
4338 build_string ("Undefined color"));
4340 init_x_parm_symbols ();
4342 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset
,
4343 "The buffer offset of the character under the pointer.");
4344 mouse_buffer_offset
= 0;
4346 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
4347 "The shape of the pointer when over text.\n\
4348 Changing the value does not affect existing frames\n\
4349 unless you set the mouse color.");
4350 Vx_pointer_shape
= Qnil
;
4352 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
4353 "The name Emacs uses to look up X resources; for internal use only.\n\
4354 `x-get-resource' uses this as the first component of the instance name\n\
4355 when requesting resource values.\n\
4356 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4357 was invoked, or to the value specified with the `-name' or `-rn'\n\
4358 switches, if present.");
4359 Vx_resource_name
= Qnil
;
4361 #if 0 /* This doesn't really do anything. */
4362 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
4363 "The shape of the pointer when not over text.\n\
4364 This variable takes effect when you create a new frame\n\
4365 or when you set the mouse color.");
4367 Vx_nontext_pointer_shape
= Qnil
;
4369 #if 0 /* This doesn't really do anything. */
4370 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
4371 "The shape of the pointer when over the mode line.\n\
4372 This variable takes effect when you create a new frame\n\
4373 or when you set the mouse color.");
4375 Vx_mode_pointer_shape
= Qnil
;
4377 DEFVAR_INT ("x-sensitive-text-pointer-shape",
4378 &Vx_sensitive_text_pointer_shape
,
4379 "The shape of the pointer when over mouse-sensitive text.\n\
4380 This variable takes effect when you create a new frame\n\
4381 or when you set the mouse color.");
4382 Vx_sensitive_text_pointer_shape
= Qnil
;
4384 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
4385 "A string indicating the foreground color of the cursor box.");
4386 Vx_cursor_fore_pixel
= Qnil
;
4388 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed
,
4389 "Non-nil if a mouse button is currently depressed.");
4390 Vmouse_depressed
= Qnil
;
4392 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
4393 "t if no X window manager is in use.");
4396 defsubr (&Sx_get_resource
);
4398 defsubr (&Sx_draw_rectangle
);
4399 defsubr (&Sx_erase_rectangle
);
4400 defsubr (&Sx_contour_region
);
4401 defsubr (&Sx_uncontour_region
);
4403 defsubr (&Sx_display_color_p
);
4404 defsubr (&Sx_list_fonts
);
4405 defsubr (&Sx_color_defined_p
);
4406 defsubr (&Sx_server_max_request_size
);
4407 defsubr (&Sx_server_vendor
);
4408 defsubr (&Sx_server_version
);
4409 defsubr (&Sx_display_pixel_width
);
4410 defsubr (&Sx_display_pixel_height
);
4411 defsubr (&Sx_display_mm_width
);
4412 defsubr (&Sx_display_mm_height
);
4413 defsubr (&Sx_display_screens
);
4414 defsubr (&Sx_display_planes
);
4415 defsubr (&Sx_display_color_cells
);
4416 defsubr (&Sx_display_visual_class
);
4417 defsubr (&Sx_display_backing_store
);
4418 defsubr (&Sx_display_save_under
);
4420 defsubr (&Sx_rebind_key
);
4421 defsubr (&Sx_rebind_keys
);
4422 defsubr (&Sx_track_pointer
);
4423 defsubr (&Sx_grab_pointer
);
4424 defsubr (&Sx_ungrab_pointer
);
4427 defsubr (&Sx_get_default
);
4428 defsubr (&Sx_store_cut_buffer
);
4429 defsubr (&Sx_get_cut_buffer
);
4431 defsubr (&Sx_parse_geometry
);
4432 defsubr (&Sx_create_frame
);
4433 defsubr (&Sfocus_frame
);
4434 defsubr (&Sunfocus_frame
);
4436 defsubr (&Sx_horizontal_line
);
4438 defsubr (&Sx_open_connection
);
4439 defsubr (&Sx_close_current_connection
);
4440 defsubr (&Sx_synchronize
);
4443 #endif /* HAVE_X_WINDOWS */