1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993, 1994 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* Completely rewritten by Richard Stallman. */
22 /* Rewritten for X11 by Joseph Arceneaux */
31 /* This makes the fields of a Display accessible, in Xlib header files. */
32 #define XLIB_ILLEGAL_ACCESS
39 #include "dispextern.h"
41 #include "blockinput.h"
47 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
48 #include "bitmaps/gray.xbm"
50 #include <X11/bitmaps/gray>
53 #include "[.bitmaps]gray.xbm"
57 #include <X11/Shell.h>
59 #include <X11/Xaw/Paned.h>
60 #include <X11/Xaw/Label.h>
63 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
72 #include "../lwlib/lwlib.h"
74 /* The one and only application context associated with the connection
75 to the one and only X display that Emacs uses. */
76 XtAppContext Xt_app_con
;
78 /* The one and only application shell. Emacs screens are popup shells of this
82 extern void free_frame_menubar ();
83 extern void free_frame_menubar ();
84 #endif /* USE_X_TOOLKIT */
86 #define min(a,b) ((a) < (b) ? (a) : (b))
87 #define max(a,b) ((a) > (b) ? (a) : (b))
90 /* X Resource data base */
91 static XrmDatabase xrdb
;
93 /* The class of this X application. */
94 #define EMACS_CLASS "Emacs"
97 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
99 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
102 /* The name we're using in resource queries. */
103 Lisp_Object Vx_resource_name
;
105 /* Title name and application name for X stuff. */
106 extern char *x_id_name
;
108 /* The background and shape of the mouse pointer, and shape when not
109 over text or in the modeline. */
110 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
111 /* The shape when over mouse-sensitive text. */
112 Lisp_Object Vx_sensitive_text_pointer_shape
;
114 /* Color of chars displayed in cursor box. */
115 Lisp_Object Vx_cursor_fore_pixel
;
117 /* The screen being used. */
118 static Screen
*x_screen
;
120 /* The X Visual we are using for X windows (the default) */
121 Visual
*screen_visual
;
123 /* Height of this X screen in pixels. */
126 /* Width of this X screen in pixels. */
129 /* Number of planes for this screen. */
132 /* Non nil if no window manager is in use. */
133 Lisp_Object Vx_no_window_manager
;
135 /* `t' if a mouse button is depressed. */
137 Lisp_Object Vmouse_depressed
;
139 extern unsigned int x_mouse_x
, x_mouse_y
, x_mouse_grabbed
;
141 /* Atom for indicating window state to the window manager. */
142 extern Atom Xatom_wm_change_state
;
144 /* Communication with window managers. */
145 extern Atom Xatom_wm_protocols
;
147 /* Kinds of protocol things we may receive. */
148 extern Atom Xatom_wm_take_focus
;
149 extern Atom Xatom_wm_save_yourself
;
150 extern Atom Xatom_wm_delete_window
;
152 /* Other WM communication */
153 extern Atom Xatom_wm_configure_denied
; /* When our config request is denied */
154 extern Atom Xatom_wm_window_moved
; /* When the WM moves us. */
156 /* EditRes protocol */
157 extern Atom Xatom_editres_name
;
161 /* Default size of an Emacs window. */
162 static char *default_window
= "=80x24+0+0";
165 char iconidentity
[MAXICID
];
166 #define ICONTAG "emacs@"
167 char minibuffer_iconidentity
[MAXICID
];
168 #define MINIBUFFER_ICONTAG "minibuffer@"
172 /* The last 23 bits of the timestamp of the last mouse button event. */
173 Time mouse_timestamp
;
175 /* Evaluate this expression to rebuild the section of syms_of_xfns
176 that initializes and staticpros the symbols declared below. Note
177 that Emacs 18 has a bug that keeps C-x C-e from being able to
178 evaluate this expression.
181 ;; Accumulate a list of the symbols we want to initialize from the
182 ;; declarations at the top of the file.
183 (goto-char (point-min))
184 (search-forward "/\*&&& symbols declared here &&&*\/\n")
186 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
188 (cons (buffer-substring (match-beginning 1) (match-end 1))
191 (setq symbol-list (nreverse symbol-list))
192 ;; Delete the section of syms_of_... where we initialize the symbols.
193 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
194 (let ((start (point)))
195 (while (looking-at "^ Q")
197 (kill-region start (point)))
198 ;; Write a new symbol initialization section.
200 (insert (format " %s = intern (\"" (car symbol-list)))
201 (let ((start (point)))
202 (insert (substring (car symbol-list) 1))
203 (subst-char-in-region start (point) ?_ ?-))
204 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
205 (setq symbol-list (cdr symbol-list)))))
209 /*&&& symbols declared here &&&*/
210 Lisp_Object Qauto_raise
;
211 Lisp_Object Qauto_lower
;
212 Lisp_Object Qbackground_color
;
214 Lisp_Object Qborder_color
;
215 Lisp_Object Qborder_width
;
217 Lisp_Object Qcursor_color
;
218 Lisp_Object Qcursor_type
;
220 Lisp_Object Qforeground_color
;
221 Lisp_Object Qgeometry
;
222 /* Lisp_Object Qicon; */
223 Lisp_Object Qicon_left
;
224 Lisp_Object Qicon_top
;
225 Lisp_Object Qicon_type
;
226 Lisp_Object Qinternal_border_width
;
228 Lisp_Object Qmouse_color
;
230 Lisp_Object Qparent_id
;
231 Lisp_Object Qsuppress_icon
;
233 Lisp_Object Qundefined_color
;
234 Lisp_Object Qvertical_scroll_bars
;
235 Lisp_Object Qvisibility
;
236 Lisp_Object Qwindow_id
;
237 Lisp_Object Qx_frame_parameter
;
238 Lisp_Object Qx_resource_name
;
239 Lisp_Object Quser_position
;
240 Lisp_Object Quser_size
;
242 /* The below are defined in frame.c. */
243 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
244 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
;
246 extern Lisp_Object Vwindow_system_version
;
249 /* Error if we are not connected to X. */
253 if (x_current_display
== 0)
254 error ("X windows are not in use or not initialized");
257 /* Nonzero if using X for display. */
262 return x_current_display
!= 0;
265 /* Return the Emacs frame-object corresponding to an X window.
266 It could be the frame's main window or an icon window. */
268 /* This function can be called during GC, so use XGCTYPE. */
271 x_window_to_frame (wdesc
)
274 Lisp_Object tail
, frame
;
277 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
278 tail
= XCONS (tail
)->cdr
)
280 frame
= XCONS (tail
)->car
;
281 if (XGCTYPE (frame
) != Lisp_Frame
)
285 if (f
->display
.nothing
== 1)
287 if ((f
->display
.x
->edit_widget
288 && XtWindow (f
->display
.x
->edit_widget
) == wdesc
)
289 || f
->display
.x
->icon_desc
== wdesc
)
291 #else /* not USE_X_TOOLKIT */
292 if (FRAME_X_WINDOW (f
) == wdesc
293 || f
->display
.x
->icon_desc
== wdesc
)
295 #endif /* not USE_X_TOOLKIT */
301 /* Like x_window_to_frame but also compares the window with the widget's
305 x_any_window_to_frame (wdesc
)
308 Lisp_Object tail
, frame
;
312 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
313 tail
= XCONS (tail
)->cdr
)
315 frame
= XCONS (tail
)->car
;
316 if (XGCTYPE (frame
) != Lisp_Frame
)
319 if (f
->display
.nothing
== 1)
322 /* This frame matches if the window is any of its widgets. */
323 if (wdesc
== XtWindow (x
->widget
)
324 || wdesc
== XtWindow (x
->column_widget
)
325 || wdesc
== XtWindow (x
->edit_widget
))
327 /* Match if the window is this frame's menubar. */
328 if (x
->menubar_widget
329 && wdesc
== XtWindow (x
->menubar_widget
))
335 /* Return the frame whose principal (outermost) window is WDESC.
336 If WDESC is some other (smaller) window, we return 0. */
339 x_top_window_to_frame (wdesc
)
342 Lisp_Object tail
, frame
;
346 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
347 tail
= XCONS (tail
)->cdr
)
349 frame
= XCONS (tail
)->car
;
350 if (XGCTYPE (frame
) != Lisp_Frame
)
353 if (f
->display
.nothing
== 1)
356 /* This frame matches if the window is its topmost widget. */
357 if (wdesc
== XtWindow (x
->widget
))
359 /* Match if the window is this frame's menubar. */
360 if (x
->menubar_widget
361 && wdesc
== XtWindow (x
->menubar_widget
))
366 #endif /* USE_X_TOOLKIT */
369 /* Connect the frame-parameter names for X frames
370 to the ways of passing the parameter values to the window system.
372 The name of a parameter, as a Lisp symbol,
373 has an `x-frame-parameter' property which is an integer in Lisp
374 but can be interpreted as an `enum x_frame_parm' in C. */
378 X_PARM_FOREGROUND_COLOR
,
379 X_PARM_BACKGROUND_COLOR
,
386 X_PARM_INTERNAL_BORDER_WIDTH
,
390 X_PARM_VERT_SCROLL_BAR
,
392 X_PARM_MENU_BAR_LINES
396 struct x_frame_parm_table
399 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
402 void x_set_foreground_color ();
403 void x_set_background_color ();
404 void x_set_mouse_color ();
405 void x_set_cursor_color ();
406 void x_set_border_color ();
407 void x_set_cursor_type ();
408 void x_set_icon_type ();
410 void x_set_border_width ();
411 void x_set_internal_border_width ();
412 void x_explicitly_set_name ();
413 void x_set_autoraise ();
414 void x_set_autolower ();
415 void x_set_vertical_scroll_bars ();
416 void x_set_visibility ();
417 void x_set_menu_bar_lines ();
419 static struct x_frame_parm_table x_frame_parms
[] =
421 "foreground-color", x_set_foreground_color
,
422 "background-color", x_set_background_color
,
423 "mouse-color", x_set_mouse_color
,
424 "cursor-color", x_set_cursor_color
,
425 "border-color", x_set_border_color
,
426 "cursor-type", x_set_cursor_type
,
427 "icon-type", x_set_icon_type
,
429 "border-width", x_set_border_width
,
430 "internal-border-width", x_set_internal_border_width
,
431 "name", x_explicitly_set_name
,
432 "auto-raise", x_set_autoraise
,
433 "auto-lower", x_set_autolower
,
434 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
435 "visibility", x_set_visibility
,
436 "menu-bar-lines", x_set_menu_bar_lines
,
439 /* Attach the `x-frame-parameter' properties to
440 the Lisp symbol names of parameters relevant to X. */
442 init_x_parm_symbols ()
446 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
447 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
451 /* Change the parameters of FRAME as specified by ALIST.
452 If a parameter is not specially recognized, do nothing;
453 otherwise call the `x_set_...' function for that parameter. */
456 x_set_frame_parameters (f
, alist
)
462 /* If both of these parameters are present, it's more efficient to
463 set them both at once. So we wait until we've looked at the
464 entire list before we set them. */
465 Lisp_Object width
, height
;
468 Lisp_Object left
, top
;
470 /* Record in these vectors all the parms specified. */
476 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
479 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
480 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
482 /* Extract parm names and values into those vectors. */
485 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
487 Lisp_Object elt
, prop
, val
;
490 parms
[i
] = Fcar (elt
);
491 values
[i
] = Fcdr (elt
);
495 width
= height
= top
= left
= Qunbound
;
497 /* Now process them in reverse of specified order. */
498 for (i
--; i
>= 0; i
--)
500 Lisp_Object prop
, val
;
505 if (EQ (prop
, Qwidth
))
507 else if (EQ (prop
, Qheight
))
509 else if (EQ (prop
, Qtop
))
511 else if (EQ (prop
, Qleft
))
515 register Lisp_Object param_index
, old_value
;
517 param_index
= Fget (prop
, Qx_frame_parameter
);
518 old_value
= get_frame_param (f
, prop
);
519 store_frame_param (f
, prop
, val
);
520 if (XTYPE (param_index
) == Lisp_Int
521 && XINT (param_index
) >= 0
522 && (XINT (param_index
)
523 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
524 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
528 /* Don't die if just one of these was set. */
529 if (EQ (left
, Qunbound
))
530 XSET (left
, Lisp_Int
, f
->display
.x
->left_pos
);
531 if (EQ (top
, Qunbound
))
532 XSET (top
, Lisp_Int
, f
->display
.x
->top_pos
);
534 /* Don't die if just one of these was set. */
535 if (EQ (width
, Qunbound
))
536 XSET (width
, Lisp_Int
, FRAME_WIDTH (f
));
537 if (EQ (height
, Qunbound
))
538 XSET (height
, Lisp_Int
, FRAME_HEIGHT (f
));
540 /* Don't set these parameters these unless they've been explicitly
541 specified. The window might be mapped or resized while we're in
542 this function, and we don't want to override that unless the lisp
543 code has asked for it.
545 Don't set these parameters unless they actually differ from the
546 window's current parameters; the window may not actually exist
551 check_frame_size (f
, &height
, &width
);
553 XSET (frame
, Lisp_Frame
, f
);
555 if ((NUMBERP (width
) && XINT (width
) != FRAME_WIDTH (f
))
556 || (NUMBERP (height
) && XINT (height
) != FRAME_HEIGHT (f
)))
557 Fset_frame_size (frame
, width
, height
);
559 if ((!NILP (left
) || !NILP (top
))
560 && ! (NUMBERP (left
) && XINT (left
) == f
->display
.x
->left_pos
561 && NUMBERP (top
) && XINT (top
) == f
->display
.x
->top_pos
))
563 int leftpos
= (NUMBERP (left
) ? XINT (left
) : 0);
564 int toppos
= (NUMBERP (top
) ? XINT (top
) : 0);
566 /* Store the numeric value of the position. */
567 f
->display
.x
->top_pos
= toppos
;
568 f
->display
.x
->left_pos
= leftpos
;
570 /* Record the signs. */
571 f
->display
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
572 if (EQ (left
, Qminus
) || (NUMBERP (left
) && XINT (left
) < 0))
573 f
->display
.x
->size_hint_flags
|= XNegative
;
574 if (EQ (top
, Qminus
) || (NUMBERP (top
) && XINT (top
) < 0))
575 f
->display
.x
->size_hint_flags
|= YNegative
;
576 f
->display
.x
->win_gravity
= NorthWestGravity
;
578 /* Actually set that position, and convert to absolute. */
579 x_set_offset (f
, leftpos
, toppos
, 0);
584 /* Store the positions of frame F into XPTR and YPTR.
585 These are the positions of the containing window manager window,
586 not Emacs's own window. */
589 x_real_positions (f
, xptr
, yptr
)
593 int win_x
= 0, win_y
= 0;
596 /* This is pretty gross, but seems to be the easiest way out of
597 the problem that arises when restarting window-managers. */
600 Window outer
= XtWindow (f
->display
.x
->widget
);
602 Window outer
= f
->display
.x
->window_desc
;
604 Window tmp_root_window
;
605 Window
*tmp_children
;
608 XQueryTree (x_current_display
, outer
, &tmp_root_window
,
609 &f
->display
.x
->parent_desc
,
610 &tmp_children
, &tmp_nchildren
);
611 xfree (tmp_children
);
613 /* Find the position of the outside upper-left corner of
614 the inner window, with respect to the outer window. */
615 if (f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
618 XTranslateCoordinates (x_current_display
,
620 /* From-window, to-window. */
622 XtWindow (f
->display
.x
->widget
),
624 f
->display
.x
->window_desc
,
626 f
->display
.x
->parent_desc
,
628 /* From-position, to-position. */
629 0, 0, &win_x
, &win_y
,
635 win_x
+= f
->display
.x
->border_width
;
636 win_y
+= f
->display
.x
->border_width
;
638 *xptr
= f
->display
.x
->left_pos
- win_x
;
639 *yptr
= f
->display
.x
->top_pos
- win_y
;
642 /* Insert a description of internally-recorded parameters of frame X
643 into the parameter alist *ALISTPTR that is to be given to the user.
644 Only parameters that are specific to the X window system
645 and whose values are not correctly recorded in the frame's
646 param_alist need to be considered here. */
648 x_report_frame_params (f
, alistptr
)
650 Lisp_Object
*alistptr
;
654 store_in_alist (alistptr
, Qleft
, make_number (f
->display
.x
->left_pos
));
655 store_in_alist (alistptr
, Qtop
, make_number (f
->display
.x
->top_pos
));
656 store_in_alist (alistptr
, Qborder_width
,
657 make_number (f
->display
.x
->border_width
));
658 store_in_alist (alistptr
, Qinternal_border_width
,
659 make_number (f
->display
.x
->internal_border_width
));
660 sprintf (buf
, "%d", FRAME_X_WINDOW (f
));
661 store_in_alist (alistptr
, Qwindow_id
,
663 FRAME_SAMPLE_VISIBILITY (f
);
664 store_in_alist (alistptr
, Qvisibility
,
665 (FRAME_VISIBLE_P (f
) ? Qt
666 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
669 /* Decide if color named COLOR is valid for the display associated with
670 the selected frame; if so, return the rgb values in COLOR_DEF.
671 If ALLOC is nonzero, allocate a new colormap cell. */
674 defined_color (color
, color_def
, alloc
)
680 Colormap screen_colormap
;
685 = DefaultColormap (x_current_display
, XDefaultScreen (x_current_display
));
687 foo
= XParseColor (x_current_display
, screen_colormap
, color
, color_def
);
689 foo
= XAllocColor (x_current_display
, screen_colormap
, color_def
);
691 foo
= XParseColor (color
, color_def
);
693 foo
= XGetHardwareColor (color_def
);
694 #endif /* not HAVE_X11 */
703 /* Given a string ARG naming a color, compute a pixel value from it
704 suitable for screen F.
705 If F is not a color screen, return DEF (default) regardless of what
709 x_decode_color (arg
, def
)
715 CHECK_STRING (arg
, 0);
717 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
718 return BLACK_PIX_DEFAULT
;
719 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
720 return WHITE_PIX_DEFAULT
;
723 if (x_screen_planes
== 1)
726 if (DISPLAY_CELLS
== 1)
730 if (defined_color (XSTRING (arg
)->data
, &cdef
, 1))
733 Fsignal (Qundefined_color
, Fcons (arg
, Qnil
));
736 /* Functions called only from `x_set_frame_param'
737 to set individual parameters.
739 If FRAME_X_WINDOW (f) is 0,
740 the frame is being created and its X-window does not exist yet.
741 In that case, just record the parameter's new value
742 in the standard place; do not attempt to change the window. */
745 x_set_foreground_color (f
, arg
, oldval
)
747 Lisp_Object arg
, oldval
;
749 f
->display
.x
->foreground_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
750 if (FRAME_X_WINDOW (f
) != 0)
754 XSetForeground (x_current_display
, f
->display
.x
->normal_gc
,
755 f
->display
.x
->foreground_pixel
);
756 XSetBackground (x_current_display
, f
->display
.x
->reverse_gc
,
757 f
->display
.x
->foreground_pixel
);
759 #endif /* HAVE_X11 */
760 recompute_basic_faces (f
);
761 if (FRAME_VISIBLE_P (f
))
767 x_set_background_color (f
, arg
, oldval
)
769 Lisp_Object arg
, oldval
;
774 f
->display
.x
->background_pixel
= x_decode_color (arg
, WHITE_PIX_DEFAULT
);
776 if (FRAME_X_WINDOW (f
) != 0)
780 /* The main frame area. */
781 XSetBackground (x_current_display
, f
->display
.x
->normal_gc
,
782 f
->display
.x
->background_pixel
);
783 XSetForeground (x_current_display
, f
->display
.x
->reverse_gc
,
784 f
->display
.x
->background_pixel
);
785 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
786 f
->display
.x
->background_pixel
);
787 XSetWindowBackground (x_current_display
, FRAME_X_WINDOW (f
),
788 f
->display
.x
->background_pixel
);
791 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
792 bar
= XSCROLL_BAR (bar
)->next
)
793 XSetWindowBackground (x_current_display
,
794 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
795 f
->display
.x
->background_pixel
);
798 temp
= XMakeTile (f
->display
.x
->background_pixel
);
799 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
801 #endif /* not HAVE_X11 */
804 recompute_basic_faces (f
);
806 if (FRAME_VISIBLE_P (f
))
812 x_set_mouse_color (f
, arg
, oldval
)
814 Lisp_Object arg
, oldval
;
816 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
820 f
->display
.x
->mouse_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
821 mask_color
= f
->display
.x
->background_pixel
;
822 /* No invisible pointers. */
823 if (mask_color
== f
->display
.x
->mouse_pixel
824 && mask_color
== f
->display
.x
->background_pixel
)
825 f
->display
.x
->mouse_pixel
= f
->display
.x
->foreground_pixel
;
830 /* It's not okay to crash if the user selects a screwy cursor. */
833 if (!EQ (Qnil
, Vx_pointer_shape
))
835 CHECK_NUMBER (Vx_pointer_shape
, 0);
836 cursor
= XCreateFontCursor (x_current_display
, XINT (Vx_pointer_shape
));
839 cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
840 x_check_errors ("bad text pointer cursor: %s");
842 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
844 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
845 nontext_cursor
= XCreateFontCursor (x_current_display
,
846 XINT (Vx_nontext_pointer_shape
));
849 nontext_cursor
= XCreateFontCursor (x_current_display
, XC_left_ptr
);
850 x_check_errors ("bad nontext pointer cursor: %s");
852 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
854 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
855 mode_cursor
= XCreateFontCursor (x_current_display
,
856 XINT (Vx_mode_pointer_shape
));
859 mode_cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
860 x_check_errors ("bad modeline pointer cursor: %s");
862 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
864 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
866 = XCreateFontCursor (x_current_display
,
867 XINT (Vx_sensitive_text_pointer_shape
));
870 cross_cursor
= XCreateFontCursor (x_current_display
, XC_crosshair
);
872 /* Check and report errors with the above calls. */
873 x_check_errors ("can't set cursor shape: %s");
877 XColor fore_color
, back_color
;
879 fore_color
.pixel
= f
->display
.x
->mouse_pixel
;
880 back_color
.pixel
= mask_color
;
881 XQueryColor (x_current_display
,
882 DefaultColormap (x_current_display
,
883 DefaultScreen (x_current_display
)),
885 XQueryColor (x_current_display
,
886 DefaultColormap (x_current_display
,
887 DefaultScreen (x_current_display
)),
889 XRecolorCursor (x_current_display
, cursor
,
890 &fore_color
, &back_color
);
891 XRecolorCursor (x_current_display
, nontext_cursor
,
892 &fore_color
, &back_color
);
893 XRecolorCursor (x_current_display
, mode_cursor
,
894 &fore_color
, &back_color
);
895 XRecolorCursor (x_current_display
, cross_cursor
,
896 &fore_color
, &back_color
);
899 cursor
= XCreateCursor (16, 16, MouseCursor
, MouseMask
,
901 f
->display
.x
->mouse_pixel
,
902 f
->display
.x
->background_pixel
,
906 if (FRAME_X_WINDOW (f
) != 0)
908 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
), cursor
);
911 if (cursor
!= f
->display
.x
->text_cursor
&& f
->display
.x
->text_cursor
!= 0)
912 XFreeCursor (XDISPLAY f
->display
.x
->text_cursor
);
913 f
->display
.x
->text_cursor
= cursor
;
915 if (nontext_cursor
!= f
->display
.x
->nontext_cursor
916 && f
->display
.x
->nontext_cursor
!= 0)
917 XFreeCursor (XDISPLAY f
->display
.x
->nontext_cursor
);
918 f
->display
.x
->nontext_cursor
= nontext_cursor
;
920 if (mode_cursor
!= f
->display
.x
->modeline_cursor
921 && f
->display
.x
->modeline_cursor
!= 0)
922 XFreeCursor (XDISPLAY f
->display
.x
->modeline_cursor
);
923 f
->display
.x
->modeline_cursor
= mode_cursor
;
924 if (cross_cursor
!= f
->display
.x
->cross_cursor
925 && f
->display
.x
->cross_cursor
!= 0)
926 XFreeCursor (XDISPLAY f
->display
.x
->cross_cursor
);
927 f
->display
.x
->cross_cursor
= cross_cursor
;
928 #endif /* HAVE_X11 */
935 x_set_cursor_color (f
, arg
, oldval
)
937 Lisp_Object arg
, oldval
;
939 unsigned long fore_pixel
;
941 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
942 fore_pixel
= x_decode_color (Vx_cursor_fore_pixel
, WHITE_PIX_DEFAULT
);
944 fore_pixel
= f
->display
.x
->background_pixel
;
945 f
->display
.x
->cursor_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
947 /* Make sure that the cursor color differs from the background color. */
948 if (f
->display
.x
->cursor_pixel
== f
->display
.x
->background_pixel
)
950 f
->display
.x
->cursor_pixel
= f
->display
.x
->mouse_pixel
;
951 if (f
->display
.x
->cursor_pixel
== fore_pixel
)
952 fore_pixel
= f
->display
.x
->background_pixel
;
954 f
->display
.x
->cursor_foreground_pixel
= fore_pixel
;
956 if (FRAME_X_WINDOW (f
) != 0)
960 XSetBackground (x_current_display
, f
->display
.x
->cursor_gc
,
961 f
->display
.x
->cursor_pixel
);
962 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
965 #endif /* HAVE_X11 */
967 if (FRAME_VISIBLE_P (f
))
969 x_display_cursor (f
, 0);
970 x_display_cursor (f
, 1);
975 /* Set the border-color of frame F to value described by ARG.
976 ARG can be a string naming a color.
977 The border-color is used for the border that is drawn by the X server.
978 Note that this does not fully take effect if done before
979 F has an x-window; it must be redone when the window is created.
981 Note: this is done in two routines because of the way X10 works.
983 Note: under X11, this is normally the province of the window manager,
984 and so emacs' border colors may be overridden. */
987 x_set_border_color (f
, arg
, oldval
)
989 Lisp_Object arg
, oldval
;
994 CHECK_STRING (arg
, 0);
995 str
= XSTRING (arg
)->data
;
998 if (!strcmp (str
, "grey") || !strcmp (str
, "Grey")
999 || !strcmp (str
, "gray") || !strcmp (str
, "Gray"))
1004 pix
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
1006 x_set_border_pixel (f
, pix
);
1009 /* Set the border-color of frame F to pixel value PIX.
1010 Note that this does not fully take effect if done before
1011 F has an x-window. */
1013 x_set_border_pixel (f
, pix
)
1017 f
->display
.x
->border_pixel
= pix
;
1019 if (FRAME_X_WINDOW (f
) != 0 && f
->display
.x
->border_width
> 0)
1026 XSetWindowBorder (x_current_display
, FRAME_X_WINDOW (f
),
1030 temp
= XMakePixmap ((Bitmap
) XStoreBitmap (gray_width
, gray_height
,
1032 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
1034 temp
= XMakeTile (pix
);
1035 XChangeBorder (FRAME_X_WINDOW (f
), temp
);
1036 XFreePixmap (XDISPLAY temp
);
1037 #endif /* not HAVE_X11 */
1040 if (FRAME_VISIBLE_P (f
))
1046 x_set_cursor_type (f
, arg
, oldval
)
1048 Lisp_Object arg
, oldval
;
1051 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1056 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
1057 /* Error messages commented out because people have trouble fixing
1058 .Xdefaults with Emacs, when it has something bad in it. */
1062 ("the `cursor-type' frame parameter should be either `bar' or `box'");
1065 /* Make sure the cursor gets redrawn. This is overkill, but how
1066 often do people change cursor types? */
1067 update_mode_lines
++;
1071 x_set_icon_type (f
, arg
, oldval
)
1073 Lisp_Object arg
, oldval
;
1078 if (EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1083 result
= x_text_icon (f
, 0);
1085 result
= x_bitmap_icon (f
);
1090 error ("No icon window available.");
1093 /* If the window was unmapped (and its icon was mapped),
1094 the new icon is not mapped, so map the window in its stead. */
1095 if (FRAME_VISIBLE_P (f
))
1096 #ifdef USE_X_TOOLKIT
1097 XtPopup (f
->display
.x
->widget
, XtGrabNone
);
1099 XMapWindow (XDISPLAY
FRAME_X_WINDOW (f
));
1105 extern Lisp_Object
x_new_font ();
1108 x_set_font (f
, arg
, oldval
)
1110 Lisp_Object arg
, oldval
;
1114 CHECK_STRING (arg
, 1);
1117 result
= x_new_font (f
, XSTRING (arg
)->data
);
1120 if (EQ (result
, Qnil
))
1121 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
1122 else if (EQ (result
, Qt
))
1123 error ("the characters of the given font have varying widths");
1124 else if (STRINGP (result
))
1126 recompute_basic_faces (f
);
1127 store_frame_param (f
, Qfont
, result
);
1134 x_set_border_width (f
, arg
, oldval
)
1136 Lisp_Object arg
, oldval
;
1138 CHECK_NUMBER (arg
, 0);
1140 if (XINT (arg
) == f
->display
.x
->border_width
)
1143 if (FRAME_X_WINDOW (f
) != 0)
1144 error ("Cannot change the border width of a window");
1146 f
->display
.x
->border_width
= XINT (arg
);
1150 x_set_internal_border_width (f
, arg
, oldval
)
1152 Lisp_Object arg
, oldval
;
1155 int old
= f
->display
.x
->internal_border_width
;
1157 CHECK_NUMBER (arg
, 0);
1158 f
->display
.x
->internal_border_width
= XINT (arg
);
1159 if (f
->display
.x
->internal_border_width
< 0)
1160 f
->display
.x
->internal_border_width
= 0;
1162 if (f
->display
.x
->internal_border_width
== old
)
1165 if (FRAME_X_WINDOW (f
) != 0)
1168 x_set_window_size (f
, 0, f
->width
, f
->height
);
1170 x_set_resize_hint (f
);
1174 SET_FRAME_GARBAGED (f
);
1179 x_set_visibility (f
, value
, oldval
)
1181 Lisp_Object value
, oldval
;
1184 XSET (frame
, Lisp_Frame
, f
);
1187 Fmake_frame_invisible (frame
, Qt
);
1188 else if (EQ (value
, Qicon
))
1189 Ficonify_frame (frame
);
1191 Fmake_frame_visible (frame
);
1195 x_set_menu_bar_lines_1 (window
, n
)
1199 struct window
*w
= XWINDOW (window
);
1201 XFASTINT (w
->top
) += n
;
1202 XFASTINT (w
->height
) -= n
;
1204 /* Handle just the top child in a vertical split. */
1205 if (!NILP (w
->vchild
))
1206 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1208 /* Adjust all children in a horizontal split. */
1209 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1211 w
= XWINDOW (window
);
1212 x_set_menu_bar_lines_1 (window
, n
);
1217 x_set_menu_bar_lines (f
, value
, oldval
)
1219 Lisp_Object value
, oldval
;
1222 int olines
= FRAME_MENU_BAR_LINES (f
);
1224 /* Right now, menu bars don't work properly in minibuf-only frames;
1225 most of the commands try to apply themselves to the minibuffer
1226 frame itslef, and get an error because you can't switch buffers
1227 in or split the minibuffer window. */
1228 if (FRAME_MINIBUF_ONLY_P (f
))
1231 if (XTYPE (value
) == Lisp_Int
)
1232 nlines
= XINT (value
);
1236 #ifdef USE_X_TOOLKIT
1237 FRAME_MENU_BAR_LINES (f
) = 0;
1239 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1242 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1243 free_frame_menubar (f
);
1244 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1245 f
->display
.x
->menubar_widget
= 0;
1247 #else /* not USE_X_TOOLKIT */
1248 FRAME_MENU_BAR_LINES (f
) = nlines
;
1249 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1250 #endif /* not USE_X_TOOLKIT */
1253 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1256 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1257 name; if NAME is a string, set F's name to NAME and set
1258 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1260 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1261 suggesting a new name, which lisp code should override; if
1262 F->explicit_name is set, ignore the new name; otherwise, set it. */
1265 x_set_name (f
, name
, explicit)
1270 /* Make sure that requests from lisp code override requests from
1271 Emacs redisplay code. */
1274 /* If we're switching from explicit to implicit, we had better
1275 update the mode lines and thereby update the title. */
1276 if (f
->explicit_name
&& NILP (name
))
1277 update_mode_lines
= 1;
1279 f
->explicit_name
= ! NILP (name
);
1281 else if (f
->explicit_name
)
1284 /* If NAME is nil, set the name to the x_id_name. */
1287 /* Check for no change needed in this very common case
1288 before we do any consing. */
1289 if (!strcmp (x_id_name
, XSTRING (f
->name
)->data
))
1291 name
= build_string (x_id_name
);
1294 CHECK_STRING (name
, 0);
1296 /* Don't change the name if it's already NAME. */
1297 if (! NILP (Fstring_equal (name
, f
->name
)))
1300 if (FRAME_X_WINDOW (f
))
1306 text
.value
= XSTRING (name
)->data
;
1307 text
.encoding
= XA_STRING
;
1309 text
.nitems
= XSTRING (name
)->size
;
1310 #ifdef USE_X_TOOLKIT
1311 XSetWMName (x_current_display
, XtWindow (f
->display
.x
->widget
), &text
);
1312 XSetWMIconName (x_current_display
, XtWindow (f
->display
.x
->widget
),
1314 #else /* not USE_X_TOOLKIT */
1315 XSetWMName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1316 XSetWMIconName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1317 #endif /* not USE_X_TOOLKIT */
1319 #else /* not HAVE_X11R4 */
1320 XSetIconName (XDISPLAY
FRAME_X_WINDOW (f
),
1321 XSTRING (name
)->data
);
1322 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
),
1323 XSTRING (name
)->data
);
1324 #endif /* not HAVE_X11R4 */
1331 /* This function should be called when the user's lisp code has
1332 specified a name for the frame; the name will override any set by the
1335 x_explicitly_set_name (f
, arg
, oldval
)
1337 Lisp_Object arg
, oldval
;
1339 x_set_name (f
, arg
, 1);
1342 /* This function should be called by Emacs redisplay code to set the
1343 name; names set this way will never override names set by the user's
1346 x_implicitly_set_name (f
, arg
, oldval
)
1348 Lisp_Object arg
, oldval
;
1350 x_set_name (f
, arg
, 0);
1354 x_set_autoraise (f
, arg
, oldval
)
1356 Lisp_Object arg
, oldval
;
1358 f
->auto_raise
= !EQ (Qnil
, arg
);
1362 x_set_autolower (f
, arg
, oldval
)
1364 Lisp_Object arg
, oldval
;
1366 f
->auto_lower
= !EQ (Qnil
, arg
);
1370 x_set_vertical_scroll_bars (f
, arg
, oldval
)
1372 Lisp_Object arg
, oldval
;
1374 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
1376 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
1378 /* We set this parameter before creating the X window for the
1379 frame, so we can get the geometry right from the start.
1380 However, if the window hasn't been created yet, we shouldn't
1381 call x_set_window_size. */
1382 if (FRAME_X_WINDOW (f
))
1383 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1387 /* Subroutines of creating an X frame. */
1391 /* Make sure that Vx_resource_name is set to a reasonable value. */
1393 validate_x_resource_name ()
1395 if (STRINGP (Vx_resource_name
))
1397 int len
= XSTRING (Vx_resource_name
)->size
;
1398 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
1401 /* Allow only letters, digits, - and _,
1402 because those are all that X allows. */
1403 for (i
= 0; i
< len
; i
++)
1406 if (! ((c
>= 'a' && c
<= 'z')
1407 || (c
>= 'A' && c
<= 'Z')
1408 || (c
>= '0' && c
<= '9')
1409 || c
== '-' || c
== '_'))
1415 Vx_resource_name
= make_string ("emacs", 5);
1419 extern char *x_get_string_resource ();
1420 extern XrmDatabase
x_load_resources ();
1422 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
1423 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1424 This uses `NAME.ATTRIBUTE' as the key and `Emacs.INSTANCE' as the\n\
1425 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1426 the name specified by the `-name' or `-rn' command-line arguments.\n\
1428 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1429 class, respectively. You must specify both of them or neither.\n\
1430 If you specify them, the key is `NAME.COMPONENT.ATTRIBUTE'\n\
1431 and the class is `Emacs.INSTANCE.SUBCLASS'.")
1432 (attribute
, class, component
, subclass
)
1433 Lisp_Object attribute
, class, component
, subclass
;
1435 register char *value
;
1438 Lisp_Object resname
;
1442 CHECK_STRING (attribute
, 0);
1443 CHECK_STRING (class, 0);
1445 if (!NILP (component
))
1446 CHECK_STRING (component
, 1);
1447 if (!NILP (subclass
))
1448 CHECK_STRING (subclass
, 2);
1449 if (NILP (component
) != NILP (subclass
))
1450 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1452 validate_x_resource_name ();
1453 resname
= Vx_resource_name
;
1455 if (NILP (component
))
1457 /* Allocate space for the components, the dots which separate them,
1458 and the final '\0'. */
1459 name_key
= (char *) alloca (XSTRING (resname
)->size
1460 + XSTRING (attribute
)->size
1462 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1463 + XSTRING (class)->size
1466 sprintf (name_key
, "%s.%s",
1467 XSTRING (resname
)->data
,
1468 XSTRING (attribute
)->data
);
1469 sprintf (class_key
, "%s.%s",
1471 XSTRING (class)->data
);
1475 name_key
= (char *) alloca (XSTRING (resname
)->size
1476 + XSTRING (component
)->size
1477 + XSTRING (attribute
)->size
1480 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1481 + XSTRING (class)->size
1482 + XSTRING (subclass
)->size
1485 sprintf (name_key
, "%s.%s.%s",
1486 XSTRING (resname
)->data
,
1487 XSTRING (component
)->data
,
1488 XSTRING (attribute
)->data
);
1489 sprintf (class_key
, "%s.%s.%s",
1491 XSTRING (class)->data
,
1492 XSTRING (subclass
)->data
);
1495 value
= x_get_string_resource (xrdb
, name_key
, class_key
);
1497 if (value
!= (char *) 0)
1498 return build_string (value
);
1503 /* Used when C code wants a resource value. */
1506 x_get_resource_string (attribute
, class)
1507 char *attribute
, *class;
1509 register char *value
;
1513 /* Allocate space for the components, the dots which separate them,
1514 and the final '\0'. */
1515 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
1516 + strlen (attribute
) + 2);
1517 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1518 + strlen (class) + 2);
1520 sprintf (name_key
, "%s.%s",
1521 XSTRING (Vinvocation_name
)->data
,
1523 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
1525 return x_get_string_resource (xrdb
, name_key
, class_key
);
1530 DEFUN ("x-get-default", Fx_get_default
, Sx_get_default
, 1, 1, 0,
1531 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1532 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1533 The defaults are specified in the file `~/.Xdefaults'.")
1537 register unsigned char *value
;
1539 CHECK_STRING (arg
, 1);
1541 value
= (unsigned char *) XGetDefault (XDISPLAY
1542 XSTRING (Vinvocation_name
)->data
,
1543 XSTRING (arg
)->data
);
1545 /* Try reversing last two args, in case this is the buggy version of X. */
1546 value
= (unsigned char *) XGetDefault (XDISPLAY
1547 XSTRING (arg
)->data
,
1548 XSTRING (Vinvocation_name
)->data
);
1550 return build_string (value
);
1555 #define Fx_get_resource(attribute, class, component, subclass) \
1556 Fx_get_default (attribute)
1560 /* Types we might convert a resource string into. */
1563 number
, boolean
, string
, symbol
1566 /* Return the value of parameter PARAM.
1568 First search ALIST, then Vdefault_frame_alist, then the X defaults
1569 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1571 Convert the resource to the type specified by desired_type.
1573 If no default is specified, return Qunbound. If you call
1574 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1575 and don't let it get stored in any lisp-visible variables! */
1578 x_get_arg (alist
, param
, attribute
, class, type
)
1579 Lisp_Object alist
, param
;
1582 enum resource_types type
;
1584 register Lisp_Object tem
;
1586 tem
= Fassq (param
, alist
);
1588 tem
= Fassq (param
, Vdefault_frame_alist
);
1594 tem
= Fx_get_resource (build_string (attribute
),
1595 build_string (class),
1604 return make_number (atoi (XSTRING (tem
)->data
));
1607 tem
= Fdowncase (tem
);
1608 if (!strcmp (XSTRING (tem
)->data
, "on")
1609 || !strcmp (XSTRING (tem
)->data
, "true"))
1618 /* As a special case, we map the values `true' and `on'
1619 to Qt, and `false' and `off' to Qnil. */
1622 lower
= Fdowncase (tem
);
1623 if (!strcmp (XSTRING (lower
)->data
, "on")
1624 || !strcmp (XSTRING (lower
)->data
, "true"))
1626 else if (!strcmp (XSTRING (lower
)->data
, "off")
1627 || !strcmp (XSTRING (lower
)->data
, "false"))
1630 return Fintern (tem
, Qnil
);
1643 /* Record in frame F the specified or default value according to ALIST
1644 of the parameter named PARAM (a Lisp symbol).
1645 If no value is specified for PARAM, look for an X default for XPROP
1646 on the frame named NAME.
1647 If that is not found either, use the value DEFLT. */
1650 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
1657 enum resource_types type
;
1661 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
1662 if (EQ (tem
, Qunbound
))
1664 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
1668 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
1669 "Parse an X-style geometry string STRING.\n\
1670 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
1671 The properties returned may include `top', `left', `height', and `width'.\n\
1672 The value of `left' or `top' may be an integer or `-'.\n\
1673 `-' means \"minus zero\".")
1678 unsigned int width
, height
;
1681 CHECK_STRING (string
, 0);
1683 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
1684 &x
, &y
, &width
, &height
);
1687 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
1688 error ("Must specify both x and y position, or neither");
1692 if (geometry
& XValue
)
1694 Lisp_Object element
;
1696 if (x
== 0 && (geometry
& XNegative
))
1697 element
= Fcons (Qleft
, Qminus
);
1699 element
= Fcons (Qleft
, make_number (x
));
1700 result
= Fcons (element
, result
);
1703 if (geometry
& YValue
)
1705 Lisp_Object element
;
1707 if (y
== 0 && (geometry
& YNegative
))
1708 element
= Fcons (Qtop
, Qminus
);
1710 element
= Fcons (Qtop
, make_number (y
));
1711 result
= Fcons (element
, result
);
1714 if (geometry
& WidthValue
)
1715 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
1716 if (geometry
& HeightValue
)
1717 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
1723 /* Calculate the desired size and position of this window,
1724 and return the flags saying which aspects were specified.
1726 This function does not make the coordinates positive. */
1728 #define DEFAULT_ROWS 40
1729 #define DEFAULT_COLS 80
1732 x_figure_window_size (f
, parms
)
1736 register Lisp_Object tem0
, tem1
, tem2
;
1737 int height
, width
, left
, top
;
1738 register int geometry
;
1739 long window_prompting
= 0;
1741 /* Default values if we fall through.
1742 Actually, if that happens we should get
1743 window manager prompting. */
1744 f
->width
= DEFAULT_COLS
;
1745 f
->height
= DEFAULT_ROWS
;
1746 /* Window managers expect that if program-specified
1747 positions are not (0,0), they're intentional, not defaults. */
1748 f
->display
.x
->top_pos
= 0;
1749 f
->display
.x
->left_pos
= 0;
1751 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
1752 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
1753 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
1754 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1756 if (!EQ (tem0
, Qunbound
))
1758 CHECK_NUMBER (tem0
, 0);
1759 f
->height
= XINT (tem0
);
1761 if (!EQ (tem1
, Qunbound
))
1763 CHECK_NUMBER (tem1
, 0);
1764 f
->width
= XINT (tem1
);
1766 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
1767 window_prompting
|= USSize
;
1769 window_prompting
|= PSize
;
1772 f
->display
.x
->vertical_scroll_bar_extra
1773 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1774 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f
)
1776 f
->display
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
1777 f
->display
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
1779 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1780 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1781 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
1782 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1784 if (EQ (tem0
, Qminus
))
1786 f
->display
.x
->top_pos
= 0;
1787 window_prompting
|= YNegative
;
1789 else if (EQ (tem0
, Qunbound
))
1790 f
->display
.x
->top_pos
= 0;
1793 CHECK_NUMBER (tem0
, 0);
1794 f
->display
.x
->top_pos
= XINT (tem0
);
1795 if (f
->display
.x
->top_pos
< 0)
1796 window_prompting
|= YNegative
;
1799 if (EQ (tem1
, Qminus
))
1801 f
->display
.x
->left_pos
= 0;
1802 window_prompting
|= XNegative
;
1804 else if (EQ (tem1
, Qunbound
))
1805 f
->display
.x
->left_pos
= 0;
1808 CHECK_NUMBER (tem1
, 0);
1809 f
->display
.x
->left_pos
= XINT (tem1
);
1810 if (f
->display
.x
->left_pos
< 0)
1811 window_prompting
|= XNegative
;
1815 window_prompting
|= USPosition
;
1817 window_prompting
|= PPosition
;
1820 return window_prompting
;
1823 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
1826 XSetWMProtocols (dpy
, w
, protocols
, count
)
1833 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
1834 if (prop
== None
) return False
;
1835 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
1836 (unsigned char *) protocols
, count
);
1839 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
1841 #ifdef USE_X_TOOLKIT
1843 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS
1844 and WM_DELETE_WINDOW, then add them. (They may already be present
1845 because of the toolkit (Motif adds them, for example, but Xt doesn't). */
1848 hack_wm_protocols (widget
)
1851 Display
*dpy
= XtDisplay (widget
);
1852 Window w
= XtWindow (widget
);
1853 int need_delete
= 1;
1858 Atom type
, *atoms
= 0;
1860 unsigned long nitems
= 0;
1861 unsigned long bytes_after
;
1863 if (Success
== XGetWindowProperty (dpy
, w
, Xatom_wm_protocols
,
1864 0, 100, False
, XA_ATOM
,
1865 &type
, &format
, &nitems
, &bytes_after
,
1866 (unsigned char **) &atoms
)
1867 && format
== 32 && type
== XA_ATOM
)
1871 if (atoms
[nitems
] == Xatom_wm_delete_window
) need_delete
= 0;
1872 else if (atoms
[nitems
] == Xatom_wm_take_focus
) need_focus
= 0;
1874 if (atoms
) XFree ((char *) atoms
);
1879 if (need_delete
) props
[count
++] = Xatom_wm_delete_window
;
1880 if (need_focus
) props
[count
++] = Xatom_wm_take_focus
;
1882 XChangeProperty (dpy
, w
, Xatom_wm_protocols
, XA_ATOM
, 32, PropModeAppend
,
1883 (unsigned char *) props
, count
);
1889 #ifdef USE_X_TOOLKIT
1891 /* Create and set up the X widget for frame F. */
1894 x_window (f
, window_prompting
, minibuffer_only
)
1896 long window_prompting
;
1897 int minibuffer_only
;
1899 XClassHint class_hints
;
1900 XSetWindowAttributes attributes
;
1901 unsigned long attribute_mask
;
1903 Widget shell_widget
;
1905 Widget screen_widget
;
1912 if (STRINGP (f
->name
))
1913 name
= (char*) XSTRING (f
->name
)->data
;
1918 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
1919 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
1920 shell_widget
= XtCreatePopupShell ("shell",
1921 topLevelShellWidgetClass
,
1922 Xt_app_shell
, al
, ac
);
1924 f
->display
.x
->widget
= shell_widget
;
1925 /* maybe_set_screen_title_format (shell_widget); */
1929 XtSetArg (al
[ac
], XtNborderWidth
, 0); ac
++;
1930 pane_widget
= XtCreateWidget ("pane",
1932 shell_widget
, al
, ac
);
1934 f
->display
.x
->column_widget
= pane_widget
;
1936 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
1937 initialize_frame_menubar (f
);
1939 /* mappedWhenManaged to false tells to the paned window to not map/unmap
1940 the emacs screen when changing menubar. This reduces flickering. */
1943 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
1944 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
1945 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
1946 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
1947 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
1948 screen_widget
= XtCreateWidget (name
,
1950 pane_widget
, al
, ac
);
1952 f
->display
.x
->edit_widget
= screen_widget
;
1954 if (f
->display
.x
->menubar_widget
)
1955 XtManageChild (f
->display
.x
->menubar_widget
);
1956 XtManageChild (screen_widget
);
1958 /* Do some needed geometry management. */
1961 char *tem
, shell_position
[32];
1965 = (f
->display
.x
->menubar_widget
1966 ? (f
->display
.x
->menubar_widget
->core
.height
1967 + f
->display
.x
->menubar_widget
->core
.border_width
)
1970 if (FRAME_EXTERNAL_MENU_BAR (f
))
1973 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
1974 menubar_size
+= ibw
;
1977 if (window_prompting
& USPosition
)
1979 int left
= f
->display
.x
->left_pos
;
1980 int xneg
= window_prompting
& XNegative
;
1981 int top
= f
->display
.x
->top_pos
;
1982 int yneg
= window_prompting
& YNegative
;
1987 sprintf (shell_position
, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f
),
1988 PIXEL_HEIGHT (f
) + menubar_size
,
1989 (xneg
? '-' : '+'), left
,
1990 (yneg
? '-' : '+'), top
);
1993 sprintf (shell_position
, "=%dx%d", PIXEL_WIDTH (f
),
1994 PIXEL_HEIGHT (f
) + menubar_size
);
1995 len
= strlen (shell_position
) + 1;
1996 tem
= (char *) xmalloc (len
);
1997 strncpy (tem
, shell_position
, len
);
1998 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
1999 XtSetValues (shell_widget
, al
, ac
);
2002 x_calc_absolute_position (f
);
2004 XtManageChild (pane_widget
);
2005 XtRealizeWidget (shell_widget
);
2007 FRAME_X_WINDOW (f
) = XtWindow (screen_widget
);
2009 validate_x_resource_name ();
2010 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2011 class_hints
.res_class
= EMACS_CLASS
;
2012 XSetClassHint (x_current_display
, XtWindow (shell_widget
), &class_hints
);
2014 f
->display
.x
->wm_hints
.input
= True
;
2015 f
->display
.x
->wm_hints
.flags
|= InputHint
;
2016 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
2018 hack_wm_protocols (shell_widget
);
2020 /* Do a stupid property change to force the server to generate a
2021 propertyNotify event so that the event_stream server timestamp will
2022 be initialized to something relevant to the time we created the window.
2024 XChangeProperty (XtDisplay (screen_widget
), XtWindow (screen_widget
),
2025 Xatom_wm_protocols
, XA_ATOM
, 32, PropModeAppend
,
2026 (unsigned char*) NULL
, 0);
2028 /* Make all the standard events reach the Emacs frame. */
2029 attributes
.event_mask
= STANDARD_EVENT_SET
;
2030 attribute_mask
= CWEventMask
;
2031 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
2032 attribute_mask
, &attributes
);
2034 XtMapWidget (screen_widget
);
2036 /* x_set_name normally ignores requests to set the name if the
2037 requested name is the same as the current name. This is the one
2038 place where that assumption isn't correct; f->name is set, but
2039 the X server hasn't been told. */
2042 int explicit = f
->explicit_name
;
2044 f
->explicit_name
= 0;
2047 x_set_name (f
, name
, explicit);
2050 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
2051 f
->display
.x
->text_cursor
);
2055 if (FRAME_X_WINDOW (f
) == 0)
2056 error ("Unable to create window");
2059 #else /* not USE_X_TOOLKIT */
2061 /* Create and set up the X window for frame F. */
2067 XClassHint class_hints
;
2068 XSetWindowAttributes attributes
;
2069 unsigned long attribute_mask
;
2071 attributes
.background_pixel
= f
->display
.x
->background_pixel
;
2072 attributes
.border_pixel
= f
->display
.x
->border_pixel
;
2073 attributes
.bit_gravity
= StaticGravity
;
2074 attributes
.backing_store
= NotUseful
;
2075 attributes
.save_under
= True
;
2076 attributes
.event_mask
= STANDARD_EVENT_SET
;
2077 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
2079 | CWBackingStore
| CWSaveUnder
2085 = XCreateWindow (x_current_display
, ROOT_WINDOW
,
2086 f
->display
.x
->left_pos
,
2087 f
->display
.x
->top_pos
,
2088 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
2089 f
->display
.x
->border_width
,
2090 CopyFromParent
, /* depth */
2091 InputOutput
, /* class */
2092 screen_visual
, /* set in Fx_open_connection */
2093 attribute_mask
, &attributes
);
2095 validate_x_resource_name ();
2096 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2097 class_hints
.res_class
= EMACS_CLASS
;
2098 XSetClassHint (x_current_display
, FRAME_X_WINDOW (f
), &class_hints
);
2100 /* This indicates that we use the "Passive Input" input model.
2101 Unless we do this, we don't get the Focus{In,Out} events that we
2102 need to draw the cursor correctly. Accursed bureaucrats.
2103 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
2105 f
->display
.x
->wm_hints
.input
= True
;
2106 f
->display
.x
->wm_hints
.flags
|= InputHint
;
2107 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
2109 /* Request "save yourself" and "delete window" commands from wm. */
2112 protocols
[0] = Xatom_wm_delete_window
;
2113 protocols
[1] = Xatom_wm_save_yourself
;
2114 XSetWMProtocols (x_current_display
, FRAME_X_WINDOW (f
), protocols
, 2);
2117 /* x_set_name normally ignores requests to set the name if the
2118 requested name is the same as the current name. This is the one
2119 place where that assumption isn't correct; f->name is set, but
2120 the X server hasn't been told. */
2123 int explicit = f
->explicit_name
;
2125 f
->explicit_name
= 0;
2128 x_set_name (f
, name
, explicit);
2131 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
2132 f
->display
.x
->text_cursor
);
2136 if (FRAME_X_WINDOW (f
) == 0)
2137 error ("Unable to create window");
2140 #endif /* not USE_X_TOOLKIT */
2142 /* Handle the icon stuff for this window. Perhaps later we might
2143 want an x_set_icon_position which can be called interactively as
2151 Lisp_Object icon_x
, icon_y
;
2153 /* Set the position of the icon. Note that twm groups all
2154 icons in an icon window. */
2155 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
2156 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
2157 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
2159 CHECK_NUMBER (icon_x
, 0);
2160 CHECK_NUMBER (icon_y
, 0);
2162 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
2163 error ("Both left and top icon corners of icon must be specified");
2167 if (! EQ (icon_x
, Qunbound
))
2168 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
2170 /* Start up iconic or window? */
2171 x_wm_set_window_state
2172 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
2179 /* Make the GC's needed for this window, setting the
2180 background, border and mouse colors; also create the
2181 mouse cursor and the gray border tile. */
2183 static char cursor_bits
[] =
2185 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2186 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2187 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2188 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2195 XGCValues gc_values
;
2201 /* Create the GC's of this frame.
2202 Note that many default values are used. */
2205 gc_values
.font
= f
->display
.x
->font
->fid
;
2206 gc_values
.foreground
= f
->display
.x
->foreground_pixel
;
2207 gc_values
.background
= f
->display
.x
->background_pixel
;
2208 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
2209 f
->display
.x
->normal_gc
= XCreateGC (x_current_display
,
2211 GCLineWidth
| GCFont
2212 | GCForeground
| GCBackground
,
2215 /* Reverse video style. */
2216 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2217 gc_values
.background
= f
->display
.x
->foreground_pixel
;
2218 f
->display
.x
->reverse_gc
= XCreateGC (x_current_display
,
2220 GCFont
| GCForeground
| GCBackground
2224 /* Cursor has cursor-color background, background-color foreground. */
2225 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2226 gc_values
.background
= f
->display
.x
->cursor_pixel
;
2227 gc_values
.fill_style
= FillOpaqueStippled
;
2229 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
2230 cursor_bits
, 16, 16);
2231 f
->display
.x
->cursor_gc
2232 = XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
2233 (GCFont
| GCForeground
| GCBackground
2234 | GCFillStyle
| GCStipple
| GCLineWidth
),
2237 /* Create the gray border tile used when the pointer is not in
2238 the frame. Since this depends on the frame's pixel values,
2239 this must be done on a per-frame basis. */
2240 f
->display
.x
->border_tile
2241 = (XCreatePixmapFromBitmapData
2242 (x_current_display
, ROOT_WINDOW
,
2243 gray_bits
, gray_width
, gray_height
,
2244 f
->display
.x
->foreground_pixel
,
2245 f
->display
.x
->background_pixel
,
2246 DefaultDepth (x_current_display
, XDefaultScreen (x_current_display
))));
2250 #endif /* HAVE_X11 */
2252 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
2254 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2255 Return an Emacs frame object representing the X window.\n\
2256 ALIST is an alist of frame parameters.\n\
2257 If the parameters specify that the frame should not have a minibuffer,\n\
2258 and do not specify a specific minibuffer window to use,\n\
2259 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2260 be shared by the new frame.")
2266 Lisp_Object frame
, tem
;
2268 int minibuffer_only
= 0;
2269 long window_prompting
= 0;
2271 int count
= specpdl_ptr
- specpdl
;
2272 struct gcpro gcpro1
;
2276 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
2277 if (XTYPE (name
) != Lisp_String
2278 && ! EQ (name
, Qunbound
)
2280 error ("x-create-frame: name parameter must be a string");
2282 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2283 if (EQ (tem
, Qnone
) || NILP (tem
))
2284 f
= make_frame_without_minibuffer (Qnil
);
2285 else if (EQ (tem
, Qonly
))
2287 f
= make_minibuffer_frame ();
2288 minibuffer_only
= 1;
2290 else if (XTYPE (tem
) == Lisp_Window
)
2291 f
= make_frame_without_minibuffer (tem
);
2295 /* Note that X Windows does support scroll bars. */
2296 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
2298 /* Set the name; the functions to which we pass f expect the name to
2300 if (EQ (name
, Qunbound
) || NILP (name
))
2302 f
->name
= build_string (x_id_name
);
2303 f
->explicit_name
= 0;
2308 f
->explicit_name
= 1;
2309 /* use the frame's title when getting resources for this frame. */
2310 specbind (Qx_resource_name
, name
);
2313 XSET (frame
, Lisp_Frame
, f
);
2316 f
->output_method
= output_x_window
;
2317 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2318 bzero (f
->display
.x
, sizeof (struct x_display
));
2320 /* Note that the frame has no physical cursor right now. */
2321 f
->phys_cursor_x
= -1;
2323 /* Extract the window parameters from the supplied values
2324 that are needed to determine window geometry. */
2328 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
2330 /* First, try whatever font the caller has specified. */
2332 font
= x_new_font (f
, XSTRING (font
)->data
);
2333 /* Try out a font which we hope has bold and italic variations. */
2334 if (!STRINGP (font
))
2335 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
2336 if (! STRINGP (font
))
2337 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
2338 if (! STRINGP (font
))
2339 /* This was formerly the first thing tried, but it finds too many fonts
2340 and takes too long. */
2341 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
2342 /* If those didn't work, look for something which will at least work. */
2343 if (! STRINGP (font
))
2344 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
2346 if (! STRINGP (font
))
2347 font
= build_string ("fixed");
2349 x_default_parameter (f
, parms
, Qfont
, font
,
2350 "font", "Font", string
);
2353 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
2354 "borderwidth", "BorderWidth", number
);
2355 /* This defaults to 2 in order to match xterm. We recognize either
2356 internalBorderWidth or internalBorder (which is what xterm calls
2358 if (NILP (Fassq (Qinternal_border_width
, parms
)))
2362 value
= x_get_arg (parms
, Qinternal_border_width
,
2363 "internalBorder", "BorderWidth", number
);
2364 if (! EQ (value
, Qunbound
))
2365 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
2368 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
2369 "internalBorderWidth", "BorderWidth", number
);
2370 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
2371 "verticalScrollBars", "ScrollBars", boolean
);
2373 /* Also do the stuff which must be set before the window exists. */
2374 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
2375 "foreground", "Foreground", string
);
2376 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
2377 "background", "Background", string
);
2378 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
2379 "pointerColor", "Foreground", string
);
2380 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
2381 "cursorColor", "Foreground", string
);
2382 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
2383 "borderColor", "BorderColor", string
);
2385 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
2386 "menuBarLines", "MenuBarLines", number
);
2388 f
->display
.x
->parent_desc
= ROOT_WINDOW
;
2389 window_prompting
= x_figure_window_size (f
, parms
);
2391 if (window_prompting
& XNegative
)
2393 if (window_prompting
& YNegative
)
2394 f
->display
.x
->win_gravity
= SouthEastGravity
;
2396 f
->display
.x
->win_gravity
= NorthEastGravity
;
2400 if (window_prompting
& YNegative
)
2401 f
->display
.x
->win_gravity
= SouthWestGravity
;
2403 f
->display
.x
->win_gravity
= NorthWestGravity
;
2406 f
->display
.x
->size_hint_flags
= window_prompting
;
2408 #ifdef USE_X_TOOLKIT
2409 x_window (f
, window_prompting
, minibuffer_only
);
2415 init_frame_faces (f
);
2417 /* We need to do this after creating the X window, so that the
2418 icon-creation functions can say whose icon they're describing. */
2419 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2420 "bitmapIcon", "BitmapIcon", symbol
);
2422 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
2423 "autoRaise", "AutoRaiseLower", boolean
);
2424 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
2425 "autoLower", "AutoRaiseLower", boolean
);
2426 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
2427 "cursorType", "CursorType", symbol
);
2429 /* Dimensions, especially f->height, must be done via change_frame_size.
2430 Change will not be effected unless different from the current
2434 f
->height
= f
->width
= 0;
2435 change_frame_size (f
, height
, width
, 1, 0);
2437 /* With the toolkit, the geometry management is done in x_window. */
2438 #ifndef USE_X_TOOLKIT
2440 x_wm_set_size_hint (f
, window_prompting
, 0);
2442 #endif /* USE_X_TOOLKIT */
2444 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2445 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2449 /* It is now ok to make the frame official
2450 even if we get an error below.
2451 And the frame needs to be on Vframe_list
2452 or making it visible won't work. */
2453 Vframe_list
= Fcons (frame
, Vframe_list
);
2455 /* Make the window appear on the frame and enable display,
2456 unless the caller says not to. */
2458 Lisp_Object visibility
;
2460 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2461 if (EQ (visibility
, Qunbound
))
2464 if (EQ (visibility
, Qicon
))
2465 x_iconify_frame (f
);
2466 else if (! NILP (visibility
))
2467 x_make_frame_visible (f
);
2469 /* Must have been Qnil. */
2473 return unbind_to (count
, frame
);
2476 Lisp_Object frame
, tem
;
2478 int pixelwidth
, pixelheight
;
2483 int minibuffer_only
= 0;
2484 Lisp_Object vscroll
, hscroll
;
2486 if (x_current_display
== 0)
2487 error ("X windows are not in use or not initialized");
2489 name
= Fassq (Qname
, parms
);
2491 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2492 if (EQ (tem
, Qnone
))
2493 f
= make_frame_without_minibuffer (Qnil
);
2494 else if (EQ (tem
, Qonly
))
2496 f
= make_minibuffer_frame ();
2497 minibuffer_only
= 1;
2499 else if (EQ (tem
, Qnil
) || EQ (tem
, Qunbound
))
2502 f
= make_frame_without_minibuffer (tem
);
2504 parent
= ROOT_WINDOW
;
2506 XSET (frame
, Lisp_Frame
, f
);
2507 f
->output_method
= output_x_window
;
2508 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2509 bzero (f
->display
.x
, sizeof (struct x_display
));
2511 /* Some temporary default values for height and width. */
2514 f
->display
.x
->left_pos
= -1;
2515 f
->display
.x
->top_pos
= -1;
2517 /* Give the frame a default name (which may be overridden with PARMS). */
2519 strncpy (iconidentity
, ICONTAG
, MAXICID
);
2520 if (gethostname (&iconidentity
[sizeof (ICONTAG
) - 1],
2521 (MAXICID
- 1) - sizeof (ICONTAG
)))
2522 iconidentity
[sizeof (ICONTAG
) - 2] = '\0';
2523 f
->name
= build_string (iconidentity
);
2525 /* Extract some window parameters from the supplied values.
2526 These are the parameters that affect window geometry. */
2528 tem
= x_get_arg (parms
, Qfont
, "BodyFont", 0, string
);
2529 if (EQ (tem
, Qunbound
))
2530 tem
= build_string ("9x15");
2531 x_set_font (f
, tem
, Qnil
);
2532 x_default_parameter (f
, parms
, Qborder_color
,
2533 build_string ("black"), "Border", 0, string
);
2534 x_default_parameter (f
, parms
, Qbackground_color
,
2535 build_string ("white"), "Background", 0, string
);
2536 x_default_parameter (f
, parms
, Qforeground_color
,
2537 build_string ("black"), "Foreground", 0, string
);
2538 x_default_parameter (f
, parms
, Qmouse_color
,
2539 build_string ("black"), "Mouse", 0, string
);
2540 x_default_parameter (f
, parms
, Qcursor_color
,
2541 build_string ("black"), "Cursor", 0, string
);
2542 x_default_parameter (f
, parms
, Qborder_width
,
2543 make_number (2), "BorderWidth", 0, number
);
2544 x_default_parameter (f
, parms
, Qinternal_border_width
,
2545 make_number (4), "InternalBorderWidth", 0, number
);
2546 x_default_parameter (f
, parms
, Qauto_raise
,
2547 Qnil
, "AutoRaise", 0, boolean
);
2549 hscroll
= EQ (x_get_arg (parms
, Qhorizontal_scroll_bar
, 0, 0, boolean
), Qt
);
2550 vscroll
= EQ (x_get_arg (parms
, Qvertical_scroll_bar
, 0, 0, boolean
), Qt
);
2552 if (f
->display
.x
->internal_border_width
< 0)
2553 f
->display
.x
->internal_border_width
= 0;
2555 tem
= x_get_arg (parms
, Qwindow_id
, 0, 0, number
);
2556 if (!EQ (tem
, Qunbound
))
2558 WINDOWINFO_TYPE wininfo
;
2560 Window
*children
, root
;
2562 CHECK_NUMBER (tem
, 0);
2563 FRAME_X_WINDOW (f
) = (Window
) XINT (tem
);
2566 XGetWindowInfo (FRAME_X_WINDOW (f
), &wininfo
);
2567 XQueryTree (FRAME_X_WINDOW (f
), &parent
, &nchildren
, &children
);
2571 height
= PIXEL_TO_CHAR_HEIGHT (f
, wininfo
.height
);
2572 width
= PIXEL_TO_CHAR_WIDTH (f
, wininfo
.width
);
2573 f
->display
.x
->left_pos
= wininfo
.x
;
2574 f
->display
.x
->top_pos
= wininfo
.y
;
2575 FRAME_SET_VISIBILITY (f
, wininfo
.mapped
!= 0);
2576 f
->display
.x
->border_width
= wininfo
.bdrwidth
;
2577 f
->display
.x
->parent_desc
= parent
;
2581 tem
= x_get_arg (parms
, Qparent_id
, 0, 0, number
);
2582 if (!EQ (tem
, Qunbound
))
2584 CHECK_NUMBER (tem
, 0);
2585 parent
= (Window
) XINT (tem
);
2587 f
->display
.x
->parent_desc
= parent
;
2588 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2589 if (EQ (tem
, Qunbound
))
2591 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2592 if (EQ (tem
, Qunbound
))
2594 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2595 if (EQ (tem
, Qunbound
))
2596 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2599 /* Now TEM is Qunbound if no edge or size was specified.
2600 In that case, we must do rubber-banding. */
2601 if (EQ (tem
, Qunbound
))
2603 tem
= x_get_arg (parms
, Qgeometry
, 0, 0, number
);
2605 &f
->display
.x
->left_pos
, &f
->display
.x
->top_pos
,
2607 (XTYPE (tem
) == Lisp_String
2608 ? (char *) XSTRING (tem
)->data
: ""),
2609 XSTRING (f
->name
)->data
,
2610 !NILP (hscroll
), !NILP (vscroll
));
2614 /* Here if at least one edge or size was specified.
2615 Demand that they all were specified, and use them. */
2616 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2617 if (EQ (tem
, Qunbound
))
2618 error ("Height not specified");
2619 CHECK_NUMBER (tem
, 0);
2620 height
= XINT (tem
);
2622 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2623 if (EQ (tem
, Qunbound
))
2624 error ("Width not specified");
2625 CHECK_NUMBER (tem
, 0);
2628 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2629 if (EQ (tem
, Qunbound
))
2630 error ("Top position not specified");
2631 CHECK_NUMBER (tem
, 0);
2632 f
->display
.x
->left_pos
= XINT (tem
);
2634 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2635 if (EQ (tem
, Qunbound
))
2636 error ("Left position not specified");
2637 CHECK_NUMBER (tem
, 0);
2638 f
->display
.x
->top_pos
= XINT (tem
);
2641 pixelwidth
= CHAR_TO_PIXEL_WIDTH (f
, width
);
2642 pixelheight
= CHAR_TO_PIXEL_HEIGHT (f
, height
);
2646 = XCreateWindow (parent
,
2647 f
->display
.x
->left_pos
, /* Absolute horizontal offset */
2648 f
->display
.x
->top_pos
, /* Absolute Vertical offset */
2649 pixelwidth
, pixelheight
,
2650 f
->display
.x
->border_width
,
2651 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
2653 if (FRAME_X_WINDOW (f
) == 0)
2654 error ("Unable to create window.");
2657 /* Install the now determined height and width
2658 in the windows and in phys_lines and desired_lines. */
2659 change_frame_size (f
, height
, width
, 1, 0);
2660 XSelectInput (FRAME_X_WINDOW (f
), KeyPressed
| ExposeWindow
2661 | ButtonPressed
| ButtonReleased
| ExposeRegion
| ExposeCopy
2662 | EnterWindow
| LeaveWindow
| UnmapWindow
);
2663 x_set_resize_hint (f
);
2665 /* Tell the server the window's default name. */
2666 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
), XSTRING (f
->name
)->data
);
2668 /* Now override the defaults with all the rest of the specified
2670 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2671 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2673 /* Do not create an icon window if the caller says not to */
2674 if (!EQ (x_get_arg (parms
, Qsuppress_icon
, 0, 0, boolean
), Qt
)
2675 || f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2677 x_text_icon (f
, iconidentity
);
2678 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2679 "BitmapIcon", 0, symbol
);
2682 /* Tell the X server the previously set values of the
2683 background, border and mouse colors; also create the mouse cursor. */
2685 temp
= XMakeTile (f
->display
.x
->background_pixel
);
2686 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
2689 x_set_border_pixel (f
, f
->display
.x
->border_pixel
);
2691 x_set_mouse_color (f
, Qnil
, Qnil
);
2693 /* Now override the defaults with all the rest of the specified parms. */
2695 Fmodify_frame_parameters (frame
, parms
);
2697 /* Make the window appear on the frame and enable display. */
2699 Lisp_Object visibility
;
2701 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2702 if (EQ (visibility
, Qunbound
))
2705 if (! EQ (visibility
, Qicon
)
2706 && ! NILP (visibility
))
2707 x_make_window_visible (f
);
2710 SET_FRAME_GARBAGED (f
);
2712 Vframe_list
= Fcons (frame
, Vframe_list
);
2718 x_get_focus_frame ()
2721 if (! x_focus_frame
)
2724 XSET (xfocus
, Lisp_Frame
, x_focus_frame
);
2728 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
2729 "Set the focus on FRAME.")
2733 CHECK_LIVE_FRAME (frame
, 0);
2735 if (FRAME_X_P (XFRAME (frame
)))
2738 x_focus_on_frame (XFRAME (frame
));
2746 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
2747 "If a frame has been focused, release it.")
2753 x_unfocus_frame (x_focus_frame
);
2761 /* Computes an X-window size and position either from geometry GEO
2764 F is a frame. It specifies an X window which is used to
2765 determine which display to compute for. Its font, borders
2766 and colors control how the rectangle will be displayed.
2768 X and Y are where to store the positions chosen.
2769 WIDTH and HEIGHT are where to store the sizes chosen.
2771 GEO is the geometry that may specify some of the info.
2772 STR is a prompt to display.
2773 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2776 x_rubber_band (f
, x
, y
, width
, height
, geo
, str
, hscroll
, vscroll
)
2778 int *x
, *y
, *width
, *height
;
2781 int hscroll
, vscroll
;
2787 int background_color
;
2793 background_color
= f
->display
.x
->background_pixel
;
2794 border_color
= f
->display
.x
->border_pixel
;
2796 frame
.bdrwidth
= f
->display
.x
->border_width
;
2797 frame
.border
= XMakeTile (border_color
);
2798 frame
.background
= XMakeTile (background_color
);
2799 tempwindow
= XCreateTerm (str
, "emacs", geo
, default_window
, &frame
, 10, 5,
2800 (2 * f
->display
.x
->internal_border_width
2801 + (vscroll
? VSCROLL_WIDTH
: 0)),
2802 (2 * f
->display
.x
->internal_border_width
2803 + (hscroll
? HSCROLL_HEIGHT
: 0)),
2804 width
, height
, f
->display
.x
->font
,
2805 FONT_WIDTH (f
->display
.x
->font
),
2806 f
->display
.x
->line_height
);
2807 XFreePixmap (frame
.border
);
2808 XFreePixmap (frame
.background
);
2810 if (tempwindow
!= 0)
2812 XQueryWindow (tempwindow
, &wininfo
);
2813 XDestroyWindow (tempwindow
);
2818 /* Coordinates we got are relative to the root window.
2819 Convert them to coordinates relative to desired parent window
2820 by scanning from there up to the root. */
2821 tempwindow
= f
->display
.x
->parent_desc
;
2822 while (tempwindow
!= ROOT_WINDOW
)
2826 XQueryWindow (tempwindow
, &wininfo
);
2829 XQueryTree (tempwindow
, &tempwindow
, &nchildren
, &children
);
2834 return tempwindow
!= 0;
2836 #endif /* not HAVE_X11 */
2838 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
2839 "Return a list of the names of available fonts matching PATTERN.\n\
2840 If optional arguments FACE and FRAME are specified, return only fonts\n\
2841 the same size as FACE on FRAME.\n\
2843 PATTERN is a string, perhaps with wildcard characters;\n\
2844 the * character matches any substring, and\n\
2845 the ? character matches any single character.\n\
2846 PATTERN is case-insensitive.\n\
2847 FACE is a face name - a symbol.\n\
2849 The return value is a list of strings, suitable as arguments to\n\
2852 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
2853 even if they match PATTERN and FACE.")
2854 (pattern
, face
, frame
)
2855 Lisp_Object pattern
, face
, frame
;
2860 XFontStruct
*size_ref
;
2864 CHECK_STRING (pattern
, 0);
2866 CHECK_SYMBOL (face
, 1);
2868 CHECK_LIVE_FRAME (frame
, 2);
2874 FRAME_PTR f
= NILP (frame
) ? selected_frame
: XFRAME (frame
);
2877 /* Don't die if we get called with a terminal frame. */
2878 if (! FRAME_X_P (f
))
2879 error ("non-X frame used in `x-list-fonts'");
2881 face_id
= face_name_id_number (f
, face
);
2883 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
2884 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
2885 size_ref
= f
->display
.x
->font
;
2888 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
2889 if (size_ref
== (XFontStruct
*) (~0))
2890 size_ref
= f
->display
.x
->font
;
2896 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
2897 #ifdef BROKEN_XLISTFONTSWITHINFO
2898 names
= XListFonts (x_current_display
,
2899 XSTRING (pattern
)->data
,
2900 2000, /* maxnames */
2901 &num_fonts
); /* count_return */
2903 names
= XListFontsWithInfo (x_current_display
,
2904 XSTRING (pattern
)->data
,
2905 2000, /* maxnames */
2906 &num_fonts
, /* count_return */
2907 &info
); /* info_return */
2919 for (i
= 0; i
< num_fonts
; i
++)
2921 XFontStruct
*thisinfo
;
2923 #ifdef BROKEN_XLISTFONTSWITHINFO
2925 thisinfo
= XLoadQueryFont (x_current_display
, names
[i
]);
2928 thisinfo
= &info
[i
];
2930 if (thisinfo
&& (! size_ref
2931 || same_size_fonts (thisinfo
, size_ref
)))
2933 *tail
= Fcons (build_string (names
[i
]), Qnil
);
2934 tail
= &XCONS (*tail
)->cdr
;
2939 #ifdef BROKEN_XLISTFONTSWITHINFO
2940 XFreeFontNames (names
);
2942 XFreeFontInfo (names
, info
, num_fonts
);
2951 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 1, 0,
2952 "Return non-nil if the X display supports the color named COLOR.")
2959 CHECK_STRING (color
, 0);
2961 if (defined_color (XSTRING (color
)->data
, &foo
, 0))
2967 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 1, 0,
2968 "Return a description of the color named COLOR.\n\
2969 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
2970 These values appear to range from 0 to 65280; white is (65280 65280 65280).")
2977 CHECK_STRING (color
, 0);
2979 if (defined_color (XSTRING (color
)->data
, &foo
, 0))
2983 rgb
[0] = make_number (foo
.red
);
2984 rgb
[1] = make_number (foo
.green
);
2985 rgb
[2] = make_number (foo
.blue
);
2986 return Flist (3, rgb
);
2992 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 0, 0,
2993 "Return t if the X screen currently in use supports color.")
2998 if (x_screen_planes
<= 2)
3001 switch (screen_visual
->class)
3014 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
3016 "Returns the width in pixels of the display FRAME is on.")
3020 Display
*dpy
= x_current_display
;
3022 return make_number (DisplayWidth (dpy
, DefaultScreen (dpy
)));
3025 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
3026 Sx_display_pixel_height
, 0, 1, 0,
3027 "Returns the height in pixels of the display FRAME is on.")
3031 Display
*dpy
= x_current_display
;
3033 return make_number (DisplayHeight (dpy
, DefaultScreen (dpy
)));
3036 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
3038 "Returns the number of bitplanes of the display FRAME is on.")
3042 Display
*dpy
= x_current_display
;
3044 return make_number (DisplayPlanes (dpy
, DefaultScreen (dpy
)));
3047 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
3049 "Returns the number of color cells of the display FRAME is on.")
3053 Display
*dpy
= x_current_display
;
3055 return make_number (DisplayCells (dpy
, DefaultScreen (dpy
)));
3058 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
3059 Sx_server_max_request_size
,
3061 "Returns the maximum request size of the X server FRAME is using.")
3065 Display
*dpy
= x_current_display
;
3067 return make_number (MAXREQUEST (dpy
));
3070 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
3071 "Returns the vendor ID string of the X server FRAME is on.")
3075 Display
*dpy
= x_current_display
;
3078 vendor
= ServerVendor (dpy
);
3079 if (! vendor
) vendor
= "";
3080 return build_string (vendor
);
3083 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
3084 "Returns the version numbers of the X server in use.\n\
3085 The value is a list of three integers: the major and minor\n\
3086 version numbers of the X Protocol in use, and the vendor-specific release\n\
3087 number. See also the variable `x-server-vendor'.")
3091 Display
*dpy
= x_current_display
;
3094 return Fcons (make_number (ProtocolVersion (dpy
)),
3095 Fcons (make_number (ProtocolRevision (dpy
)),
3096 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
3099 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
3100 "Returns the number of screens on the X server FRAME is on.")
3105 return make_number (ScreenCount (x_current_display
));
3108 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
3109 "Returns the height in millimeters of the X screen FRAME is on.")
3114 return make_number (HeightMMOfScreen (x_screen
));
3117 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
3118 "Returns the width in millimeters of the X screen FRAME is on.")
3123 return make_number (WidthMMOfScreen (x_screen
));
3126 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
3127 Sx_display_backing_store
, 0, 1, 0,
3128 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
3129 The value may be `always', `when-mapped', or `not-useful'.")
3135 switch (DoesBackingStore (x_screen
))
3138 return intern ("always");
3141 return intern ("when-mapped");
3144 return intern ("not-useful");
3147 error ("Strange value for BackingStore parameter of screen");
3151 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
3152 Sx_display_visual_class
, 0, 1, 0,
3153 "Returns the visual class of the display `screen' is on.\n\
3154 The value is one of the symbols `static-gray', `gray-scale',\n\
3155 `static-color', `pseudo-color', `true-color', or `direct-color'.")
3161 switch (screen_visual
->class)
3163 case StaticGray
: return (intern ("static-gray"));
3164 case GrayScale
: return (intern ("gray-scale"));
3165 case StaticColor
: return (intern ("static-color"));
3166 case PseudoColor
: return (intern ("pseudo-color"));
3167 case TrueColor
: return (intern ("true-color"));
3168 case DirectColor
: return (intern ("direct-color"));
3170 error ("Display has an unknown visual class");
3174 DEFUN ("x-display-save-under", Fx_display_save_under
,
3175 Sx_display_save_under
, 0, 1, 0,
3176 "Returns t if the X screen FRAME is on supports the save-under feature.")
3182 if (DoesSaveUnders (x_screen
) == True
)
3189 register struct frame
*f
;
3191 return PIXEL_WIDTH (f
);
3195 register struct frame
*f
;
3197 return PIXEL_HEIGHT (f
);
3201 register struct frame
*f
;
3203 return FONT_WIDTH (f
->display
.x
->font
);
3207 register struct frame
*f
;
3209 return f
->display
.x
->line_height
;
3212 #if 0 /* These no longer seem like the right way to do things. */
3214 /* Draw a rectangle on the frame with left top corner including
3215 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3216 CHARS by LINES wide and long and is the color of the cursor. */
3219 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
3220 register struct frame
*f
;
3222 register int top_char
, left_char
, chars
, lines
;
3226 int left
= (left_char
* FONT_WIDTH (f
->display
.x
->font
)
3227 + f
->display
.x
->internal_border_width
);
3228 int top
= (top_char
* f
->display
.x
->line_height
3229 + f
->display
.x
->internal_border_width
);
3232 width
= FONT_WIDTH (f
->display
.x
->font
) / 2;
3234 width
= FONT_WIDTH (f
->display
.x
->font
) * chars
;
3236 height
= f
->display
.x
->line_height
/ 2;
3238 height
= f
->display
.x
->line_height
* lines
;
3240 XDrawRectangle (x_current_display
, FRAME_X_WINDOW (f
),
3241 gc
, left
, top
, width
, height
);
3244 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
3245 "Draw a rectangle on FRAME between coordinates specified by\n\
3246 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3247 (frame
, X0
, Y0
, X1
, Y1
)
3248 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
3250 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3252 CHECK_LIVE_FRAME (frame
, 0);
3253 CHECK_NUMBER (X0
, 0);
3254 CHECK_NUMBER (Y0
, 1);
3255 CHECK_NUMBER (X1
, 2);
3256 CHECK_NUMBER (Y1
, 3);
3266 n_lines
= y1
- y0
+ 1;
3271 n_lines
= y0
- y1
+ 1;
3277 n_chars
= x1
- x0
+ 1;
3282 n_chars
= x0
- x1
+ 1;
3286 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->cursor_gc
,
3287 left
, top
, n_chars
, n_lines
);
3293 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
3294 "Draw a rectangle drawn on FRAME between coordinates\n\
3295 X0, Y0, X1, Y1 in the regular background-pixel.")
3296 (frame
, X0
, Y0
, X1
, Y1
)
3297 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
3299 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3301 CHECK_FRAME (frame
, 0);
3302 CHECK_NUMBER (X0
, 0);
3303 CHECK_NUMBER (Y0
, 1);
3304 CHECK_NUMBER (X1
, 2);
3305 CHECK_NUMBER (Y1
, 3);
3315 n_lines
= y1
- y0
+ 1;
3320 n_lines
= y0
- y1
+ 1;
3326 n_chars
= x1
- x0
+ 1;
3331 n_chars
= x0
- x1
+ 1;
3335 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->reverse_gc
,
3336 left
, top
, n_chars
, n_lines
);
3342 /* Draw lines around the text region beginning at the character position
3343 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3344 pixel and line characteristics. */
3346 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3349 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
3350 register struct frame
*f
;
3352 int top_x
, top_y
, bottom_x
, bottom_y
;
3354 register int ibw
= f
->display
.x
->internal_border_width
;
3355 register int font_w
= FONT_WIDTH (f
->display
.x
->font
);
3356 register int font_h
= f
->display
.x
->line_height
;
3358 int x
= line_len (y
);
3359 XPoint
*pixel_points
3360 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
3361 register XPoint
*this_point
= pixel_points
;
3363 /* Do the horizontal top line/lines */
3366 this_point
->x
= ibw
;
3367 this_point
->y
= ibw
+ (font_h
* top_y
);
3370 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
3372 this_point
->x
= ibw
+ (font_w
* x
);
3373 this_point
->y
= (this_point
- 1)->y
;
3377 this_point
->x
= ibw
;
3378 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
3380 this_point
->x
= ibw
+ (font_w
* top_x
);
3381 this_point
->y
= (this_point
- 1)->y
;
3383 this_point
->x
= (this_point
- 1)->x
;
3384 this_point
->y
= ibw
+ (font_h
* top_y
);
3386 this_point
->x
= ibw
+ (font_w
* x
);
3387 this_point
->y
= (this_point
- 1)->y
;
3390 /* Now do the right side. */
3391 while (y
< bottom_y
)
3392 { /* Right vertical edge */
3394 this_point
->x
= (this_point
- 1)->x
;
3395 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
3398 y
++; /* Horizontal connection to next line */
3401 this_point
->x
= ibw
+ (font_w
/ 2);
3403 this_point
->x
= ibw
+ (font_w
* x
);
3405 this_point
->y
= (this_point
- 1)->y
;
3408 /* Now do the bottom and connect to the top left point. */
3409 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
3412 this_point
->x
= (this_point
- 1)->x
;
3413 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
3415 this_point
->x
= ibw
;
3416 this_point
->y
= (this_point
- 1)->y
;
3418 this_point
->x
= pixel_points
->x
;
3419 this_point
->y
= pixel_points
->y
;
3421 XDrawLines (x_current_display
, FRAME_X_WINDOW (f
),
3423 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
3426 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
3427 "Highlight the region between point and the character under the mouse\n\
3430 register Lisp_Object event
;
3432 register int x0
, y0
, x1
, y1
;
3433 register struct frame
*f
= selected_frame
;
3434 register int p1
, p2
;
3436 CHECK_CONS (event
, 0);
3439 x0
= XINT (Fcar (Fcar (event
)));
3440 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3442 /* If the mouse is past the end of the line, don't that area. */
3443 /* ReWrite this... */
3448 if (y1
> y0
) /* point below mouse */
3449 outline_region (f
, f
->display
.x
->cursor_gc
,
3451 else if (y1
< y0
) /* point above mouse */
3452 outline_region (f
, f
->display
.x
->cursor_gc
,
3454 else /* same line: draw horizontal rectangle */
3457 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3458 x0
, y0
, (x1
- x0
+ 1), 1);
3460 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3461 x1
, y1
, (x0
- x1
+ 1), 1);
3464 XFlush (x_current_display
);
3470 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
3471 "Erase any highlighting of the region between point and the character\n\
3472 at X, Y on the selected frame.")
3474 register Lisp_Object event
;
3476 register int x0
, y0
, x1
, y1
;
3477 register struct frame
*f
= selected_frame
;
3480 x0
= XINT (Fcar (Fcar (event
)));
3481 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3485 if (y1
> y0
) /* point below mouse */
3486 outline_region (f
, f
->display
.x
->reverse_gc
,
3488 else if (y1
< y0
) /* point above mouse */
3489 outline_region (f
, f
->display
.x
->reverse_gc
,
3491 else /* same line: draw horizontal rectangle */
3494 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3495 x0
, y0
, (x1
- x0
+ 1), 1);
3497 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3498 x1
, y1
, (x0
- x1
+ 1), 1);
3506 int contour_begin_x
, contour_begin_y
;
3507 int contour_end_x
, contour_end_y
;
3508 int contour_npoints
;
3510 /* Clip the top part of the contour lines down (and including) line Y_POS.
3511 If X_POS is in the middle (rather than at the end) of the line, drop
3512 down a line at that character. */
3515 clip_contour_top (y_pos
, x_pos
)
3517 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
3518 register XPoint
*end
;
3519 register int npoints
;
3520 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
3522 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
3524 end
= contour_lines
[y_pos
].top_right
;
3525 npoints
= (end
- begin
+ 1);
3526 XDrawLines (x_current_display
, contour_window
,
3527 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3529 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
3530 contour_last_point
-= (npoints
- 2);
3531 XDrawLines (x_current_display
, contour_window
,
3532 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
3533 XFlush (x_current_display
);
3535 /* Now, update contour_lines structure. */
3540 register XPoint
*p
= begin
+ 1;
3541 end
= contour_lines
[y_pos
].bottom_right
;
3542 npoints
= (end
- begin
+ 1);
3543 XDrawLines (x_current_display
, contour_window
,
3544 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3547 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
3549 p
->y
= begin
->y
+ font_h
;
3551 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
3552 contour_last_point
-= (npoints
- 5);
3553 XDrawLines (x_current_display
, contour_window
,
3554 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
3555 XFlush (x_current_display
);
3557 /* Now, update contour_lines structure. */
3561 /* Erase the top horizontal lines of the contour, and then extend
3562 the contour upwards. */
3565 extend_contour_top (line
)
3570 clip_contour_bottom (x_pos
, y_pos
)
3576 extend_contour_bottom (x_pos
, y_pos
)
3580 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
3585 register struct frame
*f
= selected_frame
;
3586 register int point_x
= f
->cursor_x
;
3587 register int point_y
= f
->cursor_y
;
3588 register int mouse_below_point
;
3589 register Lisp_Object obj
;
3590 register int x_contour_x
, x_contour_y
;
3592 x_contour_x
= x_mouse_x
;
3593 x_contour_y
= x_mouse_y
;
3594 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
3595 && x_contour_x
> point_x
))
3597 mouse_below_point
= 1;
3598 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3599 x_contour_x
, x_contour_y
);
3603 mouse_below_point
= 0;
3604 outline_region (f
, f
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
3610 obj
= read_char (-1, 0, 0, Qnil
, 0);
3611 if (XTYPE (obj
) != Lisp_Cons
)
3614 if (mouse_below_point
)
3616 if (x_mouse_y
<= point_y
) /* Flipped. */
3618 mouse_below_point
= 0;
3620 outline_region (f
, f
->display
.x
->reverse_gc
, point_x
, point_y
,
3621 x_contour_x
, x_contour_y
);
3622 outline_region (f
, f
->display
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
3625 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
3627 clip_contour_bottom (x_mouse_y
);
3629 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
3631 extend_bottom_contour (x_mouse_y
);
3634 x_contour_x
= x_mouse_x
;
3635 x_contour_y
= x_mouse_y
;
3637 else /* mouse above or same line as point */
3639 if (x_mouse_y
>= point_y
) /* Flipped. */
3641 mouse_below_point
= 1;
3643 outline_region (f
, f
->display
.x
->reverse_gc
,
3644 x_contour_x
, x_contour_y
, point_x
, point_y
);
3645 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3646 x_mouse_x
, x_mouse_y
);
3648 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
3650 clip_contour_top (x_mouse_y
);
3652 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
3654 extend_contour_top (x_mouse_y
);
3659 unread_command_event
= obj
;
3660 if (mouse_below_point
)
3662 contour_begin_x
= point_x
;
3663 contour_begin_y
= point_y
;
3664 contour_end_x
= x_contour_x
;
3665 contour_end_y
= x_contour_y
;
3669 contour_begin_x
= x_contour_x
;
3670 contour_begin_y
= x_contour_y
;
3671 contour_end_x
= point_x
;
3672 contour_end_y
= point_y
;
3677 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
3682 register Lisp_Object obj
;
3683 struct frame
*f
= selected_frame
;
3684 register struct window
*w
= XWINDOW (selected_window
);
3685 register GC line_gc
= f
->display
.x
->cursor_gc
;
3686 register GC erase_gc
= f
->display
.x
->reverse_gc
;
3688 char dash_list
[] = {6, 4, 6, 4};
3690 XGCValues gc_values
;
3692 register int previous_y
;
3693 register int line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3694 + f
->display
.x
->internal_border_width
;
3695 register int left
= f
->display
.x
->internal_border_width
3697 * FONT_WIDTH (f
->display
.x
->font
));
3698 register int right
= left
+ (w
->width
3699 * FONT_WIDTH (f
->display
.x
->font
))
3700 - f
->display
.x
->internal_border_width
;
3704 gc_values
.foreground
= f
->display
.x
->cursor_pixel
;
3705 gc_values
.background
= f
->display
.x
->background_pixel
;
3706 gc_values
.line_width
= 1;
3707 gc_values
.line_style
= LineOnOffDash
;
3708 gc_values
.cap_style
= CapRound
;
3709 gc_values
.join_style
= JoinRound
;
3711 line_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3712 GCLineStyle
| GCJoinStyle
| GCCapStyle
3713 | GCLineWidth
| GCForeground
| GCBackground
,
3715 XSetDashes (x_current_display
, line_gc
, 0, dash_list
, dashes
);
3716 gc_values
.foreground
= f
->display
.x
->background_pixel
;
3717 gc_values
.background
= f
->display
.x
->foreground_pixel
;
3718 erase_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3719 GCLineStyle
| GCJoinStyle
| GCCapStyle
3720 | GCLineWidth
| GCForeground
| GCBackground
,
3722 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
3728 if (x_mouse_y
>= XINT (w
->top
)
3729 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
3731 previous_y
= x_mouse_y
;
3732 line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3733 + f
->display
.x
->internal_border_width
;
3734 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3735 line_gc
, left
, line
, right
, line
);
3742 obj
= read_char (-1, 0, 0, Qnil
, 0);
3743 if ((XTYPE (obj
) != Lisp_Cons
)
3744 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3745 Qvertical_scroll_bar
))
3749 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3750 erase_gc
, left
, line
, right
, line
);
3752 unread_command_event
= obj
;
3754 XFreeGC (x_current_display
, line_gc
);
3755 XFreeGC (x_current_display
, erase_gc
);
3760 while (x_mouse_y
== previous_y
);
3763 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3764 erase_gc
, left
, line
, right
, line
);
3770 /* Offset in buffer of character under the pointer, or 0. */
3771 int mouse_buffer_offset
;
3774 /* These keep track of the rectangle following the pointer. */
3775 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
3777 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
3778 "Track the pointer.")
3781 static Cursor current_pointer_shape
;
3782 FRAME_PTR f
= x_mouse_frame
;
3785 if (EQ (Vmouse_frame_part
, Qtext_part
)
3786 && (current_pointer_shape
!= f
->display
.x
->nontext_cursor
))
3791 current_pointer_shape
= f
->display
.x
->nontext_cursor
;
3792 XDefineCursor (x_current_display
,
3794 current_pointer_shape
);
3796 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
3797 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
3799 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
3800 && (current_pointer_shape
!= f
->display
.x
->modeline_cursor
))
3802 current_pointer_shape
= f
->display
.x
->modeline_cursor
;
3803 XDefineCursor (x_current_display
,
3805 current_pointer_shape
);
3814 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
3815 "Draw rectangle around character under mouse pointer, if there is one.")
3819 struct window
*w
= XWINDOW (Vmouse_window
);
3820 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
3821 struct buffer
*b
= XBUFFER (w
->buffer
);
3824 if (! EQ (Vmouse_window
, selected_window
))
3827 if (EQ (event
, Qnil
))
3831 x_read_mouse_position (selected_frame
, &x
, &y
);
3835 mouse_track_width
= 0;
3836 mouse_track_left
= mouse_track_top
= -1;
3840 if ((x_mouse_x
!= mouse_track_left
3841 && (x_mouse_x
< mouse_track_left
3842 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
3843 || x_mouse_y
!= mouse_track_top
)
3845 int hp
= 0; /* Horizontal position */
3846 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
3847 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
3848 int tab_width
= XINT (b
->tab_width
);
3849 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
3851 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
3852 int in_mode_line
= 0;
3854 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
3857 /* Erase previous rectangle. */
3858 if (mouse_track_width
)
3860 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3861 mouse_track_left
, mouse_track_top
,
3862 mouse_track_width
, 1);
3864 if ((mouse_track_left
== f
->phys_cursor_x
3865 || mouse_track_left
== f
->phys_cursor_x
- 1)
3866 && mouse_track_top
== f
->phys_cursor_y
)
3868 x_display_cursor (f
, 1);
3872 mouse_track_left
= x_mouse_x
;
3873 mouse_track_top
= x_mouse_y
;
3874 mouse_track_width
= 0;
3876 if (mouse_track_left
> len
) /* Past the end of line. */
3879 if (mouse_track_top
== mode_line_vpos
)
3885 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3889 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
3895 mouse_track_width
= tab_width
- (hp
% tab_width
);
3897 hp
+= mouse_track_width
;
3900 mouse_track_left
= hp
- mouse_track_width
;
3906 mouse_track_width
= -1;
3910 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3915 mouse_track_width
= 2;
3920 mouse_track_left
= hp
- mouse_track_width
;
3926 mouse_track_width
= 1;
3933 while (hp
<= x_mouse_x
);
3936 if (mouse_track_width
) /* Over text; use text pointer shape. */
3938 XDefineCursor (x_current_display
,
3940 f
->display
.x
->text_cursor
);
3941 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3942 mouse_track_left
, mouse_track_top
,
3943 mouse_track_width
, 1);
3945 else if (in_mode_line
)
3946 XDefineCursor (x_current_display
,
3948 f
->display
.x
->modeline_cursor
);
3950 XDefineCursor (x_current_display
,
3952 f
->display
.x
->nontext_cursor
);
3955 XFlush (x_current_display
);
3958 obj
= read_char (-1, 0, 0, Qnil
, 0);
3961 while (XTYPE (obj
) == Lisp_Cons
/* Mouse event */
3962 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
3963 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
3964 && EQ (Vmouse_window
, selected_window
) /* In this window */
3967 unread_command_event
= obj
;
3969 if (mouse_track_width
)
3971 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3972 mouse_track_left
, mouse_track_top
,
3973 mouse_track_width
, 1);
3974 mouse_track_width
= 0;
3975 if ((mouse_track_left
== f
->phys_cursor_x
3976 || mouse_track_left
- 1 == f
->phys_cursor_x
)
3977 && mouse_track_top
== f
->phys_cursor_y
)
3979 x_display_cursor (f
, 1);
3982 XDefineCursor (x_current_display
,
3984 f
->display
.x
->nontext_cursor
);
3985 XFlush (x_current_display
);
3995 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3996 on the frame F at position X, Y. */
3998 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
4000 int x
, y
, width
, height
;
4005 image
= XCreateBitmapFromData (x_current_display
,
4006 FRAME_X_WINDOW (f
), image_data
,
4008 XCopyPlane (x_current_display
, image
, FRAME_X_WINDOW (f
),
4009 f
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
4014 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer
, Sx_store_cut_buffer
,
4015 1, 1, "sStore text in cut buffer: ",
4016 "Store contents of STRING into the cut buffer of the X window system.")
4018 register Lisp_Object string
;
4022 CHECK_STRING (string
, 1);
4023 if (! FRAME_X_P (selected_frame
))
4024 error ("Selected frame does not understand X protocol.");
4027 XStoreBytes ((char *) XSTRING (string
)->data
, XSTRING (string
)->size
);
4033 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer
, Sx_get_cut_buffer
, 0, 0, 0,
4034 "Return contents of cut buffer of the X window system, as a string.")
4038 register Lisp_Object string
;
4043 d
= XFetchBytes (&len
);
4044 string
= make_string (d
, len
);
4051 #if 0 /* I'm told these functions are superfluous
4052 given the ability to bind function keys. */
4055 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
4056 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
4057 KEYSYM is a string which conforms to the X keysym definitions found\n\
4058 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
4059 list of strings specifying modifier keys such as Control_L, which must\n\
4060 also be depressed for NEWSTRING to appear.")
4061 (x_keysym
, modifiers
, newstring
)
4062 register Lisp_Object x_keysym
;
4063 register Lisp_Object modifiers
;
4064 register Lisp_Object newstring
;
4067 register KeySym keysym
;
4068 KeySym modifier_list
[16];
4071 CHECK_STRING (x_keysym
, 1);
4072 CHECK_STRING (newstring
, 3);
4074 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
4075 if (keysym
== NoSymbol
)
4076 error ("Keysym does not exist");
4078 if (NILP (modifiers
))
4079 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
4080 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
4083 register Lisp_Object rest
, mod
;
4086 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
4089 error ("Can't have more than 16 modifiers");
4092 CHECK_STRING (mod
, 3);
4093 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
4095 if (modifier_list
[i
] == NoSymbol
4096 || !(IsModifierKey (modifier_list
[i
])
4097 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
4098 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
4100 if (modifier_list
[i
] == NoSymbol
4101 || !IsModifierKey (modifier_list
[i
]))
4103 error ("Element is not a modifier keysym");
4107 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
4108 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
4114 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
4115 "Rebind KEYCODE to list of strings STRINGS.\n\
4116 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4117 nil as element means don't change.\n\
4118 See the documentation of `x-rebind-key' for more information.")
4120 register Lisp_Object keycode
;
4121 register Lisp_Object strings
;
4123 register Lisp_Object item
;
4124 register unsigned char *rawstring
;
4125 KeySym rawkey
, modifier
[1];
4127 register unsigned i
;
4130 CHECK_NUMBER (keycode
, 1);
4131 CHECK_CONS (strings
, 2);
4132 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
4133 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
4135 item
= Fcar (strings
);
4138 CHECK_STRING (item
, 2);
4139 strsize
= XSTRING (item
)->size
;
4140 rawstring
= (unsigned char *) xmalloc (strsize
);
4141 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
4142 modifier
[1] = 1 << i
;
4143 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
4144 rawstring
, strsize
);
4149 #endif /* HAVE_X11 */
4154 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4156 XScreenNumberOfScreen (scr
)
4157 register Screen
*scr
;
4159 register Display
*dpy
;
4160 register Screen
*dpyscr
;
4164 dpyscr
= dpy
->screens
;
4166 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
4172 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4175 select_visual (screen
, depth
)
4177 unsigned int *depth
;
4180 XVisualInfo
*vinfo
, vinfo_template
;
4183 v
= DefaultVisualOfScreen (screen
);
4186 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
4188 vinfo_template
.visualid
= v
->visualid
;
4191 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4193 vinfo
= XGetVisualInfo (x_current_display
,
4194 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
4197 fatal ("Can't get proper X visual info");
4199 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
4200 *depth
= vinfo
->depth
;
4204 int n
= vinfo
->colormap_size
- 1;
4213 XFree ((char *) vinfo
);
4216 #endif /* HAVE_X11 */
4218 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4219 1, 2, 0, "Open a connection to an X server.\n\
4220 DISPLAY is the name of the display to connect to.\n\
4221 Optional second arg XRM_STRING is a string of resources in xrdb format.")
4222 (display
, xrm_string
)
4223 Lisp_Object display
, xrm_string
;
4225 unsigned int n_planes
;
4226 unsigned char *xrm_option
;
4228 CHECK_STRING (display
, 0);
4229 if (x_current_display
!= 0)
4230 error ("X server connection is already initialized");
4231 if (! NILP (xrm_string
))
4232 CHECK_STRING (xrm_string
, 1);
4234 if (! NILP (xrm_string
))
4235 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4237 xrm_option
= (unsigned char *) 0;
4239 validate_x_resource_name ();
4241 /* This is what opens the connection and sets x_current_display.
4242 This also initializes many symbols, such as those used for input. */
4243 x_term_init (XSTRING (display
)->data
, xrm_option
,
4244 XSTRING (Vx_resource_name
)->data
);
4247 XFASTINT (Vwindow_system_version
) = 11;
4250 xrdb
= x_load_resources (x_current_display
, xrm_option
,
4251 (char *) XSTRING (Vx_resource_name
)->data
,
4254 #ifdef HAVE_XRMSETDATABASE
4255 XrmSetDatabase (x_current_display
, xrdb
);
4257 x_current_display
->db
= xrdb
;
4260 x_screen
= DefaultScreenOfDisplay (x_current_display
);
4262 screen_visual
= select_visual (x_screen
, &n_planes
);
4263 x_screen_planes
= n_planes
;
4264 x_screen_height
= HeightOfScreen (x_screen
);
4265 x_screen_width
= WidthOfScreen (x_screen
);
4267 /* X Atoms used by emacs. */
4268 Xatoms_of_xselect ();
4270 Xatom_wm_protocols
= XInternAtom (x_current_display
, "WM_PROTOCOLS",
4272 Xatom_wm_take_focus
= XInternAtom (x_current_display
, "WM_TAKE_FOCUS",
4274 Xatom_wm_save_yourself
= XInternAtom (x_current_display
, "WM_SAVE_YOURSELF",
4276 Xatom_wm_delete_window
= XInternAtom (x_current_display
, "WM_DELETE_WINDOW",
4278 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
4280 Xatom_wm_configure_denied
= XInternAtom (x_current_display
,
4281 "WM_CONFIGURE_DENIED", False
);
4282 Xatom_wm_window_moved
= XInternAtom (x_current_display
, "WM_MOVED",
4284 Xatom_editres_name
= XInternAtom (x_current_display
, "Editres", False
);
4286 #else /* not HAVE_X11 */
4287 XFASTINT (Vwindow_system_version
) = 10;
4288 #endif /* not HAVE_X11 */
4292 DEFUN ("x-close-current-connection", Fx_close_current_connection
,
4293 Sx_close_current_connection
,
4294 0, 0, 0, "Close the connection to the current X server.")
4297 /* Note: If we're going to call check_x here, then the fatal error
4298 can't happen. For the moment, this check is just for safety,
4299 so a user won't try out the function and get a crash. If it's
4300 really intended only to be called when killing emacs, then there's
4301 no reason for it to have a lisp interface at all. */
4304 /* This is ONLY used when killing emacs; For switching displays
4305 we'll have to take care of setting CloseDownMode elsewhere. */
4307 if (x_current_display
)
4310 XSetCloseDownMode (x_current_display
, DestroyAll
);
4311 XCloseDisplay (x_current_display
);
4312 x_current_display
= 0;
4315 fatal ("No current X display connection to close\n");
4320 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
,
4321 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4322 If ON is nil, allow buffering of requests.\n\
4323 Turning on synchronization prohibits the Xlib routines from buffering\n\
4324 requests and seriously degrades performance, but makes debugging much\n\
4331 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
4336 /* Wait for responses to all X commands issued so far for FRAME. */
4343 XSync (x_current_display
, False
);
4349 /* This is zero if not using X windows. */
4350 x_current_display
= 0;
4352 /* The section below is built by the lisp expression at the top of the file,
4353 just above where these variables are declared. */
4354 /*&&& init symbols here &&&*/
4355 Qauto_raise
= intern ("auto-raise");
4356 staticpro (&Qauto_raise
);
4357 Qauto_lower
= intern ("auto-lower");
4358 staticpro (&Qauto_lower
);
4359 Qbackground_color
= intern ("background-color");
4360 staticpro (&Qbackground_color
);
4361 Qbar
= intern ("bar");
4363 Qborder_color
= intern ("border-color");
4364 staticpro (&Qborder_color
);
4365 Qborder_width
= intern ("border-width");
4366 staticpro (&Qborder_width
);
4367 Qbox
= intern ("box");
4369 Qcursor_color
= intern ("cursor-color");
4370 staticpro (&Qcursor_color
);
4371 Qcursor_type
= intern ("cursor-type");
4372 staticpro (&Qcursor_type
);
4373 Qfont
= intern ("font");
4375 Qforeground_color
= intern ("foreground-color");
4376 staticpro (&Qforeground_color
);
4377 Qgeometry
= intern ("geometry");
4378 staticpro (&Qgeometry
);
4379 Qicon_left
= intern ("icon-left");
4380 staticpro (&Qicon_left
);
4381 Qicon_top
= intern ("icon-top");
4382 staticpro (&Qicon_top
);
4383 Qicon_type
= intern ("icon-type");
4384 staticpro (&Qicon_type
);
4385 Qinternal_border_width
= intern ("internal-border-width");
4386 staticpro (&Qinternal_border_width
);
4387 Qleft
= intern ("left");
4389 Qmouse_color
= intern ("mouse-color");
4390 staticpro (&Qmouse_color
);
4391 Qnone
= intern ("none");
4393 Qparent_id
= intern ("parent-id");
4394 staticpro (&Qparent_id
);
4395 Qsuppress_icon
= intern ("suppress-icon");
4396 staticpro (&Qsuppress_icon
);
4397 Qtop
= intern ("top");
4399 Qundefined_color
= intern ("undefined-color");
4400 staticpro (&Qundefined_color
);
4401 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
4402 staticpro (&Qvertical_scroll_bars
);
4403 Qvisibility
= intern ("visibility");
4404 staticpro (&Qvisibility
);
4405 Qwindow_id
= intern ("window-id");
4406 staticpro (&Qwindow_id
);
4407 Qx_frame_parameter
= intern ("x-frame-parameter");
4408 staticpro (&Qx_frame_parameter
);
4409 Qx_resource_name
= intern ("x-resource-name");
4410 staticpro (&Qx_resource_name
);
4411 Quser_position
= intern ("user-position");
4412 staticpro (&Quser_position
);
4413 Quser_size
= intern ("user-size");
4414 staticpro (&Quser_size
);
4415 /* This is the end of symbol initialization. */
4417 Fput (Qundefined_color
, Qerror_conditions
,
4418 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
4419 Fput (Qundefined_color
, Qerror_message
,
4420 build_string ("Undefined color"));
4422 init_x_parm_symbols ();
4424 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset
,
4425 "The buffer offset of the character under the pointer.");
4426 mouse_buffer_offset
= 0;
4428 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
4429 "The shape of the pointer when over text.\n\
4430 Changing the value does not affect existing frames\n\
4431 unless you set the mouse color.");
4432 Vx_pointer_shape
= Qnil
;
4434 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
4435 "The name Emacs uses to look up X resources; for internal use only.\n\
4436 `x-get-resource' uses this as the first component of the instance name\n\
4437 when requesting resource values.\n\
4438 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4439 was invoked, or to the value specified with the `-name' or `-rn'\n\
4440 switches, if present.");
4441 Vx_resource_name
= Qnil
;
4443 #if 0 /* This doesn't really do anything. */
4444 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
4445 "The shape of the pointer when not over text.\n\
4446 This variable takes effect when you create a new frame\n\
4447 or when you set the mouse color.");
4449 Vx_nontext_pointer_shape
= Qnil
;
4451 #if 0 /* This doesn't really do anything. */
4452 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
4453 "The shape of the pointer when over the mode line.\n\
4454 This variable takes effect when you create a new frame\n\
4455 or when you set the mouse color.");
4457 Vx_mode_pointer_shape
= Qnil
;
4459 DEFVAR_INT ("x-sensitive-text-pointer-shape",
4460 &Vx_sensitive_text_pointer_shape
,
4461 "The shape of the pointer when over mouse-sensitive text.\n\
4462 This variable takes effect when you create a new frame\n\
4463 or when you set the mouse color.");
4464 Vx_sensitive_text_pointer_shape
= Qnil
;
4466 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
4467 "A string indicating the foreground color of the cursor box.");
4468 Vx_cursor_fore_pixel
= Qnil
;
4470 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed
,
4471 "Non-nil if a mouse button is currently depressed.");
4472 Vmouse_depressed
= Qnil
;
4474 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
4475 "Non-nil if no X window manager is in use.");
4477 #ifdef USE_X_TOOLKIT
4478 Fprovide (intern ("x-toolkit"));
4482 defsubr (&Sx_get_resource
);
4484 defsubr (&Sx_draw_rectangle
);
4485 defsubr (&Sx_erase_rectangle
);
4486 defsubr (&Sx_contour_region
);
4487 defsubr (&Sx_uncontour_region
);
4489 defsubr (&Sx_display_color_p
);
4490 defsubr (&Sx_list_fonts
);
4491 defsubr (&Sx_color_defined_p
);
4492 defsubr (&Sx_color_values
);
4493 defsubr (&Sx_server_max_request_size
);
4494 defsubr (&Sx_server_vendor
);
4495 defsubr (&Sx_server_version
);
4496 defsubr (&Sx_display_pixel_width
);
4497 defsubr (&Sx_display_pixel_height
);
4498 defsubr (&Sx_display_mm_width
);
4499 defsubr (&Sx_display_mm_height
);
4500 defsubr (&Sx_display_screens
);
4501 defsubr (&Sx_display_planes
);
4502 defsubr (&Sx_display_color_cells
);
4503 defsubr (&Sx_display_visual_class
);
4504 defsubr (&Sx_display_backing_store
);
4505 defsubr (&Sx_display_save_under
);
4507 defsubr (&Sx_rebind_key
);
4508 defsubr (&Sx_rebind_keys
);
4509 defsubr (&Sx_track_pointer
);
4510 defsubr (&Sx_grab_pointer
);
4511 defsubr (&Sx_ungrab_pointer
);
4514 defsubr (&Sx_get_default
);
4515 defsubr (&Sx_store_cut_buffer
);
4516 defsubr (&Sx_get_cut_buffer
);
4518 defsubr (&Sx_parse_geometry
);
4519 defsubr (&Sx_create_frame
);
4520 defsubr (&Sfocus_frame
);
4521 defsubr (&Sunfocus_frame
);
4523 defsubr (&Sx_horizontal_line
);
4525 defsubr (&Sx_open_connection
);
4526 defsubr (&Sx_close_current_connection
);
4527 defsubr (&Sx_synchronize
);
4530 #endif /* HAVE_X_WINDOWS */