(CFLAGS): Use shell syntax, not Makefile.
[emacs.git] / src / xfns.c
blob2b3be77fb573e90a287eb3f767f2a31892d34f57
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)
9 any later version.
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 */
24 #if 0
25 #include <stdio.h>
26 #endif
27 #include <signal.h>
28 #include <config.h>
29 #include "lisp.h"
30 #include "xterm.h"
31 #include "frame.h"
32 #include "window.h"
33 #include "buffer.h"
34 #include "dispextern.h"
35 #include "keyboard.h"
36 #include "blockinput.h"
38 #ifdef HAVE_X_WINDOWS
39 extern void abort ();
41 #ifndef VMS
42 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
43 #include "bitmaps/gray.xbm"
44 #else
45 #include <X11/bitmaps/gray>
46 #endif
47 #else
48 #include "[.bitmaps]gray.xbm"
49 #endif
51 #ifdef USE_X_TOOLKIT
52 #include <X11/Shell.h>
54 #include <X11/Xaw/Paned.h>
55 #include <X11/Xaw/Label.h>
57 #ifdef USG
58 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
59 #include <X11/Xos.h>
60 #define USG
61 #else
62 #include <X11/Xos.h>
63 #endif
65 #include "widget.h"
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
74 application. */
75 Widget Xt_app_shell;
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))
84 #ifdef HAVE_X11
85 /* X Resource data base */
86 static XrmDatabase xrdb;
88 /* The class of this X application. */
89 #define EMACS_CLASS "Emacs"
91 #ifdef HAVE_X11R4
92 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
93 #else
94 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
95 #endif
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. */
118 int x_screen_height;
120 /* Width of this X screen in pixels. */
121 int x_screen_width;
123 /* Number of planes for this screen. */
124 int x_screen_planes;
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 #else /* X10 */
152 /* Default size of an Emacs window. */
153 static char *default_window = "=80x24+0+0";
155 #define MAXICID 80
156 char iconidentity[MAXICID];
157 #define ICONTAG "emacs@"
158 char minibuffer_iconidentity[MAXICID];
159 #define MINIBUFFER_ICONTAG "minibuffer@"
161 #endif /* X10 */
163 /* The last 23 bits of the timestamp of the last mouse button event. */
164 Time mouse_timestamp;
166 /* Evaluate this expression to rebuild the section of syms_of_xfns
167 that initializes and staticpros the symbols declared below. Note
168 that Emacs 18 has a bug that keeps C-x C-e from being able to
169 evaluate this expression.
171 (progn
172 ;; Accumulate a list of the symbols we want to initialize from the
173 ;; declarations at the top of the file.
174 (goto-char (point-min))
175 (search-forward "/\*&&& symbols declared here &&&*\/\n")
176 (let (symbol-list)
177 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
178 (setq symbol-list
179 (cons (buffer-substring (match-beginning 1) (match-end 1))
180 symbol-list))
181 (forward-line 1))
182 (setq symbol-list (nreverse symbol-list))
183 ;; Delete the section of syms_of_... where we initialize the symbols.
184 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
185 (let ((start (point)))
186 (while (looking-at "^ Q")
187 (forward-line 2))
188 (kill-region start (point)))
189 ;; Write a new symbol initialization section.
190 (while symbol-list
191 (insert (format " %s = intern (\"" (car symbol-list)))
192 (let ((start (point)))
193 (insert (substring (car symbol-list) 1))
194 (subst-char-in-region start (point) ?_ ?-))
195 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
196 (setq symbol-list (cdr symbol-list)))))
200 /*&&& symbols declared here &&&*/
201 Lisp_Object Qauto_raise;
202 Lisp_Object Qauto_lower;
203 Lisp_Object Qbackground_color;
204 Lisp_Object Qbar;
205 Lisp_Object Qborder_color;
206 Lisp_Object Qborder_width;
207 Lisp_Object Qbox;
208 Lisp_Object Qcursor_color;
209 Lisp_Object Qcursor_type;
210 Lisp_Object Qfont;
211 Lisp_Object Qforeground_color;
212 Lisp_Object Qgeometry;
213 /* Lisp_Object Qicon; */
214 Lisp_Object Qicon_left;
215 Lisp_Object Qicon_top;
216 Lisp_Object Qicon_type;
217 Lisp_Object Qinternal_border_width;
218 Lisp_Object Qleft;
219 Lisp_Object Qmouse_color;
220 Lisp_Object Qnone;
221 Lisp_Object Qparent_id;
222 Lisp_Object Qsuppress_icon;
223 Lisp_Object Qtop;
224 Lisp_Object Qundefined_color;
225 Lisp_Object Qvertical_scroll_bars;
226 Lisp_Object Qvisibility;
227 Lisp_Object Qwindow_id;
228 Lisp_Object Qx_frame_parameter;
229 Lisp_Object Qx_resource_name;
231 /* The below are defined in frame.c. */
232 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
233 extern Lisp_Object Qunsplittable, Qmenu_bar_lines;
235 extern Lisp_Object Vwindow_system_version;
238 /* Error if we are not connected to X. */
239 void
240 check_x ()
242 if (x_current_display == 0)
243 error ("X windows are not in use or not initialized");
246 /* Return the Emacs frame-object corresponding to an X window.
247 It could be the frame's main window or an icon window. */
249 /* This function can be called during GC, so use XGCTYPE. */
251 struct frame *
252 x_window_to_frame (wdesc)
253 int wdesc;
255 Lisp_Object tail, frame;
256 struct frame *f;
258 for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons;
259 tail = XCONS (tail)->cdr)
261 frame = XCONS (tail)->car;
262 if (XGCTYPE (frame) != Lisp_Frame)
263 continue;
264 f = XFRAME (frame);
265 #ifdef USE_X_TOOLKIT
266 if (f->display.nothing == 1)
267 return 0;
268 if ((f->display.x->edit_widget
269 && XtWindow (f->display.x->edit_widget) == wdesc)
270 || f->display.x->icon_desc == wdesc)
271 return f;
272 #else /* not USE_X_TOOLKIT */
273 if (FRAME_X_WINDOW (f) == wdesc
274 || f->display.x->icon_desc == wdesc)
275 return f;
276 #endif /* not USE_X_TOOLKIT */
278 return 0;
281 #ifdef USE_X_TOOLKIT
282 /* Like x_window_to_frame but also compares the window with the widget's
283 windows. */
285 struct frame *
286 x_any_window_to_frame (wdesc)
287 int wdesc;
289 Lisp_Object tail, frame;
290 struct frame *f;
291 struct x_display *x;
293 for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons;
294 tail = XCONS (tail)->cdr)
296 frame = XCONS (tail)->car;
297 if (XGCTYPE (frame) != Lisp_Frame)
298 continue;
299 f = XFRAME (frame);
300 if (f->display.nothing == 1)
301 return 0;
302 x = f->display.x;
303 /* This frame matches if the window is any of its widgets. */
304 if (wdesc == XtWindow (x->widget)
305 || wdesc == XtWindow (x->column_widget)
306 || wdesc == XtWindow (x->edit_widget))
307 return f;
308 /* Match if the window is this frame's menubar. */
309 if (x->menubar_widget
310 && wdesc == XtWindow (x->menubar_widget))
311 return f;
313 return 0;
315 #endif /* USE_X_TOOLKIT */
318 /* Connect the frame-parameter names for X frames
319 to the ways of passing the parameter values to the window system.
321 The name of a parameter, as a Lisp symbol,
322 has an `x-frame-parameter' property which is an integer in Lisp
323 but can be interpreted as an `enum x_frame_parm' in C. */
325 enum x_frame_parm
327 X_PARM_FOREGROUND_COLOR,
328 X_PARM_BACKGROUND_COLOR,
329 X_PARM_MOUSE_COLOR,
330 X_PARM_CURSOR_COLOR,
331 X_PARM_BORDER_COLOR,
332 X_PARM_ICON_TYPE,
333 X_PARM_FONT,
334 X_PARM_BORDER_WIDTH,
335 X_PARM_INTERNAL_BORDER_WIDTH,
336 X_PARM_NAME,
337 X_PARM_AUTORAISE,
338 X_PARM_AUTOLOWER,
339 X_PARM_VERT_SCROLL_BAR,
340 X_PARM_VISIBILITY,
341 X_PARM_MENU_BAR_LINES
345 struct x_frame_parm_table
347 char *name;
348 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
351 void x_set_foreground_color ();
352 void x_set_background_color ();
353 void x_set_mouse_color ();
354 void x_set_cursor_color ();
355 void x_set_border_color ();
356 void x_set_cursor_type ();
357 void x_set_icon_type ();
358 void x_set_font ();
359 void x_set_border_width ();
360 void x_set_internal_border_width ();
361 void x_explicitly_set_name ();
362 void x_set_autoraise ();
363 void x_set_autolower ();
364 void x_set_vertical_scroll_bars ();
365 void x_set_visibility ();
366 void x_set_menu_bar_lines ();
368 static struct x_frame_parm_table x_frame_parms[] =
370 "foreground-color", x_set_foreground_color,
371 "background-color", x_set_background_color,
372 "mouse-color", x_set_mouse_color,
373 "cursor-color", x_set_cursor_color,
374 "border-color", x_set_border_color,
375 "cursor-type", x_set_cursor_type,
376 "icon-type", x_set_icon_type,
377 "font", x_set_font,
378 "border-width", x_set_border_width,
379 "internal-border-width", x_set_internal_border_width,
380 "name", x_explicitly_set_name,
381 "auto-raise", x_set_autoraise,
382 "auto-lower", x_set_autolower,
383 "vertical-scroll-bars", x_set_vertical_scroll_bars,
384 "visibility", x_set_visibility,
385 "menu-bar-lines", x_set_menu_bar_lines,
388 /* Attach the `x-frame-parameter' properties to
389 the Lisp symbol names of parameters relevant to X. */
391 init_x_parm_symbols ()
393 int i;
395 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
396 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
397 make_number (i));
400 /* Change the parameters of FRAME as specified by ALIST.
401 If a parameter is not specially recognized, do nothing;
402 otherwise call the `x_set_...' function for that parameter. */
404 void
405 x_set_frame_parameters (f, alist)
406 FRAME_PTR f;
407 Lisp_Object alist;
409 Lisp_Object tail;
411 /* If both of these parameters are present, it's more efficient to
412 set them both at once. So we wait until we've looked at the
413 entire list before we set them. */
414 Lisp_Object width, height;
416 /* Same here. */
417 Lisp_Object left, top;
419 /* Record in these vectors all the parms specified. */
420 Lisp_Object *parms;
421 Lisp_Object *values;
422 int i;
424 i = 0;
425 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
426 i++;
428 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
429 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
431 /* Extract parm names and values into those vectors. */
433 i = 0;
434 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
436 Lisp_Object elt, prop, val;
438 elt = Fcar (tail);
439 parms[i] = Fcar (elt);
440 values[i] = Fcdr (elt);
441 i++;
444 width = height = top = left = Qunbound;
446 /* Now process them in reverse of specified order. */
447 for (i--; i >= 0; i--)
449 Lisp_Object prop, val;
451 prop = parms[i];
452 val = values[i];
454 if (EQ (prop, Qwidth))
455 width = val;
456 else if (EQ (prop, Qheight))
457 height = val;
458 else if (EQ (prop, Qtop))
459 top = val;
460 else if (EQ (prop, Qleft))
461 left = val;
462 else
464 register Lisp_Object param_index, old_value;
466 param_index = Fget (prop, Qx_frame_parameter);
467 old_value = get_frame_param (f, prop);
468 store_frame_param (f, prop, val);
469 if (XTYPE (param_index) == Lisp_Int
470 && XINT (param_index) >= 0
471 && (XINT (param_index)
472 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
473 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
477 /* Don't die if just one of these was set. */
478 if (EQ (left, Qunbound))
479 XSET (left, Lisp_Int, f->display.x->left_pos);
480 if (EQ (top, Qunbound))
481 XSET (top, Lisp_Int, f->display.x->top_pos);
483 /* Don't die if just one of these was set. */
484 if (EQ (width, Qunbound))
485 XSET (width, Lisp_Int, FRAME_WIDTH (f));
486 if (EQ (height, Qunbound))
487 XSET (height, Lisp_Int, FRAME_HEIGHT (f));
489 /* Don't set these parameters these unless they've been explicitly
490 specified. The window might be mapped or resized while we're in
491 this function, and we don't want to override that unless the lisp
492 code has asked for it.
494 Don't set these parameters unless they actually differ from the
495 window's current parameters; the window may not actually exist
496 yet. */
498 Lisp_Object frame;
500 check_frame_size (f, &height, &width);
502 XSET (frame, Lisp_Frame, f);
504 if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f))
505 || (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f)))
506 Fset_frame_size (frame, width, height);
507 if ((NUMBERP (left) && XINT (left) != f->display.x->left_pos)
508 || (NUMBERP (top) && XINT (top) != f->display.x->top_pos))
509 Fset_frame_position (frame, left, top);
513 /* Insert a description of internally-recorded parameters of frame X
514 into the parameter alist *ALISTPTR that is to be given to the user.
515 Only parameters that are specific to the X window system
516 and whose values are not correctly recorded in the frame's
517 param_alist need to be considered here. */
519 x_report_frame_params (f, alistptr)
520 struct frame *f;
521 Lisp_Object *alistptr;
523 char buf[16];
525 store_in_alist (alistptr, Qleft, make_number (f->display.x->left_pos));
526 store_in_alist (alistptr, Qtop, make_number (f->display.x->top_pos));
527 store_in_alist (alistptr, Qborder_width,
528 make_number (f->display.x->border_width));
529 store_in_alist (alistptr, Qinternal_border_width,
530 make_number (f->display.x->internal_border_width));
531 sprintf (buf, "%d", FRAME_X_WINDOW (f));
532 store_in_alist (alistptr, Qwindow_id,
533 build_string (buf));
534 FRAME_SAMPLE_VISIBILITY (f);
535 store_in_alist (alistptr, Qvisibility,
536 (FRAME_VISIBLE_P (f) ? Qt
537 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
540 /* Decide if color named COLOR is valid for the display
541 associated with the selected frame. */
543 defined_color (color, color_def)
544 char *color;
545 Color *color_def;
547 register int foo;
548 Colormap screen_colormap;
550 BLOCK_INPUT;
551 #ifdef HAVE_X11
552 screen_colormap
553 = DefaultColormap (x_current_display, XDefaultScreen (x_current_display));
555 foo = XParseColor (x_current_display, screen_colormap,
556 color, color_def)
557 && XAllocColor (x_current_display, screen_colormap, color_def);
558 #else
559 foo = XParseColor (color, color_def) && XGetHardwareColor (color_def);
560 #endif /* not HAVE_X11 */
561 UNBLOCK_INPUT;
563 if (foo)
564 return 1;
565 else
566 return 0;
569 /* Given a string ARG naming a color, compute a pixel value from it
570 suitable for screen F.
571 If F is not a color screen, return DEF (default) regardless of what
572 ARG says. */
575 x_decode_color (arg, def)
576 Lisp_Object arg;
577 int def;
579 Color cdef;
581 CHECK_STRING (arg, 0);
583 if (strcmp (XSTRING (arg)->data, "black") == 0)
584 return BLACK_PIX_DEFAULT;
585 else if (strcmp (XSTRING (arg)->data, "white") == 0)
586 return WHITE_PIX_DEFAULT;
588 #ifdef HAVE_X11
589 if (x_screen_planes == 1)
590 return def;
591 #else
592 if (DISPLAY_CELLS == 1)
593 return def;
594 #endif
596 if (defined_color (XSTRING (arg)->data, &cdef))
597 return cdef.pixel;
598 else
599 Fsignal (Qundefined_color, Fcons (arg, Qnil));
602 /* Functions called only from `x_set_frame_param'
603 to set individual parameters.
605 If FRAME_X_WINDOW (f) is 0,
606 the frame is being created and its X-window does not exist yet.
607 In that case, just record the parameter's new value
608 in the standard place; do not attempt to change the window. */
610 void
611 x_set_foreground_color (f, arg, oldval)
612 struct frame *f;
613 Lisp_Object arg, oldval;
615 f->display.x->foreground_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
616 if (FRAME_X_WINDOW (f) != 0)
618 #ifdef HAVE_X11
619 BLOCK_INPUT;
620 XSetForeground (x_current_display, f->display.x->normal_gc,
621 f->display.x->foreground_pixel);
622 XSetBackground (x_current_display, f->display.x->reverse_gc,
623 f->display.x->foreground_pixel);
624 UNBLOCK_INPUT;
625 #endif /* HAVE_X11 */
626 recompute_basic_faces (f);
627 if (FRAME_VISIBLE_P (f))
628 redraw_frame (f);
632 void
633 x_set_background_color (f, arg, oldval)
634 struct frame *f;
635 Lisp_Object arg, oldval;
637 Pixmap temp;
638 int mask;
640 f->display.x->background_pixel = x_decode_color (arg, WHITE_PIX_DEFAULT);
642 if (FRAME_X_WINDOW (f) != 0)
644 BLOCK_INPUT;
645 #ifdef HAVE_X11
646 /* The main frame area. */
647 XSetBackground (x_current_display, f->display.x->normal_gc,
648 f->display.x->background_pixel);
649 XSetForeground (x_current_display, f->display.x->reverse_gc,
650 f->display.x->background_pixel);
651 XSetForeground (x_current_display, f->display.x->cursor_gc,
652 f->display.x->background_pixel);
653 XSetWindowBackground (x_current_display, FRAME_X_WINDOW (f),
654 f->display.x->background_pixel);
656 #else
657 temp = XMakeTile (f->display.x->background_pixel);
658 XChangeBackground (FRAME_X_WINDOW (f), temp);
659 XFreePixmap (temp);
660 #endif /* not HAVE_X11 */
661 UNBLOCK_INPUT;
663 recompute_basic_faces (f);
665 if (FRAME_VISIBLE_P (f))
666 redraw_frame (f);
670 void
671 x_set_mouse_color (f, arg, oldval)
672 struct frame *f;
673 Lisp_Object arg, oldval;
675 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
676 int mask_color;
678 if (!EQ (Qnil, arg))
679 f->display.x->mouse_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
680 mask_color = f->display.x->background_pixel;
681 /* No invisible pointers. */
682 if (mask_color == f->display.x->mouse_pixel
683 && mask_color == f->display.x->background_pixel)
684 f->display.x->mouse_pixel = f->display.x->foreground_pixel;
686 BLOCK_INPUT;
687 #ifdef HAVE_X11
689 /* It's not okay to crash if the user selects a screwy cursor. */
690 x_catch_errors ();
692 if (!EQ (Qnil, Vx_pointer_shape))
694 CHECK_NUMBER (Vx_pointer_shape, 0);
695 cursor = XCreateFontCursor (x_current_display, XINT (Vx_pointer_shape));
697 else
698 cursor = XCreateFontCursor (x_current_display, XC_xterm);
699 x_check_errors ("bad text pointer cursor: %s");
701 if (!EQ (Qnil, Vx_nontext_pointer_shape))
703 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
704 nontext_cursor = XCreateFontCursor (x_current_display,
705 XINT (Vx_nontext_pointer_shape));
707 else
708 nontext_cursor = XCreateFontCursor (x_current_display, XC_left_ptr);
709 x_check_errors ("bad nontext pointer cursor: %s");
711 if (!EQ (Qnil, Vx_mode_pointer_shape))
713 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
714 mode_cursor = XCreateFontCursor (x_current_display,
715 XINT (Vx_mode_pointer_shape));
717 else
718 mode_cursor = XCreateFontCursor (x_current_display, XC_xterm);
719 x_check_errors ("bad modeline pointer cursor: %s");
721 if (!EQ (Qnil, Vx_cross_pointer_shape))
723 CHECK_NUMBER (Vx_cross_pointer_shape, 0);
724 cross_cursor = XCreateFontCursor (x_current_display,
725 XINT (Vx_cross_pointer_shape));
727 else
728 cross_cursor = XCreateFontCursor (x_current_display, XC_crosshair);
730 /* Check and report errors with the above calls. */
731 x_check_errors ("can't set cursor shape: %s");
732 x_uncatch_errors ();
735 XColor fore_color, back_color;
737 fore_color.pixel = f->display.x->mouse_pixel;
738 back_color.pixel = mask_color;
739 XQueryColor (x_current_display,
740 DefaultColormap (x_current_display,
741 DefaultScreen (x_current_display)),
742 &fore_color);
743 XQueryColor (x_current_display,
744 DefaultColormap (x_current_display,
745 DefaultScreen (x_current_display)),
746 &back_color);
747 XRecolorCursor (x_current_display, cursor,
748 &fore_color, &back_color);
749 XRecolorCursor (x_current_display, nontext_cursor,
750 &fore_color, &back_color);
751 XRecolorCursor (x_current_display, mode_cursor,
752 &fore_color, &back_color);
753 XRecolorCursor (x_current_display, cross_cursor,
754 &fore_color, &back_color);
756 #else /* X10 */
757 cursor = XCreateCursor (16, 16, MouseCursor, MouseMask,
758 0, 0,
759 f->display.x->mouse_pixel,
760 f->display.x->background_pixel,
761 GXcopy);
762 #endif /* X10 */
764 if (FRAME_X_WINDOW (f) != 0)
766 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f), cursor);
769 if (cursor != f->display.x->text_cursor && f->display.x->text_cursor != 0)
770 XFreeCursor (XDISPLAY f->display.x->text_cursor);
771 f->display.x->text_cursor = cursor;
772 #ifdef HAVE_X11
773 if (nontext_cursor != f->display.x->nontext_cursor
774 && f->display.x->nontext_cursor != 0)
775 XFreeCursor (XDISPLAY f->display.x->nontext_cursor);
776 f->display.x->nontext_cursor = nontext_cursor;
778 if (mode_cursor != f->display.x->modeline_cursor
779 && f->display.x->modeline_cursor != 0)
780 XFreeCursor (XDISPLAY f->display.x->modeline_cursor);
781 f->display.x->modeline_cursor = mode_cursor;
782 if (cross_cursor != f->display.x->cross_cursor
783 && f->display.x->cross_cursor != 0)
784 XFreeCursor (XDISPLAY f->display.x->cross_cursor);
785 f->display.x->cross_cursor = cross_cursor;
786 #endif /* HAVE_X11 */
788 XFlushQueue ();
789 UNBLOCK_INPUT;
792 void
793 x_set_cursor_color (f, arg, oldval)
794 struct frame *f;
795 Lisp_Object arg, oldval;
797 unsigned long fore_pixel;
799 if (!EQ (Vx_cursor_fore_pixel, Qnil))
800 fore_pixel = x_decode_color (Vx_cursor_fore_pixel, WHITE_PIX_DEFAULT);
801 else
802 fore_pixel = f->display.x->background_pixel;
803 f->display.x->cursor_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
805 /* Make sure that the cursor color differs from the background color. */
806 if (f->display.x->cursor_pixel == f->display.x->background_pixel)
808 f->display.x->cursor_pixel == f->display.x->mouse_pixel;
809 if (f->display.x->cursor_pixel == fore_pixel)
810 fore_pixel = f->display.x->background_pixel;
812 f->display.x->cursor_foreground_pixel = fore_pixel;
814 if (FRAME_X_WINDOW (f) != 0)
816 #ifdef HAVE_X11
817 BLOCK_INPUT;
818 XSetBackground (x_current_display, f->display.x->cursor_gc,
819 f->display.x->cursor_pixel);
820 XSetForeground (x_current_display, f->display.x->cursor_gc,
821 fore_pixel);
822 UNBLOCK_INPUT;
823 #endif /* HAVE_X11 */
825 if (FRAME_VISIBLE_P (f))
827 x_display_cursor (f, 0);
828 x_display_cursor (f, 1);
833 /* Set the border-color of frame F to value described by ARG.
834 ARG can be a string naming a color.
835 The border-color is used for the border that is drawn by the X server.
836 Note that this does not fully take effect if done before
837 F has an x-window; it must be redone when the window is created.
839 Note: this is done in two routines because of the way X10 works.
841 Note: under X11, this is normally the province of the window manager,
842 and so emacs' border colors may be overridden. */
844 void
845 x_set_border_color (f, arg, oldval)
846 struct frame *f;
847 Lisp_Object arg, oldval;
849 unsigned char *str;
850 int pix;
852 CHECK_STRING (arg, 0);
853 str = XSTRING (arg)->data;
855 #ifndef HAVE_X11
856 if (!strcmp (str, "grey") || !strcmp (str, "Grey")
857 || !strcmp (str, "gray") || !strcmp (str, "Gray"))
858 pix = -1;
859 else
860 #endif /* X10 */
862 pix = x_decode_color (arg, BLACK_PIX_DEFAULT);
864 x_set_border_pixel (f, pix);
867 /* Set the border-color of frame F to pixel value PIX.
868 Note that this does not fully take effect if done before
869 F has an x-window. */
871 x_set_border_pixel (f, pix)
872 struct frame *f;
873 int pix;
875 f->display.x->border_pixel = pix;
877 if (FRAME_X_WINDOW (f) != 0 && f->display.x->border_width > 0)
879 Pixmap temp;
880 int mask;
882 BLOCK_INPUT;
883 #ifdef HAVE_X11
884 XSetWindowBorder (x_current_display, FRAME_X_WINDOW (f),
885 pix);
886 #else
887 if (pix < 0)
888 temp = XMakePixmap ((Bitmap) XStoreBitmap (gray_width, gray_height,
889 gray_bits),
890 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
891 else
892 temp = XMakeTile (pix);
893 XChangeBorder (FRAME_X_WINDOW (f), temp);
894 XFreePixmap (XDISPLAY temp);
895 #endif /* not HAVE_X11 */
896 UNBLOCK_INPUT;
898 if (FRAME_VISIBLE_P (f))
899 redraw_frame (f);
903 void
904 x_set_cursor_type (f, arg, oldval)
905 FRAME_PTR f;
906 Lisp_Object arg, oldval;
908 if (EQ (arg, Qbar))
909 FRAME_DESIRED_CURSOR (f) = bar_cursor;
910 else
911 #if 0
912 if (EQ (arg, Qbox))
913 #endif
914 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
915 /* Error messages commented out because people have trouble fixing
916 .Xdefaults with Emacs, when it has something bad in it. */
917 #if 0
918 else
919 error
920 ("the `cursor-type' frame parameter should be either `bar' or `box'");
921 #endif
923 /* Make sure the cursor gets redrawn. This is overkill, but how
924 often do people change cursor types? */
925 update_mode_lines++;
928 void
929 x_set_icon_type (f, arg, oldval)
930 struct frame *f;
931 Lisp_Object arg, oldval;
933 Lisp_Object tem;
934 int result;
936 if (EQ (oldval, Qnil) == EQ (arg, Qnil))
937 return;
939 BLOCK_INPUT;
940 if (NILP (arg))
941 result = x_text_icon (f, 0);
942 else
943 result = x_bitmap_icon (f);
945 if (result)
947 UNBLOCK_INPUT;
948 error ("No icon window available.");
951 /* If the window was unmapped (and its icon was mapped),
952 the new icon is not mapped, so map the window in its stead. */
953 if (FRAME_VISIBLE_P (f))
954 #ifdef USE_X_TOOLKIT
955 XtPopup (f->display.x->widget, XtGrabNone);
956 #endif
957 XMapWindow (XDISPLAY FRAME_X_WINDOW (f));
959 XFlushQueue ();
960 UNBLOCK_INPUT;
963 extern Lisp_Object x_new_font ();
965 void
966 x_set_font (f, arg, oldval)
967 struct frame *f;
968 Lisp_Object arg, oldval;
970 Lisp_Object result;
972 CHECK_STRING (arg, 1);
974 BLOCK_INPUT;
975 result = x_new_font (f, XSTRING (arg)->data);
976 UNBLOCK_INPUT;
978 if (EQ (result, Qnil))
979 error ("Font \"%s\" is not defined", XSTRING (arg)->data);
980 else if (EQ (result, Qt))
981 error ("the characters of the given font have varying widths");
982 else if (STRINGP (result))
984 recompute_basic_faces (f);
985 store_frame_param (f, Qfont, result);
987 else
988 abort ();
991 void
992 x_set_border_width (f, arg, oldval)
993 struct frame *f;
994 Lisp_Object arg, oldval;
996 CHECK_NUMBER (arg, 0);
998 if (XINT (arg) == f->display.x->border_width)
999 return;
1001 if (FRAME_X_WINDOW (f) != 0)
1002 error ("Cannot change the border width of a window");
1004 f->display.x->border_width = XINT (arg);
1007 void
1008 x_set_internal_border_width (f, arg, oldval)
1009 struct frame *f;
1010 Lisp_Object arg, oldval;
1012 int mask;
1013 int old = f->display.x->internal_border_width;
1015 CHECK_NUMBER (arg, 0);
1016 f->display.x->internal_border_width = XINT (arg);
1017 if (f->display.x->internal_border_width < 0)
1018 f->display.x->internal_border_width = 0;
1020 if (f->display.x->internal_border_width == old)
1021 return;
1023 if (FRAME_X_WINDOW (f) != 0)
1025 BLOCK_INPUT;
1026 x_set_window_size (f, 0, f->width, f->height);
1027 #if 0
1028 x_set_resize_hint (f);
1029 #endif
1030 XFlushQueue ();
1031 UNBLOCK_INPUT;
1032 SET_FRAME_GARBAGED (f);
1036 void
1037 x_set_visibility (f, value, oldval)
1038 struct frame *f;
1039 Lisp_Object value, oldval;
1041 Lisp_Object frame;
1042 XSET (frame, Lisp_Frame, f);
1044 if (NILP (value))
1045 Fmake_frame_invisible (frame, Qt);
1046 else if (EQ (value, Qicon))
1047 Ficonify_frame (frame);
1048 else
1049 Fmake_frame_visible (frame);
1052 static void
1053 x_set_menu_bar_lines_1 (window, n)
1054 Lisp_Object window;
1055 int n;
1057 struct window *w = XWINDOW (window);
1059 XFASTINT (w->top) += n;
1060 XFASTINT (w->height) -= n;
1062 /* Handle just the top child in a vertical split. */
1063 if (!NILP (w->vchild))
1064 x_set_menu_bar_lines_1 (w->vchild, n);
1066 /* Adjust all children in a horizontal split. */
1067 for (window = w->hchild; !NILP (window); window = w->next)
1069 w = XWINDOW (window);
1070 x_set_menu_bar_lines_1 (window, n);
1074 void
1075 x_set_menu_bar_lines (f, value, oldval)
1076 struct frame *f;
1077 Lisp_Object value, oldval;
1079 int nlines;
1080 int olines = FRAME_MENU_BAR_LINES (f);
1082 /* Right now, menu bars don't work properly in minibuf-only frames;
1083 most of the commands try to apply themselves to the minibuffer
1084 frame itslef, and get an error because you can't switch buffers
1085 in or split the minibuffer window. */
1086 if (FRAME_MINIBUF_ONLY_P (f))
1087 return;
1089 if (XTYPE (value) == Lisp_Int)
1090 nlines = XINT (value);
1091 else
1092 nlines = 0;
1094 #ifdef USE_X_TOOLKIT
1095 FRAME_MENU_BAR_LINES (f) = 0;
1096 if (nlines)
1097 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1098 else
1100 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1101 free_frame_menubar (f);
1102 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1103 f->display.x->menubar_widget = 0;
1105 #else /* not USE_X_TOOLKIT */
1106 FRAME_MENU_BAR_LINES (f) = nlines;
1107 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
1108 #endif /* not USE_X_TOOLKIT */
1111 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1112 x_id_name.
1114 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1115 name; if NAME is a string, set F's name to NAME and set
1116 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1118 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1119 suggesting a new name, which lisp code should override; if
1120 F->explicit_name is set, ignore the new name; otherwise, set it. */
1122 void
1123 x_set_name (f, name, explicit)
1124 struct frame *f;
1125 Lisp_Object name;
1126 int explicit;
1128 /* Make sure that requests from lisp code override requests from
1129 Emacs redisplay code. */
1130 if (explicit)
1132 /* If we're switching from explicit to implicit, we had better
1133 update the mode lines and thereby update the title. */
1134 if (f->explicit_name && NILP (name))
1135 update_mode_lines = 1;
1137 f->explicit_name = ! NILP (name);
1139 else if (f->explicit_name)
1140 return;
1142 /* If NAME is nil, set the name to the x_id_name. */
1143 if (NILP (name))
1144 name = build_string (x_id_name);
1145 else
1146 CHECK_STRING (name, 0);
1148 /* Don't change the name if it's already NAME. */
1149 if (! NILP (Fstring_equal (name, f->name)))
1150 return;
1152 if (FRAME_X_WINDOW (f))
1154 BLOCK_INPUT;
1155 #ifdef HAVE_X11R4
1157 XTextProperty text;
1158 text.value = XSTRING (name)->data;
1159 text.encoding = XA_STRING;
1160 text.format = 8;
1161 text.nitems = XSTRING (name)->size;
1162 #ifdef USE_X_TOOLKIT
1163 XSetWMName (x_current_display, XtWindow (f->display.x->widget), &text);
1164 XSetWMIconName (x_current_display, XtWindow (f->display.x->widget),
1165 &text);
1166 #else /* not USE_X_TOOLKIT */
1167 XSetWMName (x_current_display, FRAME_X_WINDOW (f), &text);
1168 XSetWMIconName (x_current_display, FRAME_X_WINDOW (f), &text);
1169 #endif /* not USE_X_TOOLKIT */
1171 #else /* not HAVE_X11R4 */
1172 XSetIconName (XDISPLAY FRAME_X_WINDOW (f),
1173 XSTRING (name)->data);
1174 XStoreName (XDISPLAY FRAME_X_WINDOW (f),
1175 XSTRING (name)->data);
1176 #endif /* not HAVE_X11R4 */
1177 UNBLOCK_INPUT;
1180 f->name = name;
1183 /* This function should be called when the user's lisp code has
1184 specified a name for the frame; the name will override any set by the
1185 redisplay code. */
1186 void
1187 x_explicitly_set_name (f, arg, oldval)
1188 FRAME_PTR f;
1189 Lisp_Object arg, oldval;
1191 x_set_name (f, arg, 1);
1194 /* This function should be called by Emacs redisplay code to set the
1195 name; names set this way will never override names set by the user's
1196 lisp code. */
1197 void
1198 x_implicitly_set_name (f, arg, oldval)
1199 FRAME_PTR f;
1200 Lisp_Object arg, oldval;
1202 x_set_name (f, arg, 0);
1205 void
1206 x_set_autoraise (f, arg, oldval)
1207 struct frame *f;
1208 Lisp_Object arg, oldval;
1210 f->auto_raise = !EQ (Qnil, arg);
1213 void
1214 x_set_autolower (f, arg, oldval)
1215 struct frame *f;
1216 Lisp_Object arg, oldval;
1218 f->auto_lower = !EQ (Qnil, arg);
1221 void
1222 x_set_vertical_scroll_bars (f, arg, oldval)
1223 struct frame *f;
1224 Lisp_Object arg, oldval;
1226 if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1228 FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
1230 /* We set this parameter before creating the X window for the
1231 frame, so we can get the geometry right from the start.
1232 However, if the window hasn't been created yet, we shouldn't
1233 call x_set_window_size. */
1234 if (FRAME_X_WINDOW (f))
1235 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1239 /* Subroutines of creating an X frame. */
1241 #ifdef HAVE_X11
1243 /* Make sure that Vx_resource_name is set to a reasonable value. */
1244 static void
1245 validate_x_resource_name ()
1247 if (! STRINGP (Vx_resource_name))
1248 Vx_resource_name = make_string ("emacs", 5);
1252 extern char *x_get_string_resource ();
1253 extern XrmDatabase x_load_resources ();
1255 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
1256 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1257 This uses `NAME.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1258 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1259 the name specified by the `-name' or `-rn' command-line arguments.\n\
1261 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1262 class, respectively. You must specify both of them or neither.\n\
1263 If you specify them, the key is `NAME.COMPONENT.ATTRIBUTE'\n\
1264 and the class is `Emacs.CLASS.SUBCLASS'.")
1265 (attribute, class, component, subclass)
1266 Lisp_Object attribute, class, component, subclass;
1268 register char *value;
1269 char *name_key;
1270 char *class_key;
1271 Lisp_Object resname;
1273 check_x ();
1275 CHECK_STRING (attribute, 0);
1276 CHECK_STRING (class, 0);
1278 if (!NILP (component))
1279 CHECK_STRING (component, 1);
1280 if (!NILP (subclass))
1281 CHECK_STRING (subclass, 2);
1282 if (NILP (component) != NILP (subclass))
1283 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1285 validate_x_resource_name ();
1286 resname = Vx_resource_name;
1288 if (NILP (component))
1290 /* Allocate space for the components, the dots which separate them,
1291 and the final '\0'. */
1292 name_key = (char *) alloca (XSTRING (resname)->size
1293 + XSTRING (attribute)->size
1294 + 2);
1295 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1296 + XSTRING (class)->size
1297 + 2);
1299 sprintf (name_key, "%s.%s",
1300 XSTRING (resname)->data,
1301 XSTRING (attribute)->data);
1302 sprintf (class_key, "%s.%s",
1303 EMACS_CLASS,
1304 XSTRING (class)->data);
1306 else
1308 name_key = (char *) alloca (XSTRING (resname)->size
1309 + XSTRING (component)->size
1310 + XSTRING (attribute)->size
1311 + 3);
1313 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1314 + XSTRING (class)->size
1315 + XSTRING (subclass)->size
1316 + 3);
1318 sprintf (name_key, "%s.%s.%s",
1319 XSTRING (resname)->data,
1320 XSTRING (component)->data,
1321 XSTRING (attribute)->data);
1322 sprintf (class_key, "%s.%s.%s",
1323 EMACS_CLASS,
1324 XSTRING (class)->data,
1325 XSTRING (subclass)->data);
1328 value = x_get_string_resource (xrdb, name_key, class_key);
1330 if (value != (char *) 0)
1331 return build_string (value);
1332 else
1333 return Qnil;
1336 /* Used when C code wants a resource value. */
1338 char *
1339 x_get_resource_string (attribute, class)
1340 char *attribute, *class;
1342 register char *value;
1343 char *name_key;
1344 char *class_key;
1346 /* Allocate space for the components, the dots which separate them,
1347 and the final '\0'. */
1348 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
1349 + strlen (attribute) + 2);
1350 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1351 + strlen (class) + 2);
1353 sprintf (name_key, "%s.%s",
1354 XSTRING (Vinvocation_name)->data,
1355 attribute);
1356 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
1358 return x_get_string_resource (xrdb, name_key, class_key);
1361 #else /* X10 */
1363 DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
1364 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1365 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1366 The defaults are specified in the file `~/.Xdefaults'.")
1367 (arg)
1368 Lisp_Object arg;
1370 register unsigned char *value;
1372 CHECK_STRING (arg, 1);
1374 value = (unsigned char *) XGetDefault (XDISPLAY
1375 XSTRING (Vinvocation_name)->data,
1376 XSTRING (arg)->data);
1377 if (value == 0)
1378 /* Try reversing last two args, in case this is the buggy version of X. */
1379 value = (unsigned char *) XGetDefault (XDISPLAY
1380 XSTRING (arg)->data,
1381 XSTRING (Vinvocation_name)->data);
1382 if (value != 0)
1383 return build_string (value);
1384 else
1385 return (Qnil);
1388 #define Fx_get_resource(attribute, class, component, subclass) \
1389 Fx_get_default (attribute)
1391 #endif /* X10 */
1393 /* Types we might convert a resource string into. */
1394 enum resource_types
1396 number, boolean, string, symbol
1399 /* Return the value of parameter PARAM.
1401 First search ALIST, then Vdefault_frame_alist, then the X defaults
1402 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1404 Convert the resource to the type specified by desired_type.
1406 If no default is specified, return Qunbound. If you call
1407 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1408 and don't let it get stored in any lisp-visible variables! */
1410 static Lisp_Object
1411 x_get_arg (alist, param, attribute, class, type)
1412 Lisp_Object alist, param;
1413 char *attribute;
1414 char *class;
1415 enum resource_types type;
1417 register Lisp_Object tem;
1419 tem = Fassq (param, alist);
1420 if (EQ (tem, Qnil))
1421 tem = Fassq (param, Vdefault_frame_alist);
1422 if (EQ (tem, Qnil))
1425 if (attribute)
1427 tem = Fx_get_resource (build_string (attribute),
1428 build_string (class),
1429 Qnil, Qnil);
1431 if (NILP (tem))
1432 return Qunbound;
1434 switch (type)
1436 case number:
1437 return make_number (atoi (XSTRING (tem)->data));
1439 case boolean:
1440 tem = Fdowncase (tem);
1441 if (!strcmp (XSTRING (tem)->data, "on")
1442 || !strcmp (XSTRING (tem)->data, "true"))
1443 return Qt;
1444 else
1445 return Qnil;
1447 case string:
1448 return tem;
1450 case symbol:
1451 /* As a special case, we map the values `true' and `on'
1452 to Qt, and `false' and `off' to Qnil. */
1454 Lisp_Object lower;
1455 lower = Fdowncase (tem);
1456 if (!strcmp (XSTRING (lower)->data, "on")
1457 || !strcmp (XSTRING (lower)->data, "true"))
1458 return Qt;
1459 else if (!strcmp (XSTRING (lower)->data, "off")
1460 || !strcmp (XSTRING (lower)->data, "false"))
1461 return Qnil;
1462 else
1463 return Fintern (tem, Qnil);
1466 default:
1467 abort ();
1470 else
1471 return Qunbound;
1473 return Fcdr (tem);
1476 /* Record in frame F the specified or default value according to ALIST
1477 of the parameter named PARAM (a Lisp symbol).
1478 If no value is specified for PARAM, look for an X default for XPROP
1479 on the frame named NAME.
1480 If that is not found either, use the value DEFLT. */
1482 static Lisp_Object
1483 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
1484 struct frame *f;
1485 Lisp_Object alist;
1486 Lisp_Object prop;
1487 Lisp_Object deflt;
1488 char *xprop;
1489 char *xclass;
1490 enum resource_types type;
1492 Lisp_Object tem;
1494 tem = x_get_arg (alist, prop, xprop, xclass, type);
1495 if (EQ (tem, Qunbound))
1496 tem = deflt;
1497 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
1498 return tem;
1501 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
1502 "Parse an X-style geometry string STRING.\n\
1503 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1504 (string)
1505 Lisp_Object string;
1507 int geometry, x, y;
1508 unsigned int width, height;
1509 Lisp_Object values[4];
1511 CHECK_STRING (string, 0);
1513 geometry = XParseGeometry ((char *) XSTRING (string)->data,
1514 &x, &y, &width, &height);
1516 switch (geometry & 0xf) /* Mask out {X,Y}Negative */
1518 case (XValue | YValue):
1519 /* What's one pixel among friends?
1520 Perhaps fix this some day by returning symbol `extreme-top'... */
1521 if (x == 0 && (geometry & XNegative))
1522 x = -1;
1523 if (y == 0 && (geometry & YNegative))
1524 y = -1;
1525 values[0] = Fcons (Qleft, make_number (x));
1526 values[1] = Fcons (Qtop, make_number (y));
1527 return Flist (2, values);
1528 break;
1530 case (WidthValue | HeightValue):
1531 values[0] = Fcons (Qwidth, make_number (width));
1532 values[1] = Fcons (Qheight, make_number (height));
1533 return Flist (2, values);
1534 break;
1536 case (XValue | YValue | WidthValue | HeightValue):
1537 if (x == 0 && (geometry & XNegative))
1538 x = -1;
1539 if (y == 0 && (geometry & YNegative))
1540 y = -1;
1541 values[0] = Fcons (Qwidth, make_number (width));
1542 values[1] = Fcons (Qheight, make_number (height));
1543 values[2] = Fcons (Qleft, make_number (x));
1544 values[3] = Fcons (Qtop, make_number (y));
1545 return Flist (4, values);
1546 break;
1548 case 0:
1549 return Qnil;
1551 default:
1552 error ("Must specify x and y value, and/or width and height");
1556 #ifdef HAVE_X11
1557 /* Calculate the desired size and position of this window,
1558 and return the attributes saying which aspects were specified.
1560 This function does not make the coordinates positive. */
1562 #define DEFAULT_ROWS 40
1563 #define DEFAULT_COLS 80
1565 static int
1566 x_figure_window_size (f, parms)
1567 struct frame *f;
1568 Lisp_Object parms;
1570 register Lisp_Object tem0, tem1;
1571 int height, width, left, top;
1572 register int geometry;
1573 long window_prompting = 0;
1575 /* Default values if we fall through.
1576 Actually, if that happens we should get
1577 window manager prompting. */
1578 f->width = DEFAULT_COLS;
1579 f->height = DEFAULT_ROWS;
1580 /* Window managers expect that if program-specified
1581 positions are not (0,0), they're intentional, not defaults. */
1582 f->display.x->top_pos = 0;
1583 f->display.x->left_pos = 0;
1585 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
1586 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
1587 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1589 CHECK_NUMBER (tem0, 0);
1590 CHECK_NUMBER (tem1, 0);
1591 f->height = XINT (tem0);
1592 f->width = XINT (tem1);
1593 window_prompting |= USSize;
1595 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1596 error ("Must specify *both* height and width");
1598 f->display.x->vertical_scroll_bar_extra
1599 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
1600 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f)
1601 : 0);
1602 f->display.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
1603 f->display.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
1605 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
1606 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
1607 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1609 CHECK_NUMBER (tem0, 0);
1610 CHECK_NUMBER (tem1, 0);
1611 f->display.x->top_pos = XINT (tem0);
1612 f->display.x->left_pos = XINT (tem1);
1613 if (f->display.x->top_pos < 0)
1614 window_prompting |= YNegative;
1615 if (f->display.x->left_pos < 0)
1616 window_prompting |= YNegative;
1617 window_prompting |= USPosition;
1619 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1620 error ("Must specify *both* top and left corners");
1622 #if 0 /* PPosition and PSize mean "specified explicitly,
1623 by the program rather than by the user". So it is wrong to
1624 set them if nothing was specified. */
1625 switch (window_prompting)
1627 case USSize | USPosition:
1628 return window_prompting;
1629 break;
1631 case USSize: /* Got the size, need the position. */
1632 window_prompting |= PPosition;
1633 return window_prompting;
1634 break;
1636 case USPosition: /* Got the position, need the size. */
1637 window_prompting |= PSize;
1638 return window_prompting;
1639 break;
1641 case 0: /* Got nothing, take both from geometry. */
1642 window_prompting |= PPosition | PSize;
1643 return window_prompting;
1644 break;
1646 default:
1647 /* Somehow a bit got set in window_prompting that we didn't
1648 put there. */
1649 abort ();
1651 #endif
1652 return window_prompting;
1655 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
1657 Status
1658 XSetWMProtocols (dpy, w, protocols, count)
1659 Display *dpy;
1660 Window w;
1661 Atom *protocols;
1662 int count;
1664 Atom prop;
1665 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
1666 if (prop == None) return False;
1667 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
1668 (unsigned char *) protocols, count);
1669 return True;
1671 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
1673 #ifdef USE_X_TOOLKIT
1675 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS
1676 and WM_DELETE_WINDOW, then add them. (They may already be present
1677 because of the toolkit (Motif adds them, for example, but Xt doesn't). */
1679 static void
1680 hack_wm_protocols (widget)
1681 Widget widget;
1683 Display *dpy = XtDisplay (widget);
1684 Window w = XtWindow (widget);
1685 int need_delete = 1;
1686 int need_focus = 1;
1688 BLOCK_INPUT;
1690 Atom type, *atoms = 0;
1691 int format = 0;
1692 unsigned long nitems = 0;
1693 unsigned long bytes_after;
1695 if (Success == XGetWindowProperty (dpy, w, Xatom_wm_protocols,
1696 0, 100, False, XA_ATOM,
1697 &type, &format, &nitems, &bytes_after,
1698 (unsigned char **) &atoms)
1699 && format == 32 && type == XA_ATOM)
1700 while (nitems > 0)
1702 nitems--;
1703 if (atoms [nitems] == Xatom_wm_delete_window) need_delete = 0;
1704 else if (atoms [nitems] == Xatom_wm_take_focus) need_focus = 0;
1706 if (atoms) XFree ((char *) atoms);
1709 Atom props [10];
1710 int count = 0;
1711 if (need_delete) props [count++] = Xatom_wm_delete_window;
1712 if (need_focus) props [count++] = Xatom_wm_take_focus;
1713 if (count)
1714 XChangeProperty (dpy, w, Xatom_wm_protocols, XA_ATOM, 32, PropModeAppend,
1715 (unsigned char *) props, count);
1717 UNBLOCK_INPUT;
1719 #endif
1721 #ifdef USE_X_TOOLKIT
1723 /* Create and set up the X widget for frame F. */
1725 static void
1726 x_window (f, window_prompting, minibuffer_only)
1727 struct frame *f;
1728 long window_prompting;
1729 int minibuffer_only;
1731 XClassHint class_hints;
1732 XSetWindowAttributes attributes;
1733 unsigned long attribute_mask;
1735 Widget shell_widget;
1736 Widget pane_widget;
1737 Widget screen_widget;
1738 char* name;
1739 Arg al [25];
1740 int ac;
1742 BLOCK_INPUT;
1744 if (STRINGP (f->name))
1745 name = (char*) XSTRING (f->name)->data;
1746 else
1747 name = "emacs";
1749 ac = 0;
1750 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
1751 XtSetArg (al[ac], XtNinput, 1); ac++;
1752 shell_widget = XtCreatePopupShell ("shell",
1753 topLevelShellWidgetClass,
1754 Xt_app_shell, al, ac);
1756 f->display.x->widget = shell_widget;
1757 /* maybe_set_screen_title_format (shell_widget); */
1760 ac = 0;
1761 XtSetArg (al[ac], XtNborderWidth, 0); ac++;
1762 pane_widget = XtCreateWidget ("pane",
1763 panedWidgetClass,
1764 shell_widget, al, ac);
1766 f->display.x->column_widget = pane_widget;
1768 if (!minibuffer_only)
1769 initialize_frame_menubar (f);
1771 /* mappedWhenManaged to false tells to the paned window to not map/unmap
1772 * the emacs screen when changing menubar. This reduces flickering a lot.
1775 ac = 0;
1776 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
1777 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
1778 XtSetArg (al[ac], XtNallowResize, 1); ac++;
1779 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
1780 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
1781 screen_widget = XtCreateWidget (name,
1782 emacsFrameClass,
1783 pane_widget, al, ac);
1785 f->display.x->edit_widget = screen_widget;
1787 if (f->display.x->menubar_widget)
1788 XtManageChild (f->display.x->menubar_widget);
1789 XtManageChild (screen_widget);
1791 /* Do some needed geometry management. */
1793 int len;
1794 char *tem, shell_position[32];
1795 Arg al[2];
1796 int ac = 0;
1797 int menubar_size
1798 = (f->display.x->menubar_widget
1799 ? (f->display.x->menubar_widget->core.height
1800 + f->display.x->menubar_widget->core.border_width)
1801 : 0);
1803 if (window_prompting & USPosition)
1805 int left = f->display.x->left_pos;
1806 int xneg = left < 0;
1807 int top = f->display.x->top_pos;
1808 int yneg = top < 0;
1809 if (left < 0)
1810 left = -left;
1811 if (top < 0)
1812 top = -top;
1813 sprintf (shell_position, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f),
1814 PIXEL_HEIGHT (f) + menubar_size,
1815 (xneg ? '-' : '+'), left,
1816 (yneg ? '-' : '+'), top);
1818 else
1819 sprintf (shell_position, "=%dx%d", PIXEL_WIDTH (f),
1820 PIXEL_HEIGHT (f) + menubar_size);
1821 len = strlen (shell_position) + 1;
1822 tem = (char *) xmalloc (len);
1823 strncpy (tem, shell_position, len);
1824 XtSetArg (al[ac], XtNgeometry, tem); ac++;
1825 XtSetValues (shell_widget, al, ac);
1828 x_calc_absolute_position (f);
1830 XtManageChild (pane_widget);
1831 XtRealizeWidget (shell_widget);
1833 FRAME_X_WINDOW (f) = XtWindow (screen_widget);
1835 validate_x_resource_name ();
1836 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
1837 class_hints.res_class = EMACS_CLASS;
1838 XSetClassHint (x_current_display, XtWindow (shell_widget), &class_hints);
1840 hack_wm_protocols (shell_widget);
1842 /* Do a stupid property change to force the server to generate a
1843 propertyNotify event so that the event_stream server timestamp will
1844 be initialized to something relevant to the time we created the window.
1846 XChangeProperty (XtDisplay (screen_widget), XtWindow (screen_widget),
1847 Xatom_wm_protocols, XA_ATOM, 32, PropModeAppend,
1848 (unsigned char*) NULL, 0);
1850 /* Make all the standard events reach the Emacs frame. */
1851 attributes.event_mask = STANDARD_EVENT_SET;
1852 attribute_mask = CWEventMask;
1853 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
1854 attribute_mask, &attributes);
1856 XtMapWidget (screen_widget);
1858 /* x_set_name normally ignores requests to set the name if the
1859 requested name is the same as the current name. This is the one
1860 place where that assumption isn't correct; f->name is set, but
1861 the X server hasn't been told. */
1863 Lisp_Object name;
1864 int explicit = f->explicit_name;
1866 f->explicit_name = 0;
1867 name = f->name;
1868 f->name = Qnil;
1869 x_set_name (f, name, explicit);
1872 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
1873 f->display.x->text_cursor);
1875 UNBLOCK_INPUT;
1877 if (FRAME_X_WINDOW (f) == 0)
1878 error ("Unable to create window");
1881 #else /* not USE_X_TOOLKIT */
1883 /* Create and set up the X window for frame F. */
1885 x_window (f)
1886 struct frame *f;
1889 XClassHint class_hints;
1890 XSetWindowAttributes attributes;
1891 unsigned long attribute_mask;
1893 x_calc_absolute_position (f);
1895 attributes.background_pixel = f->display.x->background_pixel;
1896 attributes.border_pixel = f->display.x->border_pixel;
1897 attributes.bit_gravity = StaticGravity;
1898 attributes.backing_store = NotUseful;
1899 attributes.save_under = True;
1900 attributes.event_mask = STANDARD_EVENT_SET;
1901 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
1902 #if 0
1903 | CWBackingStore | CWSaveUnder
1904 #endif
1905 | CWEventMask);
1907 BLOCK_INPUT;
1908 FRAME_X_WINDOW (f)
1909 = XCreateWindow (x_current_display, ROOT_WINDOW,
1910 f->display.x->left_pos,
1911 f->display.x->top_pos,
1912 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
1913 f->display.x->border_width,
1914 CopyFromParent, /* depth */
1915 InputOutput, /* class */
1916 screen_visual, /* set in Fx_open_connection */
1917 attribute_mask, &attributes);
1919 validate_x_resource_name ();
1920 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
1921 class_hints.res_class = EMACS_CLASS;
1922 XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints);
1924 /* This indicates that we use the "Passive Input" input model.
1925 Unless we do this, we don't get the Focus{In,Out} events that we
1926 need to draw the cursor correctly. Accursed bureaucrats.
1927 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1929 f->display.x->wm_hints.input = True;
1930 f->display.x->wm_hints.flags |= InputHint;
1931 XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints);
1932 XSetWMProtocols (x_current_display, FRAME_X_WINDOW (f),
1933 &Xatom_wm_delete_window, 1);
1936 /* x_set_name normally ignores requests to set the name if the
1937 requested name is the same as the current name. This is the one
1938 place where that assumption isn't correct; f->name is set, but
1939 the X server hasn't been told. */
1941 Lisp_Object name;
1942 int explicit = f->explicit_name;
1944 f->explicit_name = 0;
1945 name = f->name;
1946 f->name = Qnil;
1947 x_set_name (f, name, explicit);
1950 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
1951 f->display.x->text_cursor);
1953 UNBLOCK_INPUT;
1955 if (FRAME_X_WINDOW (f) == 0)
1956 error ("Unable to create window");
1959 #endif /* not USE_X_TOOLKIT */
1961 /* Handle the icon stuff for this window. Perhaps later we might
1962 want an x_set_icon_position which can be called interactively as
1963 well. */
1965 static void
1966 x_icon (f, parms)
1967 struct frame *f;
1968 Lisp_Object parms;
1970 Lisp_Object icon_x, icon_y;
1972 /* Set the position of the icon. Note that twm groups all
1973 icons in an icon window. */
1974 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
1975 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
1976 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
1978 CHECK_NUMBER (icon_x, 0);
1979 CHECK_NUMBER (icon_y, 0);
1981 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
1982 error ("Both left and top icon corners of icon must be specified");
1984 BLOCK_INPUT;
1986 if (! EQ (icon_x, Qunbound))
1987 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
1989 /* Start up iconic or window? */
1990 x_wm_set_window_state
1991 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
1992 ? IconicState
1993 : NormalState));
1995 UNBLOCK_INPUT;
1998 /* Make the GC's needed for this window, setting the
1999 background, border and mouse colors; also create the
2000 mouse cursor and the gray border tile. */
2002 static char cursor_bits[] =
2004 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2005 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2006 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2007 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2010 static void
2011 x_make_gc (f)
2012 struct frame *f;
2014 XGCValues gc_values;
2015 GC temp_gc;
2016 XImage tileimage;
2018 BLOCK_INPUT;
2020 /* Create the GC's of this frame.
2021 Note that many default values are used. */
2023 /* Normal video */
2024 gc_values.font = f->display.x->font->fid;
2025 gc_values.foreground = f->display.x->foreground_pixel;
2026 gc_values.background = f->display.x->background_pixel;
2027 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
2028 f->display.x->normal_gc = XCreateGC (x_current_display,
2029 FRAME_X_WINDOW (f),
2030 GCLineWidth | GCFont
2031 | GCForeground | GCBackground,
2032 &gc_values);
2034 /* Reverse video style. */
2035 gc_values.foreground = f->display.x->background_pixel;
2036 gc_values.background = f->display.x->foreground_pixel;
2037 f->display.x->reverse_gc = XCreateGC (x_current_display,
2038 FRAME_X_WINDOW (f),
2039 GCFont | GCForeground | GCBackground
2040 | GCLineWidth,
2041 &gc_values);
2043 /* Cursor has cursor-color background, background-color foreground. */
2044 gc_values.foreground = f->display.x->background_pixel;
2045 gc_values.background = f->display.x->cursor_pixel;
2046 gc_values.fill_style = FillOpaqueStippled;
2047 gc_values.stipple
2048 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
2049 cursor_bits, 16, 16);
2050 f->display.x->cursor_gc
2051 = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
2052 (GCFont | GCForeground | GCBackground
2053 | GCFillStyle | GCStipple | GCLineWidth),
2054 &gc_values);
2056 /* Create the gray border tile used when the pointer is not in
2057 the frame. Since this depends on the frame's pixel values,
2058 this must be done on a per-frame basis. */
2059 f->display.x->border_tile
2060 = (XCreatePixmapFromBitmapData
2061 (x_current_display, ROOT_WINDOW,
2062 gray_bits, gray_width, gray_height,
2063 f->display.x->foreground_pixel,
2064 f->display.x->background_pixel,
2065 DefaultDepth (x_current_display, XDefaultScreen (x_current_display))));
2067 UNBLOCK_INPUT;
2069 #endif /* HAVE_X11 */
2071 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
2072 1, 1, 0,
2073 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2074 Return an Emacs frame object representing the X window.\n\
2075 ALIST is an alist of frame parameters.\n\
2076 If the parameters specify that the frame should not have a minibuffer,\n\
2077 and do not specify a specific minibuffer window to use,\n\
2078 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2079 be shared by the new frame.")
2080 (parms)
2081 Lisp_Object parms;
2083 #ifdef HAVE_X11
2084 struct frame *f;
2085 Lisp_Object frame, tem, tem0, tem1;
2086 Lisp_Object name;
2087 int minibuffer_only = 0;
2088 long window_prompting = 0;
2089 int width, height;
2090 int count = specpdl_ptr - specpdl;
2092 check_x ();
2094 name = x_get_arg (parms, Qname, "title", "Title", string);
2095 if (XTYPE (name) != Lisp_String
2096 && ! EQ (name, Qunbound)
2097 && ! NILP (name))
2098 error ("x-create-frame: name parameter must be a string");
2100 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
2101 if (EQ (tem, Qnone) || NILP (tem))
2102 f = make_frame_without_minibuffer (Qnil);
2103 else if (EQ (tem, Qonly))
2105 f = make_minibuffer_frame ();
2106 minibuffer_only = 1;
2108 else if (XTYPE (tem) == Lisp_Window)
2109 f = make_frame_without_minibuffer (tem);
2110 else
2111 f = make_frame (1);
2113 /* Note that X Windows does support scroll bars. */
2114 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
2116 /* Set the name; the functions to which we pass f expect the name to
2117 be set. */
2118 if (EQ (name, Qunbound) || NILP (name))
2120 f->name = build_string (x_id_name);
2121 f->explicit_name = 0;
2123 else
2125 f->name = name;
2126 f->explicit_name = 1;
2127 /* use the frame's title when getting resources for this frame. */
2128 specbind (Qx_resource_name, name);
2131 XSET (frame, Lisp_Frame, f);
2132 f->output_method = output_x_window;
2133 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
2134 bzero (f->display.x, sizeof (struct x_display));
2136 /* Note that the frame has no physical cursor right now. */
2137 f->phys_cursor_x = -1;
2139 /* Extract the window parameters from the supplied values
2140 that are needed to determine window geometry. */
2142 Lisp_Object font;
2144 font = x_get_arg (parms, Qfont, "font", "Font", string);
2145 BLOCK_INPUT;
2146 /* First, try whatever font the caller has specified. */
2147 if (STRINGP (font))
2148 font = x_new_font (f, XSTRING (font)->data);
2149 /* Try out a font which we hope has bold and italic variations. */
2150 if (!STRINGP (font))
2151 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2152 if (! STRINGP (font))
2153 font = x_new_font (f, "-*-*-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2154 if (! STRINGP (font))
2155 /* This was formerly the first thing tried, but it finds too many fonts
2156 and takes too long. */
2157 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
2158 /* If those didn't work, look for something which will at least work. */
2159 if (! STRINGP (font))
2160 font = x_new_font (f, "-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1");
2161 UNBLOCK_INPUT;
2162 if (! STRINGP (font))
2163 font = build_string ("fixed");
2165 x_default_parameter (f, parms, Qfont, font,
2166 "font", "Font", string);
2169 x_default_parameter (f, parms, Qborder_width, make_number (2),
2170 "borderwidth", "BorderWidth", number);
2171 /* This defaults to 2 in order to match xterm. We recognize either
2172 internalBorderWidth or internalBorder (which is what xterm calls
2173 it). */
2174 if (NILP (Fassq (Qinternal_border_width, parms)))
2176 Lisp_Object value;
2178 value = x_get_arg (parms, Qinternal_border_width,
2179 "internalBorder", "BorderWidth", number);
2180 if (! EQ (value, Qunbound))
2181 parms = Fcons (Fcons (Qinternal_border_width, value),
2182 parms);
2184 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
2185 "internalBorderWidth", "BorderWidth", number);
2186 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
2187 "verticalScrollBars", "ScrollBars", boolean);
2189 /* Also do the stuff which must be set before the window exists. */
2190 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
2191 "foreground", "Foreground", string);
2192 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
2193 "background", "Background", string);
2194 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
2195 "pointerColor", "Foreground", string);
2196 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
2197 "cursorColor", "Foreground", string);
2198 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
2199 "borderColor", "BorderColor", string);
2201 f->display.x->parent_desc = ROOT_WINDOW;
2202 window_prompting = x_figure_window_size (f, parms);
2204 #ifdef USE_X_TOOLKIT
2205 x_window (f, window_prompting, minibuffer_only);
2206 #else
2207 x_window (f);
2208 #endif
2209 x_icon (f, parms);
2210 x_make_gc (f);
2211 init_frame_faces (f);
2213 /* We need to do this after creating the X window, so that the
2214 icon-creation functions can say whose icon they're describing. */
2215 x_default_parameter (f, parms, Qicon_type, Qnil,
2216 "bitmapIcon", "BitmapIcon", symbol);
2218 x_default_parameter (f, parms, Qauto_raise, Qnil,
2219 "autoRaise", "AutoRaiseLower", boolean);
2220 x_default_parameter (f, parms, Qauto_lower, Qnil,
2221 "autoLower", "AutoRaiseLower", boolean);
2222 x_default_parameter (f, parms, Qcursor_type, Qbox,
2223 "cursorType", "CursorType", symbol);
2225 /* Dimensions, especially f->height, must be done via change_frame_size.
2226 Change will not be effected unless different from the current
2227 f->height. */
2228 width = f->width;
2229 height = f->height;
2230 f->height = f->width = 0;
2231 change_frame_size (f, height, width, 1, 0);
2233 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0),
2234 "menuBarLines", "MenuBarLines", number);
2236 /* With the toolkit, the geometry management is done in x_window. */
2237 #ifndef USE_X_TOOLKIT
2238 tem0 = x_get_arg (parms, Qleft, 0, 0, number);
2239 tem1 = x_get_arg (parms, Qtop, 0, 0, number);
2240 BLOCK_INPUT;
2241 x_wm_set_size_hint (f, window_prompting, 1, XINT (tem0), XINT (tem1));
2242 UNBLOCK_INPUT;
2243 #endif /* USE_X_TOOLKIT */
2245 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
2246 f->no_split = minibuffer_only || EQ (tem, Qt);
2248 /* It is now ok to make the frame official
2249 even if we get an error below.
2250 And the frame needs to be on Vframe_list
2251 or making it visible won't work. */
2252 Vframe_list = Fcons (frame, Vframe_list);
2254 /* Make the window appear on the frame and enable display,
2255 unless the caller says not to. */
2257 Lisp_Object visibility;
2259 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
2260 if (EQ (visibility, Qunbound))
2261 visibility = Qt;
2263 if (EQ (visibility, Qicon))
2264 x_iconify_frame (f);
2265 else if (! NILP (visibility))
2266 x_make_frame_visible (f);
2267 else
2268 /* Must have been Qnil. */
2272 return unbind_to (count, frame);
2273 #else /* X10 */
2274 struct frame *f;
2275 Lisp_Object frame, tem;
2276 Lisp_Object name;
2277 int pixelwidth, pixelheight;
2278 Cursor cursor;
2279 int height, width;
2280 Window parent;
2281 Pixmap temp;
2282 int minibuffer_only = 0;
2283 Lisp_Object vscroll, hscroll;
2285 if (x_current_display == 0)
2286 error ("X windows are not in use or not initialized");
2288 name = Fassq (Qname, parms);
2290 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
2291 if (EQ (tem, Qnone))
2292 f = make_frame_without_minibuffer (Qnil);
2293 else if (EQ (tem, Qonly))
2295 f = make_minibuffer_frame ();
2296 minibuffer_only = 1;
2298 else if (EQ (tem, Qnil) || EQ (tem, Qunbound))
2299 f = make_frame (1);
2300 else
2301 f = make_frame_without_minibuffer (tem);
2303 parent = ROOT_WINDOW;
2305 XSET (frame, Lisp_Frame, f);
2306 f->output_method = output_x_window;
2307 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
2308 bzero (f->display.x, sizeof (struct x_display));
2310 /* Some temporary default values for height and width. */
2311 width = 80;
2312 height = 40;
2313 f->display.x->left_pos = -1;
2314 f->display.x->top_pos = -1;
2316 /* Give the frame a default name (which may be overridden with PARMS). */
2318 strncpy (iconidentity, ICONTAG, MAXICID);
2319 if (gethostname (&iconidentity[sizeof (ICONTAG) - 1],
2320 (MAXICID - 1) - sizeof (ICONTAG)))
2321 iconidentity[sizeof (ICONTAG) - 2] = '\0';
2322 f->name = build_string (iconidentity);
2324 /* Extract some window parameters from the supplied values.
2325 These are the parameters that affect window geometry. */
2327 tem = x_get_arg (parms, Qfont, "BodyFont", 0, string);
2328 if (EQ (tem, Qunbound))
2329 tem = build_string ("9x15");
2330 x_set_font (f, tem, Qnil);
2331 x_default_parameter (f, parms, Qborder_color,
2332 build_string ("black"), "Border", 0, string);
2333 x_default_parameter (f, parms, Qbackground_color,
2334 build_string ("white"), "Background", 0, string);
2335 x_default_parameter (f, parms, Qforeground_color,
2336 build_string ("black"), "Foreground", 0, string);
2337 x_default_parameter (f, parms, Qmouse_color,
2338 build_string ("black"), "Mouse", 0, string);
2339 x_default_parameter (f, parms, Qcursor_color,
2340 build_string ("black"), "Cursor", 0, string);
2341 x_default_parameter (f, parms, Qborder_width,
2342 make_number (2), "BorderWidth", 0, number);
2343 x_default_parameter (f, parms, Qinternal_border_width,
2344 make_number (4), "InternalBorderWidth", 0, number);
2345 x_default_parameter (f, parms, Qauto_raise,
2346 Qnil, "AutoRaise", 0, boolean);
2348 hscroll = EQ (x_get_arg (parms, Qhorizontal_scroll_bar, 0, 0, boolean), Qt);
2349 vscroll = EQ (x_get_arg (parms, Qvertical_scroll_bar, 0, 0, boolean), Qt);
2351 if (f->display.x->internal_border_width < 0)
2352 f->display.x->internal_border_width = 0;
2354 tem = x_get_arg (parms, Qwindow_id, 0, 0, number);
2355 if (!EQ (tem, Qunbound))
2357 WINDOWINFO_TYPE wininfo;
2358 int nchildren;
2359 Window *children, root;
2361 CHECK_NUMBER (tem, 0);
2362 FRAME_X_WINDOW (f) = (Window) XINT (tem);
2364 BLOCK_INPUT;
2365 XGetWindowInfo (FRAME_X_WINDOW (f), &wininfo);
2366 XQueryTree (FRAME_X_WINDOW (f), &parent, &nchildren, &children);
2367 xfree (children);
2368 UNBLOCK_INPUT;
2370 height = PIXEL_TO_CHAR_HEIGHT (f, wininfo.height);
2371 width = PIXEL_TO_CHAR_WIDTH (f, wininfo.width);
2372 f->display.x->left_pos = wininfo.x;
2373 f->display.x->top_pos = wininfo.y;
2374 FRAME_SET_VISIBILITY (f, wininfo.mapped != 0);
2375 f->display.x->border_width = wininfo.bdrwidth;
2376 f->display.x->parent_desc = parent;
2378 else
2380 tem = x_get_arg (parms, Qparent_id, 0, 0, number);
2381 if (!EQ (tem, Qunbound))
2383 CHECK_NUMBER (tem, 0);
2384 parent = (Window) XINT (tem);
2386 f->display.x->parent_desc = parent;
2387 tem = x_get_arg (parms, Qheight, 0, 0, number);
2388 if (EQ (tem, Qunbound))
2390 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2391 if (EQ (tem, Qunbound))
2393 tem = x_get_arg (parms, Qtop, 0, 0, number);
2394 if (EQ (tem, Qunbound))
2395 tem = x_get_arg (parms, Qleft, 0, 0, number);
2398 /* Now TEM is Qunbound if no edge or size was specified.
2399 In that case, we must do rubber-banding. */
2400 if (EQ (tem, Qunbound))
2402 tem = x_get_arg (parms, Qgeometry, 0, 0, number);
2403 x_rubber_band (f,
2404 &f->display.x->left_pos, &f->display.x->top_pos,
2405 &width, &height,
2406 (XTYPE (tem) == Lisp_String
2407 ? (char *) XSTRING (tem)->data : ""),
2408 XSTRING (f->name)->data,
2409 !NILP (hscroll), !NILP (vscroll));
2411 else
2413 /* Here if at least one edge or size was specified.
2414 Demand that they all were specified, and use them. */
2415 tem = x_get_arg (parms, Qheight, 0, 0, number);
2416 if (EQ (tem, Qunbound))
2417 error ("Height not specified");
2418 CHECK_NUMBER (tem, 0);
2419 height = XINT (tem);
2421 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2422 if (EQ (tem, Qunbound))
2423 error ("Width not specified");
2424 CHECK_NUMBER (tem, 0);
2425 width = XINT (tem);
2427 tem = x_get_arg (parms, Qtop, 0, 0, number);
2428 if (EQ (tem, Qunbound))
2429 error ("Top position not specified");
2430 CHECK_NUMBER (tem, 0);
2431 f->display.x->left_pos = XINT (tem);
2433 tem = x_get_arg (parms, Qleft, 0, 0, number);
2434 if (EQ (tem, Qunbound))
2435 error ("Left position not specified");
2436 CHECK_NUMBER (tem, 0);
2437 f->display.x->top_pos = XINT (tem);
2440 pixelwidth = CHAR_TO_PIXEL_WIDTH (f, width);
2441 pixelheight = CHAR_TO_PIXEL_HEIGHT (f, height);
2443 BLOCK_INPUT;
2444 FRAME_X_WINDOW (f)
2445 = XCreateWindow (parent,
2446 f->display.x->left_pos, /* Absolute horizontal offset */
2447 f->display.x->top_pos, /* Absolute Vertical offset */
2448 pixelwidth, pixelheight,
2449 f->display.x->border_width,
2450 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
2451 UNBLOCK_INPUT;
2452 if (FRAME_X_WINDOW (f) == 0)
2453 error ("Unable to create window.");
2456 /* Install the now determined height and width
2457 in the windows and in phys_lines and desired_lines. */
2458 change_frame_size (f, height, width, 1, 0);
2459 XSelectInput (FRAME_X_WINDOW (f), KeyPressed | ExposeWindow
2460 | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy
2461 | EnterWindow | LeaveWindow | UnmapWindow );
2462 x_set_resize_hint (f);
2464 /* Tell the server the window's default name. */
2465 XStoreName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (f->name)->data);
2467 /* Now override the defaults with all the rest of the specified
2468 parms. */
2469 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
2470 f->no_split = minibuffer_only || EQ (tem, Qt);
2472 /* Do not create an icon window if the caller says not to */
2473 if (!EQ (x_get_arg (parms, Qsuppress_icon, 0, 0, boolean), Qt)
2474 || f->display.x->parent_desc != ROOT_WINDOW)
2476 x_text_icon (f, iconidentity);
2477 x_default_parameter (f, parms, Qicon_type, Qnil,
2478 "BitmapIcon", 0, symbol);
2481 /* Tell the X server the previously set values of the
2482 background, border and mouse colors; also create the mouse cursor. */
2483 BLOCK_INPUT;
2484 temp = XMakeTile (f->display.x->background_pixel);
2485 XChangeBackground (FRAME_X_WINDOW (f), temp);
2486 XFreePixmap (temp);
2487 UNBLOCK_INPUT;
2488 x_set_border_pixel (f, f->display.x->border_pixel);
2490 x_set_mouse_color (f, Qnil, Qnil);
2492 /* Now override the defaults with all the rest of the specified parms. */
2494 Fmodify_frame_parameters (frame, parms);
2496 /* Make the window appear on the frame and enable display. */
2498 Lisp_Object visibility;
2500 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
2501 if (EQ (visibility, Qunbound))
2502 visibility = Qt;
2504 if (! EQ (visibility, Qicon)
2505 && ! NILP (visibility))
2506 x_make_window_visible (f);
2509 SET_FRAME_GARBAGED (f);
2511 Vframe_list = Fcons (frame, Vframe_list);
2512 return frame;
2513 #endif /* X10 */
2516 Lisp_Object
2517 x_get_focus_frame ()
2519 Lisp_Object xfocus;
2520 if (! x_focus_frame)
2521 return Qnil;
2523 XSET (xfocus, Lisp_Frame, x_focus_frame);
2524 return xfocus;
2527 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
2528 "Set the focus on FRAME.")
2529 (frame)
2530 Lisp_Object frame;
2532 CHECK_LIVE_FRAME (frame, 0);
2534 if (FRAME_X_P (XFRAME (frame)))
2536 BLOCK_INPUT;
2537 x_focus_on_frame (XFRAME (frame));
2538 UNBLOCK_INPUT;
2539 return frame;
2542 return Qnil;
2545 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
2546 "If a frame has been focused, release it.")
2549 if (x_focus_frame)
2551 BLOCK_INPUT;
2552 x_unfocus_frame (x_focus_frame);
2553 UNBLOCK_INPUT;
2556 return Qnil;
2559 #ifndef HAVE_X11
2560 /* Computes an X-window size and position either from geometry GEO
2561 or with the mouse.
2563 F is a frame. It specifies an X window which is used to
2564 determine which display to compute for. Its font, borders
2565 and colors control how the rectangle will be displayed.
2567 X and Y are where to store the positions chosen.
2568 WIDTH and HEIGHT are where to store the sizes chosen.
2570 GEO is the geometry that may specify some of the info.
2571 STR is a prompt to display.
2572 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2575 x_rubber_band (f, x, y, width, height, geo, str, hscroll, vscroll)
2576 struct frame *f;
2577 int *x, *y, *width, *height;
2578 char *geo;
2579 char *str;
2580 int hscroll, vscroll;
2582 OpaqueFrame frame;
2583 Window tempwindow;
2584 WindowInfo wininfo;
2585 int border_color;
2586 int background_color;
2587 Lisp_Object tem;
2588 int mask;
2590 BLOCK_INPUT;
2592 background_color = f->display.x->background_pixel;
2593 border_color = f->display.x->border_pixel;
2595 frame.bdrwidth = f->display.x->border_width;
2596 frame.border = XMakeTile (border_color);
2597 frame.background = XMakeTile (background_color);
2598 tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5,
2599 (2 * f->display.x->internal_border_width
2600 + (vscroll ? VSCROLL_WIDTH : 0)),
2601 (2 * f->display.x->internal_border_width
2602 + (hscroll ? HSCROLL_HEIGHT : 0)),
2603 width, height, f->display.x->font,
2604 FONT_WIDTH (f->display.x->font),
2605 f->display.x->line_height);
2606 XFreePixmap (frame.border);
2607 XFreePixmap (frame.background);
2609 if (tempwindow != 0)
2611 XQueryWindow (tempwindow, &wininfo);
2612 XDestroyWindow (tempwindow);
2613 *x = wininfo.x;
2614 *y = wininfo.y;
2617 /* Coordinates we got are relative to the root window.
2618 Convert them to coordinates relative to desired parent window
2619 by scanning from there up to the root. */
2620 tempwindow = f->display.x->parent_desc;
2621 while (tempwindow != ROOT_WINDOW)
2623 int nchildren;
2624 Window *children;
2625 XQueryWindow (tempwindow, &wininfo);
2626 *x -= wininfo.x;
2627 *y -= wininfo.y;
2628 XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
2629 xfree (children);
2632 UNBLOCK_INPUT;
2633 return tempwindow != 0;
2635 #endif /* not HAVE_X11 */
2637 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
2638 "Return a list of the names of available fonts matching PATTERN.\n\
2639 If optional arguments FACE and FRAME are specified, return only fonts\n\
2640 the same size as FACE on FRAME.\n\
2642 PATTERN is a string, perhaps with wildcard characters;\n\
2643 the * character matches any substring, and\n\
2644 the ? character matches any single character.\n\
2645 PATTERN is case-insensitive.\n\
2646 FACE is a face name - a symbol.\n\
2648 The return value is a list of strings, suitable as arguments to\n\
2649 set-face-font.\n\
2651 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
2652 even if they match PATTERN and FACE.")
2653 (pattern, face, frame)
2654 Lisp_Object pattern, face, frame;
2656 int num_fonts;
2657 char **names;
2658 XFontStruct *info;
2659 XFontStruct *size_ref;
2660 Lisp_Object list;
2662 check_x ();
2663 CHECK_STRING (pattern, 0);
2664 if (!NILP (face))
2665 CHECK_SYMBOL (face, 1);
2666 if (!NILP (frame))
2667 CHECK_LIVE_FRAME (frame, 2);
2669 if (NILP (face))
2670 size_ref = 0;
2671 else
2673 FRAME_PTR f = NILP (frame) ? selected_frame : XFRAME (frame);
2674 int face_id = face_name_id_number (f, face);
2676 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
2677 || FRAME_PARAM_FACES (f) [face_id] == 0)
2678 size_ref = f->display.x->font;
2679 else
2681 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
2682 if (size_ref == (XFontStruct *) (~0))
2683 size_ref = f->display.x->font;
2687 BLOCK_INPUT;
2689 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
2690 #ifdef BROKEN_XLISTFONTSWITHINFO
2691 names = XListFonts (x_current_display,
2692 XSTRING (pattern)->data,
2693 2000, /* maxnames */
2694 &num_fonts); /* count_return */
2695 #else
2696 names = XListFontsWithInfo (x_current_display,
2697 XSTRING (pattern)->data,
2698 2000, /* maxnames */
2699 &num_fonts, /* count_return */
2700 &info); /* info_return */
2701 #endif
2702 UNBLOCK_INPUT;
2704 list = Qnil;
2706 if (names)
2708 Lisp_Object *tail;
2709 int i;
2711 tail = &list;
2712 for (i = 0; i < num_fonts; i++)
2714 XFontStruct *thisinfo;
2716 #ifdef BROKEN_XLISTFONTSWITHINFO
2717 BLOCK_INPUT;
2718 thisinfo = XLoadQueryFont (x_current_display, names[i]);
2719 UNBLOCK_INPUT;
2720 #else
2721 thisinfo = &info[i];
2722 #endif
2723 if (thisinfo && (! size_ref
2724 || same_size_fonts (thisinfo, size_ref)))
2726 *tail = Fcons (build_string (names[i]), Qnil);
2727 tail = &XCONS (*tail)->cdr;
2731 BLOCK_INPUT;
2732 #ifdef BROKEN_XLISTFONTSWITHINFO
2733 XFreeFontNames (names);
2734 #else
2735 XFreeFontInfo (names, info, num_fonts);
2736 #endif
2737 UNBLOCK_INPUT;
2740 return list;
2744 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 1, 0,
2745 "Return t if the current X display supports the color named COLOR.")
2746 (color)
2747 Lisp_Object color;
2749 Color foo;
2751 check_x ();
2752 CHECK_STRING (color, 0);
2754 if (defined_color (XSTRING (color)->data, &foo))
2755 return Qt;
2756 else
2757 return Qnil;
2760 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 0, 0,
2761 "Return t if the X screen currently in use supports color.")
2764 check_x ();
2766 if (x_screen_planes <= 2)
2767 return Qnil;
2769 switch (screen_visual->class)
2771 case StaticColor:
2772 case PseudoColor:
2773 case TrueColor:
2774 case DirectColor:
2775 return Qt;
2777 default:
2778 return Qnil;
2782 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2783 0, 1, 0,
2784 "Returns the width in pixels of the display FRAME is on.")
2785 (frame)
2786 Lisp_Object frame;
2788 Display *dpy = x_current_display;
2789 check_x ();
2790 return make_number (DisplayWidth (dpy, DefaultScreen (dpy)));
2793 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2794 Sx_display_pixel_height, 0, 1, 0,
2795 "Returns the height in pixels of the display FRAME is on.")
2796 (frame)
2797 Lisp_Object frame;
2799 Display *dpy = x_current_display;
2800 check_x ();
2801 return make_number (DisplayHeight (dpy, DefaultScreen (dpy)));
2804 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2805 0, 1, 0,
2806 "Returns the number of bitplanes of the display FRAME is on.")
2807 (frame)
2808 Lisp_Object frame;
2810 Display *dpy = x_current_display;
2811 check_x ();
2812 return make_number (DisplayPlanes (dpy, DefaultScreen (dpy)));
2815 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2816 0, 1, 0,
2817 "Returns the number of color cells of the display FRAME is on.")
2818 (frame)
2819 Lisp_Object frame;
2821 Display *dpy = x_current_display;
2822 check_x ();
2823 return make_number (DisplayCells (dpy, DefaultScreen (dpy)));
2826 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
2827 Sx_server_max_request_size,
2828 0, 1, 0,
2829 "Returns the maximum request size of the X server FRAME is using.")
2830 (frame)
2831 Lisp_Object frame;
2833 Display *dpy = x_current_display;
2834 check_x ();
2835 return make_number (MAXREQUEST (dpy));
2838 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
2839 "Returns the vendor ID string of the X server FRAME is on.")
2840 (frame)
2841 Lisp_Object frame;
2843 Display *dpy = x_current_display;
2844 char *vendor;
2845 check_x ();
2846 vendor = ServerVendor (dpy);
2847 if (! vendor) vendor = "";
2848 return build_string (vendor);
2851 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
2852 "Returns the version numbers of the X server in use.\n\
2853 The value is a list of three integers: the major and minor\n\
2854 version numbers of the X Protocol in use, and the vendor-specific release\n\
2855 number. See also the variable `x-server-vendor'.")
2856 (frame)
2857 Lisp_Object frame;
2859 Display *dpy = x_current_display;
2861 check_x ();
2862 return Fcons (make_number (ProtocolVersion (dpy)),
2863 Fcons (make_number (ProtocolRevision (dpy)),
2864 Fcons (make_number (VendorRelease (dpy)), Qnil)));
2867 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
2868 "Returns the number of screens on the X server FRAME is on.")
2869 (frame)
2870 Lisp_Object frame;
2872 check_x ();
2873 return make_number (ScreenCount (x_current_display));
2876 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
2877 "Returns the height in millimeters of the X screen FRAME is on.")
2878 (frame)
2879 Lisp_Object frame;
2881 check_x ();
2882 return make_number (HeightMMOfScreen (x_screen));
2885 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
2886 "Returns the width in millimeters of the X screen FRAME is on.")
2887 (frame)
2888 Lisp_Object frame;
2890 check_x ();
2891 return make_number (WidthMMOfScreen (x_screen));
2894 DEFUN ("x-display-backing-store", Fx_display_backing_store,
2895 Sx_display_backing_store, 0, 1, 0,
2896 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2897 The value may be `always', `when-mapped', or `not-useful'.")
2898 (frame)
2899 Lisp_Object frame;
2901 check_x ();
2903 switch (DoesBackingStore (x_screen))
2905 case Always:
2906 return intern ("always");
2908 case WhenMapped:
2909 return intern ("when-mapped");
2911 case NotUseful:
2912 return intern ("not-useful");
2914 default:
2915 error ("Strange value for BackingStore parameter of screen");
2919 DEFUN ("x-display-visual-class", Fx_display_visual_class,
2920 Sx_display_visual_class, 0, 1, 0,
2921 "Returns the visual class of the display `screen' is on.\n\
2922 The value is one of the symbols `static-gray', `gray-scale',\n\
2923 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2924 (screen)
2925 Lisp_Object screen;
2927 check_x ();
2929 switch (screen_visual->class)
2931 case StaticGray: return (intern ("static-gray"));
2932 case GrayScale: return (intern ("gray-scale"));
2933 case StaticColor: return (intern ("static-color"));
2934 case PseudoColor: return (intern ("pseudo-color"));
2935 case TrueColor: return (intern ("true-color"));
2936 case DirectColor: return (intern ("direct-color"));
2937 default:
2938 error ("Display has an unknown visual class");
2942 DEFUN ("x-display-save-under", Fx_display_save_under,
2943 Sx_display_save_under, 0, 1, 0,
2944 "Returns t if the X screen FRAME is on supports the save-under feature.")
2945 (frame)
2946 Lisp_Object frame;
2948 check_x ();
2950 if (DoesSaveUnders (x_screen) == True)
2951 return Qt;
2952 else
2953 return Qnil;
2956 x_pixel_width (f)
2957 register struct frame *f;
2959 return PIXEL_WIDTH (f);
2962 x_pixel_height (f)
2963 register struct frame *f;
2965 return PIXEL_HEIGHT (f);
2968 x_char_width (f)
2969 register struct frame *f;
2971 return FONT_WIDTH (f->display.x->font);
2974 x_char_height (f)
2975 register struct frame *f;
2977 return f->display.x->line_height;
2980 #if 0 /* These no longer seem like the right way to do things. */
2982 /* Draw a rectangle on the frame with left top corner including
2983 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2984 CHARS by LINES wide and long and is the color of the cursor. */
2986 void
2987 x_rectangle (f, gc, left_char, top_char, chars, lines)
2988 register struct frame *f;
2989 GC gc;
2990 register int top_char, left_char, chars, lines;
2992 int width;
2993 int height;
2994 int left = (left_char * FONT_WIDTH (f->display.x->font)
2995 + f->display.x->internal_border_width);
2996 int top = (top_char * f->display.x->line_height
2997 + f->display.x->internal_border_width);
2999 if (chars < 0)
3000 width = FONT_WIDTH (f->display.x->font) / 2;
3001 else
3002 width = FONT_WIDTH (f->display.x->font) * chars;
3003 if (lines < 0)
3004 height = f->display.x->line_height / 2;
3005 else
3006 height = f->display.x->line_height * lines;
3008 XDrawRectangle (x_current_display, FRAME_X_WINDOW (f),
3009 gc, left, top, width, height);
3012 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
3013 "Draw a rectangle on FRAME between coordinates specified by\n\
3014 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3015 (frame, X0, Y0, X1, Y1)
3016 register Lisp_Object frame, X0, X1, Y0, Y1;
3018 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3020 CHECK_LIVE_FRAME (frame, 0);
3021 CHECK_NUMBER (X0, 0);
3022 CHECK_NUMBER (Y0, 1);
3023 CHECK_NUMBER (X1, 2);
3024 CHECK_NUMBER (Y1, 3);
3026 x0 = XINT (X0);
3027 x1 = XINT (X1);
3028 y0 = XINT (Y0);
3029 y1 = XINT (Y1);
3031 if (y1 > y0)
3033 top = y0;
3034 n_lines = y1 - y0 + 1;
3036 else
3038 top = y1;
3039 n_lines = y0 - y1 + 1;
3042 if (x1 > x0)
3044 left = x0;
3045 n_chars = x1 - x0 + 1;
3047 else
3049 left = x1;
3050 n_chars = x0 - x1 + 1;
3053 BLOCK_INPUT;
3054 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->cursor_gc,
3055 left, top, n_chars, n_lines);
3056 UNBLOCK_INPUT;
3058 return Qt;
3061 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
3062 "Draw a rectangle drawn on FRAME between coordinates\n\
3063 X0, Y0, X1, Y1 in the regular background-pixel.")
3064 (frame, X0, Y0, X1, Y1)
3065 register Lisp_Object frame, X0, Y0, X1, Y1;
3067 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3069 CHECK_FRAME (frame, 0);
3070 CHECK_NUMBER (X0, 0);
3071 CHECK_NUMBER (Y0, 1);
3072 CHECK_NUMBER (X1, 2);
3073 CHECK_NUMBER (Y1, 3);
3075 x0 = XINT (X0);
3076 x1 = XINT (X1);
3077 y0 = XINT (Y0);
3078 y1 = XINT (Y1);
3080 if (y1 > y0)
3082 top = y0;
3083 n_lines = y1 - y0 + 1;
3085 else
3087 top = y1;
3088 n_lines = y0 - y1 + 1;
3091 if (x1 > x0)
3093 left = x0;
3094 n_chars = x1 - x0 + 1;
3096 else
3098 left = x1;
3099 n_chars = x0 - x1 + 1;
3102 BLOCK_INPUT;
3103 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->reverse_gc,
3104 left, top, n_chars, n_lines);
3105 UNBLOCK_INPUT;
3107 return Qt;
3110 /* Draw lines around the text region beginning at the character position
3111 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3112 pixel and line characteristics. */
3114 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3116 static void
3117 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
3118 register struct frame *f;
3119 GC gc;
3120 int top_x, top_y, bottom_x, bottom_y;
3122 register int ibw = f->display.x->internal_border_width;
3123 register int font_w = FONT_WIDTH (f->display.x->font);
3124 register int font_h = f->display.x->line_height;
3125 int y = top_y;
3126 int x = line_len (y);
3127 XPoint *pixel_points
3128 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
3129 register XPoint *this_point = pixel_points;
3131 /* Do the horizontal top line/lines */
3132 if (top_x == 0)
3134 this_point->x = ibw;
3135 this_point->y = ibw + (font_h * top_y);
3136 this_point++;
3137 if (x == 0)
3138 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
3139 else
3140 this_point->x = ibw + (font_w * x);
3141 this_point->y = (this_point - 1)->y;
3143 else
3145 this_point->x = ibw;
3146 this_point->y = ibw + (font_h * (top_y + 1));
3147 this_point++;
3148 this_point->x = ibw + (font_w * top_x);
3149 this_point->y = (this_point - 1)->y;
3150 this_point++;
3151 this_point->x = (this_point - 1)->x;
3152 this_point->y = ibw + (font_h * top_y);
3153 this_point++;
3154 this_point->x = ibw + (font_w * x);
3155 this_point->y = (this_point - 1)->y;
3158 /* Now do the right side. */
3159 while (y < bottom_y)
3160 { /* Right vertical edge */
3161 this_point++;
3162 this_point->x = (this_point - 1)->x;
3163 this_point->y = ibw + (font_h * (y + 1));
3164 this_point++;
3166 y++; /* Horizontal connection to next line */
3167 x = line_len (y);
3168 if (x == 0)
3169 this_point->x = ibw + (font_w / 2);
3170 else
3171 this_point->x = ibw + (font_w * x);
3173 this_point->y = (this_point - 1)->y;
3176 /* Now do the bottom and connect to the top left point. */
3177 this_point->x = ibw + (font_w * (bottom_x + 1));
3179 this_point++;
3180 this_point->x = (this_point - 1)->x;
3181 this_point->y = ibw + (font_h * (bottom_y + 1));
3182 this_point++;
3183 this_point->x = ibw;
3184 this_point->y = (this_point - 1)->y;
3185 this_point++;
3186 this_point->x = pixel_points->x;
3187 this_point->y = pixel_points->y;
3189 XDrawLines (x_current_display, FRAME_X_WINDOW (f),
3190 gc, pixel_points,
3191 (this_point - pixel_points + 1), CoordModeOrigin);
3194 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
3195 "Highlight the region between point and the character under the mouse\n\
3196 selected frame.")
3197 (event)
3198 register Lisp_Object event;
3200 register int x0, y0, x1, y1;
3201 register struct frame *f = selected_frame;
3202 register int p1, p2;
3204 CHECK_CONS (event, 0);
3206 BLOCK_INPUT;
3207 x0 = XINT (Fcar (Fcar (event)));
3208 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3210 /* If the mouse is past the end of the line, don't that area. */
3211 /* ReWrite this... */
3213 x1 = f->cursor_x;
3214 y1 = f->cursor_y;
3216 if (y1 > y0) /* point below mouse */
3217 outline_region (f, f->display.x->cursor_gc,
3218 x0, y0, x1, y1);
3219 else if (y1 < y0) /* point above mouse */
3220 outline_region (f, f->display.x->cursor_gc,
3221 x1, y1, x0, y0);
3222 else /* same line: draw horizontal rectangle */
3224 if (x1 > x0)
3225 x_rectangle (f, f->display.x->cursor_gc,
3226 x0, y0, (x1 - x0 + 1), 1);
3227 else if (x1 < x0)
3228 x_rectangle (f, f->display.x->cursor_gc,
3229 x1, y1, (x0 - x1 + 1), 1);
3232 XFlush (x_current_display);
3233 UNBLOCK_INPUT;
3235 return Qnil;
3238 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
3239 "Erase any highlighting of the region between point and the character\n\
3240 at X, Y on the selected frame.")
3241 (event)
3242 register Lisp_Object event;
3244 register int x0, y0, x1, y1;
3245 register struct frame *f = selected_frame;
3247 BLOCK_INPUT;
3248 x0 = XINT (Fcar (Fcar (event)));
3249 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3250 x1 = f->cursor_x;
3251 y1 = f->cursor_y;
3253 if (y1 > y0) /* point below mouse */
3254 outline_region (f, f->display.x->reverse_gc,
3255 x0, y0, x1, y1);
3256 else if (y1 < y0) /* point above mouse */
3257 outline_region (f, f->display.x->reverse_gc,
3258 x1, y1, x0, y0);
3259 else /* same line: draw horizontal rectangle */
3261 if (x1 > x0)
3262 x_rectangle (f, f->display.x->reverse_gc,
3263 x0, y0, (x1 - x0 + 1), 1);
3264 else if (x1 < x0)
3265 x_rectangle (f, f->display.x->reverse_gc,
3266 x1, y1, (x0 - x1 + 1), 1);
3268 UNBLOCK_INPUT;
3270 return Qnil;
3273 #if 0
3274 int contour_begin_x, contour_begin_y;
3275 int contour_end_x, contour_end_y;
3276 int contour_npoints;
3278 /* Clip the top part of the contour lines down (and including) line Y_POS.
3279 If X_POS is in the middle (rather than at the end) of the line, drop
3280 down a line at that character. */
3282 static void
3283 clip_contour_top (y_pos, x_pos)
3285 register XPoint *begin = contour_lines[y_pos].top_left;
3286 register XPoint *end;
3287 register int npoints;
3288 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
3290 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
3292 end = contour_lines[y_pos].top_right;
3293 npoints = (end - begin + 1);
3294 XDrawLines (x_current_display, contour_window,
3295 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3297 bcopy (end, begin + 1, contour_last_point - end + 1);
3298 contour_last_point -= (npoints - 2);
3299 XDrawLines (x_current_display, contour_window,
3300 contour_erase_gc, begin, 2, CoordModeOrigin);
3301 XFlush (x_current_display);
3303 /* Now, update contour_lines structure. */
3305 /* ______. */
3306 else /* |________*/
3308 register XPoint *p = begin + 1;
3309 end = contour_lines[y_pos].bottom_right;
3310 npoints = (end - begin + 1);
3311 XDrawLines (x_current_display, contour_window,
3312 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3314 p->y = begin->y;
3315 p->x = ibw + (font_w * (x_pos + 1));
3316 p++;
3317 p->y = begin->y + font_h;
3318 p->x = (p - 1)->x;
3319 bcopy (end, begin + 3, contour_last_point - end + 1);
3320 contour_last_point -= (npoints - 5);
3321 XDrawLines (x_current_display, contour_window,
3322 contour_erase_gc, begin, 4, CoordModeOrigin);
3323 XFlush (x_current_display);
3325 /* Now, update contour_lines structure. */
3329 /* Erase the top horizontal lines of the contour, and then extend
3330 the contour upwards. */
3332 static void
3333 extend_contour_top (line)
3337 static void
3338 clip_contour_bottom (x_pos, y_pos)
3339 int x_pos, y_pos;
3343 static void
3344 extend_contour_bottom (x_pos, y_pos)
3348 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
3350 (event)
3351 Lisp_Object event;
3353 register struct frame *f = selected_frame;
3354 register int point_x = f->cursor_x;
3355 register int point_y = f->cursor_y;
3356 register int mouse_below_point;
3357 register Lisp_Object obj;
3358 register int x_contour_x, x_contour_y;
3360 x_contour_x = x_mouse_x;
3361 x_contour_y = x_mouse_y;
3362 if (x_contour_y > point_y || (x_contour_y == point_y
3363 && x_contour_x > point_x))
3365 mouse_below_point = 1;
3366 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
3367 x_contour_x, x_contour_y);
3369 else
3371 mouse_below_point = 0;
3372 outline_region (f, f->display.x->cursor_gc, x_contour_x, x_contour_y,
3373 point_x, point_y);
3376 while (1)
3378 obj = read_char (-1, 0, 0, Qnil, 0);
3379 if (XTYPE (obj) != Lisp_Cons)
3380 break;
3382 if (mouse_below_point)
3384 if (x_mouse_y <= point_y) /* Flipped. */
3386 mouse_below_point = 0;
3388 outline_region (f, f->display.x->reverse_gc, point_x, point_y,
3389 x_contour_x, x_contour_y);
3390 outline_region (f, f->display.x->cursor_gc, x_mouse_x, x_mouse_y,
3391 point_x, point_y);
3393 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
3395 clip_contour_bottom (x_mouse_y);
3397 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
3399 extend_bottom_contour (x_mouse_y);
3402 x_contour_x = x_mouse_x;
3403 x_contour_y = x_mouse_y;
3405 else /* mouse above or same line as point */
3407 if (x_mouse_y >= point_y) /* Flipped. */
3409 mouse_below_point = 1;
3411 outline_region (f, f->display.x->reverse_gc,
3412 x_contour_x, x_contour_y, point_x, point_y);
3413 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
3414 x_mouse_x, x_mouse_y);
3416 else if (x_mouse_y > x_contour_y) /* Top clipped. */
3418 clip_contour_top (x_mouse_y);
3420 else if (x_mouse_y < x_contour_y) /* Top extended. */
3422 extend_contour_top (x_mouse_y);
3427 unread_command_event = obj;
3428 if (mouse_below_point)
3430 contour_begin_x = point_x;
3431 contour_begin_y = point_y;
3432 contour_end_x = x_contour_x;
3433 contour_end_y = x_contour_y;
3435 else
3437 contour_begin_x = x_contour_x;
3438 contour_begin_y = x_contour_y;
3439 contour_end_x = point_x;
3440 contour_end_y = point_y;
3443 #endif
3445 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
3447 (event)
3448 Lisp_Object event;
3450 register Lisp_Object obj;
3451 struct frame *f = selected_frame;
3452 register struct window *w = XWINDOW (selected_window);
3453 register GC line_gc = f->display.x->cursor_gc;
3454 register GC erase_gc = f->display.x->reverse_gc;
3455 #if 0
3456 char dash_list[] = {6, 4, 6, 4};
3457 int dashes = 4;
3458 XGCValues gc_values;
3459 #endif
3460 register int previous_y;
3461 register int line = (x_mouse_y + 1) * f->display.x->line_height
3462 + f->display.x->internal_border_width;
3463 register int left = f->display.x->internal_border_width
3464 + (w->left
3465 * FONT_WIDTH (f->display.x->font));
3466 register int right = left + (w->width
3467 * FONT_WIDTH (f->display.x->font))
3468 - f->display.x->internal_border_width;
3470 #if 0
3471 BLOCK_INPUT;
3472 gc_values.foreground = f->display.x->cursor_pixel;
3473 gc_values.background = f->display.x->background_pixel;
3474 gc_values.line_width = 1;
3475 gc_values.line_style = LineOnOffDash;
3476 gc_values.cap_style = CapRound;
3477 gc_values.join_style = JoinRound;
3479 line_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
3480 GCLineStyle | GCJoinStyle | GCCapStyle
3481 | GCLineWidth | GCForeground | GCBackground,
3482 &gc_values);
3483 XSetDashes (x_current_display, line_gc, 0, dash_list, dashes);
3484 gc_values.foreground = f->display.x->background_pixel;
3485 gc_values.background = f->display.x->foreground_pixel;
3486 erase_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
3487 GCLineStyle | GCJoinStyle | GCCapStyle
3488 | GCLineWidth | GCForeground | GCBackground,
3489 &gc_values);
3490 XSetDashes (x_current_display, erase_gc, 0, dash_list, dashes);
3491 #endif
3493 while (1)
3495 BLOCK_INPUT;
3496 if (x_mouse_y >= XINT (w->top)
3497 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
3499 previous_y = x_mouse_y;
3500 line = (x_mouse_y + 1) * f->display.x->line_height
3501 + f->display.x->internal_border_width;
3502 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3503 line_gc, left, line, right, line);
3505 XFlushQueue ();
3506 UNBLOCK_INPUT;
3510 obj = read_char (-1, 0, 0, Qnil, 0);
3511 if ((XTYPE (obj) != Lisp_Cons)
3512 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
3513 Qvertical_scroll_bar))
3514 || x_mouse_grabbed)
3516 BLOCK_INPUT;
3517 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3518 erase_gc, left, line, right, line);
3519 UNBLOCK_INPUT;
3520 unread_command_event = obj;
3521 #if 0
3522 XFreeGC (x_current_display, line_gc);
3523 XFreeGC (x_current_display, erase_gc);
3524 #endif
3525 return Qnil;
3528 while (x_mouse_y == previous_y);
3530 BLOCK_INPUT;
3531 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3532 erase_gc, left, line, right, line);
3533 UNBLOCK_INPUT;
3536 #endif
3538 /* Offset in buffer of character under the pointer, or 0. */
3539 int mouse_buffer_offset;
3541 #if 0
3542 /* These keep track of the rectangle following the pointer. */
3543 int mouse_track_top, mouse_track_left, mouse_track_width;
3545 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
3546 "Track the pointer.")
3549 static Cursor current_pointer_shape;
3550 FRAME_PTR f = x_mouse_frame;
3552 BLOCK_INPUT;
3553 if (EQ (Vmouse_frame_part, Qtext_part)
3554 && (current_pointer_shape != f->display.x->nontext_cursor))
3556 unsigned char c;
3557 struct buffer *buf;
3559 current_pointer_shape = f->display.x->nontext_cursor;
3560 XDefineCursor (x_current_display,
3561 FRAME_X_WINDOW (f),
3562 current_pointer_shape);
3564 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
3565 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
3567 else if (EQ (Vmouse_frame_part, Qmodeline_part)
3568 && (current_pointer_shape != f->display.x->modeline_cursor))
3570 current_pointer_shape = f->display.x->modeline_cursor;
3571 XDefineCursor (x_current_display,
3572 FRAME_X_WINDOW (f),
3573 current_pointer_shape);
3576 XFlushQueue ();
3577 UNBLOCK_INPUT;
3579 #endif
3581 #if 0
3582 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
3583 "Draw rectangle around character under mouse pointer, if there is one.")
3584 (event)
3585 Lisp_Object event;
3587 struct window *w = XWINDOW (Vmouse_window);
3588 struct frame *f = XFRAME (WINDOW_FRAME (w));
3589 struct buffer *b = XBUFFER (w->buffer);
3590 Lisp_Object obj;
3592 if (! EQ (Vmouse_window, selected_window))
3593 return Qnil;
3595 if (EQ (event, Qnil))
3597 int x, y;
3599 x_read_mouse_position (selected_frame, &x, &y);
3602 BLOCK_INPUT;
3603 mouse_track_width = 0;
3604 mouse_track_left = mouse_track_top = -1;
3608 if ((x_mouse_x != mouse_track_left
3609 && (x_mouse_x < mouse_track_left
3610 || x_mouse_x > (mouse_track_left + mouse_track_width)))
3611 || x_mouse_y != mouse_track_top)
3613 int hp = 0; /* Horizontal position */
3614 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
3615 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
3616 int tab_width = XINT (b->tab_width);
3617 int ctl_arrow_p = !NILP (b->ctl_arrow);
3618 unsigned char c;
3619 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
3620 int in_mode_line = 0;
3622 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
3623 break;
3625 /* Erase previous rectangle. */
3626 if (mouse_track_width)
3628 x_rectangle (f, f->display.x->reverse_gc,
3629 mouse_track_left, mouse_track_top,
3630 mouse_track_width, 1);
3632 if ((mouse_track_left == f->phys_cursor_x
3633 || mouse_track_left == f->phys_cursor_x - 1)
3634 && mouse_track_top == f->phys_cursor_y)
3636 x_display_cursor (f, 1);
3640 mouse_track_left = x_mouse_x;
3641 mouse_track_top = x_mouse_y;
3642 mouse_track_width = 0;
3644 if (mouse_track_left > len) /* Past the end of line. */
3645 goto draw_or_not;
3647 if (mouse_track_top == mode_line_vpos)
3649 in_mode_line = 1;
3650 goto draw_or_not;
3653 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
3656 c = FETCH_CHAR (p);
3657 if (len == f->width && hp == len - 1 && c != '\n')
3658 goto draw_or_not;
3660 switch (c)
3662 case '\t':
3663 mouse_track_width = tab_width - (hp % tab_width);
3664 p++;
3665 hp += mouse_track_width;
3666 if (hp > x_mouse_x)
3668 mouse_track_left = hp - mouse_track_width;
3669 goto draw_or_not;
3671 continue;
3673 case '\n':
3674 mouse_track_width = -1;
3675 goto draw_or_not;
3677 default:
3678 if (ctl_arrow_p && (c < 040 || c == 0177))
3680 if (p > ZV)
3681 goto draw_or_not;
3683 mouse_track_width = 2;
3684 p++;
3685 hp +=2;
3686 if (hp > x_mouse_x)
3688 mouse_track_left = hp - mouse_track_width;
3689 goto draw_or_not;
3692 else
3694 mouse_track_width = 1;
3695 p++;
3696 hp++;
3698 continue;
3701 while (hp <= x_mouse_x);
3703 draw_or_not:
3704 if (mouse_track_width) /* Over text; use text pointer shape. */
3706 XDefineCursor (x_current_display,
3707 FRAME_X_WINDOW (f),
3708 f->display.x->text_cursor);
3709 x_rectangle (f, f->display.x->cursor_gc,
3710 mouse_track_left, mouse_track_top,
3711 mouse_track_width, 1);
3713 else if (in_mode_line)
3714 XDefineCursor (x_current_display,
3715 FRAME_X_WINDOW (f),
3716 f->display.x->modeline_cursor);
3717 else
3718 XDefineCursor (x_current_display,
3719 FRAME_X_WINDOW (f),
3720 f->display.x->nontext_cursor);
3723 XFlush (x_current_display);
3724 UNBLOCK_INPUT;
3726 obj = read_char (-1, 0, 0, Qnil, 0);
3727 BLOCK_INPUT;
3729 while (XTYPE (obj) == Lisp_Cons /* Mouse event */
3730 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
3731 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
3732 && EQ (Vmouse_window, selected_window) /* In this window */
3733 && x_mouse_frame);
3735 unread_command_event = obj;
3737 if (mouse_track_width)
3739 x_rectangle (f, f->display.x->reverse_gc,
3740 mouse_track_left, mouse_track_top,
3741 mouse_track_width, 1);
3742 mouse_track_width = 0;
3743 if ((mouse_track_left == f->phys_cursor_x
3744 || mouse_track_left - 1 == f->phys_cursor_x)
3745 && mouse_track_top == f->phys_cursor_y)
3747 x_display_cursor (f, 1);
3750 XDefineCursor (x_current_display,
3751 FRAME_X_WINDOW (f),
3752 f->display.x->nontext_cursor);
3753 XFlush (x_current_display);
3754 UNBLOCK_INPUT;
3756 return Qnil;
3758 #endif
3760 #if 0
3761 #include "glyphs.h"
3763 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3764 on the frame F at position X, Y. */
3766 x_draw_pixmap (f, x, y, image_data, width, height)
3767 struct frame *f;
3768 int x, y, width, height;
3769 char *image_data;
3771 Pixmap image;
3773 image = XCreateBitmapFromData (x_current_display,
3774 FRAME_X_WINDOW (f), image_data,
3775 width, height);
3776 XCopyPlane (x_current_display, image, FRAME_X_WINDOW (f),
3777 f->display.x->normal_gc, 0, 0, width, height, x, y);
3779 #endif
3781 #ifndef HAVE_X11
3782 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
3783 1, 1, "sStore text in cut buffer: ",
3784 "Store contents of STRING into the cut buffer of the X window system.")
3785 (string)
3786 register Lisp_Object string;
3788 int mask;
3790 CHECK_STRING (string, 1);
3791 if (! FRAME_X_P (selected_frame))
3792 error ("Selected frame does not understand X protocol.");
3794 BLOCK_INPUT;
3795 XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size);
3796 UNBLOCK_INPUT;
3798 return Qnil;
3801 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
3802 "Return contents of cut buffer of the X window system, as a string.")
3805 int len;
3806 register Lisp_Object string;
3807 int mask;
3808 register char *d;
3810 BLOCK_INPUT;
3811 d = XFetchBytes (&len);
3812 string = make_string (d, len);
3813 XFree (d);
3814 UNBLOCK_INPUT;
3815 return string;
3817 #endif /* X10 */
3819 #if 0 /* I'm told these functions are superfluous
3820 given the ability to bind function keys. */
3822 #ifdef HAVE_X11
3823 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3824 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3825 KEYSYM is a string which conforms to the X keysym definitions found\n\
3826 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3827 list of strings specifying modifier keys such as Control_L, which must\n\
3828 also be depressed for NEWSTRING to appear.")
3829 (x_keysym, modifiers, newstring)
3830 register Lisp_Object x_keysym;
3831 register Lisp_Object modifiers;
3832 register Lisp_Object newstring;
3834 char *rawstring;
3835 register KeySym keysym;
3836 KeySym modifier_list[16];
3838 check_x ();
3839 CHECK_STRING (x_keysym, 1);
3840 CHECK_STRING (newstring, 3);
3842 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
3843 if (keysym == NoSymbol)
3844 error ("Keysym does not exist");
3846 if (NILP (modifiers))
3847 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
3848 XSTRING (newstring)->data, XSTRING (newstring)->size);
3849 else
3851 register Lisp_Object rest, mod;
3852 register int i = 0;
3854 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
3856 if (i == 16)
3857 error ("Can't have more than 16 modifiers");
3859 mod = Fcar (rest);
3860 CHECK_STRING (mod, 3);
3861 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
3862 #ifndef HAVE_X11R5
3863 if (modifier_list[i] == NoSymbol
3864 || !(IsModifierKey (modifier_list[i])
3865 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
3866 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
3867 #else
3868 if (modifier_list[i] == NoSymbol
3869 || !IsModifierKey (modifier_list[i]))
3870 #endif
3871 error ("Element is not a modifier keysym");
3872 i++;
3875 XRebindKeysym (x_current_display, keysym, modifier_list, i,
3876 XSTRING (newstring)->data, XSTRING (newstring)->size);
3879 return Qnil;
3882 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3883 "Rebind KEYCODE to list of strings STRINGS.\n\
3884 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3885 nil as element means don't change.\n\
3886 See the documentation of `x-rebind-key' for more information.")
3887 (keycode, strings)
3888 register Lisp_Object keycode;
3889 register Lisp_Object strings;
3891 register Lisp_Object item;
3892 register unsigned char *rawstring;
3893 KeySym rawkey, modifier[1];
3894 int strsize;
3895 register unsigned i;
3897 check_x ();
3898 CHECK_NUMBER (keycode, 1);
3899 CHECK_CONS (strings, 2);
3900 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3901 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3903 item = Fcar (strings);
3904 if (!NILP (item))
3906 CHECK_STRING (item, 2);
3907 strsize = XSTRING (item)->size;
3908 rawstring = (unsigned char *) xmalloc (strsize);
3909 bcopy (XSTRING (item)->data, rawstring, strsize);
3910 modifier[1] = 1 << i;
3911 XRebindKeysym (x_current_display, rawkey, modifier, 1,
3912 rawstring, strsize);
3915 return Qnil;
3917 #endif /* HAVE_X11 */
3918 #endif /* 0 */
3920 #ifdef HAVE_X11
3922 #ifndef HAVE_XSCREENNUMBEROFSCREEN
3924 XScreenNumberOfScreen (scr)
3925 register Screen *scr;
3927 register Display *dpy;
3928 register Screen *dpyscr;
3929 register int i;
3931 dpy = scr->display;
3932 dpyscr = dpy->screens;
3934 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
3935 if (scr == dpyscr)
3936 return i;
3938 return -1;
3940 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
3942 Visual *
3943 select_visual (screen, depth)
3944 Screen *screen;
3945 unsigned int *depth;
3947 Visual *v;
3948 XVisualInfo *vinfo, vinfo_template;
3949 int n_visuals;
3951 v = DefaultVisualOfScreen (screen);
3953 #ifdef HAVE_X11R4
3954 vinfo_template.visualid = XVisualIDFromVisual (v);
3955 #else
3956 vinfo_template.visualid = v->visualid;
3957 #endif
3959 vinfo_template.screen = XScreenNumberOfScreen (screen);
3961 vinfo = XGetVisualInfo (x_current_display,
3962 VisualIDMask | VisualScreenMask, &vinfo_template,
3963 &n_visuals);
3964 if (n_visuals != 1)
3965 fatal ("Can't get proper X visual info");
3967 if ((1 << vinfo->depth) == vinfo->colormap_size)
3968 *depth = vinfo->depth;
3969 else
3971 int i = 0;
3972 int n = vinfo->colormap_size - 1;
3973 while (n)
3975 n = n >> 1;
3976 i++;
3978 *depth = i;
3981 XFree ((char *) vinfo);
3982 return v;
3984 #endif /* HAVE_X11 */
3986 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
3987 1, 2, 0, "Open a connection to an X server.\n\
3988 DISPLAY is the name of the display to connect to.\n\
3989 Optional second arg XRM_STRING is a string of resources in xrdb format.")
3990 (display, xrm_string)
3991 Lisp_Object display, xrm_string;
3993 unsigned int n_planes;
3994 unsigned char *xrm_option;
3996 CHECK_STRING (display, 0);
3997 if (x_current_display != 0)
3998 error ("X server connection is already initialized");
3999 if (! NILP (xrm_string))
4000 CHECK_STRING (xrm_string, 1);
4002 /* This is what opens the connection and sets x_current_display.
4003 This also initializes many symbols, such as those used for input. */
4004 x_term_init (XSTRING (display)->data);
4006 #ifdef HAVE_X11
4007 XFASTINT (Vwindow_system_version) = 11;
4009 if (! NILP (xrm_string))
4010 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
4011 else
4012 xrm_option = (unsigned char *) 0;
4014 validate_x_resource_name ();
4016 BLOCK_INPUT;
4017 xrdb = x_load_resources (x_current_display, xrm_option,
4018 (char *) XSTRING (Vx_resource_name)->data,
4019 EMACS_CLASS);
4020 UNBLOCK_INPUT;
4021 #ifdef HAVE_XRMSETDATABASE
4022 XrmSetDatabase (x_current_display, xrdb);
4023 #else
4024 x_current_display->db = xrdb;
4025 #endif
4027 x_screen = DefaultScreenOfDisplay (x_current_display);
4029 screen_visual = select_visual (x_screen, &n_planes);
4030 x_screen_planes = n_planes;
4031 x_screen_height = HeightOfScreen (x_screen);
4032 x_screen_width = WidthOfScreen (x_screen);
4034 /* X Atoms used by emacs. */
4035 Xatoms_of_xselect ();
4036 BLOCK_INPUT;
4037 Xatom_wm_protocols = XInternAtom (x_current_display, "WM_PROTOCOLS",
4038 False);
4039 Xatom_wm_take_focus = XInternAtom (x_current_display, "WM_TAKE_FOCUS",
4040 False);
4041 Xatom_wm_save_yourself = XInternAtom (x_current_display, "WM_SAVE_YOURSELF",
4042 False);
4043 Xatom_wm_delete_window = XInternAtom (x_current_display, "WM_DELETE_WINDOW",
4044 False);
4045 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
4046 False);
4047 Xatom_wm_configure_denied = XInternAtom (x_current_display,
4048 "WM_CONFIGURE_DENIED", False);
4049 Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED",
4050 False);
4051 UNBLOCK_INPUT;
4052 #else /* not HAVE_X11 */
4053 XFASTINT (Vwindow_system_version) = 10;
4054 #endif /* not HAVE_X11 */
4055 return Qnil;
4058 DEFUN ("x-close-current-connection", Fx_close_current_connection,
4059 Sx_close_current_connection,
4060 0, 0, 0, "Close the connection to the current X server.")
4063 /* Note: If we're going to call check_x here, then the fatal error
4064 can't happen. For the moment, this check is just for safety,
4065 so a user won't try out the function and get a crash. If it's
4066 really intended only to be called when killing emacs, then there's
4067 no reason for it to have a lisp interface at all. */
4068 check_x();
4069 #ifdef HAVE_X11
4070 /* This is ONLY used when killing emacs; For switching displays
4071 we'll have to take care of setting CloseDownMode elsewhere. */
4073 if (x_current_display)
4075 BLOCK_INPUT;
4076 XSetCloseDownMode (x_current_display, DestroyAll);
4077 XCloseDisplay (x_current_display);
4078 x_current_display = 0;
4080 else
4081 fatal ("No current X display connection to close\n");
4082 #endif
4083 return Qnil;
4086 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize,
4087 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4088 If ON is nil, allow buffering of requests.\n\
4089 Turning on synchronization prohibits the Xlib routines from buffering\n\
4090 requests and seriously degrades performance, but makes debugging much\n\
4091 easier.")
4092 (on)
4093 Lisp_Object on;
4095 check_x ();
4097 XSynchronize (x_current_display, !EQ (on, Qnil));
4099 return Qnil;
4102 /* Wait for responses to all X commands issued so far for FRAME. */
4104 void
4105 x_sync (frame)
4106 Lisp_Object frame;
4108 BLOCK_INPUT;
4109 XSync (x_current_display, False);
4110 UNBLOCK_INPUT;
4113 syms_of_xfns ()
4115 /* This is zero if not using X windows. */
4116 x_current_display = 0;
4118 /* The section below is built by the lisp expression at the top of the file,
4119 just above where these variables are declared. */
4120 /*&&& init symbols here &&&*/
4121 Qauto_raise = intern ("auto-raise");
4122 staticpro (&Qauto_raise);
4123 Qauto_lower = intern ("auto-lower");
4124 staticpro (&Qauto_lower);
4125 Qbackground_color = intern ("background-color");
4126 staticpro (&Qbackground_color);
4127 Qbar = intern ("bar");
4128 staticpro (&Qbar);
4129 Qborder_color = intern ("border-color");
4130 staticpro (&Qborder_color);
4131 Qborder_width = intern ("border-width");
4132 staticpro (&Qborder_width);
4133 Qbox = intern ("box");
4134 staticpro (&Qbox);
4135 Qcursor_color = intern ("cursor-color");
4136 staticpro (&Qcursor_color);
4137 Qcursor_type = intern ("cursor-type");
4138 staticpro (&Qcursor_type);
4139 Qfont = intern ("font");
4140 staticpro (&Qfont);
4141 Qforeground_color = intern ("foreground-color");
4142 staticpro (&Qforeground_color);
4143 Qgeometry = intern ("geometry");
4144 staticpro (&Qgeometry);
4145 Qicon_left = intern ("icon-left");
4146 staticpro (&Qicon_left);
4147 Qicon_top = intern ("icon-top");
4148 staticpro (&Qicon_top);
4149 Qicon_type = intern ("icon-type");
4150 staticpro (&Qicon_type);
4151 Qinternal_border_width = intern ("internal-border-width");
4152 staticpro (&Qinternal_border_width);
4153 Qleft = intern ("left");
4154 staticpro (&Qleft);
4155 Qmouse_color = intern ("mouse-color");
4156 staticpro (&Qmouse_color);
4157 Qnone = intern ("none");
4158 staticpro (&Qnone);
4159 Qparent_id = intern ("parent-id");
4160 staticpro (&Qparent_id);
4161 Qsuppress_icon = intern ("suppress-icon");
4162 staticpro (&Qsuppress_icon);
4163 Qtop = intern ("top");
4164 staticpro (&Qtop);
4165 Qundefined_color = intern ("undefined-color");
4166 staticpro (&Qundefined_color);
4167 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
4168 staticpro (&Qvertical_scroll_bars);
4169 Qvisibility = intern ("visibility");
4170 staticpro (&Qvisibility);
4171 Qwindow_id = intern ("window-id");
4172 staticpro (&Qwindow_id);
4173 Qx_frame_parameter = intern ("x-frame-parameter");
4174 staticpro (&Qx_frame_parameter);
4175 Qx_resource_name = intern ("x-resource-name");
4176 staticpro (&Qx_resource_name);
4177 /* This is the end of symbol initialization. */
4179 Fput (Qundefined_color, Qerror_conditions,
4180 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
4181 Fput (Qundefined_color, Qerror_message,
4182 build_string ("Undefined color"));
4184 init_x_parm_symbols ();
4186 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
4187 "The buffer offset of the character under the pointer.");
4188 mouse_buffer_offset = 0;
4190 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
4191 "The shape of the pointer when over text.\n\
4192 Changing the value does not affect existing frames\n\
4193 unless you set the mouse color.");
4194 Vx_pointer_shape = Qnil;
4196 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
4197 "The name Emacs uses to look up X resources; for internal use only.\n\
4198 `x-get-resource' uses this as the first component of the instance name\n\
4199 when requesting resource values.\n\
4200 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4201 was invoked, or to the value specified with the `-name' or `-rn'\n\
4202 switches, if present.");
4203 Vx_resource_name = Qnil;
4205 #if 0
4206 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
4207 "The shape of the pointer when not over text.");
4208 #endif
4209 Vx_nontext_pointer_shape = Qnil;
4211 #if 0
4212 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
4213 "The shape of the pointer when over the mode line.");
4214 #endif
4215 Vx_mode_pointer_shape = Qnil;
4217 Vx_cross_pointer_shape = Qnil;
4219 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
4220 "A string indicating the foreground color of the cursor box.");
4221 Vx_cursor_fore_pixel = Qnil;
4223 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed,
4224 "Non-nil if a mouse button is currently depressed.");
4225 Vmouse_depressed = Qnil;
4227 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
4228 "t if no X window manager is in use.");
4230 #ifdef HAVE_X11
4231 defsubr (&Sx_get_resource);
4232 #if 0
4233 defsubr (&Sx_draw_rectangle);
4234 defsubr (&Sx_erase_rectangle);
4235 defsubr (&Sx_contour_region);
4236 defsubr (&Sx_uncontour_region);
4237 #endif
4238 defsubr (&Sx_display_color_p);
4239 defsubr (&Sx_list_fonts);
4240 defsubr (&Sx_color_defined_p);
4241 defsubr (&Sx_server_max_request_size);
4242 defsubr (&Sx_server_vendor);
4243 defsubr (&Sx_server_version);
4244 defsubr (&Sx_display_pixel_width);
4245 defsubr (&Sx_display_pixel_height);
4246 defsubr (&Sx_display_mm_width);
4247 defsubr (&Sx_display_mm_height);
4248 defsubr (&Sx_display_screens);
4249 defsubr (&Sx_display_planes);
4250 defsubr (&Sx_display_color_cells);
4251 defsubr (&Sx_display_visual_class);
4252 defsubr (&Sx_display_backing_store);
4253 defsubr (&Sx_display_save_under);
4254 #if 0
4255 defsubr (&Sx_rebind_key);
4256 defsubr (&Sx_rebind_keys);
4257 defsubr (&Sx_track_pointer);
4258 defsubr (&Sx_grab_pointer);
4259 defsubr (&Sx_ungrab_pointer);
4260 #endif
4261 #else
4262 defsubr (&Sx_get_default);
4263 defsubr (&Sx_store_cut_buffer);
4264 defsubr (&Sx_get_cut_buffer);
4265 #endif
4266 defsubr (&Sx_parse_geometry);
4267 defsubr (&Sx_create_frame);
4268 defsubr (&Sfocus_frame);
4269 defsubr (&Sunfocus_frame);
4270 #if 0
4271 defsubr (&Sx_horizontal_line);
4272 #endif
4273 defsubr (&Sx_open_connection);
4274 defsubr (&Sx_close_current_connection);
4275 defsubr (&Sx_synchronize);
4278 #endif /* HAVE_X_WINDOWS */