1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993, 1994 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* Completely rewritten by Richard Stallman. */
22 /* Rewritten for X11 by Joseph Arceneaux */
34 #include "dispextern.h"
36 #include "blockinput.h"
42 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
43 #include "bitmaps/gray.xbm"
45 #include <X11/bitmaps/gray>
48 #include "[.bitmaps]gray.xbm"
52 #include <X11/Shell.h>
54 #include <X11/Xaw/Paned.h>
55 #include <X11/Xaw/Label.h>
58 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
67 #include "../lwlib/lwlib.h"
69 /* The one and only application context associated with the connection
70 to the one and only X display that Emacs uses. */
71 XtAppContext Xt_app_con
;
73 /* The one and only application shell. Emacs screens are popup shells of this
77 extern void free_frame_menubar ();
78 extern void free_frame_menubar ();
79 #endif /* USE_X_TOOLKIT */
81 #define min(a,b) ((a) < (b) ? (a) : (b))
82 #define max(a,b) ((a) > (b) ? (a) : (b))
85 /* X Resource data base */
86 static XrmDatabase xrdb
;
88 /* The class of this X application. */
89 #define EMACS_CLASS "Emacs"
92 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
94 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
97 /* The name we're using in resource queries. */
98 Lisp_Object Vx_resource_name
;
100 /* Title name and application name for X stuff. */
101 extern char *x_id_name
;
103 /* The background and shape of the mouse pointer, and shape when not
104 over text or in the modeline. */
105 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
106 /* The shape when over mouse-sensitive text. */
107 Lisp_Object Vx_sensitive_text_pointer_shape
;
109 /* Color of chars displayed in cursor box. */
110 Lisp_Object Vx_cursor_fore_pixel
;
112 /* The screen being used. */
113 static Screen
*x_screen
;
115 /* The X Visual we are using for X windows (the default) */
116 Visual
*screen_visual
;
118 /* Height of this X screen in pixels. */
121 /* Width of this X screen in pixels. */
124 /* Number of planes for this screen. */
127 /* Non nil if no window manager is in use. */
128 Lisp_Object Vx_no_window_manager
;
130 /* `t' if a mouse button is depressed. */
132 Lisp_Object Vmouse_depressed
;
134 extern unsigned int x_mouse_x
, x_mouse_y
, x_mouse_grabbed
;
136 /* Atom for indicating window state to the window manager. */
137 extern Atom Xatom_wm_change_state
;
139 /* Communication with window managers. */
140 extern Atom Xatom_wm_protocols
;
142 /* Kinds of protocol things we may receive. */
143 extern Atom Xatom_wm_take_focus
;
144 extern Atom Xatom_wm_save_yourself
;
145 extern Atom Xatom_wm_delete_window
;
147 /* Other WM communication */
148 extern Atom Xatom_wm_configure_denied
; /* When our config request is denied */
149 extern Atom Xatom_wm_window_moved
; /* When the WM moves us. */
151 /* EditRes protocol */
152 extern Atom Xatom_editres_name
;
156 /* Default size of an Emacs window. */
157 static char *default_window
= "=80x24+0+0";
160 char iconidentity
[MAXICID
];
161 #define ICONTAG "emacs@"
162 char minibuffer_iconidentity
[MAXICID
];
163 #define MINIBUFFER_ICONTAG "minibuffer@"
167 /* The last 23 bits of the timestamp of the last mouse button event. */
168 Time mouse_timestamp
;
170 /* Evaluate this expression to rebuild the section of syms_of_xfns
171 that initializes and staticpros the symbols declared below. Note
172 that Emacs 18 has a bug that keeps C-x C-e from being able to
173 evaluate this expression.
176 ;; Accumulate a list of the symbols we want to initialize from the
177 ;; declarations at the top of the file.
178 (goto-char (point-min))
179 (search-forward "/\*&&& symbols declared here &&&*\/\n")
181 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
183 (cons (buffer-substring (match-beginning 1) (match-end 1))
186 (setq symbol-list (nreverse symbol-list))
187 ;; Delete the section of syms_of_... where we initialize the symbols.
188 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
189 (let ((start (point)))
190 (while (looking-at "^ Q")
192 (kill-region start (point)))
193 ;; Write a new symbol initialization section.
195 (insert (format " %s = intern (\"" (car symbol-list)))
196 (let ((start (point)))
197 (insert (substring (car symbol-list) 1))
198 (subst-char-in-region start (point) ?_ ?-))
199 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
200 (setq symbol-list (cdr symbol-list)))))
204 /*&&& symbols declared here &&&*/
205 Lisp_Object Qauto_raise
;
206 Lisp_Object Qauto_lower
;
207 Lisp_Object Qbackground_color
;
209 Lisp_Object Qborder_color
;
210 Lisp_Object Qborder_width
;
212 Lisp_Object Qcursor_color
;
213 Lisp_Object Qcursor_type
;
215 Lisp_Object Qforeground_color
;
216 Lisp_Object Qgeometry
;
217 /* Lisp_Object Qicon; */
218 Lisp_Object Qicon_left
;
219 Lisp_Object Qicon_top
;
220 Lisp_Object Qicon_type
;
221 Lisp_Object Qinternal_border_width
;
223 Lisp_Object Qmouse_color
;
225 Lisp_Object Qparent_id
;
226 Lisp_Object Qsuppress_icon
;
228 Lisp_Object Qundefined_color
;
229 Lisp_Object Qvertical_scroll_bars
;
230 Lisp_Object Qvisibility
;
231 Lisp_Object Qwindow_id
;
232 Lisp_Object Qx_frame_parameter
;
233 Lisp_Object Qx_resource_name
;
234 Lisp_Object Quser_position
;
235 Lisp_Object Quser_size
;
237 /* The below are defined in frame.c. */
238 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
239 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
;
241 extern Lisp_Object Vwindow_system_version
;
244 /* Error if we are not connected to X. */
248 if (x_current_display
== 0)
249 error ("X windows are not in use or not initialized");
252 /* Nonzero if using X for display. */
257 return x_current_display
!= 0;
260 /* Return the Emacs frame-object corresponding to an X window.
261 It could be the frame's main window or an icon window. */
263 /* This function can be called during GC, so use XGCTYPE. */
266 x_window_to_frame (wdesc
)
269 Lisp_Object tail
, frame
;
272 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
273 tail
= XCONS (tail
)->cdr
)
275 frame
= XCONS (tail
)->car
;
276 if (XGCTYPE (frame
) != Lisp_Frame
)
280 if (f
->display
.nothing
== 1)
282 if ((f
->display
.x
->edit_widget
283 && XtWindow (f
->display
.x
->edit_widget
) == wdesc
)
284 || f
->display
.x
->icon_desc
== wdesc
)
286 #else /* not USE_X_TOOLKIT */
287 if (FRAME_X_WINDOW (f
) == wdesc
288 || f
->display
.x
->icon_desc
== wdesc
)
290 #endif /* not USE_X_TOOLKIT */
296 /* Like x_window_to_frame but also compares the window with the widget's
300 x_any_window_to_frame (wdesc
)
303 Lisp_Object tail
, frame
;
307 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
308 tail
= XCONS (tail
)->cdr
)
310 frame
= XCONS (tail
)->car
;
311 if (XGCTYPE (frame
) != Lisp_Frame
)
314 if (f
->display
.nothing
== 1)
317 /* This frame matches if the window is any of its widgets. */
318 if (wdesc
== XtWindow (x
->widget
)
319 || wdesc
== XtWindow (x
->column_widget
)
320 || wdesc
== XtWindow (x
->edit_widget
))
322 /* Match if the window is this frame's menubar. */
323 if (x
->menubar_widget
324 && wdesc
== XtWindow (x
->menubar_widget
))
330 /* Return the frame whose principal (outermost) window is WDESC.
331 If WDESC is some other (smaller) window, we return 0. */
334 x_top_window_to_frame (wdesc
)
337 Lisp_Object tail
, frame
;
341 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
342 tail
= XCONS (tail
)->cdr
)
344 frame
= XCONS (tail
)->car
;
345 if (XGCTYPE (frame
) != Lisp_Frame
)
348 if (f
->display
.nothing
== 1)
351 /* This frame matches if the window is its topmost widget. */
352 if (wdesc
== XtWindow (x
->widget
))
354 /* Match if the window is this frame's menubar. */
355 if (x
->menubar_widget
356 && wdesc
== XtWindow (x
->menubar_widget
))
361 #endif /* USE_X_TOOLKIT */
364 /* Connect the frame-parameter names for X frames
365 to the ways of passing the parameter values to the window system.
367 The name of a parameter, as a Lisp symbol,
368 has an `x-frame-parameter' property which is an integer in Lisp
369 but can be interpreted as an `enum x_frame_parm' in C. */
373 X_PARM_FOREGROUND_COLOR
,
374 X_PARM_BACKGROUND_COLOR
,
381 X_PARM_INTERNAL_BORDER_WIDTH
,
385 X_PARM_VERT_SCROLL_BAR
,
387 X_PARM_MENU_BAR_LINES
391 struct x_frame_parm_table
394 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
397 void x_set_foreground_color ();
398 void x_set_background_color ();
399 void x_set_mouse_color ();
400 void x_set_cursor_color ();
401 void x_set_border_color ();
402 void x_set_cursor_type ();
403 void x_set_icon_type ();
405 void x_set_border_width ();
406 void x_set_internal_border_width ();
407 void x_explicitly_set_name ();
408 void x_set_autoraise ();
409 void x_set_autolower ();
410 void x_set_vertical_scroll_bars ();
411 void x_set_visibility ();
412 void x_set_menu_bar_lines ();
414 static struct x_frame_parm_table x_frame_parms
[] =
416 "foreground-color", x_set_foreground_color
,
417 "background-color", x_set_background_color
,
418 "mouse-color", x_set_mouse_color
,
419 "cursor-color", x_set_cursor_color
,
420 "border-color", x_set_border_color
,
421 "cursor-type", x_set_cursor_type
,
422 "icon-type", x_set_icon_type
,
424 "border-width", x_set_border_width
,
425 "internal-border-width", x_set_internal_border_width
,
426 "name", x_explicitly_set_name
,
427 "auto-raise", x_set_autoraise
,
428 "auto-lower", x_set_autolower
,
429 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
430 "visibility", x_set_visibility
,
431 "menu-bar-lines", x_set_menu_bar_lines
,
434 /* Attach the `x-frame-parameter' properties to
435 the Lisp symbol names of parameters relevant to X. */
437 init_x_parm_symbols ()
441 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
442 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
446 /* Change the parameters of FRAME as specified by ALIST.
447 If a parameter is not specially recognized, do nothing;
448 otherwise call the `x_set_...' function for that parameter. */
451 x_set_frame_parameters (f
, alist
)
457 /* If both of these parameters are present, it's more efficient to
458 set them both at once. So we wait until we've looked at the
459 entire list before we set them. */
460 Lisp_Object width
, height
;
463 Lisp_Object left
, top
;
465 /* Record in these vectors all the parms specified. */
471 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
474 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
475 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
477 /* Extract parm names and values into those vectors. */
480 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
482 Lisp_Object elt
, prop
, val
;
485 parms
[i
] = Fcar (elt
);
486 values
[i
] = Fcdr (elt
);
490 width
= height
= top
= left
= Qunbound
;
492 /* Now process them in reverse of specified order. */
493 for (i
--; i
>= 0; i
--)
495 Lisp_Object prop
, val
;
500 if (EQ (prop
, Qwidth
))
502 else if (EQ (prop
, Qheight
))
504 else if (EQ (prop
, Qtop
))
506 else if (EQ (prop
, Qleft
))
510 register Lisp_Object param_index
, old_value
;
512 param_index
= Fget (prop
, Qx_frame_parameter
);
513 old_value
= get_frame_param (f
, prop
);
514 store_frame_param (f
, prop
, val
);
515 if (XTYPE (param_index
) == Lisp_Int
516 && XINT (param_index
) >= 0
517 && (XINT (param_index
)
518 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
519 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
523 /* Don't die if just one of these was set. */
524 if (EQ (left
, Qunbound
))
525 XSET (left
, Lisp_Int
, f
->display
.x
->left_pos
);
526 if (EQ (top
, Qunbound
))
527 XSET (top
, Lisp_Int
, f
->display
.x
->top_pos
);
529 /* Don't die if just one of these was set. */
530 if (EQ (width
, Qunbound
))
531 XSET (width
, Lisp_Int
, FRAME_WIDTH (f
));
532 if (EQ (height
, Qunbound
))
533 XSET (height
, Lisp_Int
, FRAME_HEIGHT (f
));
535 /* Don't set these parameters these unless they've been explicitly
536 specified. The window might be mapped or resized while we're in
537 this function, and we don't want to override that unless the lisp
538 code has asked for it.
540 Don't set these parameters unless they actually differ from the
541 window's current parameters; the window may not actually exist
546 check_frame_size (f
, &height
, &width
);
548 XSET (frame
, Lisp_Frame
, f
);
550 if ((NUMBERP (width
) && XINT (width
) != FRAME_WIDTH (f
))
551 || (NUMBERP (height
) && XINT (height
) != FRAME_HEIGHT (f
)))
552 Fset_frame_size (frame
, width
, height
);
553 if ((NUMBERP (left
) && XINT (left
) != f
->display
.x
->left_pos
)
554 || (NUMBERP (top
) && XINT (top
) != f
->display
.x
->top_pos
))
555 Fset_frame_position (frame
, left
, top
);
559 /* Store the positions of frame F into XPTR and YPTR.
560 These are the positions of the containing window manager window,
561 not Emacs's own window. */
564 x_real_positions (f
, xptr
, yptr
)
568 int win_x
= 0, win_y
= 0;
571 /* Find the position of the outside upper-left corner of
572 the inner window, with respect to the outer window. */
573 if (f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
576 XTranslateCoordinates (x_current_display
,
578 /* From-window, to-window. */
580 XtWindow (f
->display
.x
->widget
),
582 f
->display
.x
->window_desc
,
584 f
->display
.x
->parent_desc
,
586 /* From-position, to-position. */
587 0, 0, &win_x
, &win_y
,
593 win_x
+= f
->display
.x
->border_width
;
594 win_y
+= f
->display
.x
->border_width
;
596 *xptr
= f
->display
.x
->left_pos
- win_x
;
597 *yptr
= f
->display
.x
->top_pos
- win_y
;
600 /* Insert a description of internally-recorded parameters of frame X
601 into the parameter alist *ALISTPTR that is to be given to the user.
602 Only parameters that are specific to the X window system
603 and whose values are not correctly recorded in the frame's
604 param_alist need to be considered here. */
606 x_report_frame_params (f
, alistptr
)
608 Lisp_Object
*alistptr
;
612 store_in_alist (alistptr
, Qleft
, make_number (f
->display
.x
->left_pos
));
613 store_in_alist (alistptr
, Qtop
, make_number (f
->display
.x
->top_pos
));
614 store_in_alist (alistptr
, Qborder_width
,
615 make_number (f
->display
.x
->border_width
));
616 store_in_alist (alistptr
, Qinternal_border_width
,
617 make_number (f
->display
.x
->internal_border_width
));
618 sprintf (buf
, "%d", FRAME_X_WINDOW (f
));
619 store_in_alist (alistptr
, Qwindow_id
,
621 FRAME_SAMPLE_VISIBILITY (f
);
622 store_in_alist (alistptr
, Qvisibility
,
623 (FRAME_VISIBLE_P (f
) ? Qt
624 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
627 /* Decide if color named COLOR is valid for the display
628 associated with the selected frame. */
630 defined_color (color
, color_def
)
635 Colormap screen_colormap
;
640 = DefaultColormap (x_current_display
, XDefaultScreen (x_current_display
));
642 foo
= XParseColor (x_current_display
, screen_colormap
,
644 && XAllocColor (x_current_display
, screen_colormap
, color_def
);
646 foo
= XParseColor (color
, color_def
) && XGetHardwareColor (color_def
);
647 #endif /* not HAVE_X11 */
656 /* Given a string ARG naming a color, compute a pixel value from it
657 suitable for screen F.
658 If F is not a color screen, return DEF (default) regardless of what
662 x_decode_color (arg
, def
)
668 CHECK_STRING (arg
, 0);
670 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
671 return BLACK_PIX_DEFAULT
;
672 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
673 return WHITE_PIX_DEFAULT
;
676 if (x_screen_planes
== 1)
679 if (DISPLAY_CELLS
== 1)
683 if (defined_color (XSTRING (arg
)->data
, &cdef
))
686 Fsignal (Qundefined_color
, Fcons (arg
, Qnil
));
689 /* Functions called only from `x_set_frame_param'
690 to set individual parameters.
692 If FRAME_X_WINDOW (f) is 0,
693 the frame is being created and its X-window does not exist yet.
694 In that case, just record the parameter's new value
695 in the standard place; do not attempt to change the window. */
698 x_set_foreground_color (f
, arg
, oldval
)
700 Lisp_Object arg
, oldval
;
702 f
->display
.x
->foreground_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
703 if (FRAME_X_WINDOW (f
) != 0)
707 XSetForeground (x_current_display
, f
->display
.x
->normal_gc
,
708 f
->display
.x
->foreground_pixel
);
709 XSetBackground (x_current_display
, f
->display
.x
->reverse_gc
,
710 f
->display
.x
->foreground_pixel
);
712 #endif /* HAVE_X11 */
713 recompute_basic_faces (f
);
714 if (FRAME_VISIBLE_P (f
))
720 x_set_background_color (f
, arg
, oldval
)
722 Lisp_Object arg
, oldval
;
727 f
->display
.x
->background_pixel
= x_decode_color (arg
, WHITE_PIX_DEFAULT
);
729 if (FRAME_X_WINDOW (f
) != 0)
733 /* The main frame area. */
734 XSetBackground (x_current_display
, f
->display
.x
->normal_gc
,
735 f
->display
.x
->background_pixel
);
736 XSetForeground (x_current_display
, f
->display
.x
->reverse_gc
,
737 f
->display
.x
->background_pixel
);
738 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
739 f
->display
.x
->background_pixel
);
740 XSetWindowBackground (x_current_display
, FRAME_X_WINDOW (f
),
741 f
->display
.x
->background_pixel
);
744 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
745 bar
= XSCROLL_BAR (bar
)->next
)
746 XSetWindowBackground (x_current_display
,
747 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
748 f
->display
.x
->background_pixel
);
751 temp
= XMakeTile (f
->display
.x
->background_pixel
);
752 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
754 #endif /* not HAVE_X11 */
757 recompute_basic_faces (f
);
759 if (FRAME_VISIBLE_P (f
))
765 x_set_mouse_color (f
, arg
, oldval
)
767 Lisp_Object arg
, oldval
;
769 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
773 f
->display
.x
->mouse_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
774 mask_color
= f
->display
.x
->background_pixel
;
775 /* No invisible pointers. */
776 if (mask_color
== f
->display
.x
->mouse_pixel
777 && mask_color
== f
->display
.x
->background_pixel
)
778 f
->display
.x
->mouse_pixel
= f
->display
.x
->foreground_pixel
;
783 /* It's not okay to crash if the user selects a screwy cursor. */
786 if (!EQ (Qnil
, Vx_pointer_shape
))
788 CHECK_NUMBER (Vx_pointer_shape
, 0);
789 cursor
= XCreateFontCursor (x_current_display
, XINT (Vx_pointer_shape
));
792 cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
793 x_check_errors ("bad text pointer cursor: %s");
795 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
797 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
798 nontext_cursor
= XCreateFontCursor (x_current_display
,
799 XINT (Vx_nontext_pointer_shape
));
802 nontext_cursor
= XCreateFontCursor (x_current_display
, XC_left_ptr
);
803 x_check_errors ("bad nontext pointer cursor: %s");
805 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
807 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
808 mode_cursor
= XCreateFontCursor (x_current_display
,
809 XINT (Vx_mode_pointer_shape
));
812 mode_cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
813 x_check_errors ("bad modeline pointer cursor: %s");
815 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
817 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
819 = XCreateFontCursor (x_current_display
,
820 XINT (Vx_sensitive_text_pointer_shape
));
823 cross_cursor
= XCreateFontCursor (x_current_display
, XC_crosshair
);
825 /* Check and report errors with the above calls. */
826 x_check_errors ("can't set cursor shape: %s");
830 XColor fore_color
, back_color
;
832 fore_color
.pixel
= f
->display
.x
->mouse_pixel
;
833 back_color
.pixel
= mask_color
;
834 XQueryColor (x_current_display
,
835 DefaultColormap (x_current_display
,
836 DefaultScreen (x_current_display
)),
838 XQueryColor (x_current_display
,
839 DefaultColormap (x_current_display
,
840 DefaultScreen (x_current_display
)),
842 XRecolorCursor (x_current_display
, cursor
,
843 &fore_color
, &back_color
);
844 XRecolorCursor (x_current_display
, nontext_cursor
,
845 &fore_color
, &back_color
);
846 XRecolorCursor (x_current_display
, mode_cursor
,
847 &fore_color
, &back_color
);
848 XRecolorCursor (x_current_display
, cross_cursor
,
849 &fore_color
, &back_color
);
852 cursor
= XCreateCursor (16, 16, MouseCursor
, MouseMask
,
854 f
->display
.x
->mouse_pixel
,
855 f
->display
.x
->background_pixel
,
859 if (FRAME_X_WINDOW (f
) != 0)
861 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
), cursor
);
864 if (cursor
!= f
->display
.x
->text_cursor
&& f
->display
.x
->text_cursor
!= 0)
865 XFreeCursor (XDISPLAY f
->display
.x
->text_cursor
);
866 f
->display
.x
->text_cursor
= cursor
;
868 if (nontext_cursor
!= f
->display
.x
->nontext_cursor
869 && f
->display
.x
->nontext_cursor
!= 0)
870 XFreeCursor (XDISPLAY f
->display
.x
->nontext_cursor
);
871 f
->display
.x
->nontext_cursor
= nontext_cursor
;
873 if (mode_cursor
!= f
->display
.x
->modeline_cursor
874 && f
->display
.x
->modeline_cursor
!= 0)
875 XFreeCursor (XDISPLAY f
->display
.x
->modeline_cursor
);
876 f
->display
.x
->modeline_cursor
= mode_cursor
;
877 if (cross_cursor
!= f
->display
.x
->cross_cursor
878 && f
->display
.x
->cross_cursor
!= 0)
879 XFreeCursor (XDISPLAY f
->display
.x
->cross_cursor
);
880 f
->display
.x
->cross_cursor
= cross_cursor
;
881 #endif /* HAVE_X11 */
888 x_set_cursor_color (f
, arg
, oldval
)
890 Lisp_Object arg
, oldval
;
892 unsigned long fore_pixel
;
894 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
895 fore_pixel
= x_decode_color (Vx_cursor_fore_pixel
, WHITE_PIX_DEFAULT
);
897 fore_pixel
= f
->display
.x
->background_pixel
;
898 f
->display
.x
->cursor_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
900 /* Make sure that the cursor color differs from the background color. */
901 if (f
->display
.x
->cursor_pixel
== f
->display
.x
->background_pixel
)
903 f
->display
.x
->cursor_pixel
= f
->display
.x
->mouse_pixel
;
904 if (f
->display
.x
->cursor_pixel
== fore_pixel
)
905 fore_pixel
= f
->display
.x
->background_pixel
;
907 f
->display
.x
->cursor_foreground_pixel
= fore_pixel
;
909 if (FRAME_X_WINDOW (f
) != 0)
913 XSetBackground (x_current_display
, f
->display
.x
->cursor_gc
,
914 f
->display
.x
->cursor_pixel
);
915 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
918 #endif /* HAVE_X11 */
920 if (FRAME_VISIBLE_P (f
))
922 x_display_cursor (f
, 0);
923 x_display_cursor (f
, 1);
928 /* Set the border-color of frame F to value described by ARG.
929 ARG can be a string naming a color.
930 The border-color is used for the border that is drawn by the X server.
931 Note that this does not fully take effect if done before
932 F has an x-window; it must be redone when the window is created.
934 Note: this is done in two routines because of the way X10 works.
936 Note: under X11, this is normally the province of the window manager,
937 and so emacs' border colors may be overridden. */
940 x_set_border_color (f
, arg
, oldval
)
942 Lisp_Object arg
, oldval
;
947 CHECK_STRING (arg
, 0);
948 str
= XSTRING (arg
)->data
;
951 if (!strcmp (str
, "grey") || !strcmp (str
, "Grey")
952 || !strcmp (str
, "gray") || !strcmp (str
, "Gray"))
957 pix
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
959 x_set_border_pixel (f
, pix
);
962 /* Set the border-color of frame F to pixel value PIX.
963 Note that this does not fully take effect if done before
964 F has an x-window. */
966 x_set_border_pixel (f
, pix
)
970 f
->display
.x
->border_pixel
= pix
;
972 if (FRAME_X_WINDOW (f
) != 0 && f
->display
.x
->border_width
> 0)
979 XSetWindowBorder (x_current_display
, FRAME_X_WINDOW (f
),
983 temp
= XMakePixmap ((Bitmap
) XStoreBitmap (gray_width
, gray_height
,
985 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
987 temp
= XMakeTile (pix
);
988 XChangeBorder (FRAME_X_WINDOW (f
), temp
);
989 XFreePixmap (XDISPLAY temp
);
990 #endif /* not HAVE_X11 */
993 if (FRAME_VISIBLE_P (f
))
999 x_set_cursor_type (f
, arg
, oldval
)
1001 Lisp_Object arg
, oldval
;
1004 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1009 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
1010 /* Error messages commented out because people have trouble fixing
1011 .Xdefaults with Emacs, when it has something bad in it. */
1015 ("the `cursor-type' frame parameter should be either `bar' or `box'");
1018 /* Make sure the cursor gets redrawn. This is overkill, but how
1019 often do people change cursor types? */
1020 update_mode_lines
++;
1024 x_set_icon_type (f
, arg
, oldval
)
1026 Lisp_Object arg
, oldval
;
1031 if (EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1036 result
= x_text_icon (f
, 0);
1038 result
= x_bitmap_icon (f
);
1043 error ("No icon window available.");
1046 /* If the window was unmapped (and its icon was mapped),
1047 the new icon is not mapped, so map the window in its stead. */
1048 if (FRAME_VISIBLE_P (f
))
1049 #ifdef USE_X_TOOLKIT
1050 XtPopup (f
->display
.x
->widget
, XtGrabNone
);
1052 XMapWindow (XDISPLAY
FRAME_X_WINDOW (f
));
1058 extern Lisp_Object
x_new_font ();
1061 x_set_font (f
, arg
, oldval
)
1063 Lisp_Object arg
, oldval
;
1067 CHECK_STRING (arg
, 1);
1070 result
= x_new_font (f
, XSTRING (arg
)->data
);
1073 if (EQ (result
, Qnil
))
1074 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
1075 else if (EQ (result
, Qt
))
1076 error ("the characters of the given font have varying widths");
1077 else if (STRINGP (result
))
1079 recompute_basic_faces (f
);
1080 store_frame_param (f
, Qfont
, result
);
1087 x_set_border_width (f
, arg
, oldval
)
1089 Lisp_Object arg
, oldval
;
1091 CHECK_NUMBER (arg
, 0);
1093 if (XINT (arg
) == f
->display
.x
->border_width
)
1096 if (FRAME_X_WINDOW (f
) != 0)
1097 error ("Cannot change the border width of a window");
1099 f
->display
.x
->border_width
= XINT (arg
);
1103 x_set_internal_border_width (f
, arg
, oldval
)
1105 Lisp_Object arg
, oldval
;
1108 int old
= f
->display
.x
->internal_border_width
;
1110 CHECK_NUMBER (arg
, 0);
1111 f
->display
.x
->internal_border_width
= XINT (arg
);
1112 if (f
->display
.x
->internal_border_width
< 0)
1113 f
->display
.x
->internal_border_width
= 0;
1115 if (f
->display
.x
->internal_border_width
== old
)
1118 if (FRAME_X_WINDOW (f
) != 0)
1121 x_set_window_size (f
, 0, f
->width
, f
->height
);
1123 x_set_resize_hint (f
);
1127 SET_FRAME_GARBAGED (f
);
1132 x_set_visibility (f
, value
, oldval
)
1134 Lisp_Object value
, oldval
;
1137 XSET (frame
, Lisp_Frame
, f
);
1140 Fmake_frame_invisible (frame
, Qt
);
1141 else if (EQ (value
, Qicon
))
1142 Ficonify_frame (frame
);
1144 Fmake_frame_visible (frame
);
1148 x_set_menu_bar_lines_1 (window
, n
)
1152 struct window
*w
= XWINDOW (window
);
1154 XFASTINT (w
->top
) += n
;
1155 XFASTINT (w
->height
) -= n
;
1157 /* Handle just the top child in a vertical split. */
1158 if (!NILP (w
->vchild
))
1159 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1161 /* Adjust all children in a horizontal split. */
1162 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1164 w
= XWINDOW (window
);
1165 x_set_menu_bar_lines_1 (window
, n
);
1170 x_set_menu_bar_lines (f
, value
, oldval
)
1172 Lisp_Object value
, oldval
;
1175 int olines
= FRAME_MENU_BAR_LINES (f
);
1177 /* Right now, menu bars don't work properly in minibuf-only frames;
1178 most of the commands try to apply themselves to the minibuffer
1179 frame itslef, and get an error because you can't switch buffers
1180 in or split the minibuffer window. */
1181 if (FRAME_MINIBUF_ONLY_P (f
))
1184 if (XTYPE (value
) == Lisp_Int
)
1185 nlines
= XINT (value
);
1189 #ifdef USE_X_TOOLKIT
1190 FRAME_MENU_BAR_LINES (f
) = 0;
1192 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1195 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1196 free_frame_menubar (f
);
1197 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1198 f
->display
.x
->menubar_widget
= 0;
1200 #else /* not USE_X_TOOLKIT */
1201 FRAME_MENU_BAR_LINES (f
) = nlines
;
1202 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1203 #endif /* not USE_X_TOOLKIT */
1206 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1209 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1210 name; if NAME is a string, set F's name to NAME and set
1211 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1213 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1214 suggesting a new name, which lisp code should override; if
1215 F->explicit_name is set, ignore the new name; otherwise, set it. */
1218 x_set_name (f
, name
, explicit)
1223 /* Make sure that requests from lisp code override requests from
1224 Emacs redisplay code. */
1227 /* If we're switching from explicit to implicit, we had better
1228 update the mode lines and thereby update the title. */
1229 if (f
->explicit_name
&& NILP (name
))
1230 update_mode_lines
= 1;
1232 f
->explicit_name
= ! NILP (name
);
1234 else if (f
->explicit_name
)
1237 /* If NAME is nil, set the name to the x_id_name. */
1239 name
= build_string (x_id_name
);
1241 CHECK_STRING (name
, 0);
1243 /* Don't change the name if it's already NAME. */
1244 if (! NILP (Fstring_equal (name
, f
->name
)))
1247 if (FRAME_X_WINDOW (f
))
1253 text
.value
= XSTRING (name
)->data
;
1254 text
.encoding
= XA_STRING
;
1256 text
.nitems
= XSTRING (name
)->size
;
1257 #ifdef USE_X_TOOLKIT
1258 XSetWMName (x_current_display
, XtWindow (f
->display
.x
->widget
), &text
);
1259 XSetWMIconName (x_current_display
, XtWindow (f
->display
.x
->widget
),
1261 #else /* not USE_X_TOOLKIT */
1262 XSetWMName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1263 XSetWMIconName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1264 #endif /* not USE_X_TOOLKIT */
1266 #else /* not HAVE_X11R4 */
1267 XSetIconName (XDISPLAY
FRAME_X_WINDOW (f
),
1268 XSTRING (name
)->data
);
1269 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
),
1270 XSTRING (name
)->data
);
1271 #endif /* not HAVE_X11R4 */
1278 /* This function should be called when the user's lisp code has
1279 specified a name for the frame; the name will override any set by the
1282 x_explicitly_set_name (f
, arg
, oldval
)
1284 Lisp_Object arg
, oldval
;
1286 x_set_name (f
, arg
, 1);
1289 /* This function should be called by Emacs redisplay code to set the
1290 name; names set this way will never override names set by the user's
1293 x_implicitly_set_name (f
, arg
, oldval
)
1295 Lisp_Object arg
, oldval
;
1297 x_set_name (f
, arg
, 0);
1301 x_set_autoraise (f
, arg
, oldval
)
1303 Lisp_Object arg
, oldval
;
1305 f
->auto_raise
= !EQ (Qnil
, arg
);
1309 x_set_autolower (f
, arg
, oldval
)
1311 Lisp_Object arg
, oldval
;
1313 f
->auto_lower
= !EQ (Qnil
, arg
);
1317 x_set_vertical_scroll_bars (f
, arg
, oldval
)
1319 Lisp_Object arg
, oldval
;
1321 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
1323 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
1325 /* We set this parameter before creating the X window for the
1326 frame, so we can get the geometry right from the start.
1327 However, if the window hasn't been created yet, we shouldn't
1328 call x_set_window_size. */
1329 if (FRAME_X_WINDOW (f
))
1330 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1334 /* Subroutines of creating an X frame. */
1338 /* Make sure that Vx_resource_name is set to a reasonable value. */
1340 validate_x_resource_name ()
1342 if (STRINGP (Vx_resource_name
))
1344 int len
= XSTRING (Vx_resource_name
)->size
;
1345 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
1348 /* Allow only letters, digits, - and _,
1349 because those are all that X allows. */
1350 for (i
= 0; i
< len
; i
++)
1353 if (! ((c
>= 'a' && c
<= 'z')
1354 || (c
>= 'A' && c
<= 'Z')
1355 || (c
>= '0' && c
<= '9')
1356 || c
== '-' || c
== '_'))
1362 Vx_resource_name
= make_string ("emacs", 5);
1366 extern char *x_get_string_resource ();
1367 extern XrmDatabase
x_load_resources ();
1369 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
1370 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1371 This uses `NAME.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1372 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1373 the name specified by the `-name' or `-rn' command-line arguments.\n\
1375 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1376 class, respectively. You must specify both of them or neither.\n\
1377 If you specify them, the key is `NAME.COMPONENT.ATTRIBUTE'\n\
1378 and the class is `Emacs.CLASS.SUBCLASS'.")
1379 (attribute
, class, component
, subclass
)
1380 Lisp_Object attribute
, class, component
, subclass
;
1382 register char *value
;
1385 Lisp_Object resname
;
1389 CHECK_STRING (attribute
, 0);
1390 CHECK_STRING (class, 0);
1392 if (!NILP (component
))
1393 CHECK_STRING (component
, 1);
1394 if (!NILP (subclass
))
1395 CHECK_STRING (subclass
, 2);
1396 if (NILP (component
) != NILP (subclass
))
1397 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1399 validate_x_resource_name ();
1400 resname
= Vx_resource_name
;
1402 if (NILP (component
))
1404 /* Allocate space for the components, the dots which separate them,
1405 and the final '\0'. */
1406 name_key
= (char *) alloca (XSTRING (resname
)->size
1407 + XSTRING (attribute
)->size
1409 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1410 + XSTRING (class)->size
1413 sprintf (name_key
, "%s.%s",
1414 XSTRING (resname
)->data
,
1415 XSTRING (attribute
)->data
);
1416 sprintf (class_key
, "%s.%s",
1418 XSTRING (class)->data
);
1422 name_key
= (char *) alloca (XSTRING (resname
)->size
1423 + XSTRING (component
)->size
1424 + XSTRING (attribute
)->size
1427 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1428 + XSTRING (class)->size
1429 + XSTRING (subclass
)->size
1432 sprintf (name_key
, "%s.%s.%s",
1433 XSTRING (resname
)->data
,
1434 XSTRING (component
)->data
,
1435 XSTRING (attribute
)->data
);
1436 sprintf (class_key
, "%s.%s.%s",
1438 XSTRING (class)->data
,
1439 XSTRING (subclass
)->data
);
1442 value
= x_get_string_resource (xrdb
, name_key
, class_key
);
1444 if (value
!= (char *) 0)
1445 return build_string (value
);
1450 /* Used when C code wants a resource value. */
1453 x_get_resource_string (attribute
, class)
1454 char *attribute
, *class;
1456 register char *value
;
1460 /* Allocate space for the components, the dots which separate them,
1461 and the final '\0'. */
1462 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
1463 + strlen (attribute
) + 2);
1464 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1465 + strlen (class) + 2);
1467 sprintf (name_key
, "%s.%s",
1468 XSTRING (Vinvocation_name
)->data
,
1470 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
1472 return x_get_string_resource (xrdb
, name_key
, class_key
);
1477 DEFUN ("x-get-default", Fx_get_default
, Sx_get_default
, 1, 1, 0,
1478 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1479 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1480 The defaults are specified in the file `~/.Xdefaults'.")
1484 register unsigned char *value
;
1486 CHECK_STRING (arg
, 1);
1488 value
= (unsigned char *) XGetDefault (XDISPLAY
1489 XSTRING (Vinvocation_name
)->data
,
1490 XSTRING (arg
)->data
);
1492 /* Try reversing last two args, in case this is the buggy version of X. */
1493 value
= (unsigned char *) XGetDefault (XDISPLAY
1494 XSTRING (arg
)->data
,
1495 XSTRING (Vinvocation_name
)->data
);
1497 return build_string (value
);
1502 #define Fx_get_resource(attribute, class, component, subclass) \
1503 Fx_get_default (attribute)
1507 /* Types we might convert a resource string into. */
1510 number
, boolean
, string
, symbol
1513 /* Return the value of parameter PARAM.
1515 First search ALIST, then Vdefault_frame_alist, then the X defaults
1516 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1518 Convert the resource to the type specified by desired_type.
1520 If no default is specified, return Qunbound. If you call
1521 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1522 and don't let it get stored in any lisp-visible variables! */
1525 x_get_arg (alist
, param
, attribute
, class, type
)
1526 Lisp_Object alist
, param
;
1529 enum resource_types type
;
1531 register Lisp_Object tem
;
1533 tem
= Fassq (param
, alist
);
1535 tem
= Fassq (param
, Vdefault_frame_alist
);
1541 tem
= Fx_get_resource (build_string (attribute
),
1542 build_string (class),
1551 return make_number (atoi (XSTRING (tem
)->data
));
1554 tem
= Fdowncase (tem
);
1555 if (!strcmp (XSTRING (tem
)->data
, "on")
1556 || !strcmp (XSTRING (tem
)->data
, "true"))
1565 /* As a special case, we map the values `true' and `on'
1566 to Qt, and `false' and `off' to Qnil. */
1569 lower
= Fdowncase (tem
);
1570 if (!strcmp (XSTRING (lower
)->data
, "on")
1571 || !strcmp (XSTRING (lower
)->data
, "true"))
1573 else if (!strcmp (XSTRING (lower
)->data
, "off")
1574 || !strcmp (XSTRING (lower
)->data
, "false"))
1577 return Fintern (tem
, Qnil
);
1590 /* Record in frame F the specified or default value according to ALIST
1591 of the parameter named PARAM (a Lisp symbol).
1592 If no value is specified for PARAM, look for an X default for XPROP
1593 on the frame named NAME.
1594 If that is not found either, use the value DEFLT. */
1597 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
1604 enum resource_types type
;
1608 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
1609 if (EQ (tem
, Qunbound
))
1611 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
1615 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
1616 "Parse an X-style geometry string STRING.\n\
1617 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
1618 The properties returned may include `top', `left', `height', and `width'.\n\
1619 The value of `left' or `top' may be an integer or `-'.\n\
1620 `-' means \"minus zero\".")
1625 unsigned int width
, height
;
1628 CHECK_STRING (string
, 0);
1630 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
1631 &x
, &y
, &width
, &height
);
1634 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
1635 error ("Must specify both x and y position, or neither");
1639 if (geometry
& XValue
)
1641 Lisp_Object element
;
1643 if (x
== 0 && (geometry
& XNegative
))
1644 element
= Fcons (Qleft
, Qminus
);
1646 element
= Fcons (Qleft
, make_number (x
));
1647 result
= Fcons (element
, result
);
1650 if (geometry
& YValue
)
1652 Lisp_Object element
;
1654 if (y
== 0 && (geometry
& YNegative
))
1655 element
= Fcons (Qtop
, Qminus
);
1657 element
= Fcons (Qtop
, make_number (y
));
1658 result
= Fcons (element
, result
);
1661 if (geometry
& WidthValue
)
1662 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
1663 if (geometry
& HeightValue
)
1664 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
1670 /* Calculate the desired size and position of this window,
1671 and return the flags saying which aspects were specified.
1673 This function does not make the coordinates positive. */
1675 #define DEFAULT_ROWS 40
1676 #define DEFAULT_COLS 80
1679 x_figure_window_size (f
, parms
)
1683 register Lisp_Object tem0
, tem1
, tem2
;
1684 int height
, width
, left
, top
;
1685 register int geometry
;
1686 long window_prompting
= 0;
1688 /* Default values if we fall through.
1689 Actually, if that happens we should get
1690 window manager prompting. */
1691 f
->width
= DEFAULT_COLS
;
1692 f
->height
= DEFAULT_ROWS
;
1693 /* Window managers expect that if program-specified
1694 positions are not (0,0), they're intentional, not defaults. */
1695 f
->display
.x
->top_pos
= 0;
1696 f
->display
.x
->left_pos
= 0;
1698 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
1699 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
1700 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
1701 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1703 if (!EQ (tem0
, Qunbound
))
1705 CHECK_NUMBER (tem0
, 0);
1706 f
->height
= XINT (tem0
);
1708 if (!EQ (tem1
, Qunbound
))
1710 CHECK_NUMBER (tem1
, 0);
1711 f
->width
= XINT (tem1
);
1713 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
1714 window_prompting
|= USSize
;
1716 window_prompting
|= PSize
;
1719 f
->display
.x
->vertical_scroll_bar_extra
1720 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1721 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f
)
1723 f
->display
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
1724 f
->display
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
1726 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1727 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1728 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
1729 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1731 if (EQ (tem0
, Qminus
))
1733 f
->display
.x
->top_pos
= 0;
1734 window_prompting
|= YNegative
;
1736 else if (EQ (tem0
, Qunbound
))
1737 f
->display
.x
->top_pos
= 0;
1740 CHECK_NUMBER (tem0
, 0);
1741 f
->display
.x
->top_pos
= XINT (tem0
);
1742 if (f
->display
.x
->top_pos
< 0)
1743 window_prompting
|= YNegative
;
1746 if (EQ (tem1
, Qminus
))
1748 f
->display
.x
->left_pos
= 0;
1749 window_prompting
|= XNegative
;
1751 else if (EQ (tem1
, Qunbound
))
1752 f
->display
.x
->left_pos
= 0;
1755 CHECK_NUMBER (tem1
, 0);
1756 f
->display
.x
->left_pos
= XINT (tem1
);
1757 if (f
->display
.x
->left_pos
< 0)
1758 window_prompting
|= XNegative
;
1762 window_prompting
|= USPosition
;
1764 window_prompting
|= PPosition
;
1767 return window_prompting
;
1770 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
1773 XSetWMProtocols (dpy
, w
, protocols
, count
)
1780 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
1781 if (prop
== None
) return False
;
1782 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
1783 (unsigned char *) protocols
, count
);
1786 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
1788 #ifdef USE_X_TOOLKIT
1790 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS
1791 and WM_DELETE_WINDOW, then add them. (They may already be present
1792 because of the toolkit (Motif adds them, for example, but Xt doesn't). */
1795 hack_wm_protocols (widget
)
1798 Display
*dpy
= XtDisplay (widget
);
1799 Window w
= XtWindow (widget
);
1800 int need_delete
= 1;
1805 Atom type
, *atoms
= 0;
1807 unsigned long nitems
= 0;
1808 unsigned long bytes_after
;
1810 if (Success
== XGetWindowProperty (dpy
, w
, Xatom_wm_protocols
,
1811 0, 100, False
, XA_ATOM
,
1812 &type
, &format
, &nitems
, &bytes_after
,
1813 (unsigned char **) &atoms
)
1814 && format
== 32 && type
== XA_ATOM
)
1818 if (atoms
[nitems
] == Xatom_wm_delete_window
) need_delete
= 0;
1819 else if (atoms
[nitems
] == Xatom_wm_take_focus
) need_focus
= 0;
1821 if (atoms
) XFree ((char *) atoms
);
1826 if (need_delete
) props
[count
++] = Xatom_wm_delete_window
;
1827 if (need_focus
) props
[count
++] = Xatom_wm_take_focus
;
1829 XChangeProperty (dpy
, w
, Xatom_wm_protocols
, XA_ATOM
, 32, PropModeAppend
,
1830 (unsigned char *) props
, count
);
1836 #ifdef USE_X_TOOLKIT
1838 /* Create and set up the X widget for frame F. */
1841 x_window (f
, window_prompting
, minibuffer_only
)
1843 long window_prompting
;
1844 int minibuffer_only
;
1846 XClassHint class_hints
;
1847 XSetWindowAttributes attributes
;
1848 unsigned long attribute_mask
;
1850 Widget shell_widget
;
1852 Widget screen_widget
;
1859 if (STRINGP (f
->name
))
1860 name
= (char*) XSTRING (f
->name
)->data
;
1865 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
1866 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
1867 shell_widget
= XtCreatePopupShell ("shell",
1868 topLevelShellWidgetClass
,
1869 Xt_app_shell
, al
, ac
);
1871 f
->display
.x
->widget
= shell_widget
;
1872 /* maybe_set_screen_title_format (shell_widget); */
1876 XtSetArg (al
[ac
], XtNborderWidth
, 0); ac
++;
1877 pane_widget
= XtCreateWidget ("pane",
1879 shell_widget
, al
, ac
);
1881 f
->display
.x
->column_widget
= pane_widget
;
1883 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
1884 initialize_frame_menubar (f
);
1886 /* mappedWhenManaged to false tells to the paned window to not map/unmap
1887 the emacs screen when changing menubar. This reduces flickering. */
1890 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
1891 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
1892 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
1893 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
1894 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
1895 screen_widget
= XtCreateWidget (name
,
1897 pane_widget
, al
, ac
);
1899 f
->display
.x
->edit_widget
= screen_widget
;
1901 if (f
->display
.x
->menubar_widget
)
1902 XtManageChild (f
->display
.x
->menubar_widget
);
1903 XtManageChild (screen_widget
);
1905 /* Do some needed geometry management. */
1908 char *tem
, shell_position
[32];
1913 = (f
->display
.x
->menubar_widget
1914 ? (f
->display
.x
->menubar_widget
->core
.height
1915 + f
->display
.x
->menubar_widget
->core
.border_width
)
1918 XtVaGetValues (pane_widget
,
1919 XtNinternalBorderWidth
, &ibw
,
1921 menubar_size
+= ibw
;
1923 if (window_prompting
& USPosition
)
1925 int left
= f
->display
.x
->left_pos
;
1926 int xneg
= window_prompting
& XNegative
;
1927 int top
= f
->display
.x
->top_pos
;
1928 int yneg
= window_prompting
& YNegative
;
1933 sprintf (shell_position
, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f
),
1934 PIXEL_HEIGHT (f
) + menubar_size
,
1935 (xneg
? '-' : '+'), left
,
1936 (yneg
? '-' : '+'), top
);
1939 sprintf (shell_position
, "=%dx%d", PIXEL_WIDTH (f
),
1940 PIXEL_HEIGHT (f
) + menubar_size
);
1941 len
= strlen (shell_position
) + 1;
1942 tem
= (char *) xmalloc (len
);
1943 strncpy (tem
, shell_position
, len
);
1944 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
1945 XtSetValues (shell_widget
, al
, ac
);
1948 x_calc_absolute_position (f
);
1950 XtManageChild (pane_widget
);
1951 XtRealizeWidget (shell_widget
);
1953 FRAME_X_WINDOW (f
) = XtWindow (screen_widget
);
1955 validate_x_resource_name ();
1956 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
1957 class_hints
.res_class
= EMACS_CLASS
;
1958 XSetClassHint (x_current_display
, XtWindow (shell_widget
), &class_hints
);
1960 f
->display
.x
->wm_hints
.input
= True
;
1961 f
->display
.x
->wm_hints
.flags
|= InputHint
;
1962 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
1964 hack_wm_protocols (shell_widget
);
1966 /* Do a stupid property change to force the server to generate a
1967 propertyNotify event so that the event_stream server timestamp will
1968 be initialized to something relevant to the time we created the window.
1970 XChangeProperty (XtDisplay (screen_widget
), XtWindow (screen_widget
),
1971 Xatom_wm_protocols
, XA_ATOM
, 32, PropModeAppend
,
1972 (unsigned char*) NULL
, 0);
1974 /* Make all the standard events reach the Emacs frame. */
1975 attributes
.event_mask
= STANDARD_EVENT_SET
;
1976 attribute_mask
= CWEventMask
;
1977 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
1978 attribute_mask
, &attributes
);
1980 XtMapWidget (screen_widget
);
1982 /* x_set_name normally ignores requests to set the name if the
1983 requested name is the same as the current name. This is the one
1984 place where that assumption isn't correct; f->name is set, but
1985 the X server hasn't been told. */
1988 int explicit = f
->explicit_name
;
1990 f
->explicit_name
= 0;
1993 x_set_name (f
, name
, explicit);
1996 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
1997 f
->display
.x
->text_cursor
);
2001 if (FRAME_X_WINDOW (f
) == 0)
2002 error ("Unable to create window");
2005 #else /* not USE_X_TOOLKIT */
2007 /* Create and set up the X window for frame F. */
2013 XClassHint class_hints
;
2014 XSetWindowAttributes attributes
;
2015 unsigned long attribute_mask
;
2017 attributes
.background_pixel
= f
->display
.x
->background_pixel
;
2018 attributes
.border_pixel
= f
->display
.x
->border_pixel
;
2019 attributes
.bit_gravity
= StaticGravity
;
2020 attributes
.backing_store
= NotUseful
;
2021 attributes
.save_under
= True
;
2022 attributes
.event_mask
= STANDARD_EVENT_SET
;
2023 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
2025 | CWBackingStore
| CWSaveUnder
2031 = XCreateWindow (x_current_display
, ROOT_WINDOW
,
2032 f
->display
.x
->left_pos
,
2033 f
->display
.x
->top_pos
,
2034 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
2035 f
->display
.x
->border_width
,
2036 CopyFromParent
, /* depth */
2037 InputOutput
, /* class */
2038 screen_visual
, /* set in Fx_open_connection */
2039 attribute_mask
, &attributes
);
2041 validate_x_resource_name ();
2042 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2043 class_hints
.res_class
= EMACS_CLASS
;
2044 XSetClassHint (x_current_display
, FRAME_X_WINDOW (f
), &class_hints
);
2046 /* This indicates that we use the "Passive Input" input model.
2047 Unless we do this, we don't get the Focus{In,Out} events that we
2048 need to draw the cursor correctly. Accursed bureaucrats.
2049 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
2051 f
->display
.x
->wm_hints
.input
= True
;
2052 f
->display
.x
->wm_hints
.flags
|= InputHint
;
2053 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
2055 /* Request "save yourself" and "delete window" commands from wm. */
2058 protocols
[0] = Xatom_wm_delete_window
;
2059 protocols
[1] = Xatom_wm_save_yourself
;
2060 XSetWMProtocols (x_current_display
, FRAME_X_WINDOW (f
), protocols
, 2);
2063 /* x_set_name normally ignores requests to set the name if the
2064 requested name is the same as the current name. This is the one
2065 place where that assumption isn't correct; f->name is set, but
2066 the X server hasn't been told. */
2069 int explicit = f
->explicit_name
;
2071 f
->explicit_name
= 0;
2074 x_set_name (f
, name
, explicit);
2077 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
2078 f
->display
.x
->text_cursor
);
2082 if (FRAME_X_WINDOW (f
) == 0)
2083 error ("Unable to create window");
2086 #endif /* not USE_X_TOOLKIT */
2088 /* Handle the icon stuff for this window. Perhaps later we might
2089 want an x_set_icon_position which can be called interactively as
2097 Lisp_Object icon_x
, icon_y
;
2099 /* Set the position of the icon. Note that twm groups all
2100 icons in an icon window. */
2101 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
2102 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
2103 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
2105 CHECK_NUMBER (icon_x
, 0);
2106 CHECK_NUMBER (icon_y
, 0);
2108 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
2109 error ("Both left and top icon corners of icon must be specified");
2113 if (! EQ (icon_x
, Qunbound
))
2114 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
2116 /* Start up iconic or window? */
2117 x_wm_set_window_state
2118 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
2125 /* Make the GC's needed for this window, setting the
2126 background, border and mouse colors; also create the
2127 mouse cursor and the gray border tile. */
2129 static char cursor_bits
[] =
2131 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2132 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2133 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2134 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2141 XGCValues gc_values
;
2147 /* Create the GC's of this frame.
2148 Note that many default values are used. */
2151 gc_values
.font
= f
->display
.x
->font
->fid
;
2152 gc_values
.foreground
= f
->display
.x
->foreground_pixel
;
2153 gc_values
.background
= f
->display
.x
->background_pixel
;
2154 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
2155 f
->display
.x
->normal_gc
= XCreateGC (x_current_display
,
2157 GCLineWidth
| GCFont
2158 | GCForeground
| GCBackground
,
2161 /* Reverse video style. */
2162 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2163 gc_values
.background
= f
->display
.x
->foreground_pixel
;
2164 f
->display
.x
->reverse_gc
= XCreateGC (x_current_display
,
2166 GCFont
| GCForeground
| GCBackground
2170 /* Cursor has cursor-color background, background-color foreground. */
2171 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2172 gc_values
.background
= f
->display
.x
->cursor_pixel
;
2173 gc_values
.fill_style
= FillOpaqueStippled
;
2175 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
2176 cursor_bits
, 16, 16);
2177 f
->display
.x
->cursor_gc
2178 = XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
2179 (GCFont
| GCForeground
| GCBackground
2180 | GCFillStyle
| GCStipple
| GCLineWidth
),
2183 /* Create the gray border tile used when the pointer is not in
2184 the frame. Since this depends on the frame's pixel values,
2185 this must be done on a per-frame basis. */
2186 f
->display
.x
->border_tile
2187 = (XCreatePixmapFromBitmapData
2188 (x_current_display
, ROOT_WINDOW
,
2189 gray_bits
, gray_width
, gray_height
,
2190 f
->display
.x
->foreground_pixel
,
2191 f
->display
.x
->background_pixel
,
2192 DefaultDepth (x_current_display
, XDefaultScreen (x_current_display
))));
2196 #endif /* HAVE_X11 */
2198 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
2200 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2201 Return an Emacs frame object representing the X window.\n\
2202 ALIST is an alist of frame parameters.\n\
2203 If the parameters specify that the frame should not have a minibuffer,\n\
2204 and do not specify a specific minibuffer window to use,\n\
2205 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2206 be shared by the new frame.")
2212 Lisp_Object frame
, tem
;
2214 int minibuffer_only
= 0;
2215 long window_prompting
= 0;
2217 int count
= specpdl_ptr
- specpdl
;
2221 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
2222 if (XTYPE (name
) != Lisp_String
2223 && ! EQ (name
, Qunbound
)
2225 error ("x-create-frame: name parameter must be a string");
2227 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2228 if (EQ (tem
, Qnone
) || NILP (tem
))
2229 f
= make_frame_without_minibuffer (Qnil
);
2230 else if (EQ (tem
, Qonly
))
2232 f
= make_minibuffer_frame ();
2233 minibuffer_only
= 1;
2235 else if (XTYPE (tem
) == Lisp_Window
)
2236 f
= make_frame_without_minibuffer (tem
);
2240 /* Note that X Windows does support scroll bars. */
2241 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
2243 /* Set the name; the functions to which we pass f expect the name to
2245 if (EQ (name
, Qunbound
) || NILP (name
))
2247 f
->name
= build_string (x_id_name
);
2248 f
->explicit_name
= 0;
2253 f
->explicit_name
= 1;
2254 /* use the frame's title when getting resources for this frame. */
2255 specbind (Qx_resource_name
, name
);
2258 XSET (frame
, Lisp_Frame
, f
);
2259 f
->output_method
= output_x_window
;
2260 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2261 bzero (f
->display
.x
, sizeof (struct x_display
));
2263 /* Note that the frame has no physical cursor right now. */
2264 f
->phys_cursor_x
= -1;
2266 /* Extract the window parameters from the supplied values
2267 that are needed to determine window geometry. */
2271 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
2273 /* First, try whatever font the caller has specified. */
2275 font
= x_new_font (f
, XSTRING (font
)->data
);
2276 /* Try out a font which we hope has bold and italic variations. */
2277 if (!STRINGP (font
))
2278 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2279 if (! STRINGP (font
))
2280 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2281 if (! STRINGP (font
))
2282 /* This was formerly the first thing tried, but it finds too many fonts
2283 and takes too long. */
2284 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
2285 /* If those didn't work, look for something which will at least work. */
2286 if (! STRINGP (font
))
2287 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1");
2289 if (! STRINGP (font
))
2290 font
= build_string ("fixed");
2292 x_default_parameter (f
, parms
, Qfont
, font
,
2293 "font", "Font", string
);
2296 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
2297 "borderwidth", "BorderWidth", number
);
2298 /* This defaults to 2 in order to match xterm. We recognize either
2299 internalBorderWidth or internalBorder (which is what xterm calls
2301 if (NILP (Fassq (Qinternal_border_width
, parms
)))
2305 value
= x_get_arg (parms
, Qinternal_border_width
,
2306 "internalBorder", "BorderWidth", number
);
2307 if (! EQ (value
, Qunbound
))
2308 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
2311 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
2312 "internalBorderWidth", "BorderWidth", number
);
2313 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
2314 "verticalScrollBars", "ScrollBars", boolean
);
2316 /* Also do the stuff which must be set before the window exists. */
2317 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
2318 "foreground", "Foreground", string
);
2319 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
2320 "background", "Background", string
);
2321 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
2322 "pointerColor", "Foreground", string
);
2323 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
2324 "cursorColor", "Foreground", string
);
2325 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
2326 "borderColor", "BorderColor", string
);
2328 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (0),
2329 "menuBarLines", "MenuBarLines", number
);
2331 f
->display
.x
->parent_desc
= ROOT_WINDOW
;
2332 window_prompting
= x_figure_window_size (f
, parms
);
2334 if (window_prompting
& XNegative
)
2336 if (window_prompting
& YNegative
)
2337 f
->display
.x
->win_gravity
= SouthEastGravity
;
2339 f
->display
.x
->win_gravity
= NorthEastGravity
;
2343 if (window_prompting
& YNegative
)
2344 f
->display
.x
->win_gravity
= SouthWestGravity
;
2346 f
->display
.x
->win_gravity
= NorthWestGravity
;
2349 f
->display
.x
->size_hint_flags
= window_prompting
;
2351 #ifdef USE_X_TOOLKIT
2352 x_window (f
, window_prompting
, minibuffer_only
);
2358 init_frame_faces (f
);
2360 /* We need to do this after creating the X window, so that the
2361 icon-creation functions can say whose icon they're describing. */
2362 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2363 "bitmapIcon", "BitmapIcon", symbol
);
2365 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
2366 "autoRaise", "AutoRaiseLower", boolean
);
2367 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
2368 "autoLower", "AutoRaiseLower", boolean
);
2369 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
2370 "cursorType", "CursorType", symbol
);
2372 /* Dimensions, especially f->height, must be done via change_frame_size.
2373 Change will not be effected unless different from the current
2377 f
->height
= f
->width
= 0;
2378 change_frame_size (f
, height
, width
, 1, 0);
2380 /* With the toolkit, the geometry management is done in x_window. */
2381 #ifndef USE_X_TOOLKIT
2383 x_wm_set_size_hint (f
, window_prompting
, 0);
2385 #endif /* USE_X_TOOLKIT */
2387 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2388 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2390 /* It is now ok to make the frame official
2391 even if we get an error below.
2392 And the frame needs to be on Vframe_list
2393 or making it visible won't work. */
2394 Vframe_list
= Fcons (frame
, Vframe_list
);
2396 /* Make the window appear on the frame and enable display,
2397 unless the caller says not to. */
2399 Lisp_Object visibility
;
2401 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2402 if (EQ (visibility
, Qunbound
))
2405 if (EQ (visibility
, Qicon
))
2406 x_iconify_frame (f
);
2407 else if (! NILP (visibility
))
2408 x_make_frame_visible (f
);
2410 /* Must have been Qnil. */
2414 return unbind_to (count
, frame
);
2417 Lisp_Object frame
, tem
;
2419 int pixelwidth
, pixelheight
;
2424 int minibuffer_only
= 0;
2425 Lisp_Object vscroll
, hscroll
;
2427 if (x_current_display
== 0)
2428 error ("X windows are not in use or not initialized");
2430 name
= Fassq (Qname
, parms
);
2432 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2433 if (EQ (tem
, Qnone
))
2434 f
= make_frame_without_minibuffer (Qnil
);
2435 else if (EQ (tem
, Qonly
))
2437 f
= make_minibuffer_frame ();
2438 minibuffer_only
= 1;
2440 else if (EQ (tem
, Qnil
) || EQ (tem
, Qunbound
))
2443 f
= make_frame_without_minibuffer (tem
);
2445 parent
= ROOT_WINDOW
;
2447 XSET (frame
, Lisp_Frame
, f
);
2448 f
->output_method
= output_x_window
;
2449 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2450 bzero (f
->display
.x
, sizeof (struct x_display
));
2452 /* Some temporary default values for height and width. */
2455 f
->display
.x
->left_pos
= -1;
2456 f
->display
.x
->top_pos
= -1;
2458 /* Give the frame a default name (which may be overridden with PARMS). */
2460 strncpy (iconidentity
, ICONTAG
, MAXICID
);
2461 if (gethostname (&iconidentity
[sizeof (ICONTAG
) - 1],
2462 (MAXICID
- 1) - sizeof (ICONTAG
)))
2463 iconidentity
[sizeof (ICONTAG
) - 2] = '\0';
2464 f
->name
= build_string (iconidentity
);
2466 /* Extract some window parameters from the supplied values.
2467 These are the parameters that affect window geometry. */
2469 tem
= x_get_arg (parms
, Qfont
, "BodyFont", 0, string
);
2470 if (EQ (tem
, Qunbound
))
2471 tem
= build_string ("9x15");
2472 x_set_font (f
, tem
, Qnil
);
2473 x_default_parameter (f
, parms
, Qborder_color
,
2474 build_string ("black"), "Border", 0, string
);
2475 x_default_parameter (f
, parms
, Qbackground_color
,
2476 build_string ("white"), "Background", 0, string
);
2477 x_default_parameter (f
, parms
, Qforeground_color
,
2478 build_string ("black"), "Foreground", 0, string
);
2479 x_default_parameter (f
, parms
, Qmouse_color
,
2480 build_string ("black"), "Mouse", 0, string
);
2481 x_default_parameter (f
, parms
, Qcursor_color
,
2482 build_string ("black"), "Cursor", 0, string
);
2483 x_default_parameter (f
, parms
, Qborder_width
,
2484 make_number (2), "BorderWidth", 0, number
);
2485 x_default_parameter (f
, parms
, Qinternal_border_width
,
2486 make_number (4), "InternalBorderWidth", 0, number
);
2487 x_default_parameter (f
, parms
, Qauto_raise
,
2488 Qnil
, "AutoRaise", 0, boolean
);
2490 hscroll
= EQ (x_get_arg (parms
, Qhorizontal_scroll_bar
, 0, 0, boolean
), Qt
);
2491 vscroll
= EQ (x_get_arg (parms
, Qvertical_scroll_bar
, 0, 0, boolean
), Qt
);
2493 if (f
->display
.x
->internal_border_width
< 0)
2494 f
->display
.x
->internal_border_width
= 0;
2496 tem
= x_get_arg (parms
, Qwindow_id
, 0, 0, number
);
2497 if (!EQ (tem
, Qunbound
))
2499 WINDOWINFO_TYPE wininfo
;
2501 Window
*children
, root
;
2503 CHECK_NUMBER (tem
, 0);
2504 FRAME_X_WINDOW (f
) = (Window
) XINT (tem
);
2507 XGetWindowInfo (FRAME_X_WINDOW (f
), &wininfo
);
2508 XQueryTree (FRAME_X_WINDOW (f
), &parent
, &nchildren
, &children
);
2512 height
= PIXEL_TO_CHAR_HEIGHT (f
, wininfo
.height
);
2513 width
= PIXEL_TO_CHAR_WIDTH (f
, wininfo
.width
);
2514 f
->display
.x
->left_pos
= wininfo
.x
;
2515 f
->display
.x
->top_pos
= wininfo
.y
;
2516 FRAME_SET_VISIBILITY (f
, wininfo
.mapped
!= 0);
2517 f
->display
.x
->border_width
= wininfo
.bdrwidth
;
2518 f
->display
.x
->parent_desc
= parent
;
2522 tem
= x_get_arg (parms
, Qparent_id
, 0, 0, number
);
2523 if (!EQ (tem
, Qunbound
))
2525 CHECK_NUMBER (tem
, 0);
2526 parent
= (Window
) XINT (tem
);
2528 f
->display
.x
->parent_desc
= parent
;
2529 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2530 if (EQ (tem
, Qunbound
))
2532 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2533 if (EQ (tem
, Qunbound
))
2535 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2536 if (EQ (tem
, Qunbound
))
2537 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2540 /* Now TEM is Qunbound if no edge or size was specified.
2541 In that case, we must do rubber-banding. */
2542 if (EQ (tem
, Qunbound
))
2544 tem
= x_get_arg (parms
, Qgeometry
, 0, 0, number
);
2546 &f
->display
.x
->left_pos
, &f
->display
.x
->top_pos
,
2548 (XTYPE (tem
) == Lisp_String
2549 ? (char *) XSTRING (tem
)->data
: ""),
2550 XSTRING (f
->name
)->data
,
2551 !NILP (hscroll
), !NILP (vscroll
));
2555 /* Here if at least one edge or size was specified.
2556 Demand that they all were specified, and use them. */
2557 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2558 if (EQ (tem
, Qunbound
))
2559 error ("Height not specified");
2560 CHECK_NUMBER (tem
, 0);
2561 height
= XINT (tem
);
2563 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2564 if (EQ (tem
, Qunbound
))
2565 error ("Width not specified");
2566 CHECK_NUMBER (tem
, 0);
2569 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2570 if (EQ (tem
, Qunbound
))
2571 error ("Top position not specified");
2572 CHECK_NUMBER (tem
, 0);
2573 f
->display
.x
->left_pos
= XINT (tem
);
2575 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2576 if (EQ (tem
, Qunbound
))
2577 error ("Left position not specified");
2578 CHECK_NUMBER (tem
, 0);
2579 f
->display
.x
->top_pos
= XINT (tem
);
2582 pixelwidth
= CHAR_TO_PIXEL_WIDTH (f
, width
);
2583 pixelheight
= CHAR_TO_PIXEL_HEIGHT (f
, height
);
2587 = XCreateWindow (parent
,
2588 f
->display
.x
->left_pos
, /* Absolute horizontal offset */
2589 f
->display
.x
->top_pos
, /* Absolute Vertical offset */
2590 pixelwidth
, pixelheight
,
2591 f
->display
.x
->border_width
,
2592 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
2594 if (FRAME_X_WINDOW (f
) == 0)
2595 error ("Unable to create window.");
2598 /* Install the now determined height and width
2599 in the windows and in phys_lines and desired_lines. */
2600 change_frame_size (f
, height
, width
, 1, 0);
2601 XSelectInput (FRAME_X_WINDOW (f
), KeyPressed
| ExposeWindow
2602 | ButtonPressed
| ButtonReleased
| ExposeRegion
| ExposeCopy
2603 | EnterWindow
| LeaveWindow
| UnmapWindow
);
2604 x_set_resize_hint (f
);
2606 /* Tell the server the window's default name. */
2607 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
), XSTRING (f
->name
)->data
);
2609 /* Now override the defaults with all the rest of the specified
2611 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2612 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2614 /* Do not create an icon window if the caller says not to */
2615 if (!EQ (x_get_arg (parms
, Qsuppress_icon
, 0, 0, boolean
), Qt
)
2616 || f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2618 x_text_icon (f
, iconidentity
);
2619 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2620 "BitmapIcon", 0, symbol
);
2623 /* Tell the X server the previously set values of the
2624 background, border and mouse colors; also create the mouse cursor. */
2626 temp
= XMakeTile (f
->display
.x
->background_pixel
);
2627 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
2630 x_set_border_pixel (f
, f
->display
.x
->border_pixel
);
2632 x_set_mouse_color (f
, Qnil
, Qnil
);
2634 /* Now override the defaults with all the rest of the specified parms. */
2636 Fmodify_frame_parameters (frame
, parms
);
2638 /* Make the window appear on the frame and enable display. */
2640 Lisp_Object visibility
;
2642 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2643 if (EQ (visibility
, Qunbound
))
2646 if (! EQ (visibility
, Qicon
)
2647 && ! NILP (visibility
))
2648 x_make_window_visible (f
);
2651 SET_FRAME_GARBAGED (f
);
2653 Vframe_list
= Fcons (frame
, Vframe_list
);
2659 x_get_focus_frame ()
2662 if (! x_focus_frame
)
2665 XSET (xfocus
, Lisp_Frame
, x_focus_frame
);
2669 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
2670 "Set the focus on FRAME.")
2674 CHECK_LIVE_FRAME (frame
, 0);
2676 if (FRAME_X_P (XFRAME (frame
)))
2679 x_focus_on_frame (XFRAME (frame
));
2687 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
2688 "If a frame has been focused, release it.")
2694 x_unfocus_frame (x_focus_frame
);
2702 /* Computes an X-window size and position either from geometry GEO
2705 F is a frame. It specifies an X window which is used to
2706 determine which display to compute for. Its font, borders
2707 and colors control how the rectangle will be displayed.
2709 X and Y are where to store the positions chosen.
2710 WIDTH and HEIGHT are where to store the sizes chosen.
2712 GEO is the geometry that may specify some of the info.
2713 STR is a prompt to display.
2714 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2717 x_rubber_band (f
, x
, y
, width
, height
, geo
, str
, hscroll
, vscroll
)
2719 int *x
, *y
, *width
, *height
;
2722 int hscroll
, vscroll
;
2728 int background_color
;
2734 background_color
= f
->display
.x
->background_pixel
;
2735 border_color
= f
->display
.x
->border_pixel
;
2737 frame
.bdrwidth
= f
->display
.x
->border_width
;
2738 frame
.border
= XMakeTile (border_color
);
2739 frame
.background
= XMakeTile (background_color
);
2740 tempwindow
= XCreateTerm (str
, "emacs", geo
, default_window
, &frame
, 10, 5,
2741 (2 * f
->display
.x
->internal_border_width
2742 + (vscroll
? VSCROLL_WIDTH
: 0)),
2743 (2 * f
->display
.x
->internal_border_width
2744 + (hscroll
? HSCROLL_HEIGHT
: 0)),
2745 width
, height
, f
->display
.x
->font
,
2746 FONT_WIDTH (f
->display
.x
->font
),
2747 f
->display
.x
->line_height
);
2748 XFreePixmap (frame
.border
);
2749 XFreePixmap (frame
.background
);
2751 if (tempwindow
!= 0)
2753 XQueryWindow (tempwindow
, &wininfo
);
2754 XDestroyWindow (tempwindow
);
2759 /* Coordinates we got are relative to the root window.
2760 Convert them to coordinates relative to desired parent window
2761 by scanning from there up to the root. */
2762 tempwindow
= f
->display
.x
->parent_desc
;
2763 while (tempwindow
!= ROOT_WINDOW
)
2767 XQueryWindow (tempwindow
, &wininfo
);
2770 XQueryTree (tempwindow
, &tempwindow
, &nchildren
, &children
);
2775 return tempwindow
!= 0;
2777 #endif /* not HAVE_X11 */
2779 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
2780 "Return a list of the names of available fonts matching PATTERN.\n\
2781 If optional arguments FACE and FRAME are specified, return only fonts\n\
2782 the same size as FACE on FRAME.\n\
2784 PATTERN is a string, perhaps with wildcard characters;\n\
2785 the * character matches any substring, and\n\
2786 the ? character matches any single character.\n\
2787 PATTERN is case-insensitive.\n\
2788 FACE is a face name - a symbol.\n\
2790 The return value is a list of strings, suitable as arguments to\n\
2793 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
2794 even if they match PATTERN and FACE.")
2795 (pattern
, face
, frame
)
2796 Lisp_Object pattern
, face
, frame
;
2801 XFontStruct
*size_ref
;
2805 CHECK_STRING (pattern
, 0);
2807 CHECK_SYMBOL (face
, 1);
2809 CHECK_LIVE_FRAME (frame
, 2);
2815 FRAME_PTR f
= NILP (frame
) ? selected_frame
: XFRAME (frame
);
2818 /* Don't die if we get called with a terminal frame. */
2819 if (! FRAME_X_P (f
))
2820 error ("non-X frame used in `x-list-fonts'");
2822 face_id
= face_name_id_number (f
, face
);
2824 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
2825 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
2826 size_ref
= f
->display
.x
->font
;
2829 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
2830 if (size_ref
== (XFontStruct
*) (~0))
2831 size_ref
= f
->display
.x
->font
;
2837 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
2838 #ifdef BROKEN_XLISTFONTSWITHINFO
2839 names
= XListFonts (x_current_display
,
2840 XSTRING (pattern
)->data
,
2841 2000, /* maxnames */
2842 &num_fonts
); /* count_return */
2844 names
= XListFontsWithInfo (x_current_display
,
2845 XSTRING (pattern
)->data
,
2846 2000, /* maxnames */
2847 &num_fonts
, /* count_return */
2848 &info
); /* info_return */
2860 for (i
= 0; i
< num_fonts
; i
++)
2862 XFontStruct
*thisinfo
;
2864 #ifdef BROKEN_XLISTFONTSWITHINFO
2866 thisinfo
= XLoadQueryFont (x_current_display
, names
[i
]);
2869 thisinfo
= &info
[i
];
2871 if (thisinfo
&& (! size_ref
2872 || same_size_fonts (thisinfo
, size_ref
)))
2874 *tail
= Fcons (build_string (names
[i
]), Qnil
);
2875 tail
= &XCONS (*tail
)->cdr
;
2880 #ifdef BROKEN_XLISTFONTSWITHINFO
2881 XFreeFontNames (names
);
2883 XFreeFontInfo (names
, info
, num_fonts
);
2892 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 1, 0,
2893 "Return t if the current X display supports the color named COLOR.")
2900 CHECK_STRING (color
, 0);
2902 if (defined_color (XSTRING (color
)->data
, &foo
))
2908 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 0, 0,
2909 "Return t if the X screen currently in use supports color.")
2914 if (x_screen_planes
<= 2)
2917 switch (screen_visual
->class)
2930 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
2932 "Returns the width in pixels of the display FRAME is on.")
2936 Display
*dpy
= x_current_display
;
2938 return make_number (DisplayWidth (dpy
, DefaultScreen (dpy
)));
2941 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
2942 Sx_display_pixel_height
, 0, 1, 0,
2943 "Returns the height in pixels of the display FRAME is on.")
2947 Display
*dpy
= x_current_display
;
2949 return make_number (DisplayHeight (dpy
, DefaultScreen (dpy
)));
2952 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
2954 "Returns the number of bitplanes of the display FRAME is on.")
2958 Display
*dpy
= x_current_display
;
2960 return make_number (DisplayPlanes (dpy
, DefaultScreen (dpy
)));
2963 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
2965 "Returns the number of color cells of the display FRAME is on.")
2969 Display
*dpy
= x_current_display
;
2971 return make_number (DisplayCells (dpy
, DefaultScreen (dpy
)));
2974 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
2975 Sx_server_max_request_size
,
2977 "Returns the maximum request size of the X server FRAME is using.")
2981 Display
*dpy
= x_current_display
;
2983 return make_number (MAXREQUEST (dpy
));
2986 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
2987 "Returns the vendor ID string of the X server FRAME is on.")
2991 Display
*dpy
= x_current_display
;
2994 vendor
= ServerVendor (dpy
);
2995 if (! vendor
) vendor
= "";
2996 return build_string (vendor
);
2999 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
3000 "Returns the version numbers of the X server in use.\n\
3001 The value is a list of three integers: the major and minor\n\
3002 version numbers of the X Protocol in use, and the vendor-specific release\n\
3003 number. See also the variable `x-server-vendor'.")
3007 Display
*dpy
= x_current_display
;
3010 return Fcons (make_number (ProtocolVersion (dpy
)),
3011 Fcons (make_number (ProtocolRevision (dpy
)),
3012 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
3015 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
3016 "Returns the number of screens on the X server FRAME is on.")
3021 return make_number (ScreenCount (x_current_display
));
3024 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
3025 "Returns the height in millimeters of the X screen FRAME is on.")
3030 return make_number (HeightMMOfScreen (x_screen
));
3033 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
3034 "Returns the width in millimeters of the X screen FRAME is on.")
3039 return make_number (WidthMMOfScreen (x_screen
));
3042 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
3043 Sx_display_backing_store
, 0, 1, 0,
3044 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
3045 The value may be `always', `when-mapped', or `not-useful'.")
3051 switch (DoesBackingStore (x_screen
))
3054 return intern ("always");
3057 return intern ("when-mapped");
3060 return intern ("not-useful");
3063 error ("Strange value for BackingStore parameter of screen");
3067 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
3068 Sx_display_visual_class
, 0, 1, 0,
3069 "Returns the visual class of the display `screen' is on.\n\
3070 The value is one of the symbols `static-gray', `gray-scale',\n\
3071 `static-color', `pseudo-color', `true-color', or `direct-color'.")
3077 switch (screen_visual
->class)
3079 case StaticGray
: return (intern ("static-gray"));
3080 case GrayScale
: return (intern ("gray-scale"));
3081 case StaticColor
: return (intern ("static-color"));
3082 case PseudoColor
: return (intern ("pseudo-color"));
3083 case TrueColor
: return (intern ("true-color"));
3084 case DirectColor
: return (intern ("direct-color"));
3086 error ("Display has an unknown visual class");
3090 DEFUN ("x-display-save-under", Fx_display_save_under
,
3091 Sx_display_save_under
, 0, 1, 0,
3092 "Returns t if the X screen FRAME is on supports the save-under feature.")
3098 if (DoesSaveUnders (x_screen
) == True
)
3105 register struct frame
*f
;
3107 return PIXEL_WIDTH (f
);
3111 register struct frame
*f
;
3113 return PIXEL_HEIGHT (f
);
3117 register struct frame
*f
;
3119 return FONT_WIDTH (f
->display
.x
->font
);
3123 register struct frame
*f
;
3125 return f
->display
.x
->line_height
;
3128 #if 0 /* These no longer seem like the right way to do things. */
3130 /* Draw a rectangle on the frame with left top corner including
3131 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3132 CHARS by LINES wide and long and is the color of the cursor. */
3135 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
3136 register struct frame
*f
;
3138 register int top_char
, left_char
, chars
, lines
;
3142 int left
= (left_char
* FONT_WIDTH (f
->display
.x
->font
)
3143 + f
->display
.x
->internal_border_width
);
3144 int top
= (top_char
* f
->display
.x
->line_height
3145 + f
->display
.x
->internal_border_width
);
3148 width
= FONT_WIDTH (f
->display
.x
->font
) / 2;
3150 width
= FONT_WIDTH (f
->display
.x
->font
) * chars
;
3152 height
= f
->display
.x
->line_height
/ 2;
3154 height
= f
->display
.x
->line_height
* lines
;
3156 XDrawRectangle (x_current_display
, FRAME_X_WINDOW (f
),
3157 gc
, left
, top
, width
, height
);
3160 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
3161 "Draw a rectangle on FRAME between coordinates specified by\n\
3162 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3163 (frame
, X0
, Y0
, X1
, Y1
)
3164 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
3166 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3168 CHECK_LIVE_FRAME (frame
, 0);
3169 CHECK_NUMBER (X0
, 0);
3170 CHECK_NUMBER (Y0
, 1);
3171 CHECK_NUMBER (X1
, 2);
3172 CHECK_NUMBER (Y1
, 3);
3182 n_lines
= y1
- y0
+ 1;
3187 n_lines
= y0
- y1
+ 1;
3193 n_chars
= x1
- x0
+ 1;
3198 n_chars
= x0
- x1
+ 1;
3202 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->cursor_gc
,
3203 left
, top
, n_chars
, n_lines
);
3209 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
3210 "Draw a rectangle drawn on FRAME between coordinates\n\
3211 X0, Y0, X1, Y1 in the regular background-pixel.")
3212 (frame
, X0
, Y0
, X1
, Y1
)
3213 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
3215 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3217 CHECK_FRAME (frame
, 0);
3218 CHECK_NUMBER (X0
, 0);
3219 CHECK_NUMBER (Y0
, 1);
3220 CHECK_NUMBER (X1
, 2);
3221 CHECK_NUMBER (Y1
, 3);
3231 n_lines
= y1
- y0
+ 1;
3236 n_lines
= y0
- y1
+ 1;
3242 n_chars
= x1
- x0
+ 1;
3247 n_chars
= x0
- x1
+ 1;
3251 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->reverse_gc
,
3252 left
, top
, n_chars
, n_lines
);
3258 /* Draw lines around the text region beginning at the character position
3259 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3260 pixel and line characteristics. */
3262 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3265 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
3266 register struct frame
*f
;
3268 int top_x
, top_y
, bottom_x
, bottom_y
;
3270 register int ibw
= f
->display
.x
->internal_border_width
;
3271 register int font_w
= FONT_WIDTH (f
->display
.x
->font
);
3272 register int font_h
= f
->display
.x
->line_height
;
3274 int x
= line_len (y
);
3275 XPoint
*pixel_points
3276 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
3277 register XPoint
*this_point
= pixel_points
;
3279 /* Do the horizontal top line/lines */
3282 this_point
->x
= ibw
;
3283 this_point
->y
= ibw
+ (font_h
* top_y
);
3286 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
3288 this_point
->x
= ibw
+ (font_w
* x
);
3289 this_point
->y
= (this_point
- 1)->y
;
3293 this_point
->x
= ibw
;
3294 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
3296 this_point
->x
= ibw
+ (font_w
* top_x
);
3297 this_point
->y
= (this_point
- 1)->y
;
3299 this_point
->x
= (this_point
- 1)->x
;
3300 this_point
->y
= ibw
+ (font_h
* top_y
);
3302 this_point
->x
= ibw
+ (font_w
* x
);
3303 this_point
->y
= (this_point
- 1)->y
;
3306 /* Now do the right side. */
3307 while (y
< bottom_y
)
3308 { /* Right vertical edge */
3310 this_point
->x
= (this_point
- 1)->x
;
3311 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
3314 y
++; /* Horizontal connection to next line */
3317 this_point
->x
= ibw
+ (font_w
/ 2);
3319 this_point
->x
= ibw
+ (font_w
* x
);
3321 this_point
->y
= (this_point
- 1)->y
;
3324 /* Now do the bottom and connect to the top left point. */
3325 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
3328 this_point
->x
= (this_point
- 1)->x
;
3329 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
3331 this_point
->x
= ibw
;
3332 this_point
->y
= (this_point
- 1)->y
;
3334 this_point
->x
= pixel_points
->x
;
3335 this_point
->y
= pixel_points
->y
;
3337 XDrawLines (x_current_display
, FRAME_X_WINDOW (f
),
3339 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
3342 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
3343 "Highlight the region between point and the character under the mouse\n\
3346 register Lisp_Object event
;
3348 register int x0
, y0
, x1
, y1
;
3349 register struct frame
*f
= selected_frame
;
3350 register int p1
, p2
;
3352 CHECK_CONS (event
, 0);
3355 x0
= XINT (Fcar (Fcar (event
)));
3356 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3358 /* If the mouse is past the end of the line, don't that area. */
3359 /* ReWrite this... */
3364 if (y1
> y0
) /* point below mouse */
3365 outline_region (f
, f
->display
.x
->cursor_gc
,
3367 else if (y1
< y0
) /* point above mouse */
3368 outline_region (f
, f
->display
.x
->cursor_gc
,
3370 else /* same line: draw horizontal rectangle */
3373 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3374 x0
, y0
, (x1
- x0
+ 1), 1);
3376 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3377 x1
, y1
, (x0
- x1
+ 1), 1);
3380 XFlush (x_current_display
);
3386 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
3387 "Erase any highlighting of the region between point and the character\n\
3388 at X, Y on the selected frame.")
3390 register Lisp_Object event
;
3392 register int x0
, y0
, x1
, y1
;
3393 register struct frame
*f
= selected_frame
;
3396 x0
= XINT (Fcar (Fcar (event
)));
3397 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3401 if (y1
> y0
) /* point below mouse */
3402 outline_region (f
, f
->display
.x
->reverse_gc
,
3404 else if (y1
< y0
) /* point above mouse */
3405 outline_region (f
, f
->display
.x
->reverse_gc
,
3407 else /* same line: draw horizontal rectangle */
3410 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3411 x0
, y0
, (x1
- x0
+ 1), 1);
3413 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3414 x1
, y1
, (x0
- x1
+ 1), 1);
3422 int contour_begin_x
, contour_begin_y
;
3423 int contour_end_x
, contour_end_y
;
3424 int contour_npoints
;
3426 /* Clip the top part of the contour lines down (and including) line Y_POS.
3427 If X_POS is in the middle (rather than at the end) of the line, drop
3428 down a line at that character. */
3431 clip_contour_top (y_pos
, x_pos
)
3433 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
3434 register XPoint
*end
;
3435 register int npoints
;
3436 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
3438 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
3440 end
= contour_lines
[y_pos
].top_right
;
3441 npoints
= (end
- begin
+ 1);
3442 XDrawLines (x_current_display
, contour_window
,
3443 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3445 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
3446 contour_last_point
-= (npoints
- 2);
3447 XDrawLines (x_current_display
, contour_window
,
3448 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
3449 XFlush (x_current_display
);
3451 /* Now, update contour_lines structure. */
3456 register XPoint
*p
= begin
+ 1;
3457 end
= contour_lines
[y_pos
].bottom_right
;
3458 npoints
= (end
- begin
+ 1);
3459 XDrawLines (x_current_display
, contour_window
,
3460 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3463 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
3465 p
->y
= begin
->y
+ font_h
;
3467 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
3468 contour_last_point
-= (npoints
- 5);
3469 XDrawLines (x_current_display
, contour_window
,
3470 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
3471 XFlush (x_current_display
);
3473 /* Now, update contour_lines structure. */
3477 /* Erase the top horizontal lines of the contour, and then extend
3478 the contour upwards. */
3481 extend_contour_top (line
)
3486 clip_contour_bottom (x_pos
, y_pos
)
3492 extend_contour_bottom (x_pos
, y_pos
)
3496 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
3501 register struct frame
*f
= selected_frame
;
3502 register int point_x
= f
->cursor_x
;
3503 register int point_y
= f
->cursor_y
;
3504 register int mouse_below_point
;
3505 register Lisp_Object obj
;
3506 register int x_contour_x
, x_contour_y
;
3508 x_contour_x
= x_mouse_x
;
3509 x_contour_y
= x_mouse_y
;
3510 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
3511 && x_contour_x
> point_x
))
3513 mouse_below_point
= 1;
3514 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3515 x_contour_x
, x_contour_y
);
3519 mouse_below_point
= 0;
3520 outline_region (f
, f
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
3526 obj
= read_char (-1, 0, 0, Qnil
, 0);
3527 if (XTYPE (obj
) != Lisp_Cons
)
3530 if (mouse_below_point
)
3532 if (x_mouse_y
<= point_y
) /* Flipped. */
3534 mouse_below_point
= 0;
3536 outline_region (f
, f
->display
.x
->reverse_gc
, point_x
, point_y
,
3537 x_contour_x
, x_contour_y
);
3538 outline_region (f
, f
->display
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
3541 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
3543 clip_contour_bottom (x_mouse_y
);
3545 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
3547 extend_bottom_contour (x_mouse_y
);
3550 x_contour_x
= x_mouse_x
;
3551 x_contour_y
= x_mouse_y
;
3553 else /* mouse above or same line as point */
3555 if (x_mouse_y
>= point_y
) /* Flipped. */
3557 mouse_below_point
= 1;
3559 outline_region (f
, f
->display
.x
->reverse_gc
,
3560 x_contour_x
, x_contour_y
, point_x
, point_y
);
3561 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3562 x_mouse_x
, x_mouse_y
);
3564 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
3566 clip_contour_top (x_mouse_y
);
3568 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
3570 extend_contour_top (x_mouse_y
);
3575 unread_command_event
= obj
;
3576 if (mouse_below_point
)
3578 contour_begin_x
= point_x
;
3579 contour_begin_y
= point_y
;
3580 contour_end_x
= x_contour_x
;
3581 contour_end_y
= x_contour_y
;
3585 contour_begin_x
= x_contour_x
;
3586 contour_begin_y
= x_contour_y
;
3587 contour_end_x
= point_x
;
3588 contour_end_y
= point_y
;
3593 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
3598 register Lisp_Object obj
;
3599 struct frame
*f
= selected_frame
;
3600 register struct window
*w
= XWINDOW (selected_window
);
3601 register GC line_gc
= f
->display
.x
->cursor_gc
;
3602 register GC erase_gc
= f
->display
.x
->reverse_gc
;
3604 char dash_list
[] = {6, 4, 6, 4};
3606 XGCValues gc_values
;
3608 register int previous_y
;
3609 register int line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3610 + f
->display
.x
->internal_border_width
;
3611 register int left
= f
->display
.x
->internal_border_width
3613 * FONT_WIDTH (f
->display
.x
->font
));
3614 register int right
= left
+ (w
->width
3615 * FONT_WIDTH (f
->display
.x
->font
))
3616 - f
->display
.x
->internal_border_width
;
3620 gc_values
.foreground
= f
->display
.x
->cursor_pixel
;
3621 gc_values
.background
= f
->display
.x
->background_pixel
;
3622 gc_values
.line_width
= 1;
3623 gc_values
.line_style
= LineOnOffDash
;
3624 gc_values
.cap_style
= CapRound
;
3625 gc_values
.join_style
= JoinRound
;
3627 line_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3628 GCLineStyle
| GCJoinStyle
| GCCapStyle
3629 | GCLineWidth
| GCForeground
| GCBackground
,
3631 XSetDashes (x_current_display
, line_gc
, 0, dash_list
, dashes
);
3632 gc_values
.foreground
= f
->display
.x
->background_pixel
;
3633 gc_values
.background
= f
->display
.x
->foreground_pixel
;
3634 erase_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3635 GCLineStyle
| GCJoinStyle
| GCCapStyle
3636 | GCLineWidth
| GCForeground
| GCBackground
,
3638 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
3644 if (x_mouse_y
>= XINT (w
->top
)
3645 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
3647 previous_y
= x_mouse_y
;
3648 line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3649 + f
->display
.x
->internal_border_width
;
3650 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3651 line_gc
, left
, line
, right
, line
);
3658 obj
= read_char (-1, 0, 0, Qnil
, 0);
3659 if ((XTYPE (obj
) != Lisp_Cons
)
3660 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3661 Qvertical_scroll_bar
))
3665 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3666 erase_gc
, left
, line
, right
, line
);
3668 unread_command_event
= obj
;
3670 XFreeGC (x_current_display
, line_gc
);
3671 XFreeGC (x_current_display
, erase_gc
);
3676 while (x_mouse_y
== previous_y
);
3679 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3680 erase_gc
, left
, line
, right
, line
);
3686 /* Offset in buffer of character under the pointer, or 0. */
3687 int mouse_buffer_offset
;
3690 /* These keep track of the rectangle following the pointer. */
3691 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
3693 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
3694 "Track the pointer.")
3697 static Cursor current_pointer_shape
;
3698 FRAME_PTR f
= x_mouse_frame
;
3701 if (EQ (Vmouse_frame_part
, Qtext_part
)
3702 && (current_pointer_shape
!= f
->display
.x
->nontext_cursor
))
3707 current_pointer_shape
= f
->display
.x
->nontext_cursor
;
3708 XDefineCursor (x_current_display
,
3710 current_pointer_shape
);
3712 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
3713 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
3715 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
3716 && (current_pointer_shape
!= f
->display
.x
->modeline_cursor
))
3718 current_pointer_shape
= f
->display
.x
->modeline_cursor
;
3719 XDefineCursor (x_current_display
,
3721 current_pointer_shape
);
3730 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
3731 "Draw rectangle around character under mouse pointer, if there is one.")
3735 struct window
*w
= XWINDOW (Vmouse_window
);
3736 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
3737 struct buffer
*b
= XBUFFER (w
->buffer
);
3740 if (! EQ (Vmouse_window
, selected_window
))
3743 if (EQ (event
, Qnil
))
3747 x_read_mouse_position (selected_frame
, &x
, &y
);
3751 mouse_track_width
= 0;
3752 mouse_track_left
= mouse_track_top
= -1;
3756 if ((x_mouse_x
!= mouse_track_left
3757 && (x_mouse_x
< mouse_track_left
3758 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
3759 || x_mouse_y
!= mouse_track_top
)
3761 int hp
= 0; /* Horizontal position */
3762 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
3763 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
3764 int tab_width
= XINT (b
->tab_width
);
3765 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
3767 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
3768 int in_mode_line
= 0;
3770 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
3773 /* Erase previous rectangle. */
3774 if (mouse_track_width
)
3776 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3777 mouse_track_left
, mouse_track_top
,
3778 mouse_track_width
, 1);
3780 if ((mouse_track_left
== f
->phys_cursor_x
3781 || mouse_track_left
== f
->phys_cursor_x
- 1)
3782 && mouse_track_top
== f
->phys_cursor_y
)
3784 x_display_cursor (f
, 1);
3788 mouse_track_left
= x_mouse_x
;
3789 mouse_track_top
= x_mouse_y
;
3790 mouse_track_width
= 0;
3792 if (mouse_track_left
> len
) /* Past the end of line. */
3795 if (mouse_track_top
== mode_line_vpos
)
3801 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3805 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
3811 mouse_track_width
= tab_width
- (hp
% tab_width
);
3813 hp
+= mouse_track_width
;
3816 mouse_track_left
= hp
- mouse_track_width
;
3822 mouse_track_width
= -1;
3826 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3831 mouse_track_width
= 2;
3836 mouse_track_left
= hp
- mouse_track_width
;
3842 mouse_track_width
= 1;
3849 while (hp
<= x_mouse_x
);
3852 if (mouse_track_width
) /* Over text; use text pointer shape. */
3854 XDefineCursor (x_current_display
,
3856 f
->display
.x
->text_cursor
);
3857 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3858 mouse_track_left
, mouse_track_top
,
3859 mouse_track_width
, 1);
3861 else if (in_mode_line
)
3862 XDefineCursor (x_current_display
,
3864 f
->display
.x
->modeline_cursor
);
3866 XDefineCursor (x_current_display
,
3868 f
->display
.x
->nontext_cursor
);
3871 XFlush (x_current_display
);
3874 obj
= read_char (-1, 0, 0, Qnil
, 0);
3877 while (XTYPE (obj
) == Lisp_Cons
/* Mouse event */
3878 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
3879 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
3880 && EQ (Vmouse_window
, selected_window
) /* In this window */
3883 unread_command_event
= obj
;
3885 if (mouse_track_width
)
3887 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3888 mouse_track_left
, mouse_track_top
,
3889 mouse_track_width
, 1);
3890 mouse_track_width
= 0;
3891 if ((mouse_track_left
== f
->phys_cursor_x
3892 || mouse_track_left
- 1 == f
->phys_cursor_x
)
3893 && mouse_track_top
== f
->phys_cursor_y
)
3895 x_display_cursor (f
, 1);
3898 XDefineCursor (x_current_display
,
3900 f
->display
.x
->nontext_cursor
);
3901 XFlush (x_current_display
);
3911 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3912 on the frame F at position X, Y. */
3914 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
3916 int x
, y
, width
, height
;
3921 image
= XCreateBitmapFromData (x_current_display
,
3922 FRAME_X_WINDOW (f
), image_data
,
3924 XCopyPlane (x_current_display
, image
, FRAME_X_WINDOW (f
),
3925 f
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
3930 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer
, Sx_store_cut_buffer
,
3931 1, 1, "sStore text in cut buffer: ",
3932 "Store contents of STRING into the cut buffer of the X window system.")
3934 register Lisp_Object string
;
3938 CHECK_STRING (string
, 1);
3939 if (! FRAME_X_P (selected_frame
))
3940 error ("Selected frame does not understand X protocol.");
3943 XStoreBytes ((char *) XSTRING (string
)->data
, XSTRING (string
)->size
);
3949 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer
, Sx_get_cut_buffer
, 0, 0, 0,
3950 "Return contents of cut buffer of the X window system, as a string.")
3954 register Lisp_Object string
;
3959 d
= XFetchBytes (&len
);
3960 string
= make_string (d
, len
);
3967 #if 0 /* I'm told these functions are superfluous
3968 given the ability to bind function keys. */
3971 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3972 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3973 KEYSYM is a string which conforms to the X keysym definitions found\n\
3974 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3975 list of strings specifying modifier keys such as Control_L, which must\n\
3976 also be depressed for NEWSTRING to appear.")
3977 (x_keysym
, modifiers
, newstring
)
3978 register Lisp_Object x_keysym
;
3979 register Lisp_Object modifiers
;
3980 register Lisp_Object newstring
;
3983 register KeySym keysym
;
3984 KeySym modifier_list
[16];
3987 CHECK_STRING (x_keysym
, 1);
3988 CHECK_STRING (newstring
, 3);
3990 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
3991 if (keysym
== NoSymbol
)
3992 error ("Keysym does not exist");
3994 if (NILP (modifiers
))
3995 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
3996 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3999 register Lisp_Object rest
, mod
;
4002 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
4005 error ("Can't have more than 16 modifiers");
4008 CHECK_STRING (mod
, 3);
4009 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
4011 if (modifier_list
[i
] == NoSymbol
4012 || !(IsModifierKey (modifier_list
[i
])
4013 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
4014 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
4016 if (modifier_list
[i
] == NoSymbol
4017 || !IsModifierKey (modifier_list
[i
]))
4019 error ("Element is not a modifier keysym");
4023 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
4024 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
4030 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
4031 "Rebind KEYCODE to list of strings STRINGS.\n\
4032 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4033 nil as element means don't change.\n\
4034 See the documentation of `x-rebind-key' for more information.")
4036 register Lisp_Object keycode
;
4037 register Lisp_Object strings
;
4039 register Lisp_Object item
;
4040 register unsigned char *rawstring
;
4041 KeySym rawkey
, modifier
[1];
4043 register unsigned i
;
4046 CHECK_NUMBER (keycode
, 1);
4047 CHECK_CONS (strings
, 2);
4048 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
4049 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
4051 item
= Fcar (strings
);
4054 CHECK_STRING (item
, 2);
4055 strsize
= XSTRING (item
)->size
;
4056 rawstring
= (unsigned char *) xmalloc (strsize
);
4057 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
4058 modifier
[1] = 1 << i
;
4059 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
4060 rawstring
, strsize
);
4065 #endif /* HAVE_X11 */
4070 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4072 XScreenNumberOfScreen (scr
)
4073 register Screen
*scr
;
4075 register Display
*dpy
;
4076 register Screen
*dpyscr
;
4080 dpyscr
= dpy
->screens
;
4082 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
4088 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4091 select_visual (screen
, depth
)
4093 unsigned int *depth
;
4096 XVisualInfo
*vinfo
, vinfo_template
;
4099 v
= DefaultVisualOfScreen (screen
);
4102 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
4104 vinfo_template
.visualid
= v
->visualid
;
4107 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4109 vinfo
= XGetVisualInfo (x_current_display
,
4110 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
4113 fatal ("Can't get proper X visual info");
4115 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
4116 *depth
= vinfo
->depth
;
4120 int n
= vinfo
->colormap_size
- 1;
4129 XFree ((char *) vinfo
);
4132 #endif /* HAVE_X11 */
4134 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4135 1, 2, 0, "Open a connection to an X server.\n\
4136 DISPLAY is the name of the display to connect to.\n\
4137 Optional second arg XRM_STRING is a string of resources in xrdb format.")
4138 (display
, xrm_string
)
4139 Lisp_Object display
, xrm_string
;
4141 unsigned int n_planes
;
4142 unsigned char *xrm_option
;
4144 CHECK_STRING (display
, 0);
4145 if (x_current_display
!= 0)
4146 error ("X server connection is already initialized");
4147 if (! NILP (xrm_string
))
4148 CHECK_STRING (xrm_string
, 1);
4150 if (! NILP (xrm_string
))
4151 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4153 xrm_option
= (unsigned char *) 0;
4155 validate_x_resource_name ();
4157 /* This is what opens the connection and sets x_current_display.
4158 This also initializes many symbols, such as those used for input. */
4159 x_term_init (XSTRING (display
)->data
, xrm_option
,
4160 XSTRING (Vx_resource_name
)->data
);
4163 XFASTINT (Vwindow_system_version
) = 11;
4166 xrdb
= x_load_resources (x_current_display
, xrm_option
,
4167 (char *) XSTRING (Vx_resource_name
)->data
,
4170 #ifdef HAVE_XRMSETDATABASE
4171 XrmSetDatabase (x_current_display
, xrdb
);
4173 x_current_display
->db
= xrdb
;
4176 x_screen
= DefaultScreenOfDisplay (x_current_display
);
4178 screen_visual
= select_visual (x_screen
, &n_planes
);
4179 x_screen_planes
= n_planes
;
4180 x_screen_height
= HeightOfScreen (x_screen
);
4181 x_screen_width
= WidthOfScreen (x_screen
);
4183 /* X Atoms used by emacs. */
4184 Xatoms_of_xselect ();
4186 Xatom_wm_protocols
= XInternAtom (x_current_display
, "WM_PROTOCOLS",
4188 Xatom_wm_take_focus
= XInternAtom (x_current_display
, "WM_TAKE_FOCUS",
4190 Xatom_wm_save_yourself
= XInternAtom (x_current_display
, "WM_SAVE_YOURSELF",
4192 Xatom_wm_delete_window
= XInternAtom (x_current_display
, "WM_DELETE_WINDOW",
4194 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
4196 Xatom_wm_configure_denied
= XInternAtom (x_current_display
,
4197 "WM_CONFIGURE_DENIED", False
);
4198 Xatom_wm_window_moved
= XInternAtom (x_current_display
, "WM_MOVED",
4200 Xatom_editres_name
= XInternAtom (x_current_display
, "Editres", False
);
4202 #else /* not HAVE_X11 */
4203 XFASTINT (Vwindow_system_version
) = 10;
4204 #endif /* not HAVE_X11 */
4208 DEFUN ("x-close-current-connection", Fx_close_current_connection
,
4209 Sx_close_current_connection
,
4210 0, 0, 0, "Close the connection to the current X server.")
4213 /* Note: If we're going to call check_x here, then the fatal error
4214 can't happen. For the moment, this check is just for safety,
4215 so a user won't try out the function and get a crash. If it's
4216 really intended only to be called when killing emacs, then there's
4217 no reason for it to have a lisp interface at all. */
4220 /* This is ONLY used when killing emacs; For switching displays
4221 we'll have to take care of setting CloseDownMode elsewhere. */
4223 if (x_current_display
)
4226 XSetCloseDownMode (x_current_display
, DestroyAll
);
4227 XCloseDisplay (x_current_display
);
4228 x_current_display
= 0;
4231 fatal ("No current X display connection to close\n");
4236 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
,
4237 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4238 If ON is nil, allow buffering of requests.\n\
4239 Turning on synchronization prohibits the Xlib routines from buffering\n\
4240 requests and seriously degrades performance, but makes debugging much\n\
4247 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
4252 /* Wait for responses to all X commands issued so far for FRAME. */
4259 XSync (x_current_display
, False
);
4265 /* This is zero if not using X windows. */
4266 x_current_display
= 0;
4268 /* The section below is built by the lisp expression at the top of the file,
4269 just above where these variables are declared. */
4270 /*&&& init symbols here &&&*/
4271 Qauto_raise
= intern ("auto-raise");
4272 staticpro (&Qauto_raise
);
4273 Qauto_lower
= intern ("auto-lower");
4274 staticpro (&Qauto_lower
);
4275 Qbackground_color
= intern ("background-color");
4276 staticpro (&Qbackground_color
);
4277 Qbar
= intern ("bar");
4279 Qborder_color
= intern ("border-color");
4280 staticpro (&Qborder_color
);
4281 Qborder_width
= intern ("border-width");
4282 staticpro (&Qborder_width
);
4283 Qbox
= intern ("box");
4285 Qcursor_color
= intern ("cursor-color");
4286 staticpro (&Qcursor_color
);
4287 Qcursor_type
= intern ("cursor-type");
4288 staticpro (&Qcursor_type
);
4289 Qfont
= intern ("font");
4291 Qforeground_color
= intern ("foreground-color");
4292 staticpro (&Qforeground_color
);
4293 Qgeometry
= intern ("geometry");
4294 staticpro (&Qgeometry
);
4295 Qicon_left
= intern ("icon-left");
4296 staticpro (&Qicon_left
);
4297 Qicon_top
= intern ("icon-top");
4298 staticpro (&Qicon_top
);
4299 Qicon_type
= intern ("icon-type");
4300 staticpro (&Qicon_type
);
4301 Qinternal_border_width
= intern ("internal-border-width");
4302 staticpro (&Qinternal_border_width
);
4303 Qleft
= intern ("left");
4305 Qmouse_color
= intern ("mouse-color");
4306 staticpro (&Qmouse_color
);
4307 Qnone
= intern ("none");
4309 Qparent_id
= intern ("parent-id");
4310 staticpro (&Qparent_id
);
4311 Qsuppress_icon
= intern ("suppress-icon");
4312 staticpro (&Qsuppress_icon
);
4313 Qtop
= intern ("top");
4315 Qundefined_color
= intern ("undefined-color");
4316 staticpro (&Qundefined_color
);
4317 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
4318 staticpro (&Qvertical_scroll_bars
);
4319 Qvisibility
= intern ("visibility");
4320 staticpro (&Qvisibility
);
4321 Qwindow_id
= intern ("window-id");
4322 staticpro (&Qwindow_id
);
4323 Qx_frame_parameter
= intern ("x-frame-parameter");
4324 staticpro (&Qx_frame_parameter
);
4325 Qx_resource_name
= intern ("x-resource-name");
4326 staticpro (&Qx_resource_name
);
4327 Quser_position
= intern ("user-position");
4328 staticpro (&Quser_position
);
4329 Quser_size
= intern ("user-size");
4330 staticpro (&Quser_size
);
4331 /* This is the end of symbol initialization. */
4333 Fput (Qundefined_color
, Qerror_conditions
,
4334 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
4335 Fput (Qundefined_color
, Qerror_message
,
4336 build_string ("Undefined color"));
4338 init_x_parm_symbols ();
4340 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset
,
4341 "The buffer offset of the character under the pointer.");
4342 mouse_buffer_offset
= 0;
4344 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
4345 "The shape of the pointer when over text.\n\
4346 Changing the value does not affect existing frames\n\
4347 unless you set the mouse color.");
4348 Vx_pointer_shape
= Qnil
;
4350 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
4351 "The name Emacs uses to look up X resources; for internal use only.\n\
4352 `x-get-resource' uses this as the first component of the instance name\n\
4353 when requesting resource values.\n\
4354 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4355 was invoked, or to the value specified with the `-name' or `-rn'\n\
4356 switches, if present.");
4357 Vx_resource_name
= Qnil
;
4359 #if 0 /* This doesn't really do anything. */
4360 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
4361 "The shape of the pointer when not over text.\n\
4362 This variable takes effect when you create a new frame\n\
4363 or when you set the mouse color.");
4365 Vx_nontext_pointer_shape
= Qnil
;
4367 #if 0 /* This doesn't really do anything. */
4368 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
4369 "The shape of the pointer when over the mode line.\n\
4370 This variable takes effect when you create a new frame\n\
4371 or when you set the mouse color.");
4373 Vx_mode_pointer_shape
= Qnil
;
4375 DEFVAR_INT ("x-sensitive-text-pointer-shape",
4376 &Vx_sensitive_text_pointer_shape
,
4377 "The shape of the pointer when over mouse-sensitive text.\n\
4378 This variable takes effect when you create a new frame\n\
4379 or when you set the mouse color.");
4380 Vx_sensitive_text_pointer_shape
= Qnil
;
4382 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
4383 "A string indicating the foreground color of the cursor box.");
4384 Vx_cursor_fore_pixel
= Qnil
;
4386 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed
,
4387 "Non-nil if a mouse button is currently depressed.");
4388 Vmouse_depressed
= Qnil
;
4390 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
4391 "t if no X window manager is in use.");
4394 defsubr (&Sx_get_resource
);
4396 defsubr (&Sx_draw_rectangle
);
4397 defsubr (&Sx_erase_rectangle
);
4398 defsubr (&Sx_contour_region
);
4399 defsubr (&Sx_uncontour_region
);
4401 defsubr (&Sx_display_color_p
);
4402 defsubr (&Sx_list_fonts
);
4403 defsubr (&Sx_color_defined_p
);
4404 defsubr (&Sx_server_max_request_size
);
4405 defsubr (&Sx_server_vendor
);
4406 defsubr (&Sx_server_version
);
4407 defsubr (&Sx_display_pixel_width
);
4408 defsubr (&Sx_display_pixel_height
);
4409 defsubr (&Sx_display_mm_width
);
4410 defsubr (&Sx_display_mm_height
);
4411 defsubr (&Sx_display_screens
);
4412 defsubr (&Sx_display_planes
);
4413 defsubr (&Sx_display_color_cells
);
4414 defsubr (&Sx_display_visual_class
);
4415 defsubr (&Sx_display_backing_store
);
4416 defsubr (&Sx_display_save_under
);
4418 defsubr (&Sx_rebind_key
);
4419 defsubr (&Sx_rebind_keys
);
4420 defsubr (&Sx_track_pointer
);
4421 defsubr (&Sx_grab_pointer
);
4422 defsubr (&Sx_ungrab_pointer
);
4425 defsubr (&Sx_get_default
);
4426 defsubr (&Sx_store_cut_buffer
);
4427 defsubr (&Sx_get_cut_buffer
);
4429 defsubr (&Sx_parse_geometry
);
4430 defsubr (&Sx_create_frame
);
4431 defsubr (&Sfocus_frame
);
4432 defsubr (&Sunfocus_frame
);
4434 defsubr (&Sx_horizontal_line
);
4436 defsubr (&Sx_open_connection
);
4437 defsubr (&Sx_close_current_connection
);
4438 defsubr (&Sx_synchronize
);
4441 #endif /* HAVE_X_WINDOWS */