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
|= YNegative
;
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 hack_wm_protocols (shell_widget
);
1876 /* Do a stupid property change to force the server to generate a
1877 propertyNotify event so that the event_stream server timestamp will
1878 be initialized to something relevant to the time we created the window.
1880 XChangeProperty (XtDisplay (screen_widget
), XtWindow (screen_widget
),
1881 Xatom_wm_protocols
, XA_ATOM
, 32, PropModeAppend
,
1882 (unsigned char*) NULL
, 0);
1884 /* Make all the standard events reach the Emacs frame. */
1885 attributes
.event_mask
= STANDARD_EVENT_SET
;
1886 attribute_mask
= CWEventMask
;
1887 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
1888 attribute_mask
, &attributes
);
1890 XtMapWidget (screen_widget
);
1892 /* x_set_name normally ignores requests to set the name if the
1893 requested name is the same as the current name. This is the one
1894 place where that assumption isn't correct; f->name is set, but
1895 the X server hasn't been told. */
1898 int explicit = f
->explicit_name
;
1900 f
->explicit_name
= 0;
1903 x_set_name (f
, name
, explicit);
1906 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
1907 f
->display
.x
->text_cursor
);
1911 if (FRAME_X_WINDOW (f
) == 0)
1912 error ("Unable to create window");
1915 #else /* not USE_X_TOOLKIT */
1917 /* Create and set up the X window for frame F. */
1923 XClassHint class_hints
;
1924 XSetWindowAttributes attributes
;
1925 unsigned long attribute_mask
;
1927 attributes
.background_pixel
= f
->display
.x
->background_pixel
;
1928 attributes
.border_pixel
= f
->display
.x
->border_pixel
;
1929 attributes
.bit_gravity
= StaticGravity
;
1930 attributes
.backing_store
= NotUseful
;
1931 attributes
.save_under
= True
;
1932 attributes
.event_mask
= STANDARD_EVENT_SET
;
1933 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
1935 | CWBackingStore
| CWSaveUnder
1941 = XCreateWindow (x_current_display
, ROOT_WINDOW
,
1942 f
->display
.x
->left_pos
,
1943 f
->display
.x
->top_pos
,
1944 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
1945 f
->display
.x
->border_width
,
1946 CopyFromParent
, /* depth */
1947 InputOutput
, /* class */
1948 screen_visual
, /* set in Fx_open_connection */
1949 attribute_mask
, &attributes
);
1951 validate_x_resource_name ();
1952 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
1953 class_hints
.res_class
= EMACS_CLASS
;
1954 XSetClassHint (x_current_display
, FRAME_X_WINDOW (f
), &class_hints
);
1956 /* This indicates that we use the "Passive Input" input model.
1957 Unless we do this, we don't get the Focus{In,Out} events that we
1958 need to draw the cursor correctly. Accursed bureaucrats.
1959 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1961 f
->display
.x
->wm_hints
.input
= True
;
1962 f
->display
.x
->wm_hints
.flags
|= InputHint
;
1963 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
1964 XSetWMProtocols (x_current_display
, FRAME_X_WINDOW (f
),
1965 &Xatom_wm_delete_window
, 1);
1968 /* x_set_name normally ignores requests to set the name if the
1969 requested name is the same as the current name. This is the one
1970 place where that assumption isn't correct; f->name is set, but
1971 the X server hasn't been told. */
1974 int explicit = f
->explicit_name
;
1976 f
->explicit_name
= 0;
1979 x_set_name (f
, name
, explicit);
1982 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
1983 f
->display
.x
->text_cursor
);
1987 if (FRAME_X_WINDOW (f
) == 0)
1988 error ("Unable to create window");
1991 #endif /* not USE_X_TOOLKIT */
1993 /* Handle the icon stuff for this window. Perhaps later we might
1994 want an x_set_icon_position which can be called interactively as
2002 Lisp_Object icon_x
, icon_y
;
2004 /* Set the position of the icon. Note that twm groups all
2005 icons in an icon window. */
2006 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
2007 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
2008 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
2010 CHECK_NUMBER (icon_x
, 0);
2011 CHECK_NUMBER (icon_y
, 0);
2013 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
2014 error ("Both left and top icon corners of icon must be specified");
2018 if (! EQ (icon_x
, Qunbound
))
2019 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
2021 /* Start up iconic or window? */
2022 x_wm_set_window_state
2023 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
2030 /* Make the GC's needed for this window, setting the
2031 background, border and mouse colors; also create the
2032 mouse cursor and the gray border tile. */
2034 static char cursor_bits
[] =
2036 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2037 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2038 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2039 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2046 XGCValues gc_values
;
2052 /* Create the GC's of this frame.
2053 Note that many default values are used. */
2056 gc_values
.font
= f
->display
.x
->font
->fid
;
2057 gc_values
.foreground
= f
->display
.x
->foreground_pixel
;
2058 gc_values
.background
= f
->display
.x
->background_pixel
;
2059 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
2060 f
->display
.x
->normal_gc
= XCreateGC (x_current_display
,
2062 GCLineWidth
| GCFont
2063 | GCForeground
| GCBackground
,
2066 /* Reverse video style. */
2067 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2068 gc_values
.background
= f
->display
.x
->foreground_pixel
;
2069 f
->display
.x
->reverse_gc
= XCreateGC (x_current_display
,
2071 GCFont
| GCForeground
| GCBackground
2075 /* Cursor has cursor-color background, background-color foreground. */
2076 gc_values
.foreground
= f
->display
.x
->background_pixel
;
2077 gc_values
.background
= f
->display
.x
->cursor_pixel
;
2078 gc_values
.fill_style
= FillOpaqueStippled
;
2080 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
2081 cursor_bits
, 16, 16);
2082 f
->display
.x
->cursor_gc
2083 = XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
2084 (GCFont
| GCForeground
| GCBackground
2085 | GCFillStyle
| GCStipple
| GCLineWidth
),
2088 /* Create the gray border tile used when the pointer is not in
2089 the frame. Since this depends on the frame's pixel values,
2090 this must be done on a per-frame basis. */
2091 f
->display
.x
->border_tile
2092 = (XCreatePixmapFromBitmapData
2093 (x_current_display
, ROOT_WINDOW
,
2094 gray_bits
, gray_width
, gray_height
,
2095 f
->display
.x
->foreground_pixel
,
2096 f
->display
.x
->background_pixel
,
2097 DefaultDepth (x_current_display
, XDefaultScreen (x_current_display
))));
2101 #endif /* HAVE_X11 */
2103 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
2105 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2106 Return an Emacs frame object representing the X window.\n\
2107 ALIST is an alist of frame parameters.\n\
2108 If the parameters specify that the frame should not have a minibuffer,\n\
2109 and do not specify a specific minibuffer window to use,\n\
2110 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2111 be shared by the new frame.")
2117 Lisp_Object frame
, tem
;
2119 int minibuffer_only
= 0;
2120 long window_prompting
= 0;
2122 int count
= specpdl_ptr
- specpdl
;
2126 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
2127 if (XTYPE (name
) != Lisp_String
2128 && ! EQ (name
, Qunbound
)
2130 error ("x-create-frame: name parameter must be a string");
2132 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2133 if (EQ (tem
, Qnone
) || NILP (tem
))
2134 f
= make_frame_without_minibuffer (Qnil
);
2135 else if (EQ (tem
, Qonly
))
2137 f
= make_minibuffer_frame ();
2138 minibuffer_only
= 1;
2140 else if (XTYPE (tem
) == Lisp_Window
)
2141 f
= make_frame_without_minibuffer (tem
);
2145 /* Note that X Windows does support scroll bars. */
2146 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
2148 /* Set the name; the functions to which we pass f expect the name to
2150 if (EQ (name
, Qunbound
) || NILP (name
))
2152 f
->name
= build_string (x_id_name
);
2153 f
->explicit_name
= 0;
2158 f
->explicit_name
= 1;
2159 /* use the frame's title when getting resources for this frame. */
2160 specbind (Qx_resource_name
, name
);
2163 XSET (frame
, Lisp_Frame
, f
);
2164 f
->output_method
= output_x_window
;
2165 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2166 bzero (f
->display
.x
, sizeof (struct x_display
));
2168 /* Note that the frame has no physical cursor right now. */
2169 f
->phys_cursor_x
= -1;
2171 /* Extract the window parameters from the supplied values
2172 that are needed to determine window geometry. */
2176 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
2178 /* First, try whatever font the caller has specified. */
2180 font
= x_new_font (f
, XSTRING (font
)->data
);
2181 /* Try out a font which we hope has bold and italic variations. */
2182 if (!STRINGP (font
))
2183 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2184 if (! STRINGP (font
))
2185 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2186 if (! STRINGP (font
))
2187 /* This was formerly the first thing tried, but it finds too many fonts
2188 and takes too long. */
2189 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
2190 /* If those didn't work, look for something which will at least work. */
2191 if (! STRINGP (font
))
2192 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1");
2194 if (! STRINGP (font
))
2195 font
= build_string ("fixed");
2197 x_default_parameter (f
, parms
, Qfont
, font
,
2198 "font", "Font", string
);
2201 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
2202 "borderwidth", "BorderWidth", number
);
2203 /* This defaults to 2 in order to match xterm. We recognize either
2204 internalBorderWidth or internalBorder (which is what xterm calls
2206 if (NILP (Fassq (Qinternal_border_width
, parms
)))
2210 value
= x_get_arg (parms
, Qinternal_border_width
,
2211 "internalBorder", "BorderWidth", number
);
2212 if (! EQ (value
, Qunbound
))
2213 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
2216 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
2217 "internalBorderWidth", "BorderWidth", number
);
2218 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
2219 "verticalScrollBars", "ScrollBars", boolean
);
2221 /* Also do the stuff which must be set before the window exists. */
2222 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
2223 "foreground", "Foreground", string
);
2224 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
2225 "background", "Background", string
);
2226 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
2227 "pointerColor", "Foreground", string
);
2228 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
2229 "cursorColor", "Foreground", string
);
2230 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
2231 "borderColor", "BorderColor", string
);
2233 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (0),
2234 "menuBarLines", "MenuBarLines", number
);
2236 f
->display
.x
->parent_desc
= ROOT_WINDOW
;
2237 window_prompting
= x_figure_window_size (f
, parms
);
2239 switch (((f
->display
.x
->left_pos
< 0) << 1) + (f
->display
.x
->top_pos
< 0))
2242 f
->display
.x
->win_gravity
= NorthWestGravity
;
2245 f
->display
.x
->win_gravity
= SouthWestGravity
;
2248 f
->display
.x
->win_gravity
= NorthEastGravity
;
2251 f
->display
.x
->win_gravity
= SouthEastGravity
;
2255 #ifdef USE_X_TOOLKIT
2256 x_window (f
, window_prompting
, minibuffer_only
);
2262 init_frame_faces (f
);
2264 /* We need to do this after creating the X window, so that the
2265 icon-creation functions can say whose icon they're describing. */
2266 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2267 "bitmapIcon", "BitmapIcon", symbol
);
2269 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
2270 "autoRaise", "AutoRaiseLower", boolean
);
2271 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
2272 "autoLower", "AutoRaiseLower", boolean
);
2273 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
2274 "cursorType", "CursorType", symbol
);
2276 /* Dimensions, especially f->height, must be done via change_frame_size.
2277 Change will not be effected unless different from the current
2281 f
->height
= f
->width
= 0;
2282 change_frame_size (f
, height
, width
, 1, 0);
2284 /* With the toolkit, the geometry management is done in x_window. */
2285 #ifndef USE_X_TOOLKIT
2287 x_wm_set_size_hint (f
, window_prompting
, 1);
2289 #endif /* USE_X_TOOLKIT */
2291 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2292 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2294 /* It is now ok to make the frame official
2295 even if we get an error below.
2296 And the frame needs to be on Vframe_list
2297 or making it visible won't work. */
2298 Vframe_list
= Fcons (frame
, Vframe_list
);
2300 /* Make the window appear on the frame and enable display,
2301 unless the caller says not to. */
2303 Lisp_Object visibility
;
2305 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2306 if (EQ (visibility
, Qunbound
))
2309 if (EQ (visibility
, Qicon
))
2310 x_iconify_frame (f
);
2311 else if (! NILP (visibility
))
2312 x_make_frame_visible (f
);
2314 /* Must have been Qnil. */
2318 return unbind_to (count
, frame
);
2321 Lisp_Object frame
, tem
;
2323 int pixelwidth
, pixelheight
;
2328 int minibuffer_only
= 0;
2329 Lisp_Object vscroll
, hscroll
;
2331 if (x_current_display
== 0)
2332 error ("X windows are not in use or not initialized");
2334 name
= Fassq (Qname
, parms
);
2336 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2337 if (EQ (tem
, Qnone
))
2338 f
= make_frame_without_minibuffer (Qnil
);
2339 else if (EQ (tem
, Qonly
))
2341 f
= make_minibuffer_frame ();
2342 minibuffer_only
= 1;
2344 else if (EQ (tem
, Qnil
) || EQ (tem
, Qunbound
))
2347 f
= make_frame_without_minibuffer (tem
);
2349 parent
= ROOT_WINDOW
;
2351 XSET (frame
, Lisp_Frame
, f
);
2352 f
->output_method
= output_x_window
;
2353 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2354 bzero (f
->display
.x
, sizeof (struct x_display
));
2356 /* Some temporary default values for height and width. */
2359 f
->display
.x
->left_pos
= -1;
2360 f
->display
.x
->top_pos
= -1;
2362 /* Give the frame a default name (which may be overridden with PARMS). */
2364 strncpy (iconidentity
, ICONTAG
, MAXICID
);
2365 if (gethostname (&iconidentity
[sizeof (ICONTAG
) - 1],
2366 (MAXICID
- 1) - sizeof (ICONTAG
)))
2367 iconidentity
[sizeof (ICONTAG
) - 2] = '\0';
2368 f
->name
= build_string (iconidentity
);
2370 /* Extract some window parameters from the supplied values.
2371 These are the parameters that affect window geometry. */
2373 tem
= x_get_arg (parms
, Qfont
, "BodyFont", 0, string
);
2374 if (EQ (tem
, Qunbound
))
2375 tem
= build_string ("9x15");
2376 x_set_font (f
, tem
, Qnil
);
2377 x_default_parameter (f
, parms
, Qborder_color
,
2378 build_string ("black"), "Border", 0, string
);
2379 x_default_parameter (f
, parms
, Qbackground_color
,
2380 build_string ("white"), "Background", 0, string
);
2381 x_default_parameter (f
, parms
, Qforeground_color
,
2382 build_string ("black"), "Foreground", 0, string
);
2383 x_default_parameter (f
, parms
, Qmouse_color
,
2384 build_string ("black"), "Mouse", 0, string
);
2385 x_default_parameter (f
, parms
, Qcursor_color
,
2386 build_string ("black"), "Cursor", 0, string
);
2387 x_default_parameter (f
, parms
, Qborder_width
,
2388 make_number (2), "BorderWidth", 0, number
);
2389 x_default_parameter (f
, parms
, Qinternal_border_width
,
2390 make_number (4), "InternalBorderWidth", 0, number
);
2391 x_default_parameter (f
, parms
, Qauto_raise
,
2392 Qnil
, "AutoRaise", 0, boolean
);
2394 hscroll
= EQ (x_get_arg (parms
, Qhorizontal_scroll_bar
, 0, 0, boolean
), Qt
);
2395 vscroll
= EQ (x_get_arg (parms
, Qvertical_scroll_bar
, 0, 0, boolean
), Qt
);
2397 if (f
->display
.x
->internal_border_width
< 0)
2398 f
->display
.x
->internal_border_width
= 0;
2400 tem
= x_get_arg (parms
, Qwindow_id
, 0, 0, number
);
2401 if (!EQ (tem
, Qunbound
))
2403 WINDOWINFO_TYPE wininfo
;
2405 Window
*children
, root
;
2407 CHECK_NUMBER (tem
, 0);
2408 FRAME_X_WINDOW (f
) = (Window
) XINT (tem
);
2411 XGetWindowInfo (FRAME_X_WINDOW (f
), &wininfo
);
2412 XQueryTree (FRAME_X_WINDOW (f
), &parent
, &nchildren
, &children
);
2416 height
= PIXEL_TO_CHAR_HEIGHT (f
, wininfo
.height
);
2417 width
= PIXEL_TO_CHAR_WIDTH (f
, wininfo
.width
);
2418 f
->display
.x
->left_pos
= wininfo
.x
;
2419 f
->display
.x
->top_pos
= wininfo
.y
;
2420 FRAME_SET_VISIBILITY (f
, wininfo
.mapped
!= 0);
2421 f
->display
.x
->border_width
= wininfo
.bdrwidth
;
2422 f
->display
.x
->parent_desc
= parent
;
2426 tem
= x_get_arg (parms
, Qparent_id
, 0, 0, number
);
2427 if (!EQ (tem
, Qunbound
))
2429 CHECK_NUMBER (tem
, 0);
2430 parent
= (Window
) XINT (tem
);
2432 f
->display
.x
->parent_desc
= parent
;
2433 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2434 if (EQ (tem
, Qunbound
))
2436 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2437 if (EQ (tem
, Qunbound
))
2439 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2440 if (EQ (tem
, Qunbound
))
2441 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2444 /* Now TEM is Qunbound if no edge or size was specified.
2445 In that case, we must do rubber-banding. */
2446 if (EQ (tem
, Qunbound
))
2448 tem
= x_get_arg (parms
, Qgeometry
, 0, 0, number
);
2450 &f
->display
.x
->left_pos
, &f
->display
.x
->top_pos
,
2452 (XTYPE (tem
) == Lisp_String
2453 ? (char *) XSTRING (tem
)->data
: ""),
2454 XSTRING (f
->name
)->data
,
2455 !NILP (hscroll
), !NILP (vscroll
));
2459 /* Here if at least one edge or size was specified.
2460 Demand that they all were specified, and use them. */
2461 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2462 if (EQ (tem
, Qunbound
))
2463 error ("Height not specified");
2464 CHECK_NUMBER (tem
, 0);
2465 height
= XINT (tem
);
2467 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2468 if (EQ (tem
, Qunbound
))
2469 error ("Width not specified");
2470 CHECK_NUMBER (tem
, 0);
2473 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2474 if (EQ (tem
, Qunbound
))
2475 error ("Top position not specified");
2476 CHECK_NUMBER (tem
, 0);
2477 f
->display
.x
->left_pos
= XINT (tem
);
2479 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2480 if (EQ (tem
, Qunbound
))
2481 error ("Left position not specified");
2482 CHECK_NUMBER (tem
, 0);
2483 f
->display
.x
->top_pos
= XINT (tem
);
2486 pixelwidth
= CHAR_TO_PIXEL_WIDTH (f
, width
);
2487 pixelheight
= CHAR_TO_PIXEL_HEIGHT (f
, height
);
2491 = XCreateWindow (parent
,
2492 f
->display
.x
->left_pos
, /* Absolute horizontal offset */
2493 f
->display
.x
->top_pos
, /* Absolute Vertical offset */
2494 pixelwidth
, pixelheight
,
2495 f
->display
.x
->border_width
,
2496 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
2498 if (FRAME_X_WINDOW (f
) == 0)
2499 error ("Unable to create window.");
2502 /* Install the now determined height and width
2503 in the windows and in phys_lines and desired_lines. */
2504 change_frame_size (f
, height
, width
, 1, 0);
2505 XSelectInput (FRAME_X_WINDOW (f
), KeyPressed
| ExposeWindow
2506 | ButtonPressed
| ButtonReleased
| ExposeRegion
| ExposeCopy
2507 | EnterWindow
| LeaveWindow
| UnmapWindow
);
2508 x_set_resize_hint (f
);
2510 /* Tell the server the window's default name. */
2511 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
), XSTRING (f
->name
)->data
);
2513 /* Now override the defaults with all the rest of the specified
2515 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2516 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2518 /* Do not create an icon window if the caller says not to */
2519 if (!EQ (x_get_arg (parms
, Qsuppress_icon
, 0, 0, boolean
), Qt
)
2520 || f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2522 x_text_icon (f
, iconidentity
);
2523 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2524 "BitmapIcon", 0, symbol
);
2527 /* Tell the X server the previously set values of the
2528 background, border and mouse colors; also create the mouse cursor. */
2530 temp
= XMakeTile (f
->display
.x
->background_pixel
);
2531 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
2534 x_set_border_pixel (f
, f
->display
.x
->border_pixel
);
2536 x_set_mouse_color (f
, Qnil
, Qnil
);
2538 /* Now override the defaults with all the rest of the specified parms. */
2540 Fmodify_frame_parameters (frame
, parms
);
2542 /* Make the window appear on the frame and enable display. */
2544 Lisp_Object visibility
;
2546 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2547 if (EQ (visibility
, Qunbound
))
2550 if (! EQ (visibility
, Qicon
)
2551 && ! NILP (visibility
))
2552 x_make_window_visible (f
);
2555 SET_FRAME_GARBAGED (f
);
2557 Vframe_list
= Fcons (frame
, Vframe_list
);
2563 x_get_focus_frame ()
2566 if (! x_focus_frame
)
2569 XSET (xfocus
, Lisp_Frame
, x_focus_frame
);
2573 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
2574 "Set the focus on FRAME.")
2578 CHECK_LIVE_FRAME (frame
, 0);
2580 if (FRAME_X_P (XFRAME (frame
)))
2583 x_focus_on_frame (XFRAME (frame
));
2591 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
2592 "If a frame has been focused, release it.")
2598 x_unfocus_frame (x_focus_frame
);
2606 /* Computes an X-window size and position either from geometry GEO
2609 F is a frame. It specifies an X window which is used to
2610 determine which display to compute for. Its font, borders
2611 and colors control how the rectangle will be displayed.
2613 X and Y are where to store the positions chosen.
2614 WIDTH and HEIGHT are where to store the sizes chosen.
2616 GEO is the geometry that may specify some of the info.
2617 STR is a prompt to display.
2618 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2621 x_rubber_band (f
, x
, y
, width
, height
, geo
, str
, hscroll
, vscroll
)
2623 int *x
, *y
, *width
, *height
;
2626 int hscroll
, vscroll
;
2632 int background_color
;
2638 background_color
= f
->display
.x
->background_pixel
;
2639 border_color
= f
->display
.x
->border_pixel
;
2641 frame
.bdrwidth
= f
->display
.x
->border_width
;
2642 frame
.border
= XMakeTile (border_color
);
2643 frame
.background
= XMakeTile (background_color
);
2644 tempwindow
= XCreateTerm (str
, "emacs", geo
, default_window
, &frame
, 10, 5,
2645 (2 * f
->display
.x
->internal_border_width
2646 + (vscroll
? VSCROLL_WIDTH
: 0)),
2647 (2 * f
->display
.x
->internal_border_width
2648 + (hscroll
? HSCROLL_HEIGHT
: 0)),
2649 width
, height
, f
->display
.x
->font
,
2650 FONT_WIDTH (f
->display
.x
->font
),
2651 f
->display
.x
->line_height
);
2652 XFreePixmap (frame
.border
);
2653 XFreePixmap (frame
.background
);
2655 if (tempwindow
!= 0)
2657 XQueryWindow (tempwindow
, &wininfo
);
2658 XDestroyWindow (tempwindow
);
2663 /* Coordinates we got are relative to the root window.
2664 Convert them to coordinates relative to desired parent window
2665 by scanning from there up to the root. */
2666 tempwindow
= f
->display
.x
->parent_desc
;
2667 while (tempwindow
!= ROOT_WINDOW
)
2671 XQueryWindow (tempwindow
, &wininfo
);
2674 XQueryTree (tempwindow
, &tempwindow
, &nchildren
, &children
);
2679 return tempwindow
!= 0;
2681 #endif /* not HAVE_X11 */
2683 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
2684 "Return a list of the names of available fonts matching PATTERN.\n\
2685 If optional arguments FACE and FRAME are specified, return only fonts\n\
2686 the same size as FACE on FRAME.\n\
2688 PATTERN is a string, perhaps with wildcard characters;\n\
2689 the * character matches any substring, and\n\
2690 the ? character matches any single character.\n\
2691 PATTERN is case-insensitive.\n\
2692 FACE is a face name - a symbol.\n\
2694 The return value is a list of strings, suitable as arguments to\n\
2697 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
2698 even if they match PATTERN and FACE.")
2699 (pattern
, face
, frame
)
2700 Lisp_Object pattern
, face
, frame
;
2705 XFontStruct
*size_ref
;
2709 CHECK_STRING (pattern
, 0);
2711 CHECK_SYMBOL (face
, 1);
2713 CHECK_LIVE_FRAME (frame
, 2);
2719 FRAME_PTR f
= NILP (frame
) ? selected_frame
: XFRAME (frame
);
2722 /* Don't die if we get called with a terminal frame. */
2723 if (! FRAME_X_P (f
))
2724 error ("non-X frame used in `x-list-fonts'");
2726 face_id
= face_name_id_number (f
, face
);
2728 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
2729 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
2730 size_ref
= f
->display
.x
->font
;
2733 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
2734 if (size_ref
== (XFontStruct
*) (~0))
2735 size_ref
= f
->display
.x
->font
;
2741 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
2742 #ifdef BROKEN_XLISTFONTSWITHINFO
2743 names
= XListFonts (x_current_display
,
2744 XSTRING (pattern
)->data
,
2745 2000, /* maxnames */
2746 &num_fonts
); /* count_return */
2748 names
= XListFontsWithInfo (x_current_display
,
2749 XSTRING (pattern
)->data
,
2750 2000, /* maxnames */
2751 &num_fonts
, /* count_return */
2752 &info
); /* info_return */
2764 for (i
= 0; i
< num_fonts
; i
++)
2766 XFontStruct
*thisinfo
;
2768 #ifdef BROKEN_XLISTFONTSWITHINFO
2770 thisinfo
= XLoadQueryFont (x_current_display
, names
[i
]);
2773 thisinfo
= &info
[i
];
2775 if (thisinfo
&& (! size_ref
2776 || same_size_fonts (thisinfo
, size_ref
)))
2778 *tail
= Fcons (build_string (names
[i
]), Qnil
);
2779 tail
= &XCONS (*tail
)->cdr
;
2784 #ifdef BROKEN_XLISTFONTSWITHINFO
2785 XFreeFontNames (names
);
2787 XFreeFontInfo (names
, info
, num_fonts
);
2796 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 1, 0,
2797 "Return t if the current X display supports the color named COLOR.")
2804 CHECK_STRING (color
, 0);
2806 if (defined_color (XSTRING (color
)->data
, &foo
))
2812 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 0, 0,
2813 "Return t if the X screen currently in use supports color.")
2818 if (x_screen_planes
<= 2)
2821 switch (screen_visual
->class)
2834 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
2836 "Returns the width in pixels of the display FRAME is on.")
2840 Display
*dpy
= x_current_display
;
2842 return make_number (DisplayWidth (dpy
, DefaultScreen (dpy
)));
2845 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
2846 Sx_display_pixel_height
, 0, 1, 0,
2847 "Returns the height in pixels of the display FRAME is on.")
2851 Display
*dpy
= x_current_display
;
2853 return make_number (DisplayHeight (dpy
, DefaultScreen (dpy
)));
2856 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
2858 "Returns the number of bitplanes of the display FRAME is on.")
2862 Display
*dpy
= x_current_display
;
2864 return make_number (DisplayPlanes (dpy
, DefaultScreen (dpy
)));
2867 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
2869 "Returns the number of color cells of the display FRAME is on.")
2873 Display
*dpy
= x_current_display
;
2875 return make_number (DisplayCells (dpy
, DefaultScreen (dpy
)));
2878 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
2879 Sx_server_max_request_size
,
2881 "Returns the maximum request size of the X server FRAME is using.")
2885 Display
*dpy
= x_current_display
;
2887 return make_number (MAXREQUEST (dpy
));
2890 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
2891 "Returns the vendor ID string of the X server FRAME is on.")
2895 Display
*dpy
= x_current_display
;
2898 vendor
= ServerVendor (dpy
);
2899 if (! vendor
) vendor
= "";
2900 return build_string (vendor
);
2903 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
2904 "Returns the version numbers of the X server in use.\n\
2905 The value is a list of three integers: the major and minor\n\
2906 version numbers of the X Protocol in use, and the vendor-specific release\n\
2907 number. See also the variable `x-server-vendor'.")
2911 Display
*dpy
= x_current_display
;
2914 return Fcons (make_number (ProtocolVersion (dpy
)),
2915 Fcons (make_number (ProtocolRevision (dpy
)),
2916 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
2919 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
2920 "Returns the number of screens on the X server FRAME is on.")
2925 return make_number (ScreenCount (x_current_display
));
2928 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
2929 "Returns the height in millimeters of the X screen FRAME is on.")
2934 return make_number (HeightMMOfScreen (x_screen
));
2937 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
2938 "Returns the width in millimeters of the X screen FRAME is on.")
2943 return make_number (WidthMMOfScreen (x_screen
));
2946 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
2947 Sx_display_backing_store
, 0, 1, 0,
2948 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2949 The value may be `always', `when-mapped', or `not-useful'.")
2955 switch (DoesBackingStore (x_screen
))
2958 return intern ("always");
2961 return intern ("when-mapped");
2964 return intern ("not-useful");
2967 error ("Strange value for BackingStore parameter of screen");
2971 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
2972 Sx_display_visual_class
, 0, 1, 0,
2973 "Returns the visual class of the display `screen' is on.\n\
2974 The value is one of the symbols `static-gray', `gray-scale',\n\
2975 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2981 switch (screen_visual
->class)
2983 case StaticGray
: return (intern ("static-gray"));
2984 case GrayScale
: return (intern ("gray-scale"));
2985 case StaticColor
: return (intern ("static-color"));
2986 case PseudoColor
: return (intern ("pseudo-color"));
2987 case TrueColor
: return (intern ("true-color"));
2988 case DirectColor
: return (intern ("direct-color"));
2990 error ("Display has an unknown visual class");
2994 DEFUN ("x-display-save-under", Fx_display_save_under
,
2995 Sx_display_save_under
, 0, 1, 0,
2996 "Returns t if the X screen FRAME is on supports the save-under feature.")
3002 if (DoesSaveUnders (x_screen
) == True
)
3009 register struct frame
*f
;
3011 return PIXEL_WIDTH (f
);
3015 register struct frame
*f
;
3017 return PIXEL_HEIGHT (f
);
3021 register struct frame
*f
;
3023 return FONT_WIDTH (f
->display
.x
->font
);
3027 register struct frame
*f
;
3029 return f
->display
.x
->line_height
;
3032 #if 0 /* These no longer seem like the right way to do things. */
3034 /* Draw a rectangle on the frame with left top corner including
3035 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3036 CHARS by LINES wide and long and is the color of the cursor. */
3039 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
3040 register struct frame
*f
;
3042 register int top_char
, left_char
, chars
, lines
;
3046 int left
= (left_char
* FONT_WIDTH (f
->display
.x
->font
)
3047 + f
->display
.x
->internal_border_width
);
3048 int top
= (top_char
* f
->display
.x
->line_height
3049 + f
->display
.x
->internal_border_width
);
3052 width
= FONT_WIDTH (f
->display
.x
->font
) / 2;
3054 width
= FONT_WIDTH (f
->display
.x
->font
) * chars
;
3056 height
= f
->display
.x
->line_height
/ 2;
3058 height
= f
->display
.x
->line_height
* lines
;
3060 XDrawRectangle (x_current_display
, FRAME_X_WINDOW (f
),
3061 gc
, left
, top
, width
, height
);
3064 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
3065 "Draw a rectangle on FRAME between coordinates specified by\n\
3066 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3067 (frame
, X0
, Y0
, X1
, Y1
)
3068 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
3070 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3072 CHECK_LIVE_FRAME (frame
, 0);
3073 CHECK_NUMBER (X0
, 0);
3074 CHECK_NUMBER (Y0
, 1);
3075 CHECK_NUMBER (X1
, 2);
3076 CHECK_NUMBER (Y1
, 3);
3086 n_lines
= y1
- y0
+ 1;
3091 n_lines
= y0
- y1
+ 1;
3097 n_chars
= x1
- x0
+ 1;
3102 n_chars
= x0
- x1
+ 1;
3106 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->cursor_gc
,
3107 left
, top
, n_chars
, n_lines
);
3113 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
3114 "Draw a rectangle drawn on FRAME between coordinates\n\
3115 X0, Y0, X1, Y1 in the regular background-pixel.")
3116 (frame
, X0
, Y0
, X1
, Y1
)
3117 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
3119 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3121 CHECK_FRAME (frame
, 0);
3122 CHECK_NUMBER (X0
, 0);
3123 CHECK_NUMBER (Y0
, 1);
3124 CHECK_NUMBER (X1
, 2);
3125 CHECK_NUMBER (Y1
, 3);
3135 n_lines
= y1
- y0
+ 1;
3140 n_lines
= y0
- y1
+ 1;
3146 n_chars
= x1
- x0
+ 1;
3151 n_chars
= x0
- x1
+ 1;
3155 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->reverse_gc
,
3156 left
, top
, n_chars
, n_lines
);
3162 /* Draw lines around the text region beginning at the character position
3163 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3164 pixel and line characteristics. */
3166 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3169 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
3170 register struct frame
*f
;
3172 int top_x
, top_y
, bottom_x
, bottom_y
;
3174 register int ibw
= f
->display
.x
->internal_border_width
;
3175 register int font_w
= FONT_WIDTH (f
->display
.x
->font
);
3176 register int font_h
= f
->display
.x
->line_height
;
3178 int x
= line_len (y
);
3179 XPoint
*pixel_points
3180 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
3181 register XPoint
*this_point
= pixel_points
;
3183 /* Do the horizontal top line/lines */
3186 this_point
->x
= ibw
;
3187 this_point
->y
= ibw
+ (font_h
* top_y
);
3190 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
3192 this_point
->x
= ibw
+ (font_w
* x
);
3193 this_point
->y
= (this_point
- 1)->y
;
3197 this_point
->x
= ibw
;
3198 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
3200 this_point
->x
= ibw
+ (font_w
* top_x
);
3201 this_point
->y
= (this_point
- 1)->y
;
3203 this_point
->x
= (this_point
- 1)->x
;
3204 this_point
->y
= ibw
+ (font_h
* top_y
);
3206 this_point
->x
= ibw
+ (font_w
* x
);
3207 this_point
->y
= (this_point
- 1)->y
;
3210 /* Now do the right side. */
3211 while (y
< bottom_y
)
3212 { /* Right vertical edge */
3214 this_point
->x
= (this_point
- 1)->x
;
3215 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
3218 y
++; /* Horizontal connection to next line */
3221 this_point
->x
= ibw
+ (font_w
/ 2);
3223 this_point
->x
= ibw
+ (font_w
* x
);
3225 this_point
->y
= (this_point
- 1)->y
;
3228 /* Now do the bottom and connect to the top left point. */
3229 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
3232 this_point
->x
= (this_point
- 1)->x
;
3233 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
3235 this_point
->x
= ibw
;
3236 this_point
->y
= (this_point
- 1)->y
;
3238 this_point
->x
= pixel_points
->x
;
3239 this_point
->y
= pixel_points
->y
;
3241 XDrawLines (x_current_display
, FRAME_X_WINDOW (f
),
3243 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
3246 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
3247 "Highlight the region between point and the character under the mouse\n\
3250 register Lisp_Object event
;
3252 register int x0
, y0
, x1
, y1
;
3253 register struct frame
*f
= selected_frame
;
3254 register int p1
, p2
;
3256 CHECK_CONS (event
, 0);
3259 x0
= XINT (Fcar (Fcar (event
)));
3260 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3262 /* If the mouse is past the end of the line, don't that area. */
3263 /* ReWrite this... */
3268 if (y1
> y0
) /* point below mouse */
3269 outline_region (f
, f
->display
.x
->cursor_gc
,
3271 else if (y1
< y0
) /* point above mouse */
3272 outline_region (f
, f
->display
.x
->cursor_gc
,
3274 else /* same line: draw horizontal rectangle */
3277 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3278 x0
, y0
, (x1
- x0
+ 1), 1);
3280 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3281 x1
, y1
, (x0
- x1
+ 1), 1);
3284 XFlush (x_current_display
);
3290 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
3291 "Erase any highlighting of the region between point and the character\n\
3292 at X, Y on the selected frame.")
3294 register Lisp_Object event
;
3296 register int x0
, y0
, x1
, y1
;
3297 register struct frame
*f
= selected_frame
;
3300 x0
= XINT (Fcar (Fcar (event
)));
3301 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3305 if (y1
> y0
) /* point below mouse */
3306 outline_region (f
, f
->display
.x
->reverse_gc
,
3308 else if (y1
< y0
) /* point above mouse */
3309 outline_region (f
, f
->display
.x
->reverse_gc
,
3311 else /* same line: draw horizontal rectangle */
3314 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3315 x0
, y0
, (x1
- x0
+ 1), 1);
3317 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3318 x1
, y1
, (x0
- x1
+ 1), 1);
3326 int contour_begin_x
, contour_begin_y
;
3327 int contour_end_x
, contour_end_y
;
3328 int contour_npoints
;
3330 /* Clip the top part of the contour lines down (and including) line Y_POS.
3331 If X_POS is in the middle (rather than at the end) of the line, drop
3332 down a line at that character. */
3335 clip_contour_top (y_pos
, x_pos
)
3337 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
3338 register XPoint
*end
;
3339 register int npoints
;
3340 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
3342 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
3344 end
= contour_lines
[y_pos
].top_right
;
3345 npoints
= (end
- begin
+ 1);
3346 XDrawLines (x_current_display
, contour_window
,
3347 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3349 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
3350 contour_last_point
-= (npoints
- 2);
3351 XDrawLines (x_current_display
, contour_window
,
3352 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
3353 XFlush (x_current_display
);
3355 /* Now, update contour_lines structure. */
3360 register XPoint
*p
= begin
+ 1;
3361 end
= contour_lines
[y_pos
].bottom_right
;
3362 npoints
= (end
- begin
+ 1);
3363 XDrawLines (x_current_display
, contour_window
,
3364 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3367 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
3369 p
->y
= begin
->y
+ font_h
;
3371 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
3372 contour_last_point
-= (npoints
- 5);
3373 XDrawLines (x_current_display
, contour_window
,
3374 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
3375 XFlush (x_current_display
);
3377 /* Now, update contour_lines structure. */
3381 /* Erase the top horizontal lines of the contour, and then extend
3382 the contour upwards. */
3385 extend_contour_top (line
)
3390 clip_contour_bottom (x_pos
, y_pos
)
3396 extend_contour_bottom (x_pos
, y_pos
)
3400 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
3405 register struct frame
*f
= selected_frame
;
3406 register int point_x
= f
->cursor_x
;
3407 register int point_y
= f
->cursor_y
;
3408 register int mouse_below_point
;
3409 register Lisp_Object obj
;
3410 register int x_contour_x
, x_contour_y
;
3412 x_contour_x
= x_mouse_x
;
3413 x_contour_y
= x_mouse_y
;
3414 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
3415 && x_contour_x
> point_x
))
3417 mouse_below_point
= 1;
3418 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3419 x_contour_x
, x_contour_y
);
3423 mouse_below_point
= 0;
3424 outline_region (f
, f
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
3430 obj
= read_char (-1, 0, 0, Qnil
, 0);
3431 if (XTYPE (obj
) != Lisp_Cons
)
3434 if (mouse_below_point
)
3436 if (x_mouse_y
<= point_y
) /* Flipped. */
3438 mouse_below_point
= 0;
3440 outline_region (f
, f
->display
.x
->reverse_gc
, point_x
, point_y
,
3441 x_contour_x
, x_contour_y
);
3442 outline_region (f
, f
->display
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
3445 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
3447 clip_contour_bottom (x_mouse_y
);
3449 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
3451 extend_bottom_contour (x_mouse_y
);
3454 x_contour_x
= x_mouse_x
;
3455 x_contour_y
= x_mouse_y
;
3457 else /* mouse above or same line as point */
3459 if (x_mouse_y
>= point_y
) /* Flipped. */
3461 mouse_below_point
= 1;
3463 outline_region (f
, f
->display
.x
->reverse_gc
,
3464 x_contour_x
, x_contour_y
, point_x
, point_y
);
3465 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3466 x_mouse_x
, x_mouse_y
);
3468 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
3470 clip_contour_top (x_mouse_y
);
3472 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
3474 extend_contour_top (x_mouse_y
);
3479 unread_command_event
= obj
;
3480 if (mouse_below_point
)
3482 contour_begin_x
= point_x
;
3483 contour_begin_y
= point_y
;
3484 contour_end_x
= x_contour_x
;
3485 contour_end_y
= x_contour_y
;
3489 contour_begin_x
= x_contour_x
;
3490 contour_begin_y
= x_contour_y
;
3491 contour_end_x
= point_x
;
3492 contour_end_y
= point_y
;
3497 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
3502 register Lisp_Object obj
;
3503 struct frame
*f
= selected_frame
;
3504 register struct window
*w
= XWINDOW (selected_window
);
3505 register GC line_gc
= f
->display
.x
->cursor_gc
;
3506 register GC erase_gc
= f
->display
.x
->reverse_gc
;
3508 char dash_list
[] = {6, 4, 6, 4};
3510 XGCValues gc_values
;
3512 register int previous_y
;
3513 register int line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3514 + f
->display
.x
->internal_border_width
;
3515 register int left
= f
->display
.x
->internal_border_width
3517 * FONT_WIDTH (f
->display
.x
->font
));
3518 register int right
= left
+ (w
->width
3519 * FONT_WIDTH (f
->display
.x
->font
))
3520 - f
->display
.x
->internal_border_width
;
3524 gc_values
.foreground
= f
->display
.x
->cursor_pixel
;
3525 gc_values
.background
= f
->display
.x
->background_pixel
;
3526 gc_values
.line_width
= 1;
3527 gc_values
.line_style
= LineOnOffDash
;
3528 gc_values
.cap_style
= CapRound
;
3529 gc_values
.join_style
= JoinRound
;
3531 line_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3532 GCLineStyle
| GCJoinStyle
| GCCapStyle
3533 | GCLineWidth
| GCForeground
| GCBackground
,
3535 XSetDashes (x_current_display
, line_gc
, 0, dash_list
, dashes
);
3536 gc_values
.foreground
= f
->display
.x
->background_pixel
;
3537 gc_values
.background
= f
->display
.x
->foreground_pixel
;
3538 erase_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3539 GCLineStyle
| GCJoinStyle
| GCCapStyle
3540 | GCLineWidth
| GCForeground
| GCBackground
,
3542 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
3548 if (x_mouse_y
>= XINT (w
->top
)
3549 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
3551 previous_y
= x_mouse_y
;
3552 line
= (x_mouse_y
+ 1) * f
->display
.x
->line_height
3553 + f
->display
.x
->internal_border_width
;
3554 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3555 line_gc
, left
, line
, right
, line
);
3562 obj
= read_char (-1, 0, 0, Qnil
, 0);
3563 if ((XTYPE (obj
) != Lisp_Cons
)
3564 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3565 Qvertical_scroll_bar
))
3569 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3570 erase_gc
, left
, line
, right
, line
);
3572 unread_command_event
= obj
;
3574 XFreeGC (x_current_display
, line_gc
);
3575 XFreeGC (x_current_display
, erase_gc
);
3580 while (x_mouse_y
== previous_y
);
3583 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3584 erase_gc
, left
, line
, right
, line
);
3590 /* Offset in buffer of character under the pointer, or 0. */
3591 int mouse_buffer_offset
;
3594 /* These keep track of the rectangle following the pointer. */
3595 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
3597 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
3598 "Track the pointer.")
3601 static Cursor current_pointer_shape
;
3602 FRAME_PTR f
= x_mouse_frame
;
3605 if (EQ (Vmouse_frame_part
, Qtext_part
)
3606 && (current_pointer_shape
!= f
->display
.x
->nontext_cursor
))
3611 current_pointer_shape
= f
->display
.x
->nontext_cursor
;
3612 XDefineCursor (x_current_display
,
3614 current_pointer_shape
);
3616 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
3617 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
3619 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
3620 && (current_pointer_shape
!= f
->display
.x
->modeline_cursor
))
3622 current_pointer_shape
= f
->display
.x
->modeline_cursor
;
3623 XDefineCursor (x_current_display
,
3625 current_pointer_shape
);
3634 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
3635 "Draw rectangle around character under mouse pointer, if there is one.")
3639 struct window
*w
= XWINDOW (Vmouse_window
);
3640 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
3641 struct buffer
*b
= XBUFFER (w
->buffer
);
3644 if (! EQ (Vmouse_window
, selected_window
))
3647 if (EQ (event
, Qnil
))
3651 x_read_mouse_position (selected_frame
, &x
, &y
);
3655 mouse_track_width
= 0;
3656 mouse_track_left
= mouse_track_top
= -1;
3660 if ((x_mouse_x
!= mouse_track_left
3661 && (x_mouse_x
< mouse_track_left
3662 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
3663 || x_mouse_y
!= mouse_track_top
)
3665 int hp
= 0; /* Horizontal position */
3666 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
3667 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
3668 int tab_width
= XINT (b
->tab_width
);
3669 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
3671 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
3672 int in_mode_line
= 0;
3674 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
3677 /* Erase previous rectangle. */
3678 if (mouse_track_width
)
3680 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3681 mouse_track_left
, mouse_track_top
,
3682 mouse_track_width
, 1);
3684 if ((mouse_track_left
== f
->phys_cursor_x
3685 || mouse_track_left
== f
->phys_cursor_x
- 1)
3686 && mouse_track_top
== f
->phys_cursor_y
)
3688 x_display_cursor (f
, 1);
3692 mouse_track_left
= x_mouse_x
;
3693 mouse_track_top
= x_mouse_y
;
3694 mouse_track_width
= 0;
3696 if (mouse_track_left
> len
) /* Past the end of line. */
3699 if (mouse_track_top
== mode_line_vpos
)
3705 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3709 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
3715 mouse_track_width
= tab_width
- (hp
% tab_width
);
3717 hp
+= mouse_track_width
;
3720 mouse_track_left
= hp
- mouse_track_width
;
3726 mouse_track_width
= -1;
3730 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3735 mouse_track_width
= 2;
3740 mouse_track_left
= hp
- mouse_track_width
;
3746 mouse_track_width
= 1;
3753 while (hp
<= x_mouse_x
);
3756 if (mouse_track_width
) /* Over text; use text pointer shape. */
3758 XDefineCursor (x_current_display
,
3760 f
->display
.x
->text_cursor
);
3761 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3762 mouse_track_left
, mouse_track_top
,
3763 mouse_track_width
, 1);
3765 else if (in_mode_line
)
3766 XDefineCursor (x_current_display
,
3768 f
->display
.x
->modeline_cursor
);
3770 XDefineCursor (x_current_display
,
3772 f
->display
.x
->nontext_cursor
);
3775 XFlush (x_current_display
);
3778 obj
= read_char (-1, 0, 0, Qnil
, 0);
3781 while (XTYPE (obj
) == Lisp_Cons
/* Mouse event */
3782 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
3783 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
3784 && EQ (Vmouse_window
, selected_window
) /* In this window */
3787 unread_command_event
= obj
;
3789 if (mouse_track_width
)
3791 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3792 mouse_track_left
, mouse_track_top
,
3793 mouse_track_width
, 1);
3794 mouse_track_width
= 0;
3795 if ((mouse_track_left
== f
->phys_cursor_x
3796 || mouse_track_left
- 1 == f
->phys_cursor_x
)
3797 && mouse_track_top
== f
->phys_cursor_y
)
3799 x_display_cursor (f
, 1);
3802 XDefineCursor (x_current_display
,
3804 f
->display
.x
->nontext_cursor
);
3805 XFlush (x_current_display
);
3815 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3816 on the frame F at position X, Y. */
3818 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
3820 int x
, y
, width
, height
;
3825 image
= XCreateBitmapFromData (x_current_display
,
3826 FRAME_X_WINDOW (f
), image_data
,
3828 XCopyPlane (x_current_display
, image
, FRAME_X_WINDOW (f
),
3829 f
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
3834 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer
, Sx_store_cut_buffer
,
3835 1, 1, "sStore text in cut buffer: ",
3836 "Store contents of STRING into the cut buffer of the X window system.")
3838 register Lisp_Object string
;
3842 CHECK_STRING (string
, 1);
3843 if (! FRAME_X_P (selected_frame
))
3844 error ("Selected frame does not understand X protocol.");
3847 XStoreBytes ((char *) XSTRING (string
)->data
, XSTRING (string
)->size
);
3853 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer
, Sx_get_cut_buffer
, 0, 0, 0,
3854 "Return contents of cut buffer of the X window system, as a string.")
3858 register Lisp_Object string
;
3863 d
= XFetchBytes (&len
);
3864 string
= make_string (d
, len
);
3871 #if 0 /* I'm told these functions are superfluous
3872 given the ability to bind function keys. */
3875 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3876 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3877 KEYSYM is a string which conforms to the X keysym definitions found\n\
3878 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3879 list of strings specifying modifier keys such as Control_L, which must\n\
3880 also be depressed for NEWSTRING to appear.")
3881 (x_keysym
, modifiers
, newstring
)
3882 register Lisp_Object x_keysym
;
3883 register Lisp_Object modifiers
;
3884 register Lisp_Object newstring
;
3887 register KeySym keysym
;
3888 KeySym modifier_list
[16];
3891 CHECK_STRING (x_keysym
, 1);
3892 CHECK_STRING (newstring
, 3);
3894 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
3895 if (keysym
== NoSymbol
)
3896 error ("Keysym does not exist");
3898 if (NILP (modifiers
))
3899 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
3900 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3903 register Lisp_Object rest
, mod
;
3906 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
3909 error ("Can't have more than 16 modifiers");
3912 CHECK_STRING (mod
, 3);
3913 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
3915 if (modifier_list
[i
] == NoSymbol
3916 || !(IsModifierKey (modifier_list
[i
])
3917 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
3918 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
3920 if (modifier_list
[i
] == NoSymbol
3921 || !IsModifierKey (modifier_list
[i
]))
3923 error ("Element is not a modifier keysym");
3927 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
3928 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3934 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
3935 "Rebind KEYCODE to list of strings STRINGS.\n\
3936 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3937 nil as element means don't change.\n\
3938 See the documentation of `x-rebind-key' for more information.")
3940 register Lisp_Object keycode
;
3941 register Lisp_Object strings
;
3943 register Lisp_Object item
;
3944 register unsigned char *rawstring
;
3945 KeySym rawkey
, modifier
[1];
3947 register unsigned i
;
3950 CHECK_NUMBER (keycode
, 1);
3951 CHECK_CONS (strings
, 2);
3952 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
3953 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
3955 item
= Fcar (strings
);
3958 CHECK_STRING (item
, 2);
3959 strsize
= XSTRING (item
)->size
;
3960 rawstring
= (unsigned char *) xmalloc (strsize
);
3961 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
3962 modifier
[1] = 1 << i
;
3963 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
3964 rawstring
, strsize
);
3969 #endif /* HAVE_X11 */
3974 #ifndef HAVE_XSCREENNUMBEROFSCREEN
3976 XScreenNumberOfScreen (scr
)
3977 register Screen
*scr
;
3979 register Display
*dpy
;
3980 register Screen
*dpyscr
;
3984 dpyscr
= dpy
->screens
;
3986 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
3992 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
3995 select_visual (screen
, depth
)
3997 unsigned int *depth
;
4000 XVisualInfo
*vinfo
, vinfo_template
;
4003 v
= DefaultVisualOfScreen (screen
);
4006 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
4008 vinfo_template
.visualid
= v
->visualid
;
4011 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4013 vinfo
= XGetVisualInfo (x_current_display
,
4014 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
4017 fatal ("Can't get proper X visual info");
4019 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
4020 *depth
= vinfo
->depth
;
4024 int n
= vinfo
->colormap_size
- 1;
4033 XFree ((char *) vinfo
);
4036 #endif /* HAVE_X11 */
4038 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4039 1, 2, 0, "Open a connection to an X server.\n\
4040 DISPLAY is the name of the display to connect to.\n\
4041 Optional second arg XRM_STRING is a string of resources in xrdb format.")
4042 (display
, xrm_string
)
4043 Lisp_Object display
, xrm_string
;
4045 unsigned int n_planes
;
4046 unsigned char *xrm_option
;
4048 CHECK_STRING (display
, 0);
4049 if (x_current_display
!= 0)
4050 error ("X server connection is already initialized");
4051 if (! NILP (xrm_string
))
4052 CHECK_STRING (xrm_string
, 1);
4054 /* This is what opens the connection and sets x_current_display.
4055 This also initializes many symbols, such as those used for input. */
4056 x_term_init (XSTRING (display
)->data
);
4059 XFASTINT (Vwindow_system_version
) = 11;
4061 if (! NILP (xrm_string
))
4062 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4064 xrm_option
= (unsigned char *) 0;
4066 validate_x_resource_name ();
4069 xrdb
= x_load_resources (x_current_display
, xrm_option
,
4070 (char *) XSTRING (Vx_resource_name
)->data
,
4073 #ifdef HAVE_XRMSETDATABASE
4074 XrmSetDatabase (x_current_display
, xrdb
);
4076 x_current_display
->db
= xrdb
;
4079 x_screen
= DefaultScreenOfDisplay (x_current_display
);
4081 screen_visual
= select_visual (x_screen
, &n_planes
);
4082 x_screen_planes
= n_planes
;
4083 x_screen_height
= HeightOfScreen (x_screen
);
4084 x_screen_width
= WidthOfScreen (x_screen
);
4086 /* X Atoms used by emacs. */
4087 Xatoms_of_xselect ();
4089 Xatom_wm_protocols
= XInternAtom (x_current_display
, "WM_PROTOCOLS",
4091 Xatom_wm_take_focus
= XInternAtom (x_current_display
, "WM_TAKE_FOCUS",
4093 Xatom_wm_save_yourself
= XInternAtom (x_current_display
, "WM_SAVE_YOURSELF",
4095 Xatom_wm_delete_window
= XInternAtom (x_current_display
, "WM_DELETE_WINDOW",
4097 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
4099 Xatom_wm_configure_denied
= XInternAtom (x_current_display
,
4100 "WM_CONFIGURE_DENIED", False
);
4101 Xatom_wm_window_moved
= XInternAtom (x_current_display
, "WM_MOVED",
4103 Xatom_editres_name
= XInternAtom (x_current_display
, "Editres", False
);
4105 #else /* not HAVE_X11 */
4106 XFASTINT (Vwindow_system_version
) = 10;
4107 #endif /* not HAVE_X11 */
4111 DEFUN ("x-close-current-connection", Fx_close_current_connection
,
4112 Sx_close_current_connection
,
4113 0, 0, 0, "Close the connection to the current X server.")
4116 /* Note: If we're going to call check_x here, then the fatal error
4117 can't happen. For the moment, this check is just for safety,
4118 so a user won't try out the function and get a crash. If it's
4119 really intended only to be called when killing emacs, then there's
4120 no reason for it to have a lisp interface at all. */
4123 /* This is ONLY used when killing emacs; For switching displays
4124 we'll have to take care of setting CloseDownMode elsewhere. */
4126 if (x_current_display
)
4129 XSetCloseDownMode (x_current_display
, DestroyAll
);
4130 XCloseDisplay (x_current_display
);
4131 x_current_display
= 0;
4134 fatal ("No current X display connection to close\n");
4139 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
,
4140 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4141 If ON is nil, allow buffering of requests.\n\
4142 Turning on synchronization prohibits the Xlib routines from buffering\n\
4143 requests and seriously degrades performance, but makes debugging much\n\
4150 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
4155 /* Wait for responses to all X commands issued so far for FRAME. */
4162 XSync (x_current_display
, False
);
4168 /* This is zero if not using X windows. */
4169 x_current_display
= 0;
4171 /* The section below is built by the lisp expression at the top of the file,
4172 just above where these variables are declared. */
4173 /*&&& init symbols here &&&*/
4174 Qauto_raise
= intern ("auto-raise");
4175 staticpro (&Qauto_raise
);
4176 Qauto_lower
= intern ("auto-lower");
4177 staticpro (&Qauto_lower
);
4178 Qbackground_color
= intern ("background-color");
4179 staticpro (&Qbackground_color
);
4180 Qbar
= intern ("bar");
4182 Qborder_color
= intern ("border-color");
4183 staticpro (&Qborder_color
);
4184 Qborder_width
= intern ("border-width");
4185 staticpro (&Qborder_width
);
4186 Qbox
= intern ("box");
4188 Qcursor_color
= intern ("cursor-color");
4189 staticpro (&Qcursor_color
);
4190 Qcursor_type
= intern ("cursor-type");
4191 staticpro (&Qcursor_type
);
4192 Qfont
= intern ("font");
4194 Qforeground_color
= intern ("foreground-color");
4195 staticpro (&Qforeground_color
);
4196 Qgeometry
= intern ("geometry");
4197 staticpro (&Qgeometry
);
4198 Qicon_left
= intern ("icon-left");
4199 staticpro (&Qicon_left
);
4200 Qicon_top
= intern ("icon-top");
4201 staticpro (&Qicon_top
);
4202 Qicon_type
= intern ("icon-type");
4203 staticpro (&Qicon_type
);
4204 Qinternal_border_width
= intern ("internal-border-width");
4205 staticpro (&Qinternal_border_width
);
4206 Qleft
= intern ("left");
4208 Qmouse_color
= intern ("mouse-color");
4209 staticpro (&Qmouse_color
);
4210 Qnone
= intern ("none");
4212 Qparent_id
= intern ("parent-id");
4213 staticpro (&Qparent_id
);
4214 Qsuppress_icon
= intern ("suppress-icon");
4215 staticpro (&Qsuppress_icon
);
4216 Qtop
= intern ("top");
4218 Qundefined_color
= intern ("undefined-color");
4219 staticpro (&Qundefined_color
);
4220 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
4221 staticpro (&Qvertical_scroll_bars
);
4222 Qvisibility
= intern ("visibility");
4223 staticpro (&Qvisibility
);
4224 Qwindow_id
= intern ("window-id");
4225 staticpro (&Qwindow_id
);
4226 Qx_frame_parameter
= intern ("x-frame-parameter");
4227 staticpro (&Qx_frame_parameter
);
4228 Qx_resource_name
= intern ("x-resource-name");
4229 staticpro (&Qx_resource_name
);
4230 /* This is the end of symbol initialization. */
4232 Fput (Qundefined_color
, Qerror_conditions
,
4233 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
4234 Fput (Qundefined_color
, Qerror_message
,
4235 build_string ("Undefined color"));
4237 init_x_parm_symbols ();
4239 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset
,
4240 "The buffer offset of the character under the pointer.");
4241 mouse_buffer_offset
= 0;
4243 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
4244 "The shape of the pointer when over text.\n\
4245 Changing the value does not affect existing frames\n\
4246 unless you set the mouse color.");
4247 Vx_pointer_shape
= Qnil
;
4249 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
4250 "The name Emacs uses to look up X resources; for internal use only.\n\
4251 `x-get-resource' uses this as the first component of the instance name\n\
4252 when requesting resource values.\n\
4253 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4254 was invoked, or to the value specified with the `-name' or `-rn'\n\
4255 switches, if present.");
4256 Vx_resource_name
= Qnil
;
4259 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
4260 "The shape of the pointer when not over text.");
4262 Vx_nontext_pointer_shape
= Qnil
;
4265 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
4266 "The shape of the pointer when over the mode line.");
4268 Vx_mode_pointer_shape
= Qnil
;
4270 Vx_cross_pointer_shape
= Qnil
;
4272 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
4273 "A string indicating the foreground color of the cursor box.");
4274 Vx_cursor_fore_pixel
= Qnil
;
4276 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed
,
4277 "Non-nil if a mouse button is currently depressed.");
4278 Vmouse_depressed
= Qnil
;
4280 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
4281 "t if no X window manager is in use.");
4284 defsubr (&Sx_get_resource
);
4286 defsubr (&Sx_draw_rectangle
);
4287 defsubr (&Sx_erase_rectangle
);
4288 defsubr (&Sx_contour_region
);
4289 defsubr (&Sx_uncontour_region
);
4291 defsubr (&Sx_display_color_p
);
4292 defsubr (&Sx_list_fonts
);
4293 defsubr (&Sx_color_defined_p
);
4294 defsubr (&Sx_server_max_request_size
);
4295 defsubr (&Sx_server_vendor
);
4296 defsubr (&Sx_server_version
);
4297 defsubr (&Sx_display_pixel_width
);
4298 defsubr (&Sx_display_pixel_height
);
4299 defsubr (&Sx_display_mm_width
);
4300 defsubr (&Sx_display_mm_height
);
4301 defsubr (&Sx_display_screens
);
4302 defsubr (&Sx_display_planes
);
4303 defsubr (&Sx_display_color_cells
);
4304 defsubr (&Sx_display_visual_class
);
4305 defsubr (&Sx_display_backing_store
);
4306 defsubr (&Sx_display_save_under
);
4308 defsubr (&Sx_rebind_key
);
4309 defsubr (&Sx_rebind_keys
);
4310 defsubr (&Sx_track_pointer
);
4311 defsubr (&Sx_grab_pointer
);
4312 defsubr (&Sx_ungrab_pointer
);
4315 defsubr (&Sx_get_default
);
4316 defsubr (&Sx_store_cut_buffer
);
4317 defsubr (&Sx_get_cut_buffer
);
4319 defsubr (&Sx_parse_geometry
);
4320 defsubr (&Sx_create_frame
);
4321 defsubr (&Sfocus_frame
);
4322 defsubr (&Sunfocus_frame
);
4324 defsubr (&Sx_horizontal_line
);
4326 defsubr (&Sx_open_connection
);
4327 defsubr (&Sx_close_current_connection
);
4328 defsubr (&Sx_synchronize
);
4331 #endif /* HAVE_X_WINDOWS */