1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* Completely rewritten by Richard Stallman. */
22 /* Rewritten for X11 by Joseph Arceneaux */
34 #include "dispextern.h"
36 #include "blockinput.h"
42 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
43 #include "bitmaps/gray.xbm"
45 #include <X11/bitmaps/gray>
48 #include "[.bitmaps]gray.xbm"
52 #include <X11/Shell.h>
54 #include <X11/Xaw/Paned.h>
55 #include <X11/Xaw/Label.h>
58 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
67 #include "../lwlib/lwlib.h"
69 /* The one and only application context associated with the connection
70 to the one and only X display that Emacs uses. */
71 XtAppContext Xt_app_con
;
73 /* The one and only application shell. Emacs screens are popup shells of this
77 extern void free_frame_menubar ();
78 extern void free_frame_menubar ();
79 #endif /* USE_X_TOOLKIT */
81 #define min(a,b) ((a) < (b) ? (a) : (b))
82 #define max(a,b) ((a) > (b) ? (a) : (b))
85 /* X Resource data base */
86 static XrmDatabase xrdb
;
88 /* The class of this X application. */
89 #define EMACS_CLASS "Emacs"
92 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
94 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
97 /* The name we're using in resource queries. */
98 Lisp_Object Vx_resource_name
;
100 /* Title name and application name for X stuff. */
101 extern char *x_id_name
;
103 /* The background and shape of the mouse pointer, and shape when not
104 over text or in the modeline. */
105 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
106 Lisp_Object Vx_cross_pointer_shape
;
108 /* Color of chars displayed in cursor box. */
109 Lisp_Object Vx_cursor_fore_pixel
;
111 /* The screen being used. */
112 static Screen
*x_screen
;
114 /* The X Visual we are using for X windows (the default) */
115 Visual
*screen_visual
;
117 /* Height of this X screen in pixels. */
120 /* Width of this X screen in pixels. */
123 /* Number of planes for this screen. */
126 /* Non nil if no window manager is in use. */
127 Lisp_Object Vx_no_window_manager
;
129 /* `t' if a mouse button is depressed. */
131 Lisp_Object Vmouse_depressed
;
133 extern unsigned int x_mouse_x
, x_mouse_y
, x_mouse_grabbed
;
135 /* Atom for indicating window state to the window manager. */
136 extern Atom Xatom_wm_change_state
;
138 /* Communication with window managers. */
139 extern Atom Xatom_wm_protocols
;
141 /* Kinds of protocol things we may receive. */
142 extern Atom Xatom_wm_take_focus
;
143 extern Atom Xatom_wm_save_yourself
;
144 extern Atom Xatom_wm_delete_window
;
146 /* Other WM communication */
147 extern Atom Xatom_wm_configure_denied
; /* When our config request is denied */
148 extern Atom Xatom_wm_window_moved
; /* When the WM moves us. */
150 /* EditRes protocol */
151 extern Atom Xatom_editres_name
;
155 /* Default size of an Emacs window. */
156 static char *default_window
= "=80x24+0+0";
159 char iconidentity
[MAXICID
];
160 #define ICONTAG "emacs@"
161 char minibuffer_iconidentity
[MAXICID
];
162 #define MINIBUFFER_ICONTAG "minibuffer@"
166 /* The last 23 bits of the timestamp of the last mouse button event. */
167 Time mouse_timestamp
;
169 /* Evaluate this expression to rebuild the section of syms_of_xfns
170 that initializes and staticpros the symbols declared below. Note
171 that Emacs 18 has a bug that keeps C-x C-e from being able to
172 evaluate this expression.
175 ;; Accumulate a list of the symbols we want to initialize from the
176 ;; declarations at the top of the file.
177 (goto-char (point-min))
178 (search-forward "/\*&&& symbols declared here &&&*\/\n")
180 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
182 (cons (buffer-substring (match-beginning 1) (match-end 1))
185 (setq symbol-list (nreverse symbol-list))
186 ;; Delete the section of syms_of_... where we initialize the symbols.
187 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
188 (let ((start (point)))
189 (while (looking-at "^ Q")
191 (kill-region start (point)))
192 ;; Write a new symbol initialization section.
194 (insert (format " %s = intern (\"" (car symbol-list)))
195 (let ((start (point)))
196 (insert (substring (car symbol-list) 1))
197 (subst-char-in-region start (point) ?_ ?-))
198 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
199 (setq symbol-list (cdr symbol-list)))))
203 /*&&& symbols declared here &&&*/
204 Lisp_Object Qauto_raise
;
205 Lisp_Object Qauto_lower
;
206 Lisp_Object Qbackground_color
;
208 Lisp_Object Qborder_color
;
209 Lisp_Object Qborder_width
;
211 Lisp_Object Qcursor_color
;
212 Lisp_Object Qcursor_type
;
214 Lisp_Object Qforeground_color
;
215 Lisp_Object Qgeometry
;
216 /* Lisp_Object Qicon; */
217 Lisp_Object Qicon_left
;
218 Lisp_Object Qicon_top
;
219 Lisp_Object Qicon_type
;
220 Lisp_Object Qinternal_border_width
;
222 Lisp_Object Qmouse_color
;
224 Lisp_Object Qparent_id
;
225 Lisp_Object Qsuppress_icon
;
227 Lisp_Object Qundefined_color
;
228 Lisp_Object Qvertical_scroll_bars
;
229 Lisp_Object Qvisibility
;
230 Lisp_Object Qwindow_id
;
231 Lisp_Object Qx_frame_parameter
;
232 Lisp_Object Qx_resource_name
;
234 /* The below are defined in frame.c. */
235 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
236 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
;
238 extern Lisp_Object Vwindow_system_version
;
241 /* Error if we are not connected to X. */
245 if (x_current_display
== 0)
246 error ("X windows are not in use or not initialized");
249 /* Return the Emacs frame-object corresponding to an X window.
250 It could be the frame's main window or an icon window. */
252 /* This function can be called during GC, so use XGCTYPE. */
255 x_window_to_frame (wdesc
)
258 Lisp_Object tail
, frame
;
261 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
262 tail
= XCONS (tail
)->cdr
)
264 frame
= XCONS (tail
)->car
;
265 if (XGCTYPE (frame
) != Lisp_Frame
)
269 if (f
->display
.nothing
== 1)
271 if ((f
->display
.x
->edit_widget
272 && XtWindow (f
->display
.x
->edit_widget
) == wdesc
)
273 || f
->display
.x
->icon_desc
== wdesc
)
275 #else /* not USE_X_TOOLKIT */
276 if (FRAME_X_WINDOW (f
) == wdesc
277 || f
->display
.x
->icon_desc
== wdesc
)
279 #endif /* not USE_X_TOOLKIT */
285 /* Like x_window_to_frame but also compares the window with the widget's
289 x_any_window_to_frame (wdesc
)
292 Lisp_Object tail
, frame
;
296 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
297 tail
= XCONS (tail
)->cdr
)
299 frame
= XCONS (tail
)->car
;
300 if (XGCTYPE (frame
) != Lisp_Frame
)
303 if (f
->display
.nothing
== 1)
306 /* This frame matches if the window is any of its widgets. */
307 if (wdesc
== XtWindow (x
->widget
)
308 || wdesc
== XtWindow (x
->column_widget
)
309 || wdesc
== XtWindow (x
->edit_widget
))
311 /* Match if the window is this frame's menubar. */
312 if (x
->menubar_widget
313 && wdesc
== XtWindow (x
->menubar_widget
))
319 /* Return the frame whose principal (outermost) window is WDESC.
320 If WDESC is some other (smaller) window, we return 0. */
323 x_top_window_to_frame (wdesc
)
326 Lisp_Object tail
, frame
;
330 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
331 tail
= XCONS (tail
)->cdr
)
333 frame
= XCONS (tail
)->car
;
334 if (XGCTYPE (frame
) != Lisp_Frame
)
337 if (f
->display
.nothing
== 1)
340 /* This frame matches if the window is its topmost widget. */
341 if (wdesc
== XtWindow (x
->widget
))
343 /* Match if the window is this frame's menubar. */
344 if (x
->menubar_widget
345 && wdesc
== XtWindow (x
->menubar_widget
))
350 #endif /* USE_X_TOOLKIT */
353 /* Connect the frame-parameter names for X frames
354 to the ways of passing the parameter values to the window system.
356 The name of a parameter, as a Lisp symbol,
357 has an `x-frame-parameter' property which is an integer in Lisp
358 but can be interpreted as an `enum x_frame_parm' in C. */
362 X_PARM_FOREGROUND_COLOR
,
363 X_PARM_BACKGROUND_COLOR
,
370 X_PARM_INTERNAL_BORDER_WIDTH
,
374 X_PARM_VERT_SCROLL_BAR
,
376 X_PARM_MENU_BAR_LINES
380 struct x_frame_parm_table
383 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
386 void x_set_foreground_color ();
387 void x_set_background_color ();
388 void x_set_mouse_color ();
389 void x_set_cursor_color ();
390 void x_set_border_color ();
391 void x_set_cursor_type ();
392 void x_set_icon_type ();
394 void x_set_border_width ();
395 void x_set_internal_border_width ();
396 void x_explicitly_set_name ();
397 void x_set_autoraise ();
398 void x_set_autolower ();
399 void x_set_vertical_scroll_bars ();
400 void x_set_visibility ();
401 void x_set_menu_bar_lines ();
403 static struct x_frame_parm_table x_frame_parms
[] =
405 "foreground-color", x_set_foreground_color
,
406 "background-color", x_set_background_color
,
407 "mouse-color", x_set_mouse_color
,
408 "cursor-color", x_set_cursor_color
,
409 "border-color", x_set_border_color
,
410 "cursor-type", x_set_cursor_type
,
411 "icon-type", x_set_icon_type
,
413 "border-width", x_set_border_width
,
414 "internal-border-width", x_set_internal_border_width
,
415 "name", x_explicitly_set_name
,
416 "auto-raise", x_set_autoraise
,
417 "auto-lower", x_set_autolower
,
418 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
419 "visibility", x_set_visibility
,
420 "menu-bar-lines", x_set_menu_bar_lines
,
423 /* Attach the `x-frame-parameter' properties to
424 the Lisp symbol names of parameters relevant to X. */
426 init_x_parm_symbols ()
430 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
431 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
435 /* Change the parameters of FRAME as specified by ALIST.
436 If a parameter is not specially recognized, do nothing;
437 otherwise call the `x_set_...' function for that parameter. */
440 x_set_frame_parameters (f
, alist
)
446 /* If both of these parameters are present, it's more efficient to
447 set them both at once. So we wait until we've looked at the
448 entire list before we set them. */
449 Lisp_Object width
, height
;
452 Lisp_Object left
, top
;
454 /* Record in these vectors all the parms specified. */
460 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
463 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
464 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
466 /* Extract parm names and values into those vectors. */
469 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
471 Lisp_Object elt
, prop
, val
;
474 parms
[i
] = Fcar (elt
);
475 values
[i
] = Fcdr (elt
);
479 width
= height
= top
= left
= Qunbound
;
481 /* Now process them in reverse of specified order. */
482 for (i
--; i
>= 0; i
--)
484 Lisp_Object prop
, val
;
489 if (EQ (prop
, Qwidth
))
491 else if (EQ (prop
, Qheight
))
493 else if (EQ (prop
, Qtop
))
495 else if (EQ (prop
, Qleft
))
499 register Lisp_Object param_index
, old_value
;
501 param_index
= Fget (prop
, Qx_frame_parameter
);
502 old_value
= get_frame_param (f
, prop
);
503 store_frame_param (f
, prop
, val
);
504 if (XTYPE (param_index
) == Lisp_Int
505 && XINT (param_index
) >= 0
506 && (XINT (param_index
)
507 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
508 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
512 /* Don't die if just one of these was set. */
513 if (EQ (left
, Qunbound
))
514 XSET (left
, Lisp_Int
, f
->display
.x
->left_pos
);
515 if (EQ (top
, Qunbound
))
516 XSET (top
, Lisp_Int
, f
->display
.x
->top_pos
);
518 /* Don't die if just one of these was set. */
519 if (EQ (width
, Qunbound
))
520 XSET (width
, Lisp_Int
, FRAME_WIDTH (f
));
521 if (EQ (height
, Qunbound
))
522 XSET (height
, Lisp_Int
, FRAME_HEIGHT (f
));
524 /* Don't set these parameters these unless they've been explicitly
525 specified. The window might be mapped or resized while we're in
526 this function, and we don't want to override that unless the lisp
527 code has asked for it.
529 Don't set these parameters unless they actually differ from the
530 window's current parameters; the window may not actually exist
535 check_frame_size (f
, &height
, &width
);
537 XSET (frame
, Lisp_Frame
, f
);
539 if ((NUMBERP (width
) && XINT (width
) != FRAME_WIDTH (f
))
540 || (NUMBERP (height
) && XINT (height
) != FRAME_HEIGHT (f
)))
541 Fset_frame_size (frame
, width
, height
);
542 if ((NUMBERP (left
) && XINT (left
) != f
->display
.x
->left_pos
)
543 || (NUMBERP (top
) && XINT (top
) != f
->display
.x
->top_pos
))
544 Fset_frame_position (frame
, left
, top
);
548 /* Insert a description of internally-recorded parameters of frame X
549 into the parameter alist *ALISTPTR that is to be given to the user.
550 Only parameters that are specific to the X window system
551 and whose values are not correctly recorded in the frame's
552 param_alist need to be considered here. */
554 x_report_frame_params (f
, alistptr
)
556 Lisp_Object
*alistptr
;
560 store_in_alist (alistptr
, Qleft
, make_number (f
->display
.x
->left_pos
));
561 store_in_alist (alistptr
, Qtop
, make_number (f
->display
.x
->top_pos
));
562 store_in_alist (alistptr
, Qborder_width
,
563 make_number (f
->display
.x
->border_width
));
564 store_in_alist (alistptr
, Qinternal_border_width
,
565 make_number (f
->display
.x
->internal_border_width
));
566 sprintf (buf
, "%d", FRAME_X_WINDOW (f
));
567 store_in_alist (alistptr
, Qwindow_id
,
569 FRAME_SAMPLE_VISIBILITY (f
);
570 store_in_alist (alistptr
, Qvisibility
,
571 (FRAME_VISIBLE_P (f
) ? Qt
572 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
575 /* Decide if color named COLOR is valid for the display
576 associated with the selected frame. */
578 defined_color (color
, color_def
)
583 Colormap screen_colormap
;
588 = DefaultColormap (x_current_display
, XDefaultScreen (x_current_display
));
590 foo
= XParseColor (x_current_display
, screen_colormap
,
592 && XAllocColor (x_current_display
, screen_colormap
, color_def
);
594 foo
= XParseColor (color
, color_def
) && XGetHardwareColor (color_def
);
595 #endif /* not HAVE_X11 */
604 /* Given a string ARG naming a color, compute a pixel value from it
605 suitable for screen F.
606 If F is not a color screen, return DEF (default) regardless of what
610 x_decode_color (arg
, def
)
616 CHECK_STRING (arg
, 0);
618 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
619 return BLACK_PIX_DEFAULT
;
620 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
621 return WHITE_PIX_DEFAULT
;
624 if (x_screen_planes
== 1)
627 if (DISPLAY_CELLS
== 1)
631 if (defined_color (XSTRING (arg
)->data
, &cdef
))
634 Fsignal (Qundefined_color
, Fcons (arg
, Qnil
));
637 /* Functions called only from `x_set_frame_param'
638 to set individual parameters.
640 If FRAME_X_WINDOW (f) is 0,
641 the frame is being created and its X-window does not exist yet.
642 In that case, just record the parameter's new value
643 in the standard place; do not attempt to change the window. */
646 x_set_foreground_color (f
, arg
, oldval
)
648 Lisp_Object arg
, oldval
;
650 f
->display
.x
->foreground_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
651 if (FRAME_X_WINDOW (f
) != 0)
655 XSetForeground (x_current_display
, f
->display
.x
->normal_gc
,
656 f
->display
.x
->foreground_pixel
);
657 XSetBackground (x_current_display
, f
->display
.x
->reverse_gc
,
658 f
->display
.x
->foreground_pixel
);
660 #endif /* HAVE_X11 */
661 recompute_basic_faces (f
);
662 if (FRAME_VISIBLE_P (f
))
668 x_set_background_color (f
, arg
, oldval
)
670 Lisp_Object arg
, oldval
;
675 f
->display
.x
->background_pixel
= x_decode_color (arg
, WHITE_PIX_DEFAULT
);
677 if (FRAME_X_WINDOW (f
) != 0)
681 /* The main frame area. */
682 XSetBackground (x_current_display
, f
->display
.x
->normal_gc
,
683 f
->display
.x
->background_pixel
);
684 XSetForeground (x_current_display
, f
->display
.x
->reverse_gc
,
685 f
->display
.x
->background_pixel
);
686 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
687 f
->display
.x
->background_pixel
);
688 XSetWindowBackground (x_current_display
, FRAME_X_WINDOW (f
),
689 f
->display
.x
->background_pixel
);
692 temp
= XMakeTile (f
->display
.x
->background_pixel
);
693 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
695 #endif /* not HAVE_X11 */
698 recompute_basic_faces (f
);
700 if (FRAME_VISIBLE_P (f
))
706 x_set_mouse_color (f
, arg
, oldval
)
708 Lisp_Object arg
, oldval
;
710 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
714 f
->display
.x
->mouse_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
715 mask_color
= f
->display
.x
->background_pixel
;
716 /* No invisible pointers. */
717 if (mask_color
== f
->display
.x
->mouse_pixel
718 && mask_color
== f
->display
.x
->background_pixel
)
719 f
->display
.x
->mouse_pixel
= f
->display
.x
->foreground_pixel
;
724 /* It's not okay to crash if the user selects a screwy cursor. */
727 if (!EQ (Qnil
, Vx_pointer_shape
))
729 CHECK_NUMBER (Vx_pointer_shape
, 0);
730 cursor
= XCreateFontCursor (x_current_display
, XINT (Vx_pointer_shape
));
733 cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
734 x_check_errors ("bad text pointer cursor: %s");
736 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
738 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
739 nontext_cursor
= XCreateFontCursor (x_current_display
,
740 XINT (Vx_nontext_pointer_shape
));
743 nontext_cursor
= XCreateFontCursor (x_current_display
, XC_left_ptr
);
744 x_check_errors ("bad nontext pointer cursor: %s");
746 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
748 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
749 mode_cursor
= XCreateFontCursor (x_current_display
,
750 XINT (Vx_mode_pointer_shape
));
753 mode_cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
754 x_check_errors ("bad modeline pointer cursor: %s");
756 if (!EQ (Qnil
, Vx_cross_pointer_shape
))
758 CHECK_NUMBER (Vx_cross_pointer_shape
, 0);
759 cross_cursor
= XCreateFontCursor (x_current_display
,
760 XINT (Vx_cross_pointer_shape
));
763 cross_cursor
= XCreateFontCursor (x_current_display
, XC_crosshair
);
765 /* Check and report errors with the above calls. */
766 x_check_errors ("can't set cursor shape: %s");
770 XColor fore_color
, back_color
;
772 fore_color
.pixel
= f
->display
.x
->mouse_pixel
;
773 back_color
.pixel
= mask_color
;
774 XQueryColor (x_current_display
,
775 DefaultColormap (x_current_display
,
776 DefaultScreen (x_current_display
)),
778 XQueryColor (x_current_display
,
779 DefaultColormap (x_current_display
,
780 DefaultScreen (x_current_display
)),
782 XRecolorCursor (x_current_display
, cursor
,
783 &fore_color
, &back_color
);
784 XRecolorCursor (x_current_display
, nontext_cursor
,
785 &fore_color
, &back_color
);
786 XRecolorCursor (x_current_display
, mode_cursor
,
787 &fore_color
, &back_color
);
788 XRecolorCursor (x_current_display
, cross_cursor
,
789 &fore_color
, &back_color
);
792 cursor
= XCreateCursor (16, 16, MouseCursor
, MouseMask
,
794 f
->display
.x
->mouse_pixel
,
795 f
->display
.x
->background_pixel
,
799 if (FRAME_X_WINDOW (f
) != 0)
801 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
), cursor
);
804 if (cursor
!= f
->display
.x
->text_cursor
&& f
->display
.x
->text_cursor
!= 0)
805 XFreeCursor (XDISPLAY f
->display
.x
->text_cursor
);
806 f
->display
.x
->text_cursor
= cursor
;
808 if (nontext_cursor
!= f
->display
.x
->nontext_cursor
809 && f
->display
.x
->nontext_cursor
!= 0)
810 XFreeCursor (XDISPLAY f
->display
.x
->nontext_cursor
);
811 f
->display
.x
->nontext_cursor
= nontext_cursor
;
813 if (mode_cursor
!= f
->display
.x
->modeline_cursor
814 && f
->display
.x
->modeline_cursor
!= 0)
815 XFreeCursor (XDISPLAY f
->display
.x
->modeline_cursor
);
816 f
->display
.x
->modeline_cursor
= mode_cursor
;
817 if (cross_cursor
!= f
->display
.x
->cross_cursor
818 && f
->display
.x
->cross_cursor
!= 0)
819 XFreeCursor (XDISPLAY f
->display
.x
->cross_cursor
);
820 f
->display
.x
->cross_cursor
= cross_cursor
;
821 #endif /* HAVE_X11 */
828 x_set_cursor_color (f
, arg
, oldval
)
830 Lisp_Object arg
, oldval
;
832 unsigned long fore_pixel
;
834 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
835 fore_pixel
= x_decode_color (Vx_cursor_fore_pixel
, WHITE_PIX_DEFAULT
);
837 fore_pixel
= f
->display
.x
->background_pixel
;
838 f
->display
.x
->cursor_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
840 /* Make sure that the cursor color differs from the background color. */
841 if (f
->display
.x
->cursor_pixel
== f
->display
.x
->background_pixel
)
843 f
->display
.x
->cursor_pixel
== f
->display
.x
->mouse_pixel
;
844 if (f
->display
.x
->cursor_pixel
== fore_pixel
)
845 fore_pixel
= f
->display
.x
->background_pixel
;
847 f
->display
.x
->cursor_foreground_pixel
= fore_pixel
;
849 if (FRAME_X_WINDOW (f
) != 0)
853 XSetBackground (x_current_display
, f
->display
.x
->cursor_gc
,
854 f
->display
.x
->cursor_pixel
);
855 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
858 #endif /* HAVE_X11 */
860 if (FRAME_VISIBLE_P (f
))
862 x_display_cursor (f
, 0);
863 x_display_cursor (f
, 1);
868 /* Set the border-color of frame F to value described by ARG.
869 ARG can be a string naming a color.
870 The border-color is used for the border that is drawn by the X server.
871 Note that this does not fully take effect if done before
872 F has an x-window; it must be redone when the window is created.
874 Note: this is done in two routines because of the way X10 works.
876 Note: under X11, this is normally the province of the window manager,
877 and so emacs' border colors may be overridden. */
880 x_set_border_color (f
, arg
, oldval
)
882 Lisp_Object arg
, oldval
;
887 CHECK_STRING (arg
, 0);
888 str
= XSTRING (arg
)->data
;
891 if (!strcmp (str
, "grey") || !strcmp (str
, "Grey")
892 || !strcmp (str
, "gray") || !strcmp (str
, "Gray"))
897 pix
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
899 x_set_border_pixel (f
, pix
);
902 /* Set the border-color of frame F to pixel value PIX.
903 Note that this does not fully take effect if done before
904 F has an x-window. */
906 x_set_border_pixel (f
, pix
)
910 f
->display
.x
->border_pixel
= pix
;
912 if (FRAME_X_WINDOW (f
) != 0 && f
->display
.x
->border_width
> 0)
919 XSetWindowBorder (x_current_display
, FRAME_X_WINDOW (f
),
923 temp
= XMakePixmap ((Bitmap
) XStoreBitmap (gray_width
, gray_height
,
925 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
927 temp
= XMakeTile (pix
);
928 XChangeBorder (FRAME_X_WINDOW (f
), temp
);
929 XFreePixmap (XDISPLAY temp
);
930 #endif /* not HAVE_X11 */
933 if (FRAME_VISIBLE_P (f
))
939 x_set_cursor_type (f
, arg
, oldval
)
941 Lisp_Object arg
, oldval
;
944 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
949 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
950 /* Error messages commented out because people have trouble fixing
951 .Xdefaults with Emacs, when it has something bad in it. */
955 ("the `cursor-type' frame parameter should be either `bar' or `box'");
958 /* Make sure the cursor gets redrawn. This is overkill, but how
959 often do people change cursor types? */
964 x_set_icon_type (f
, arg
, oldval
)
966 Lisp_Object arg
, oldval
;
971 if (EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
976 result
= x_text_icon (f
, 0);
978 result
= x_bitmap_icon (f
);
983 error ("No icon window available.");
986 /* If the window was unmapped (and its icon was mapped),
987 the new icon is not mapped, so map the window in its stead. */
988 if (FRAME_VISIBLE_P (f
))
990 XtPopup (f
->display
.x
->widget
, XtGrabNone
);
992 XMapWindow (XDISPLAY
FRAME_X_WINDOW (f
));
998 extern Lisp_Object
x_new_font ();
1001 x_set_font (f
, arg
, oldval
)
1003 Lisp_Object arg
, oldval
;
1007 CHECK_STRING (arg
, 1);
1010 result
= x_new_font (f
, XSTRING (arg
)->data
);
1013 if (EQ (result
, Qnil
))
1014 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
1015 else if (EQ (result
, Qt
))
1016 error ("the characters of the given font have varying widths");
1017 else if (STRINGP (result
))
1019 recompute_basic_faces (f
);
1020 store_frame_param (f
, Qfont
, result
);
1027 x_set_border_width (f
, arg
, oldval
)
1029 Lisp_Object arg
, oldval
;
1031 CHECK_NUMBER (arg
, 0);
1033 if (XINT (arg
) == f
->display
.x
->border_width
)
1036 if (FRAME_X_WINDOW (f
) != 0)
1037 error ("Cannot change the border width of a window");
1039 f
->display
.x
->border_width
= XINT (arg
);
1043 x_set_internal_border_width (f
, arg
, oldval
)
1045 Lisp_Object arg
, oldval
;
1048 int old
= f
->display
.x
->internal_border_width
;
1050 CHECK_NUMBER (arg
, 0);
1051 f
->display
.x
->internal_border_width
= XINT (arg
);
1052 if (f
->display
.x
->internal_border_width
< 0)
1053 f
->display
.x
->internal_border_width
= 0;
1055 if (f
->display
.x
->internal_border_width
== old
)
1058 if (FRAME_X_WINDOW (f
) != 0)
1061 x_set_window_size (f
, 0, f
->width
, f
->height
);
1063 x_set_resize_hint (f
);
1067 SET_FRAME_GARBAGED (f
);
1072 x_set_visibility (f
, value
, oldval
)
1074 Lisp_Object value
, oldval
;
1077 XSET (frame
, Lisp_Frame
, f
);
1080 Fmake_frame_invisible (frame
, Qt
);
1081 else if (EQ (value
, Qicon
))
1082 Ficonify_frame (frame
);
1084 Fmake_frame_visible (frame
);
1088 x_set_menu_bar_lines_1 (window
, n
)
1092 struct window
*w
= XWINDOW (window
);
1094 XFASTINT (w
->top
) += n
;
1095 XFASTINT (w
->height
) -= n
;
1097 /* Handle just the top child in a vertical split. */
1098 if (!NILP (w
->vchild
))
1099 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1101 /* Adjust all children in a horizontal split. */
1102 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1104 w
= XWINDOW (window
);
1105 x_set_menu_bar_lines_1 (window
, n
);
1110 x_set_menu_bar_lines (f
, value
, oldval
)
1112 Lisp_Object value
, oldval
;
1115 int olines
= FRAME_MENU_BAR_LINES (f
);
1117 /* Right now, menu bars don't work properly in minibuf-only frames;
1118 most of the commands try to apply themselves to the minibuffer
1119 frame itslef, and get an error because you can't switch buffers
1120 in or split the minibuffer window. */
1121 if (FRAME_MINIBUF_ONLY_P (f
))
1124 if (XTYPE (value
) == Lisp_Int
)
1125 nlines
= XINT (value
);
1129 #ifdef USE_X_TOOLKIT
1130 FRAME_MENU_BAR_LINES (f
) = 0;
1132 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1135 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1136 free_frame_menubar (f
);
1137 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1138 f
->display
.x
->menubar_widget
= 0;
1140 #else /* not USE_X_TOOLKIT */
1141 FRAME_MENU_BAR_LINES (f
) = nlines
;
1142 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1143 #endif /* not USE_X_TOOLKIT */
1146 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1149 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1150 name; if NAME is a string, set F's name to NAME and set
1151 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1153 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1154 suggesting a new name, which lisp code should override; if
1155 F->explicit_name is set, ignore the new name; otherwise, set it. */
1158 x_set_name (f
, name
, explicit)
1163 /* Make sure that requests from lisp code override requests from
1164 Emacs redisplay code. */
1167 /* If we're switching from explicit to implicit, we had better
1168 update the mode lines and thereby update the title. */
1169 if (f
->explicit_name
&& NILP (name
))
1170 update_mode_lines
= 1;
1172 f
->explicit_name
= ! NILP (name
);
1174 else if (f
->explicit_name
)
1177 /* If NAME is nil, set the name to the x_id_name. */
1179 name
= build_string (x_id_name
);
1181 CHECK_STRING (name
, 0);
1183 /* Don't change the name if it's already NAME. */
1184 if (! NILP (Fstring_equal (name
, f
->name
)))
1187 if (FRAME_X_WINDOW (f
))
1193 text
.value
= XSTRING (name
)->data
;
1194 text
.encoding
= XA_STRING
;
1196 text
.nitems
= XSTRING (name
)->size
;
1197 #ifdef USE_X_TOOLKIT
1198 XSetWMName (x_current_display
, XtWindow (f
->display
.x
->widget
), &text
);
1199 XSetWMIconName (x_current_display
, XtWindow (f
->display
.x
->widget
),
1201 #else /* not USE_X_TOOLKIT */
1202 XSetWMName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1203 XSetWMIconName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1204 #endif /* not USE_X_TOOLKIT */
1206 #else /* not HAVE_X11R4 */
1207 XSetIconName (XDISPLAY
FRAME_X_WINDOW (f
),
1208 XSTRING (name
)->data
);
1209 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
),
1210 XSTRING (name
)->data
);
1211 #endif /* not HAVE_X11R4 */
1218 /* This function should be called when the user's lisp code has
1219 specified a name for the frame; the name will override any set by the
1222 x_explicitly_set_name (f
, arg
, oldval
)
1224 Lisp_Object arg
, oldval
;
1226 x_set_name (f
, arg
, 1);
1229 /* This function should be called by Emacs redisplay code to set the
1230 name; names set this way will never override names set by the user's
1233 x_implicitly_set_name (f
, arg
, oldval
)
1235 Lisp_Object arg
, oldval
;
1237 x_set_name (f
, arg
, 0);
1241 x_set_autoraise (f
, arg
, oldval
)
1243 Lisp_Object arg
, oldval
;
1245 f
->auto_raise
= !EQ (Qnil
, arg
);
1249 x_set_autolower (f
, arg
, oldval
)
1251 Lisp_Object arg
, oldval
;
1253 f
->auto_lower
= !EQ (Qnil
, arg
);
1257 x_set_vertical_scroll_bars (f
, arg
, oldval
)
1259 Lisp_Object arg
, oldval
;
1261 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
1263 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
1265 /* We set this parameter before creating the X window for the
1266 frame, so we can get the geometry right from the start.
1267 However, if the window hasn't been created yet, we shouldn't
1268 call x_set_window_size. */
1269 if (FRAME_X_WINDOW (f
))
1270 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1274 /* Subroutines of creating an X frame. */
1278 /* Make sure that Vx_resource_name is set to a reasonable value. */
1280 validate_x_resource_name ()
1282 if (! STRINGP (Vx_resource_name
))
1283 Vx_resource_name
= make_string ("emacs", 5);
1287 extern char *x_get_string_resource ();
1288 extern XrmDatabase
x_load_resources ();
1290 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
1291 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1292 This uses `NAME.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1293 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1294 the name specified by the `-name' or `-rn' command-line arguments.\n\
1296 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1297 class, respectively. You must specify both of them or neither.\n\
1298 If you specify them, the key is `NAME.COMPONENT.ATTRIBUTE'\n\
1299 and the class is `Emacs.CLASS.SUBCLASS'.")
1300 (attribute
, class, component
, subclass
)
1301 Lisp_Object attribute
, class, component
, subclass
;
1303 register char *value
;
1306 Lisp_Object resname
;
1310 CHECK_STRING (attribute
, 0);
1311 CHECK_STRING (class, 0);
1313 if (!NILP (component
))
1314 CHECK_STRING (component
, 1);
1315 if (!NILP (subclass
))
1316 CHECK_STRING (subclass
, 2);
1317 if (NILP (component
) != NILP (subclass
))
1318 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1320 validate_x_resource_name ();
1321 resname
= Vx_resource_name
;
1323 if (NILP (component
))
1325 /* Allocate space for the components, the dots which separate them,
1326 and the final '\0'. */
1327 name_key
= (char *) alloca (XSTRING (resname
)->size
1328 + XSTRING (attribute
)->size
1330 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1331 + XSTRING (class)->size
1334 sprintf (name_key
, "%s.%s",
1335 XSTRING (resname
)->data
,
1336 XSTRING (attribute
)->data
);
1337 sprintf (class_key
, "%s.%s",
1339 XSTRING (class)->data
);
1343 name_key
= (char *) alloca (XSTRING (resname
)->size
1344 + XSTRING (component
)->size
1345 + XSTRING (attribute
)->size
1348 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1349 + XSTRING (class)->size
1350 + XSTRING (subclass
)->size
1353 sprintf (name_key
, "%s.%s.%s",
1354 XSTRING (resname
)->data
,
1355 XSTRING (component
)->data
,
1356 XSTRING (attribute
)->data
);
1357 sprintf (class_key
, "%s.%s.%s",
1359 XSTRING (class)->data
,
1360 XSTRING (subclass
)->data
);
1363 value
= x_get_string_resource (xrdb
, name_key
, class_key
);
1365 if (value
!= (char *) 0)
1366 return build_string (value
);
1371 /* Used when C code wants a resource value. */
1374 x_get_resource_string (attribute
, class)
1375 char *attribute
, *class;
1377 register char *value
;
1381 /* Allocate space for the components, the dots which separate them,
1382 and the final '\0'. */
1383 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
1384 + strlen (attribute
) + 2);
1385 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1386 + strlen (class) + 2);
1388 sprintf (name_key
, "%s.%s",
1389 XSTRING (Vinvocation_name
)->data
,
1391 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
1393 return x_get_string_resource (xrdb
, name_key
, class_key
);
1398 DEFUN ("x-get-default", Fx_get_default
, Sx_get_default
, 1, 1, 0,
1399 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1400 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1401 The defaults are specified in the file `~/.Xdefaults'.")
1405 register unsigned char *value
;
1407 CHECK_STRING (arg
, 1);
1409 value
= (unsigned char *) XGetDefault (XDISPLAY
1410 XSTRING (Vinvocation_name
)->data
,
1411 XSTRING (arg
)->data
);
1413 /* Try reversing last two args, in case this is the buggy version of X. */
1414 value
= (unsigned char *) XGetDefault (XDISPLAY
1415 XSTRING (arg
)->data
,
1416 XSTRING (Vinvocation_name
)->data
);
1418 return build_string (value
);
1423 #define Fx_get_resource(attribute, class, component, subclass) \
1424 Fx_get_default (attribute)
1428 /* Types we might convert a resource string into. */
1431 number
, boolean
, string
, symbol
1434 /* Return the value of parameter PARAM.
1436 First search ALIST, then Vdefault_frame_alist, then the X defaults
1437 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1439 Convert the resource to the type specified by desired_type.
1441 If no default is specified, return Qunbound. If you call
1442 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1443 and don't let it get stored in any lisp-visible variables! */
1446 x_get_arg (alist
, param
, attribute
, class, type
)
1447 Lisp_Object alist
, param
;
1450 enum resource_types type
;
1452 register Lisp_Object tem
;
1454 tem
= Fassq (param
, alist
);
1456 tem
= Fassq (param
, Vdefault_frame_alist
);
1462 tem
= Fx_get_resource (build_string (attribute
),
1463 build_string (class),
1472 return make_number (atoi (XSTRING (tem
)->data
));
1475 tem
= Fdowncase (tem
);
1476 if (!strcmp (XSTRING (tem
)->data
, "on")
1477 || !strcmp (XSTRING (tem
)->data
, "true"))
1486 /* As a special case, we map the values `true' and `on'
1487 to Qt, and `false' and `off' to Qnil. */
1490 lower
= Fdowncase (tem
);
1491 if (!strcmp (XSTRING (lower
)->data
, "on")
1492 || !strcmp (XSTRING (lower
)->data
, "true"))
1494 else if (!strcmp (XSTRING (lower
)->data
, "off")
1495 || !strcmp (XSTRING (lower
)->data
, "false"))
1498 return Fintern (tem
, Qnil
);
1511 /* Record in frame F the specified or default value according to ALIST
1512 of the parameter named PARAM (a Lisp symbol).
1513 If no value is specified for PARAM, look for an X default for XPROP
1514 on the frame named NAME.
1515 If that is not found either, use the value DEFLT. */
1518 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
1525 enum resource_types type
;
1529 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
1530 if (EQ (tem
, Qunbound
))
1532 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
1536 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
1537 "Parse an X-style geometry string STRING.\n\
1538 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1543 unsigned int width
, height
;
1544 Lisp_Object values
[4];
1546 CHECK_STRING (string
, 0);
1548 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
1549 &x
, &y
, &width
, &height
);
1551 switch (geometry
& 0xf) /* Mask out {X,Y}Negative */
1553 case (XValue
| YValue
):
1554 /* What's one pixel among friends?
1555 Perhaps fix this some day by returning symbol `extreme-top'... */
1556 if (x
== 0 && (geometry
& XNegative
))
1558 if (y
== 0 && (geometry
& YNegative
))
1560 values
[0] = Fcons (Qleft
, make_number (x
));
1561 values
[1] = Fcons (Qtop
, make_number (y
));
1562 return Flist (2, values
);
1565 case (WidthValue
| HeightValue
):
1566 values
[0] = Fcons (Qwidth
, make_number (width
));
1567 values
[1] = Fcons (Qheight
, make_number (height
));
1568 return Flist (2, values
);
1571 case (XValue
| YValue
| WidthValue
| HeightValue
):
1572 if (x
== 0 && (geometry
& XNegative
))
1574 if (y
== 0 && (geometry
& YNegative
))
1576 values
[0] = Fcons (Qwidth
, make_number (width
));
1577 values
[1] = Fcons (Qheight
, make_number (height
));
1578 values
[2] = Fcons (Qleft
, make_number (x
));
1579 values
[3] = Fcons (Qtop
, make_number (y
));
1580 return Flist (4, values
);
1587 error ("Must specify x and y value, and/or width and height");
1592 /* Calculate the desired size and position of this window,
1593 and return the attributes saying which aspects were specified.
1595 This function does not make the coordinates positive. */
1597 #define DEFAULT_ROWS 40
1598 #define DEFAULT_COLS 80
1601 x_figure_window_size (f
, parms
)
1605 register Lisp_Object tem0
, tem1
;
1606 int height
, width
, left
, top
;
1607 register int geometry
;
1608 long window_prompting
= 0;
1610 /* Default values if we fall through.
1611 Actually, if that happens we should get
1612 window manager prompting. */
1613 f
->width
= DEFAULT_COLS
;
1614 f
->height
= DEFAULT_ROWS
;
1615 /* Window managers expect that if program-specified
1616 positions are not (0,0), they're intentional, not defaults. */
1617 f
->display
.x
->top_pos
= 0;
1618 f
->display
.x
->left_pos
= 0;
1620 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
1621 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
1622 if (! EQ (tem0
, Qunbound
) && ! EQ (tem1
, Qunbound
))
1624 CHECK_NUMBER (tem0
, 0);
1625 CHECK_NUMBER (tem1
, 0);
1626 f
->height
= XINT (tem0
);
1627 f
->width
= XINT (tem1
);
1628 window_prompting
|= USSize
;
1630 else if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1631 error ("Must specify *both* height and width");
1633 f
->display
.x
->vertical_scroll_bar_extra
1634 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1635 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f
)
1637 f
->display
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
1638 f
->display
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
1640 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1641 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1642 if (! EQ (tem0
, Qunbound
) && ! EQ (tem1
, Qunbound
))
1644 CHECK_NUMBER (tem0
, 0);
1645 CHECK_NUMBER (tem1
, 0);
1646 f
->display
.x
->top_pos
= XINT (tem0
);
1647 f
->display
.x
->left_pos
= XINT (tem1
);
1648 if (f
->display
.x
->top_pos
< 0)
1649 window_prompting
|= YNegative
;
1650 if (f
->display
.x
->left_pos
< 0)
1651 window_prompting
|= XNegative
;
1652 window_prompting
|= USPosition
;
1654 else if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1655 error ("Must specify *both* top and left corners");
1657 #if 0 /* PPosition and PSize mean "specified explicitly,
1658 by the program rather than by the user". So it is wrong to
1659 set them if nothing was specified. */
1660 switch (window_prompting
)
1662 case USSize
| USPosition
:
1663 return window_prompting
;
1666 case USSize
: /* Got the size, need the position. */
1667 window_prompting
|= PPosition
;
1668 return window_prompting
;
1671 case USPosition
: /* Got the position, need the size. */
1672 window_prompting
|= PSize
;
1673 return window_prompting
;
1676 case 0: /* Got nothing, take both from geometry. */
1677 window_prompting
|= PPosition
| PSize
;
1678 return window_prompting
;
1682 /* Somehow a bit got set in window_prompting that we didn't
1687 return window_prompting
;
1690 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
1693 XSetWMProtocols (dpy
, w
, protocols
, count
)
1700 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
1701 if (prop
== None
) return False
;
1702 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
1703 (unsigned char *) protocols
, count
);
1706 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
1708 #ifdef USE_X_TOOLKIT
1710 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS
1711 and WM_DELETE_WINDOW, then add them. (They may already be present
1712 because of the toolkit (Motif adds them, for example, but Xt doesn't). */
1715 hack_wm_protocols (widget
)
1718 Display
*dpy
= XtDisplay (widget
);
1719 Window w
= XtWindow (widget
);
1720 int need_delete
= 1;
1725 Atom type
, *atoms
= 0;
1727 unsigned long nitems
= 0;
1728 unsigned long bytes_after
;
1730 if (Success
== XGetWindowProperty (dpy
, w
, Xatom_wm_protocols
,
1731 0, 100, False
, XA_ATOM
,
1732 &type
, &format
, &nitems
, &bytes_after
,
1733 (unsigned char **) &atoms
)
1734 && format
== 32 && type
== XA_ATOM
)
1738 if (atoms
[nitems
] == Xatom_wm_delete_window
) need_delete
= 0;
1739 else if (atoms
[nitems
] == Xatom_wm_take_focus
) need_focus
= 0;
1741 if (atoms
) XFree ((char *) atoms
);
1746 if (need_delete
) props
[count
++] = Xatom_wm_delete_window
;
1747 if (need_focus
) props
[count
++] = Xatom_wm_take_focus
;
1749 XChangeProperty (dpy
, w
, Xatom_wm_protocols
, XA_ATOM
, 32, PropModeAppend
,
1750 (unsigned char *) props
, count
);
1756 #ifdef USE_X_TOOLKIT
1758 /* Create and set up the X widget for frame F. */
1761 x_window (f
, window_prompting
, minibuffer_only
)
1763 long window_prompting
;
1764 int minibuffer_only
;
1766 XClassHint class_hints
;
1767 XSetWindowAttributes attributes
;
1768 unsigned long attribute_mask
;
1770 Widget shell_widget
;
1772 Widget screen_widget
;
1779 if (STRINGP (f
->name
))
1780 name
= (char*) XSTRING (f
->name
)->data
;
1785 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
1786 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
1787 shell_widget
= XtCreatePopupShell ("shell",
1788 topLevelShellWidgetClass
,
1789 Xt_app_shell
, al
, ac
);
1791 f
->display
.x
->widget
= shell_widget
;
1792 /* maybe_set_screen_title_format (shell_widget); */
1796 XtSetArg (al
[ac
], XtNborderWidth
, 0); ac
++;
1797 pane_widget
= XtCreateWidget ("pane",
1799 shell_widget
, al
, ac
);
1801 f
->display
.x
->column_widget
= pane_widget
;
1803 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
1804 initialize_frame_menubar (f
);
1806 /* mappedWhenManaged to false tells to the paned window to not map/unmap
1807 the emacs screen when changing menubar. This reduces flickering. */
1810 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
1811 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
1812 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
1813 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
1814 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
1815 screen_widget
= XtCreateWidget (name
,
1817 pane_widget
, al
, ac
);
1819 f
->display
.x
->edit_widget
= screen_widget
;
1821 if (f
->display
.x
->menubar_widget
)
1822 XtManageChild (f
->display
.x
->menubar_widget
);
1823 XtManageChild (screen_widget
);
1825 /* Do some needed geometry management. */
1828 char *tem
, shell_position
[32];
1832 = (f
->display
.x
->menubar_widget
1833 ? (f
->display
.x
->menubar_widget
->core
.height
1834 + f
->display
.x
->menubar_widget
->core
.border_width
)
1837 if (window_prompting
& USPosition
)
1839 int left
= f
->display
.x
->left_pos
;
1840 int xneg
= left
< 0;
1841 int top
= f
->display
.x
->top_pos
;
1847 sprintf (shell_position
, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f
),
1848 PIXEL_HEIGHT (f
) + menubar_size
,
1849 (xneg
? '-' : '+'), left
,
1850 (yneg
? '-' : '+'), top
);
1853 sprintf (shell_position
, "=%dx%d", PIXEL_WIDTH (f
),
1854 PIXEL_HEIGHT (f
) + menubar_size
);
1855 len
= strlen (shell_position
) + 1;
1856 tem
= (char *) xmalloc (len
);
1857 strncpy (tem
, shell_position
, len
);
1858 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
1859 XtSetValues (shell_widget
, al
, ac
);
1862 x_calc_absolute_position (f
);
1864 XtManageChild (pane_widget
);
1865 XtRealizeWidget (shell_widget
);
1867 FRAME_X_WINDOW (f
) = XtWindow (screen_widget
);
1869 validate_x_resource_name ();
1870 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
1871 class_hints
.res_class
= EMACS_CLASS
;
1872 XSetClassHint (x_current_display
, XtWindow (shell_widget
), &class_hints
);
1874 f
->display
.x
->wm_hints
.input
= True
;
1875 f
->display
.x
->wm_hints
.flags
|= InputHint
;
1876 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
1878 hack_wm_protocols (shell_widget
);
1880 /* Do a stupid property change to force the server to generate a
1881 propertyNotify event so that the event_stream server timestamp will
1882 be initialized to something relevant to the time we created the window.
1884 XChangeProperty (XtDisplay (screen_widget
), XtWindow (screen_widget
),
1885 Xatom_wm_protocols
, XA_ATOM
, 32, PropModeAppend
,
1886 (unsigned char*) NULL
, 0);
1888 /* Make all the standard events reach the Emacs frame. */
1889 attributes
.event_mask
= STANDARD_EVENT_SET
;
1890 attribute_mask
= CWEventMask
;
1891 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
1892 attribute_mask
, &attributes
);
1894 XtMapWidget (screen_widget
);
1896 /* x_set_name normally ignores requests to set the name if the
1897 requested name is the same as the current name. This is the one
1898 place where that assumption isn't correct; f->name is set, but
1899 the X server hasn't been told. */
1902 int explicit = f
->explicit_name
;
1904 f
->explicit_name
= 0;
1907 x_set_name (f
, name
, explicit);
1910 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
1911 f
->display
.x
->text_cursor
);
1915 if (FRAME_X_WINDOW (f
) == 0)
1916 error ("Unable to create window");
1919 #else /* not USE_X_TOOLKIT */
1921 /* Create and set up the X window for frame F. */
1927 XClassHint class_hints
;
1928 XSetWindowAttributes attributes
;
1929 unsigned long attribute_mask
;
1931 attributes
.background_pixel
= f
->display
.x
->background_pixel
;
1932 attributes
.border_pixel
= f
->display
.x
->border_pixel
;
1933 attributes
.bit_gravity
= StaticGravity
;
1934 attributes
.backing_store
= NotUseful
;
1935 attributes
.save_under
= True
;
1936 attributes
.event_mask
= STANDARD_EVENT_SET
;
1937 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
1939 | CWBackingStore
| CWSaveUnder
1945 = XCreateWindow (x_current_display
, ROOT_WINDOW
,
1946 f
->display
.x
->left_pos
,
1947 f
->display
.x
->top_pos
,
1948 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
1949 f
->display
.x
->border_width
,
1950 CopyFromParent
, /* depth */
1951 InputOutput
, /* class */
1952 screen_visual
, /* set in Fx_open_connection */
1953 attribute_mask
, &attributes
);
1955 validate_x_resource_name ();
1956 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
1957 class_hints
.res_class
= EMACS_CLASS
;
1958 XSetClassHint (x_current_display
, FRAME_X_WINDOW (f
), &class_hints
);
1960 /* This indicates that we use the "Passive Input" input model.
1961 Unless we do this, we don't get the Focus{In,Out} events that we
1962 need to draw the cursor correctly. Accursed bureaucrats.
1963 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1965 f
->display
.x
->wm_hints
.input
= True
;
1966 f
->display
.x
->wm_hints
.flags
|= InputHint
;
1967 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
1968 XSetWMProtocols (x_current_display
, FRAME_X_WINDOW (f
),
1969 &Xatom_wm_delete_window
, 1);
1972 /* x_set_name normally ignores requests to set the name if the
1973 requested name is the same as the current name. This is the one
1974 place where that assumption isn't correct; f->name is set, but
1975 the X server hasn't been told. */
1978 int explicit = f
->explicit_name
;
1980 f
->explicit_name
= 0;
1983 x_set_name (f
, name
, explicit);
1986 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
1987 f
->display
.x
->text_cursor
);
1991 if (FRAME_X_WINDOW (f
) == 0)
1992 error ("Unable to create window");
1995 #endif /* not USE_X_TOOLKIT */
1997 /* Handle the icon stuff for this window. Perhaps later we might
1998 want an x_set_icon_position which can be called interactively as
2006 Lisp_Object icon_x
, icon_y
;
2008 /* Set the position of the icon. Note that twm groups all
2009 icons in an icon window. */
2010 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
2011 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
2012 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
2014 CHECK_NUMBER (icon_x
, 0);
2015 CHECK_NUMBER (icon_y
, 0);
2017 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
2018 error ("Both left and top icon corners of icon must be specified");
2022 if (! EQ (icon_x
, Qunbound
))
2023 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
2025 /* Start up iconic or window? */
2026 x_wm_set_window_state
2027 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
2034 /* Make the GC's needed for this window, setting the
2035 background, border and mouse colors; also create the
2036 mouse cursor and the gray border tile. */
2038 static char cursor_bits
[] =
2040 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2041 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2042 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2043 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2050 XGCValues gc_values
;
2056 /* Create the GC's of this frame.
2057 Note that many default values are used. */
2060 gc_values
.font
= f
->display
.x
->font
->fid
;
2061 gc_values
.foreground
= f
->display
.x
->foreground_pixel
;
2062 gc_values
.background
= f
->display
.x
->background_pixel
;
2063 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
2064 f
->display
.x
->normal_gc
= XCreateGC (x_current_display
,
2066 GCLineWidth
| GCFont
2067 | GCForeground
| GCBackground
,
2070 /* Reverse video style. */
2071 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2072 gc_values
.background
= f
->display
.x
->foreground_pixel
;
2073 f
->display
.x
->reverse_gc
= XCreateGC (x_current_display
,
2075 GCFont
| GCForeground
| GCBackground
2079 /* Cursor has cursor-color background, background-color foreground. */
2080 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2081 gc_values
.background
= f
->display
.x
->cursor_pixel
;
2082 gc_values
.fill_style
= FillOpaqueStippled
;
2084 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
2085 cursor_bits
, 16, 16);
2086 f
->display
.x
->cursor_gc
2087 = XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
2088 (GCFont
| GCForeground
| GCBackground
2089 | GCFillStyle
| GCStipple
| GCLineWidth
),
2092 /* Create the gray border tile used when the pointer is not in
2093 the frame. Since this depends on the frame's pixel values,
2094 this must be done on a per-frame basis. */
2095 f
->display
.x
->border_tile
2096 = (XCreatePixmapFromBitmapData
2097 (x_current_display
, ROOT_WINDOW
,
2098 gray_bits
, gray_width
, gray_height
,
2099 f
->display
.x
->foreground_pixel
,
2100 f
->display
.x
->background_pixel
,
2101 DefaultDepth (x_current_display
, XDefaultScreen (x_current_display
))));
2105 #endif /* HAVE_X11 */
2107 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
2109 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2110 Return an Emacs frame object representing the X window.\n\
2111 ALIST is an alist of frame parameters.\n\
2112 If the parameters specify that the frame should not have a minibuffer,\n\
2113 and do not specify a specific minibuffer window to use,\n\
2114 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2115 be shared by the new frame.")
2121 Lisp_Object frame
, tem
;
2123 int minibuffer_only
= 0;
2124 long window_prompting
= 0;
2126 int count
= specpdl_ptr
- specpdl
;
2130 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
2131 if (XTYPE (name
) != Lisp_String
2132 && ! EQ (name
, Qunbound
)
2134 error ("x-create-frame: name parameter must be a string");
2136 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2137 if (EQ (tem
, Qnone
) || NILP (tem
))
2138 f
= make_frame_without_minibuffer (Qnil
);
2139 else if (EQ (tem
, Qonly
))
2141 f
= make_minibuffer_frame ();
2142 minibuffer_only
= 1;
2144 else if (XTYPE (tem
) == Lisp_Window
)
2145 f
= make_frame_without_minibuffer (tem
);
2149 /* Note that X Windows does support scroll bars. */
2150 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
2152 /* Set the name; the functions to which we pass f expect the name to
2154 if (EQ (name
, Qunbound
) || NILP (name
))
2156 f
->name
= build_string (x_id_name
);
2157 f
->explicit_name
= 0;
2162 f
->explicit_name
= 1;
2163 /* use the frame's title when getting resources for this frame. */
2164 specbind (Qx_resource_name
, name
);
2167 XSET (frame
, Lisp_Frame
, f
);
2168 f
->output_method
= output_x_window
;
2169 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2170 bzero (f
->display
.x
, sizeof (struct x_display
));
2172 /* Note that the frame has no physical cursor right now. */
2173 f
->phys_cursor_x
= -1;
2175 /* Extract the window parameters from the supplied values
2176 that are needed to determine window geometry. */
2180 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
2182 /* First, try whatever font the caller has specified. */
2184 font
= x_new_font (f
, XSTRING (font
)->data
);
2185 /* Try out a font which we hope has bold and italic variations. */
2186 if (!STRINGP (font
))
2187 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2188 if (! STRINGP (font
))
2189 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2190 if (! STRINGP (font
))
2191 /* This was formerly the first thing tried, but it finds too many fonts
2192 and takes too long. */
2193 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
2194 /* If those didn't work, look for something which will at least work. */
2195 if (! STRINGP (font
))
2196 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1");
2198 if (! STRINGP (font
))
2199 font
= build_string ("fixed");
2201 x_default_parameter (f
, parms
, Qfont
, font
,
2202 "font", "Font", string
);
2205 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
2206 "borderwidth", "BorderWidth", number
);
2207 /* This defaults to 2 in order to match xterm. We recognize either
2208 internalBorderWidth or internalBorder (which is what xterm calls
2210 if (NILP (Fassq (Qinternal_border_width
, parms
)))
2214 value
= x_get_arg (parms
, Qinternal_border_width
,
2215 "internalBorder", "BorderWidth", number
);
2216 if (! EQ (value
, Qunbound
))
2217 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
2220 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
2221 "internalBorderWidth", "BorderWidth", number
);
2222 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
2223 "verticalScrollBars", "ScrollBars", boolean
);
2225 /* Also do the stuff which must be set before the window exists. */
2226 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
2227 "foreground", "Foreground", string
);
2228 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
2229 "background", "Background", string
);
2230 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
2231 "pointerColor", "Foreground", string
);
2232 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
2233 "cursorColor", "Foreground", string
);
2234 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
2235 "borderColor", "BorderColor", string
);
2237 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (0),
2238 "menuBarLines", "MenuBarLines", number
);
2240 f
->display
.x
->parent_desc
= ROOT_WINDOW
;
2241 window_prompting
= x_figure_window_size (f
, parms
);
2243 switch (((f
->display
.x
->left_pos
< 0) << 1) + (f
->display
.x
->top_pos
< 0))
2246 f
->display
.x
->win_gravity
= NorthWestGravity
;
2249 f
->display
.x
->win_gravity
= SouthWestGravity
;
2252 f
->display
.x
->win_gravity
= NorthEastGravity
;
2255 f
->display
.x
->win_gravity
= SouthEastGravity
;
2259 #ifdef USE_X_TOOLKIT
2260 x_window (f
, window_prompting
, minibuffer_only
);
2266 init_frame_faces (f
);
2268 /* We need to do this after creating the X window, so that the
2269 icon-creation functions can say whose icon they're describing. */
2270 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2271 "bitmapIcon", "BitmapIcon", symbol
);
2273 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
2274 "autoRaise", "AutoRaiseLower", boolean
);
2275 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
2276 "autoLower", "AutoRaiseLower", boolean
);
2277 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
2278 "cursorType", "CursorType", symbol
);
2280 /* Dimensions, especially f->height, must be done via change_frame_size.
2281 Change will not be effected unless different from the current
2285 f
->height
= f
->width
= 0;
2286 change_frame_size (f
, height
, width
, 1, 0);
2288 /* With the toolkit, the geometry management is done in x_window. */
2289 #ifndef USE_X_TOOLKIT
2291 x_wm_set_size_hint (f
, window_prompting
, 0);
2293 #endif /* USE_X_TOOLKIT */
2295 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2296 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2298 /* It is now ok to make the frame official
2299 even if we get an error below.
2300 And the frame needs to be on Vframe_list
2301 or making it visible won't work. */
2302 Vframe_list
= Fcons (frame
, Vframe_list
);
2304 /* Make the window appear on the frame and enable display,
2305 unless the caller says not to. */
2307 Lisp_Object visibility
;
2309 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2310 if (EQ (visibility
, Qunbound
))
2313 if (EQ (visibility
, Qicon
))
2314 x_iconify_frame (f
);
2315 else if (! NILP (visibility
))
2316 x_make_frame_visible (f
);
2318 /* Must have been Qnil. */
2322 return unbind_to (count
, frame
);
2325 Lisp_Object frame
, tem
;
2327 int pixelwidth
, pixelheight
;
2332 int minibuffer_only
= 0;
2333 Lisp_Object vscroll
, hscroll
;
2335 if (x_current_display
== 0)
2336 error ("X windows are not in use or not initialized");
2338 name
= Fassq (Qname
, parms
);
2340 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2341 if (EQ (tem
, Qnone
))
2342 f
= make_frame_without_minibuffer (Qnil
);
2343 else if (EQ (tem
, Qonly
))
2345 f
= make_minibuffer_frame ();
2346 minibuffer_only
= 1;
2348 else if (EQ (tem
, Qnil
) || EQ (tem
, Qunbound
))
2351 f
= make_frame_without_minibuffer (tem
);
2353 parent
= ROOT_WINDOW
;
2355 XSET (frame
, Lisp_Frame
, f
);
2356 f
->output_method
= output_x_window
;
2357 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2358 bzero (f
->display
.x
, sizeof (struct x_display
));
2360 /* Some temporary default values for height and width. */
2363 f
->display
.x
->left_pos
= -1;
2364 f
->display
.x
->top_pos
= -1;
2366 /* Give the frame a default name (which may be overridden with PARMS). */
2368 strncpy (iconidentity
, ICONTAG
, MAXICID
);
2369 if (gethostname (&iconidentity
[sizeof (ICONTAG
) - 1],
2370 (MAXICID
- 1) - sizeof (ICONTAG
)))
2371 iconidentity
[sizeof (ICONTAG
) - 2] = '\0';
2372 f
->name
= build_string (iconidentity
);
2374 /* Extract some window parameters from the supplied values.
2375 These are the parameters that affect window geometry. */
2377 tem
= x_get_arg (parms
, Qfont
, "BodyFont", 0, string
);
2378 if (EQ (tem
, Qunbound
))
2379 tem
= build_string ("9x15");
2380 x_set_font (f
, tem
, Qnil
);
2381 x_default_parameter (f
, parms
, Qborder_color
,
2382 build_string ("black"), "Border", 0, string
);
2383 x_default_parameter (f
, parms
, Qbackground_color
,
2384 build_string ("white"), "Background", 0, string
);
2385 x_default_parameter (f
, parms
, Qforeground_color
,
2386 build_string ("black"), "Foreground", 0, string
);
2387 x_default_parameter (f
, parms
, Qmouse_color
,
2388 build_string ("black"), "Mouse", 0, string
);
2389 x_default_parameter (f
, parms
, Qcursor_color
,
2390 build_string ("black"), "Cursor", 0, string
);
2391 x_default_parameter (f
, parms
, Qborder_width
,
2392 make_number (2), "BorderWidth", 0, number
);
2393 x_default_parameter (f
, parms
, Qinternal_border_width
,
2394 make_number (4), "InternalBorderWidth", 0, number
);
2395 x_default_parameter (f
, parms
, Qauto_raise
,
2396 Qnil
, "AutoRaise", 0, boolean
);
2398 hscroll
= EQ (x_get_arg (parms
, Qhorizontal_scroll_bar
, 0, 0, boolean
), Qt
);
2399 vscroll
= EQ (x_get_arg (parms
, Qvertical_scroll_bar
, 0, 0, boolean
), Qt
);
2401 if (f
->display
.x
->internal_border_width
< 0)
2402 f
->display
.x
->internal_border_width
= 0;
2404 tem
= x_get_arg (parms
, Qwindow_id
, 0, 0, number
);
2405 if (!EQ (tem
, Qunbound
))
2407 WINDOWINFO_TYPE wininfo
;
2409 Window
*children
, root
;
2411 CHECK_NUMBER (tem
, 0);
2412 FRAME_X_WINDOW (f
) = (Window
) XINT (tem
);
2415 XGetWindowInfo (FRAME_X_WINDOW (f
), &wininfo
);
2416 XQueryTree (FRAME_X_WINDOW (f
), &parent
, &nchildren
, &children
);
2420 height
= PIXEL_TO_CHAR_HEIGHT (f
, wininfo
.height
);
2421 width
= PIXEL_TO_CHAR_WIDTH (f
, wininfo
.width
);
2422 f
->display
.x
->left_pos
= wininfo
.x
;
2423 f
->display
.x
->top_pos
= wininfo
.y
;
2424 FRAME_SET_VISIBILITY (f
, wininfo
.mapped
!= 0);
2425 f
->display
.x
->border_width
= wininfo
.bdrwidth
;
2426 f
->display
.x
->parent_desc
= parent
;
2430 tem
= x_get_arg (parms
, Qparent_id
, 0, 0, number
);
2431 if (!EQ (tem
, Qunbound
))
2433 CHECK_NUMBER (tem
, 0);
2434 parent
= (Window
) XINT (tem
);
2436 f
->display
.x
->parent_desc
= parent
;
2437 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2438 if (EQ (tem
, Qunbound
))
2440 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2441 if (EQ (tem
, Qunbound
))
2443 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2444 if (EQ (tem
, Qunbound
))
2445 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2448 /* Now TEM is Qunbound if no edge or size was specified.
2449 In that case, we must do rubber-banding. */
2450 if (EQ (tem
, Qunbound
))
2452 tem
= x_get_arg (parms
, Qgeometry
, 0, 0, number
);
2454 &f
->display
.x
->left_pos
, &f
->display
.x
->top_pos
,
2456 (XTYPE (tem
) == Lisp_String
2457 ? (char *) XSTRING (tem
)->data
: ""),
2458 XSTRING (f
->name
)->data
,
2459 !NILP (hscroll
), !NILP (vscroll
));
2463 /* Here if at least one edge or size was specified.
2464 Demand that they all were specified, and use them. */
2465 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2466 if (EQ (tem
, Qunbound
))
2467 error ("Height not specified");
2468 CHECK_NUMBER (tem
, 0);
2469 height
= XINT (tem
);
2471 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2472 if (EQ (tem
, Qunbound
))
2473 error ("Width not specified");
2474 CHECK_NUMBER (tem
, 0);
2477 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2478 if (EQ (tem
, Qunbound
))
2479 error ("Top position not specified");
2480 CHECK_NUMBER (tem
, 0);
2481 f
->display
.x
->left_pos
= XINT (tem
);
2483 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2484 if (EQ (tem
, Qunbound
))
2485 error ("Left position not specified");
2486 CHECK_NUMBER (tem
, 0);
2487 f
->display
.x
->top_pos
= XINT (tem
);
2490 pixelwidth
= CHAR_TO_PIXEL_WIDTH (f
, width
);
2491 pixelheight
= CHAR_TO_PIXEL_HEIGHT (f
, height
);
2495 = XCreateWindow (parent
,
2496 f
->display
.x
->left_pos
, /* Absolute horizontal offset */
2497 f
->display
.x
->top_pos
, /* Absolute Vertical offset */
2498 pixelwidth
, pixelheight
,
2499 f
->display
.x
->border_width
,
2500 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
2502 if (FRAME_X_WINDOW (f
) == 0)
2503 error ("Unable to create window.");
2506 /* Install the now determined height and width
2507 in the windows and in phys_lines and desired_lines. */
2508 change_frame_size (f
, height
, width
, 1, 0);
2509 XSelectInput (FRAME_X_WINDOW (f
), KeyPressed
| ExposeWindow
2510 | ButtonPressed
| ButtonReleased
| ExposeRegion
| ExposeCopy
2511 | EnterWindow
| LeaveWindow
| UnmapWindow
);
2512 x_set_resize_hint (f
);
2514 /* Tell the server the window's default name. */
2515 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
), XSTRING (f
->name
)->data
);
2517 /* Now override the defaults with all the rest of the specified
2519 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2520 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2522 /* Do not create an icon window if the caller says not to */
2523 if (!EQ (x_get_arg (parms
, Qsuppress_icon
, 0, 0, boolean
), Qt
)
2524 || f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2526 x_text_icon (f
, iconidentity
);
2527 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2528 "BitmapIcon", 0, symbol
);
2531 /* Tell the X server the previously set values of the
2532 background, border and mouse colors; also create the mouse cursor. */
2534 temp
= XMakeTile (f
->display
.x
->background_pixel
);
2535 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
2538 x_set_border_pixel (f
, f
->display
.x
->border_pixel
);
2540 x_set_mouse_color (f
, Qnil
, Qnil
);
2542 /* Now override the defaults with all the rest of the specified parms. */
2544 Fmodify_frame_parameters (frame
, parms
);
2546 /* Make the window appear on the frame and enable display. */
2548 Lisp_Object visibility
;
2550 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2551 if (EQ (visibility
, Qunbound
))
2554 if (! EQ (visibility
, Qicon
)
2555 && ! NILP (visibility
))
2556 x_make_window_visible (f
);
2559 SET_FRAME_GARBAGED (f
);
2561 Vframe_list
= Fcons (frame
, Vframe_list
);
2567 x_get_focus_frame ()
2570 if (! x_focus_frame
)
2573 XSET (xfocus
, Lisp_Frame
, x_focus_frame
);
2577 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
2578 "Set the focus on FRAME.")
2582 CHECK_LIVE_FRAME (frame
, 0);
2584 if (FRAME_X_P (XFRAME (frame
)))
2587 x_focus_on_frame (XFRAME (frame
));
2595 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
2596 "If a frame has been focused, release it.")
2602 x_unfocus_frame (x_focus_frame
);
2610 /* Computes an X-window size and position either from geometry GEO
2613 F is a frame. It specifies an X window which is used to
2614 determine which display to compute for. Its font, borders
2615 and colors control how the rectangle will be displayed.
2617 X and Y are where to store the positions chosen.
2618 WIDTH and HEIGHT are where to store the sizes chosen.
2620 GEO is the geometry that may specify some of the info.
2621 STR is a prompt to display.
2622 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2625 x_rubber_band (f
, x
, y
, width
, height
, geo
, str
, hscroll
, vscroll
)
2627 int *x
, *y
, *width
, *height
;
2630 int hscroll
, vscroll
;
2636 int background_color
;
2642 background_color
= f
->display
.x
->background_pixel
;
2643 border_color
= f
->display
.x
->border_pixel
;
2645 frame
.bdrwidth
= f
->display
.x
->border_width
;
2646 frame
.border
= XMakeTile (border_color
);
2647 frame
.background
= XMakeTile (background_color
);
2648 tempwindow
= XCreateTerm (str
, "emacs", geo
, default_window
, &frame
, 10, 5,
2649 (2 * f
->display
.x
->internal_border_width
2650 + (vscroll
? VSCROLL_WIDTH
: 0)),
2651 (2 * f
->display
.x
->internal_border_width
2652 + (hscroll
? HSCROLL_HEIGHT
: 0)),
2653 width
, height
, f
->display
.x
->font
,
2654 FONT_WIDTH (f
->display
.x
->font
),
2655 f
->display
.x
->line_height
);
2656 XFreePixmap (frame
.border
);
2657 XFreePixmap (frame
.background
);
2659 if (tempwindow
!= 0)
2661 XQueryWindow (tempwindow
, &wininfo
);
2662 XDestroyWindow (tempwindow
);
2667 /* Coordinates we got are relative to the root window.
2668 Convert them to coordinates relative to desired parent window
2669 by scanning from there up to the root. */
2670 tempwindow
= f
->display
.x
->parent_desc
;
2671 while (tempwindow
!= ROOT_WINDOW
)
2675 XQueryWindow (tempwindow
, &wininfo
);
2678 XQueryTree (tempwindow
, &tempwindow
, &nchildren
, &children
);
2683 return tempwindow
!= 0;
2685 #endif /* not HAVE_X11 */
2687 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
2688 "Return a list of the names of available fonts matching PATTERN.\n\
2689 If optional arguments FACE and FRAME are specified, return only fonts\n\
2690 the same size as FACE on FRAME.\n\
2692 PATTERN is a string, perhaps with wildcard characters;\n\
2693 the * character matches any substring, and\n\
2694 the ? character matches any single character.\n\
2695 PATTERN is case-insensitive.\n\
2696 FACE is a face name - a symbol.\n\
2698 The return value is a list of strings, suitable as arguments to\n\
2701 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
2702 even if they match PATTERN and FACE.")
2703 (pattern
, face
, frame
)
2704 Lisp_Object pattern
, face
, frame
;
2709 XFontStruct
*size_ref
;
2713 CHECK_STRING (pattern
, 0);
2715 CHECK_SYMBOL (face
, 1);
2717 CHECK_LIVE_FRAME (frame
, 2);
2723 FRAME_PTR f
= NILP (frame
) ? selected_frame
: XFRAME (frame
);
2726 /* Don't die if we get called with a terminal frame. */
2727 if (! FRAME_X_P (f
))
2728 error ("non-X frame used in `x-list-fonts'");
2730 face_id
= face_name_id_number (f
, face
);
2732 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
2733 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
2734 size_ref
= f
->display
.x
->font
;
2737 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
2738 if (size_ref
== (XFontStruct
*) (~0))
2739 size_ref
= f
->display
.x
->font
;
2745 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
2746 #ifdef BROKEN_XLISTFONTSWITHINFO
2747 names
= XListFonts (x_current_display
,
2748 XSTRING (pattern
)->data
,
2749 2000, /* maxnames */
2750 &num_fonts
); /* count_return */
2752 names
= XListFontsWithInfo (x_current_display
,
2753 XSTRING (pattern
)->data
,
2754 2000, /* maxnames */
2755 &num_fonts
, /* count_return */
2756 &info
); /* info_return */
2768 for (i
= 0; i
< num_fonts
; i
++)
2770 XFontStruct
*thisinfo
;
2772 #ifdef BROKEN_XLISTFONTSWITHINFO
2774 thisinfo
= XLoadQueryFont (x_current_display
, names
[i
]);
2777 thisinfo
= &info
[i
];
2779 if (thisinfo
&& (! size_ref
2780 || same_size_fonts (thisinfo
, size_ref
)))
2782 *tail
= Fcons (build_string (names
[i
]), Qnil
);
2783 tail
= &XCONS (*tail
)->cdr
;
2788 #ifdef BROKEN_XLISTFONTSWITHINFO
2789 XFreeFontNames (names
);
2791 XFreeFontInfo (names
, info
, num_fonts
);
2800 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 1, 0,
2801 "Return t if the current X display supports the color named COLOR.")
2808 CHECK_STRING (color
, 0);
2810 if (defined_color (XSTRING (color
)->data
, &foo
))
2816 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 0, 0,
2817 "Return t if the X screen currently in use supports color.")
2822 if (x_screen_planes
<= 2)
2825 switch (screen_visual
->class)
2838 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
2840 "Returns the width in pixels of the display FRAME is on.")
2844 Display
*dpy
= x_current_display
;
2846 return make_number (DisplayWidth (dpy
, DefaultScreen (dpy
)));
2849 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
2850 Sx_display_pixel_height
, 0, 1, 0,
2851 "Returns the height in pixels of the display FRAME is on.")
2855 Display
*dpy
= x_current_display
;
2857 return make_number (DisplayHeight (dpy
, DefaultScreen (dpy
)));
2860 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
2862 "Returns the number of bitplanes of the display FRAME is on.")
2866 Display
*dpy
= x_current_display
;
2868 return make_number (DisplayPlanes (dpy
, DefaultScreen (dpy
)));
2871 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
2873 "Returns the number of color cells of the display FRAME is on.")
2877 Display
*dpy
= x_current_display
;
2879 return make_number (DisplayCells (dpy
, DefaultScreen (dpy
)));
2882 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
2883 Sx_server_max_request_size
,
2885 "Returns the maximum request size of the X server FRAME is using.")
2889 Display
*dpy
= x_current_display
;
2891 return make_number (MAXREQUEST (dpy
));
2894 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
2895 "Returns the vendor ID string of the X server FRAME is on.")
2899 Display
*dpy
= x_current_display
;
2902 vendor
= ServerVendor (dpy
);
2903 if (! vendor
) vendor
= "";
2904 return build_string (vendor
);
2907 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
2908 "Returns the version numbers of the X server in use.\n\
2909 The value is a list of three integers: the major and minor\n\
2910 version numbers of the X Protocol in use, and the vendor-specific release\n\
2911 number. See also the variable `x-server-vendor'.")
2915 Display
*dpy
= x_current_display
;
2918 return Fcons (make_number (ProtocolVersion (dpy
)),
2919 Fcons (make_number (ProtocolRevision (dpy
)),
2920 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
2923 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
2924 "Returns the number of screens on the X server FRAME is on.")
2929 return make_number (ScreenCount (x_current_display
));
2932 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
2933 "Returns the height in millimeters of the X screen FRAME is on.")
2938 return make_number (HeightMMOfScreen (x_screen
));
2941 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
2942 "Returns the width in millimeters of the X screen FRAME is on.")
2947 return make_number (WidthMMOfScreen (x_screen
));
2950 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
2951 Sx_display_backing_store
, 0, 1, 0,
2952 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2953 The value may be `always', `when-mapped', or `not-useful'.")
2959 switch (DoesBackingStore (x_screen
))
2962 return intern ("always");
2965 return intern ("when-mapped");
2968 return intern ("not-useful");
2971 error ("Strange value for BackingStore parameter of screen");
2975 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
2976 Sx_display_visual_class
, 0, 1, 0,
2977 "Returns the visual class of the display `screen' is on.\n\
2978 The value is one of the symbols `static-gray', `gray-scale',\n\
2979 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2985 switch (screen_visual
->class)
2987 case StaticGray
: return (intern ("static-gray"));
2988 case GrayScale
: return (intern ("gray-scale"));
2989 case StaticColor
: return (intern ("static-color"));
2990 case PseudoColor
: return (intern ("pseudo-color"));
2991 case TrueColor
: return (intern ("true-color"));
2992 case DirectColor
: return (intern ("direct-color"));
2994 error ("Display has an unknown visual class");
2998 DEFUN ("x-display-save-under", Fx_display_save_under
,
2999 Sx_display_save_under
, 0, 1, 0,
3000 "Returns t if the X screen FRAME is on supports the save-under feature.")
3006 if (DoesSaveUnders (x_screen
) == True
)
3013 register struct frame
*f
;
3015 return PIXEL_WIDTH (f
);
3019 register struct frame
*f
;
3021 return PIXEL_HEIGHT (f
);
3025 register struct frame
*f
;
3027 return FONT_WIDTH (f
->display
.x
->font
);
3031 register struct frame
*f
;
3033 return f
->display
.x
->line_height
;
3036 #if 0 /* These no longer seem like the right way to do things. */
3038 /* Draw a rectangle on the frame with left top corner including
3039 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3040 CHARS by LINES wide and long and is the color of the cursor. */
3043 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
3044 register struct frame
*f
;
3046 register int top_char
, left_char
, chars
, lines
;
3050 int left
= (left_char
* FONT_WIDTH (f
->display
.x
->font
)
3051 + f
->display
.x
->internal_border_width
);
3052 int top
= (top_char
* f
->display
.x
->line_height
3053 + f
->display
.x
->internal_border_width
);
3056 width
= FONT_WIDTH (f
->display
.x
->font
) / 2;
3058 width
= FONT_WIDTH (f
->display
.x
->font
) * chars
;
3060 height
= f
->display
.x
->line_height
/ 2;
3062 height
= f
->display
.x
->line_height
* lines
;
3064 XDrawRectangle (x_current_display
, FRAME_X_WINDOW (f
),
3065 gc
, left
, top
, width
, height
);
3068 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
3069 "Draw a rectangle on FRAME between coordinates specified by\n\
3070 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3071 (frame
, X0
, Y0
, X1
, Y1
)
3072 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
3074 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3076 CHECK_LIVE_FRAME (frame
, 0);
3077 CHECK_NUMBER (X0
, 0);
3078 CHECK_NUMBER (Y0
, 1);
3079 CHECK_NUMBER (X1
, 2);
3080 CHECK_NUMBER (Y1
, 3);
3090 n_lines
= y1
- y0
+ 1;
3095 n_lines
= y0
- y1
+ 1;
3101 n_chars
= x1
- x0
+ 1;
3106 n_chars
= x0
- x1
+ 1;
3110 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->cursor_gc
,
3111 left
, top
, n_chars
, n_lines
);
3117 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
3118 "Draw a rectangle drawn on FRAME between coordinates\n\
3119 X0, Y0, X1, Y1 in the regular background-pixel.")
3120 (frame
, X0
, Y0
, X1
, Y1
)
3121 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
3123 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3125 CHECK_FRAME (frame
, 0);
3126 CHECK_NUMBER (X0
, 0);
3127 CHECK_NUMBER (Y0
, 1);
3128 CHECK_NUMBER (X1
, 2);
3129 CHECK_NUMBER (Y1
, 3);
3139 n_lines
= y1
- y0
+ 1;
3144 n_lines
= y0
- y1
+ 1;
3150 n_chars
= x1
- x0
+ 1;
3155 n_chars
= x0
- x1
+ 1;
3159 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->reverse_gc
,
3160 left
, top
, n_chars
, n_lines
);
3166 /* Draw lines around the text region beginning at the character position
3167 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3168 pixel and line characteristics. */
3170 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3173 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
3174 register struct frame
*f
;
3176 int top_x
, top_y
, bottom_x
, bottom_y
;
3178 register int ibw
= f
->display
.x
->internal_border_width
;
3179 register int font_w
= FONT_WIDTH (f
->display
.x
->font
);
3180 register int font_h
= f
->display
.x
->line_height
;
3182 int x
= line_len (y
);
3183 XPoint
*pixel_points
3184 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
3185 register XPoint
*this_point
= pixel_points
;
3187 /* Do the horizontal top line/lines */
3190 this_point
->x
= ibw
;
3191 this_point
->y
= ibw
+ (font_h
* top_y
);
3194 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
3196 this_point
->x
= ibw
+ (font_w
* x
);
3197 this_point
->y
= (this_point
- 1)->y
;
3201 this_point
->x
= ibw
;
3202 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
3204 this_point
->x
= ibw
+ (font_w
* top_x
);
3205 this_point
->y
= (this_point
- 1)->y
;
3207 this_point
->x
= (this_point
- 1)->x
;
3208 this_point
->y
= ibw
+ (font_h
* top_y
);
3210 this_point
->x
= ibw
+ (font_w
* x
);
3211 this_point
->y
= (this_point
- 1)->y
;
3214 /* Now do the right side. */
3215 while (y
< bottom_y
)
3216 { /* Right vertical edge */
3218 this_point
->x
= (this_point
- 1)->x
;
3219 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
3222 y
++; /* Horizontal connection to next line */
3225 this_point
->x
= ibw
+ (font_w
/ 2);
3227 this_point
->x
= ibw
+ (font_w
* x
);
3229 this_point
->y
= (this_point
- 1)->y
;
3232 /* Now do the bottom and connect to the top left point. */
3233 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
3236 this_point
->x
= (this_point
- 1)->x
;
3237 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
3239 this_point
->x
= ibw
;
3240 this_point
->y
= (this_point
- 1)->y
;
3242 this_point
->x
= pixel_points
->x
;
3243 this_point
->y
= pixel_points
->y
;
3245 XDrawLines (x_current_display
, FRAME_X_WINDOW (f
),
3247 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
3250 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
3251 "Highlight the region between point and the character under the mouse\n\
3254 register Lisp_Object event
;
3256 register int x0
, y0
, x1
, y1
;
3257 register struct frame
*f
= selected_frame
;
3258 register int p1
, p2
;
3260 CHECK_CONS (event
, 0);
3263 x0
= XINT (Fcar (Fcar (event
)));
3264 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3266 /* If the mouse is past the end of the line, don't that area. */
3267 /* ReWrite this... */
3272 if (y1
> y0
) /* point below mouse */
3273 outline_region (f
, f
->display
.x
->cursor_gc
,
3275 else if (y1
< y0
) /* point above mouse */
3276 outline_region (f
, f
->display
.x
->cursor_gc
,
3278 else /* same line: draw horizontal rectangle */
3281 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3282 x0
, y0
, (x1
- x0
+ 1), 1);
3284 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3285 x1
, y1
, (x0
- x1
+ 1), 1);
3288 XFlush (x_current_display
);
3294 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
3295 "Erase any highlighting of the region between point and the character\n\
3296 at X, Y on the selected frame.")
3298 register Lisp_Object event
;
3300 register int x0
, y0
, x1
, y1
;
3301 register struct frame
*f
= selected_frame
;
3304 x0
= XINT (Fcar (Fcar (event
)));
3305 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3309 if (y1
> y0
) /* point below mouse */
3310 outline_region (f
, f
->display
.x
->reverse_gc
,
3312 else if (y1
< y0
) /* point above mouse */
3313 outline_region (f
, f
->display
.x
->reverse_gc
,
3315 else /* same line: draw horizontal rectangle */
3318 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3319 x0
, y0
, (x1
- x0
+ 1), 1);
3321 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3322 x1
, y1
, (x0
- x1
+ 1), 1);
3330 int contour_begin_x
, contour_begin_y
;
3331 int contour_end_x
, contour_end_y
;
3332 int contour_npoints
;
3334 /* Clip the top part of the contour lines down (and including) line Y_POS.
3335 If X_POS is in the middle (rather than at the end) of the line, drop
3336 down a line at that character. */
3339 clip_contour_top (y_pos
, x_pos
)
3341 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
3342 register XPoint
*end
;
3343 register int npoints
;
3344 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
3346 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
3348 end
= contour_lines
[y_pos
].top_right
;
3349 npoints
= (end
- begin
+ 1);
3350 XDrawLines (x_current_display
, contour_window
,
3351 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3353 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
3354 contour_last_point
-= (npoints
- 2);
3355 XDrawLines (x_current_display
, contour_window
,
3356 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
3357 XFlush (x_current_display
);
3359 /* Now, update contour_lines structure. */
3364 register XPoint
*p
= begin
+ 1;
3365 end
= contour_lines
[y_pos
].bottom_right
;
3366 npoints
= (end
- begin
+ 1);
3367 XDrawLines (x_current_display
, contour_window
,
3368 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3371 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
3373 p
->y
= begin
->y
+ font_h
;
3375 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
3376 contour_last_point
-= (npoints
- 5);
3377 XDrawLines (x_current_display
, contour_window
,
3378 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
3379 XFlush (x_current_display
);
3381 /* Now, update contour_lines structure. */
3385 /* Erase the top horizontal lines of the contour, and then extend
3386 the contour upwards. */
3389 extend_contour_top (line
)
3394 clip_contour_bottom (x_pos
, y_pos
)
3400 extend_contour_bottom (x_pos
, y_pos
)
3404 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
3409 register struct frame
*f
= selected_frame
;
3410 register int point_x
= f
->cursor_x
;
3411 register int point_y
= f
->cursor_y
;
3412 register int mouse_below_point
;
3413 register Lisp_Object obj
;
3414 register int x_contour_x
, x_contour_y
;
3416 x_contour_x
= x_mouse_x
;
3417 x_contour_y
= x_mouse_y
;
3418 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
3419 && x_contour_x
> point_x
))
3421 mouse_below_point
= 1;
3422 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3423 x_contour_x
, x_contour_y
);
3427 mouse_below_point
= 0;
3428 outline_region (f
, f
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
3434 obj
= read_char (-1, 0, 0, Qnil
, 0);
3435 if (XTYPE (obj
) != Lisp_Cons
)
3438 if (mouse_below_point
)
3440 if (x_mouse_y
<= point_y
) /* Flipped. */
3442 mouse_below_point
= 0;
3444 outline_region (f
, f
->display
.x
->reverse_gc
, point_x
, point_y
,
3445 x_contour_x
, x_contour_y
);
3446 outline_region (f
, f
->display
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
3449 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
3451 clip_contour_bottom (x_mouse_y
);
3453 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
3455 extend_bottom_contour (x_mouse_y
);
3458 x_contour_x
= x_mouse_x
;
3459 x_contour_y
= x_mouse_y
;
3461 else /* mouse above or same line as point */
3463 if (x_mouse_y
>= point_y
) /* Flipped. */
3465 mouse_below_point
= 1;
3467 outline_region (f
, f
->display
.x
->reverse_gc
,
3468 x_contour_x
, x_contour_y
, point_x
, point_y
);
3469 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3470 x_mouse_x
, x_mouse_y
);
3472 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
3474 clip_contour_top (x_mouse_y
);
3476 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
3478 extend_contour_top (x_mouse_y
);
3483 unread_command_event
= obj
;
3484 if (mouse_below_point
)
3486 contour_begin_x
= point_x
;
3487 contour_begin_y
= point_y
;
3488 contour_end_x
= x_contour_x
;
3489 contour_end_y
= x_contour_y
;
3493 contour_begin_x
= x_contour_x
;
3494 contour_begin_y
= x_contour_y
;
3495 contour_end_x
= point_x
;
3496 contour_end_y
= point_y
;
3501 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
3506 register Lisp_Object obj
;
3507 struct frame
*f
= selected_frame
;
3508 register struct window
*w
= XWINDOW (selected_window
);
3509 register GC line_gc
= f
->display
.x
->cursor_gc
;
3510 register GC erase_gc
= f
->display
.x
->reverse_gc
;
3512 char dash_list
[] = {6, 4, 6, 4};
3514 XGCValues gc_values
;
3516 register int previous_y
;
3517 register int line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3518 + f
->display
.x
->internal_border_width
;
3519 register int left
= f
->display
.x
->internal_border_width
3521 * FONT_WIDTH (f
->display
.x
->font
));
3522 register int right
= left
+ (w
->width
3523 * FONT_WIDTH (f
->display
.x
->font
))
3524 - f
->display
.x
->internal_border_width
;
3528 gc_values
.foreground
= f
->display
.x
->cursor_pixel
;
3529 gc_values
.background
= f
->display
.x
->background_pixel
;
3530 gc_values
.line_width
= 1;
3531 gc_values
.line_style
= LineOnOffDash
;
3532 gc_values
.cap_style
= CapRound
;
3533 gc_values
.join_style
= JoinRound
;
3535 line_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3536 GCLineStyle
| GCJoinStyle
| GCCapStyle
3537 | GCLineWidth
| GCForeground
| GCBackground
,
3539 XSetDashes (x_current_display
, line_gc
, 0, dash_list
, dashes
);
3540 gc_values
.foreground
= f
->display
.x
->background_pixel
;
3541 gc_values
.background
= f
->display
.x
->foreground_pixel
;
3542 erase_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3543 GCLineStyle
| GCJoinStyle
| GCCapStyle
3544 | GCLineWidth
| GCForeground
| GCBackground
,
3546 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
3552 if (x_mouse_y
>= XINT (w
->top
)
3553 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
3555 previous_y
= x_mouse_y
;
3556 line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3557 + f
->display
.x
->internal_border_width
;
3558 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3559 line_gc
, left
, line
, right
, line
);
3566 obj
= read_char (-1, 0, 0, Qnil
, 0);
3567 if ((XTYPE (obj
) != Lisp_Cons
)
3568 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3569 Qvertical_scroll_bar
))
3573 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3574 erase_gc
, left
, line
, right
, line
);
3576 unread_command_event
= obj
;
3578 XFreeGC (x_current_display
, line_gc
);
3579 XFreeGC (x_current_display
, erase_gc
);
3584 while (x_mouse_y
== previous_y
);
3587 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3588 erase_gc
, left
, line
, right
, line
);
3594 /* Offset in buffer of character under the pointer, or 0. */
3595 int mouse_buffer_offset
;
3598 /* These keep track of the rectangle following the pointer. */
3599 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
3601 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
3602 "Track the pointer.")
3605 static Cursor current_pointer_shape
;
3606 FRAME_PTR f
= x_mouse_frame
;
3609 if (EQ (Vmouse_frame_part
, Qtext_part
)
3610 && (current_pointer_shape
!= f
->display
.x
->nontext_cursor
))
3615 current_pointer_shape
= f
->display
.x
->nontext_cursor
;
3616 XDefineCursor (x_current_display
,
3618 current_pointer_shape
);
3620 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
3621 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
3623 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
3624 && (current_pointer_shape
!= f
->display
.x
->modeline_cursor
))
3626 current_pointer_shape
= f
->display
.x
->modeline_cursor
;
3627 XDefineCursor (x_current_display
,
3629 current_pointer_shape
);
3638 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
3639 "Draw rectangle around character under mouse pointer, if there is one.")
3643 struct window
*w
= XWINDOW (Vmouse_window
);
3644 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
3645 struct buffer
*b
= XBUFFER (w
->buffer
);
3648 if (! EQ (Vmouse_window
, selected_window
))
3651 if (EQ (event
, Qnil
))
3655 x_read_mouse_position (selected_frame
, &x
, &y
);
3659 mouse_track_width
= 0;
3660 mouse_track_left
= mouse_track_top
= -1;
3664 if ((x_mouse_x
!= mouse_track_left
3665 && (x_mouse_x
< mouse_track_left
3666 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
3667 || x_mouse_y
!= mouse_track_top
)
3669 int hp
= 0; /* Horizontal position */
3670 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
3671 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
3672 int tab_width
= XINT (b
->tab_width
);
3673 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
3675 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
3676 int in_mode_line
= 0;
3678 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
3681 /* Erase previous rectangle. */
3682 if (mouse_track_width
)
3684 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3685 mouse_track_left
, mouse_track_top
,
3686 mouse_track_width
, 1);
3688 if ((mouse_track_left
== f
->phys_cursor_x
3689 || mouse_track_left
== f
->phys_cursor_x
- 1)
3690 && mouse_track_top
== f
->phys_cursor_y
)
3692 x_display_cursor (f
, 1);
3696 mouse_track_left
= x_mouse_x
;
3697 mouse_track_top
= x_mouse_y
;
3698 mouse_track_width
= 0;
3700 if (mouse_track_left
> len
) /* Past the end of line. */
3703 if (mouse_track_top
== mode_line_vpos
)
3709 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3713 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
3719 mouse_track_width
= tab_width
- (hp
% tab_width
);
3721 hp
+= mouse_track_width
;
3724 mouse_track_left
= hp
- mouse_track_width
;
3730 mouse_track_width
= -1;
3734 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3739 mouse_track_width
= 2;
3744 mouse_track_left
= hp
- mouse_track_width
;
3750 mouse_track_width
= 1;
3757 while (hp
<= x_mouse_x
);
3760 if (mouse_track_width
) /* Over text; use text pointer shape. */
3762 XDefineCursor (x_current_display
,
3764 f
->display
.x
->text_cursor
);
3765 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3766 mouse_track_left
, mouse_track_top
,
3767 mouse_track_width
, 1);
3769 else if (in_mode_line
)
3770 XDefineCursor (x_current_display
,
3772 f
->display
.x
->modeline_cursor
);
3774 XDefineCursor (x_current_display
,
3776 f
->display
.x
->nontext_cursor
);
3779 XFlush (x_current_display
);
3782 obj
= read_char (-1, 0, 0, Qnil
, 0);
3785 while (XTYPE (obj
) == Lisp_Cons
/* Mouse event */
3786 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
3787 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
3788 && EQ (Vmouse_window
, selected_window
) /* In this window */
3791 unread_command_event
= obj
;
3793 if (mouse_track_width
)
3795 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3796 mouse_track_left
, mouse_track_top
,
3797 mouse_track_width
, 1);
3798 mouse_track_width
= 0;
3799 if ((mouse_track_left
== f
->phys_cursor_x
3800 || mouse_track_left
- 1 == f
->phys_cursor_x
)
3801 && mouse_track_top
== f
->phys_cursor_y
)
3803 x_display_cursor (f
, 1);
3806 XDefineCursor (x_current_display
,
3808 f
->display
.x
->nontext_cursor
);
3809 XFlush (x_current_display
);
3819 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3820 on the frame F at position X, Y. */
3822 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
3824 int x
, y
, width
, height
;
3829 image
= XCreateBitmapFromData (x_current_display
,
3830 FRAME_X_WINDOW (f
), image_data
,
3832 XCopyPlane (x_current_display
, image
, FRAME_X_WINDOW (f
),
3833 f
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
3838 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer
, Sx_store_cut_buffer
,
3839 1, 1, "sStore text in cut buffer: ",
3840 "Store contents of STRING into the cut buffer of the X window system.")
3842 register Lisp_Object string
;
3846 CHECK_STRING (string
, 1);
3847 if (! FRAME_X_P (selected_frame
))
3848 error ("Selected frame does not understand X protocol.");
3851 XStoreBytes ((char *) XSTRING (string
)->data
, XSTRING (string
)->size
);
3857 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer
, Sx_get_cut_buffer
, 0, 0, 0,
3858 "Return contents of cut buffer of the X window system, as a string.")
3862 register Lisp_Object string
;
3867 d
= XFetchBytes (&len
);
3868 string
= make_string (d
, len
);
3875 #if 0 /* I'm told these functions are superfluous
3876 given the ability to bind function keys. */
3879 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3880 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3881 KEYSYM is a string which conforms to the X keysym definitions found\n\
3882 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3883 list of strings specifying modifier keys such as Control_L, which must\n\
3884 also be depressed for NEWSTRING to appear.")
3885 (x_keysym
, modifiers
, newstring
)
3886 register Lisp_Object x_keysym
;
3887 register Lisp_Object modifiers
;
3888 register Lisp_Object newstring
;
3891 register KeySym keysym
;
3892 KeySym modifier_list
[16];
3895 CHECK_STRING (x_keysym
, 1);
3896 CHECK_STRING (newstring
, 3);
3898 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
3899 if (keysym
== NoSymbol
)
3900 error ("Keysym does not exist");
3902 if (NILP (modifiers
))
3903 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
3904 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3907 register Lisp_Object rest
, mod
;
3910 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
3913 error ("Can't have more than 16 modifiers");
3916 CHECK_STRING (mod
, 3);
3917 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
3919 if (modifier_list
[i
] == NoSymbol
3920 || !(IsModifierKey (modifier_list
[i
])
3921 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
3922 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
3924 if (modifier_list
[i
] == NoSymbol
3925 || !IsModifierKey (modifier_list
[i
]))
3927 error ("Element is not a modifier keysym");
3931 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
3932 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3938 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
3939 "Rebind KEYCODE to list of strings STRINGS.\n\
3940 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3941 nil as element means don't change.\n\
3942 See the documentation of `x-rebind-key' for more information.")
3944 register Lisp_Object keycode
;
3945 register Lisp_Object strings
;
3947 register Lisp_Object item
;
3948 register unsigned char *rawstring
;
3949 KeySym rawkey
, modifier
[1];
3951 register unsigned i
;
3954 CHECK_NUMBER (keycode
, 1);
3955 CHECK_CONS (strings
, 2);
3956 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
3957 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
3959 item
= Fcar (strings
);
3962 CHECK_STRING (item
, 2);
3963 strsize
= XSTRING (item
)->size
;
3964 rawstring
= (unsigned char *) xmalloc (strsize
);
3965 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
3966 modifier
[1] = 1 << i
;
3967 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
3968 rawstring
, strsize
);
3973 #endif /* HAVE_X11 */
3978 #ifndef HAVE_XSCREENNUMBEROFSCREEN
3980 XScreenNumberOfScreen (scr
)
3981 register Screen
*scr
;
3983 register Display
*dpy
;
3984 register Screen
*dpyscr
;
3988 dpyscr
= dpy
->screens
;
3990 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
3996 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
3999 select_visual (screen
, depth
)
4001 unsigned int *depth
;
4004 XVisualInfo
*vinfo
, vinfo_template
;
4007 v
= DefaultVisualOfScreen (screen
);
4010 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
4012 vinfo_template
.visualid
= v
->visualid
;
4015 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4017 vinfo
= XGetVisualInfo (x_current_display
,
4018 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
4021 fatal ("Can't get proper X visual info");
4023 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
4024 *depth
= vinfo
->depth
;
4028 int n
= vinfo
->colormap_size
- 1;
4037 XFree ((char *) vinfo
);
4040 #endif /* HAVE_X11 */
4042 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4043 1, 2, 0, "Open a connection to an X server.\n\
4044 DISPLAY is the name of the display to connect to.\n\
4045 Optional second arg XRM_STRING is a string of resources in xrdb format.")
4046 (display
, xrm_string
)
4047 Lisp_Object display
, xrm_string
;
4049 unsigned int n_planes
;
4050 unsigned char *xrm_option
;
4052 CHECK_STRING (display
, 0);
4053 if (x_current_display
!= 0)
4054 error ("X server connection is already initialized");
4055 if (! NILP (xrm_string
))
4056 CHECK_STRING (xrm_string
, 1);
4058 /* This is what opens the connection and sets x_current_display.
4059 This also initializes many symbols, such as those used for input. */
4060 x_term_init (XSTRING (display
)->data
);
4063 XFASTINT (Vwindow_system_version
) = 11;
4065 if (! NILP (xrm_string
))
4066 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4068 xrm_option
= (unsigned char *) 0;
4070 validate_x_resource_name ();
4073 xrdb
= x_load_resources (x_current_display
, xrm_option
,
4074 (char *) XSTRING (Vx_resource_name
)->data
,
4077 #ifdef HAVE_XRMSETDATABASE
4078 XrmSetDatabase (x_current_display
, xrdb
);
4080 x_current_display
->db
= xrdb
;
4083 x_screen
= DefaultScreenOfDisplay (x_current_display
);
4085 screen_visual
= select_visual (x_screen
, &n_planes
);
4086 x_screen_planes
= n_planes
;
4087 x_screen_height
= HeightOfScreen (x_screen
);
4088 x_screen_width
= WidthOfScreen (x_screen
);
4090 /* X Atoms used by emacs. */
4091 Xatoms_of_xselect ();
4093 Xatom_wm_protocols
= XInternAtom (x_current_display
, "WM_PROTOCOLS",
4095 Xatom_wm_take_focus
= XInternAtom (x_current_display
, "WM_TAKE_FOCUS",
4097 Xatom_wm_save_yourself
= XInternAtom (x_current_display
, "WM_SAVE_YOURSELF",
4099 Xatom_wm_delete_window
= XInternAtom (x_current_display
, "WM_DELETE_WINDOW",
4101 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
4103 Xatom_wm_configure_denied
= XInternAtom (x_current_display
,
4104 "WM_CONFIGURE_DENIED", False
);
4105 Xatom_wm_window_moved
= XInternAtom (x_current_display
, "WM_MOVED",
4107 Xatom_editres_name
= XInternAtom (x_current_display
, "Editres", False
);
4109 #else /* not HAVE_X11 */
4110 XFASTINT (Vwindow_system_version
) = 10;
4111 #endif /* not HAVE_X11 */
4115 DEFUN ("x-close-current-connection", Fx_close_current_connection
,
4116 Sx_close_current_connection
,
4117 0, 0, 0, "Close the connection to the current X server.")
4120 /* Note: If we're going to call check_x here, then the fatal error
4121 can't happen. For the moment, this check is just for safety,
4122 so a user won't try out the function and get a crash. If it's
4123 really intended only to be called when killing emacs, then there's
4124 no reason for it to have a lisp interface at all. */
4127 /* This is ONLY used when killing emacs; For switching displays
4128 we'll have to take care of setting CloseDownMode elsewhere. */
4130 if (x_current_display
)
4133 XSetCloseDownMode (x_current_display
, DestroyAll
);
4134 XCloseDisplay (x_current_display
);
4135 x_current_display
= 0;
4138 fatal ("No current X display connection to close\n");
4143 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
,
4144 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4145 If ON is nil, allow buffering of requests.\n\
4146 Turning on synchronization prohibits the Xlib routines from buffering\n\
4147 requests and seriously degrades performance, but makes debugging much\n\
4154 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
4159 /* Wait for responses to all X commands issued so far for FRAME. */
4166 XSync (x_current_display
, False
);
4172 /* This is zero if not using X windows. */
4173 x_current_display
= 0;
4175 /* The section below is built by the lisp expression at the top of the file,
4176 just above where these variables are declared. */
4177 /*&&& init symbols here &&&*/
4178 Qauto_raise
= intern ("auto-raise");
4179 staticpro (&Qauto_raise
);
4180 Qauto_lower
= intern ("auto-lower");
4181 staticpro (&Qauto_lower
);
4182 Qbackground_color
= intern ("background-color");
4183 staticpro (&Qbackground_color
);
4184 Qbar
= intern ("bar");
4186 Qborder_color
= intern ("border-color");
4187 staticpro (&Qborder_color
);
4188 Qborder_width
= intern ("border-width");
4189 staticpro (&Qborder_width
);
4190 Qbox
= intern ("box");
4192 Qcursor_color
= intern ("cursor-color");
4193 staticpro (&Qcursor_color
);
4194 Qcursor_type
= intern ("cursor-type");
4195 staticpro (&Qcursor_type
);
4196 Qfont
= intern ("font");
4198 Qforeground_color
= intern ("foreground-color");
4199 staticpro (&Qforeground_color
);
4200 Qgeometry
= intern ("geometry");
4201 staticpro (&Qgeometry
);
4202 Qicon_left
= intern ("icon-left");
4203 staticpro (&Qicon_left
);
4204 Qicon_top
= intern ("icon-top");
4205 staticpro (&Qicon_top
);
4206 Qicon_type
= intern ("icon-type");
4207 staticpro (&Qicon_type
);
4208 Qinternal_border_width
= intern ("internal-border-width");
4209 staticpro (&Qinternal_border_width
);
4210 Qleft
= intern ("left");
4212 Qmouse_color
= intern ("mouse-color");
4213 staticpro (&Qmouse_color
);
4214 Qnone
= intern ("none");
4216 Qparent_id
= intern ("parent-id");
4217 staticpro (&Qparent_id
);
4218 Qsuppress_icon
= intern ("suppress-icon");
4219 staticpro (&Qsuppress_icon
);
4220 Qtop
= intern ("top");
4222 Qundefined_color
= intern ("undefined-color");
4223 staticpro (&Qundefined_color
);
4224 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
4225 staticpro (&Qvertical_scroll_bars
);
4226 Qvisibility
= intern ("visibility");
4227 staticpro (&Qvisibility
);
4228 Qwindow_id
= intern ("window-id");
4229 staticpro (&Qwindow_id
);
4230 Qx_frame_parameter
= intern ("x-frame-parameter");
4231 staticpro (&Qx_frame_parameter
);
4232 Qx_resource_name
= intern ("x-resource-name");
4233 staticpro (&Qx_resource_name
);
4234 /* This is the end of symbol initialization. */
4236 Fput (Qundefined_color
, Qerror_conditions
,
4237 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
4238 Fput (Qundefined_color
, Qerror_message
,
4239 build_string ("Undefined color"));
4241 init_x_parm_symbols ();
4243 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset
,
4244 "The buffer offset of the character under the pointer.");
4245 mouse_buffer_offset
= 0;
4247 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
4248 "The shape of the pointer when over text.\n\
4249 Changing the value does not affect existing frames\n\
4250 unless you set the mouse color.");
4251 Vx_pointer_shape
= Qnil
;
4253 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
4254 "The name Emacs uses to look up X resources; for internal use only.\n\
4255 `x-get-resource' uses this as the first component of the instance name\n\
4256 when requesting resource values.\n\
4257 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4258 was invoked, or to the value specified with the `-name' or `-rn'\n\
4259 switches, if present.");
4260 Vx_resource_name
= Qnil
;
4263 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
4264 "The shape of the pointer when not over text.");
4266 Vx_nontext_pointer_shape
= Qnil
;
4269 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
4270 "The shape of the pointer when over the mode line.");
4272 Vx_mode_pointer_shape
= Qnil
;
4274 Vx_cross_pointer_shape
= Qnil
;
4276 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
4277 "A string indicating the foreground color of the cursor box.");
4278 Vx_cursor_fore_pixel
= Qnil
;
4280 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed
,
4281 "Non-nil if a mouse button is currently depressed.");
4282 Vmouse_depressed
= Qnil
;
4284 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
4285 "t if no X window manager is in use.");
4288 defsubr (&Sx_get_resource
);
4290 defsubr (&Sx_draw_rectangle
);
4291 defsubr (&Sx_erase_rectangle
);
4292 defsubr (&Sx_contour_region
);
4293 defsubr (&Sx_uncontour_region
);
4295 defsubr (&Sx_display_color_p
);
4296 defsubr (&Sx_list_fonts
);
4297 defsubr (&Sx_color_defined_p
);
4298 defsubr (&Sx_server_max_request_size
);
4299 defsubr (&Sx_server_vendor
);
4300 defsubr (&Sx_server_version
);
4301 defsubr (&Sx_display_pixel_width
);
4302 defsubr (&Sx_display_pixel_height
);
4303 defsubr (&Sx_display_mm_width
);
4304 defsubr (&Sx_display_mm_height
);
4305 defsubr (&Sx_display_screens
);
4306 defsubr (&Sx_display_planes
);
4307 defsubr (&Sx_display_color_cells
);
4308 defsubr (&Sx_display_visual_class
);
4309 defsubr (&Sx_display_backing_store
);
4310 defsubr (&Sx_display_save_under
);
4312 defsubr (&Sx_rebind_key
);
4313 defsubr (&Sx_rebind_keys
);
4314 defsubr (&Sx_track_pointer
);
4315 defsubr (&Sx_grab_pointer
);
4316 defsubr (&Sx_ungrab_pointer
);
4319 defsubr (&Sx_get_default
);
4320 defsubr (&Sx_store_cut_buffer
);
4321 defsubr (&Sx_get_cut_buffer
);
4323 defsubr (&Sx_parse_geometry
);
4324 defsubr (&Sx_create_frame
);
4325 defsubr (&Sfocus_frame
);
4326 defsubr (&Sunfocus_frame
);
4328 defsubr (&Sx_horizontal_line
);
4330 defsubr (&Sx_open_connection
);
4331 defsubr (&Sx_close_current_connection
);
4332 defsubr (&Sx_synchronize
);
4335 #endif /* HAVE_X_WINDOWS */