(gnus-inews-buggy-date): Doc fix.
[bpt/emacs.git] / src / xfns.c
CommitLineData
01f1ba30 1/* Functions for the X window system.
cf177271 2 Copyright (C) 1989, 1992, 1993 Free Software Foundation.
01f1ba30
JB
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
1113d9db 8the Free Software Foundation; either version 2, or (at your option)
01f1ba30
JB
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20/* Completely rewritten by Richard Stallman. */
21
22/* Rewritten for X11 by Joseph Arceneaux */
23
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"
f676886a 31#include "frame.h"
01f1ba30
JB
32#include "window.h"
33#include "buffer.h"
34#include "dispextern.h"
1f98fa48 35#include "keyboard.h"
9ac0d9e0 36#include "blockinput.h"
01f1ba30
JB
37
38#ifdef HAVE_X_WINDOWS
39extern void abort ();
40
0a93081c 41#ifndef VMS
dbc4e1c1 42#include <X11/bitmaps/gray>
0a93081c
JB
43#else
44#include "[.bitmaps]gray.xbm"
45#endif
dbc4e1c1 46
01f1ba30
JB
47#define min(a,b) ((a) < (b) ? (a) : (b))
48#define max(a,b) ((a) > (b) ? (a) : (b))
49
50#ifdef HAVE_X11
51/* X Resource data base */
52static XrmDatabase xrdb;
53
54/* The class of this X application. */
55#define EMACS_CLASS "Emacs"
56
ac63d3d6
JB
57/* The name we're using for this X application. */
58Lisp_Object Vxrdb_name;
59
01f1ba30 60/* Title name and application name for X stuff. */
60fb3ee1 61extern char *x_id_name;
01f1ba30
JB
62
63/* The background and shape of the mouse pointer, and shape when not
64 over text or in the modeline. */
65Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
66
67/* Color of chars displayed in cursor box. */
68Lisp_Object Vx_cursor_fore_pixel;
69
41beb8fc
RS
70/* The screen being used. */
71static Screen *x_screen;
72
01f1ba30
JB
73/* The X Visual we are using for X windows (the default) */
74Visual *screen_visual;
75
01f1ba30
JB
76/* Height of this X screen in pixels. */
77int x_screen_height;
78
01f1ba30
JB
79/* Width of this X screen in pixels. */
80int x_screen_width;
81
01f1ba30
JB
82/* Number of planes for this screen. */
83int x_screen_planes;
84
01f1ba30
JB
85/* Non nil if no window manager is in use. */
86Lisp_Object Vx_no_window_manager;
87
01f1ba30
JB
88/* `t' if a mouse button is depressed. */
89
90Lisp_Object Vmouse_depressed;
91
f370ccb7 92extern unsigned int x_mouse_x, x_mouse_y, x_mouse_grabbed;
f370ccb7 93
01f1ba30 94/* Atom for indicating window state to the window manager. */
99e72068 95extern Atom Xatom_wm_change_state;
01f1ba30 96
3c254570
JA
97/* Communication with window managers. */
98extern Atom Xatom_wm_protocols;
99
100/* Kinds of protocol things we may receive. */
101extern Atom Xatom_wm_take_focus;
102extern Atom Xatom_wm_save_yourself;
103extern Atom Xatom_wm_delete_window;
104
105/* Other WM communication */
c047688c
JA
106extern Atom Xatom_wm_configure_denied; /* When our config request is denied */
107extern Atom Xatom_wm_window_moved; /* When the WM moves us. */
3c254570 108
01f1ba30
JB
109#else /* X10 */
110
179956b9 111/* Default size of an Emacs window. */
01f1ba30
JB
112static char *default_window = "=80x24+0+0";
113
114#define MAXICID 80
115char iconidentity[MAXICID];
116#define ICONTAG "emacs@"
117char minibuffer_iconidentity[MAXICID];
118#define MINIBUFFER_ICONTAG "minibuffer@"
119
120#endif /* X10 */
121
122/* The last 23 bits of the timestamp of the last mouse button event. */
123Time mouse_timestamp;
124
f9942c9e
JB
125/* Evaluate this expression to rebuild the section of syms_of_xfns
126 that initializes and staticpros the symbols declared below. Note
127 that Emacs 18 has a bug that keeps C-x C-e from being able to
128 evaluate this expression.
129
130(progn
131 ;; Accumulate a list of the symbols we want to initialize from the
132 ;; declarations at the top of the file.
133 (goto-char (point-min))
134 (search-forward "/\*&&& symbols declared here &&&*\/\n")
135 (let (symbol-list)
136 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
137 (setq symbol-list
138 (cons (buffer-substring (match-beginning 1) (match-end 1))
139 symbol-list))
140 (forward-line 1))
141 (setq symbol-list (nreverse symbol-list))
142 ;; Delete the section of syms_of_... where we initialize the symbols.
143 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
144 (let ((start (point)))
145 (while (looking-at "^ Q")
146 (forward-line 2))
147 (kill-region start (point)))
148 ;; Write a new symbol initialization section.
149 (while symbol-list
150 (insert (format " %s = intern (\"" (car symbol-list)))
151 (let ((start (point)))
152 (insert (substring (car symbol-list) 1))
153 (subst-char-in-region start (point) ?_ ?-))
154 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
155 (setq symbol-list (cdr symbol-list)))))
156
157 */
158
159/*&&& symbols declared here &&&*/
160Lisp_Object Qauto_raise;
161Lisp_Object Qauto_lower;
162Lisp_Object Qbackground_color;
dbc4e1c1 163Lisp_Object Qbar;
f9942c9e
JB
164Lisp_Object Qborder_color;
165Lisp_Object Qborder_width;
dbc4e1c1 166Lisp_Object Qbox;
f9942c9e 167Lisp_Object Qcursor_color;
dbc4e1c1 168Lisp_Object Qcursor_type;
f9942c9e
JB
169Lisp_Object Qfont;
170Lisp_Object Qforeground_color;
171Lisp_Object Qgeometry;
49795535 172Lisp_Object Qicon;
f9942c9e
JB
173Lisp_Object Qicon_left;
174Lisp_Object Qicon_top;
175Lisp_Object Qicon_type;
f9942c9e
JB
176Lisp_Object Qinternal_border_width;
177Lisp_Object Qleft;
178Lisp_Object Qmouse_color;
baaed68e 179Lisp_Object Qnone;
f9942c9e 180Lisp_Object Qparent_id;
8af1d7ca 181Lisp_Object Qsuppress_icon;
f9942c9e 182Lisp_Object Qtop;
01f1ba30 183Lisp_Object Qundefined_color;
a3c87d4e 184Lisp_Object Qvertical_scroll_bars;
49795535 185Lisp_Object Qvisibility;
f9942c9e 186Lisp_Object Qwindow_id;
f676886a 187Lisp_Object Qx_frame_parameter;
01f1ba30 188
f9942c9e 189/* The below are defined in frame.c. */
baaed68e 190extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
d043f1a4 191extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qicon;
f9942c9e 192
01f1ba30
JB
193extern Lisp_Object Vwindow_system_version;
194
195/* Mouse map for clicks in windows. */
196extern Lisp_Object Vglobal_mouse_map;
197
01f1ba30 198\f
11ae94fe
RS
199/* Error if we are not connected to X. */
200static void
201check_x ()
202{
203 if (x_current_display == 0)
204 error ("X windows are not in use or not initialized");
205}
206
f676886a
JB
207/* Return the Emacs frame-object corresponding to an X window.
208 It could be the frame's main window or an icon window. */
01f1ba30 209
bcb2db92
RS
210/* This function can be called during GC, so use XGCTYPE. */
211
f676886a
JB
212struct frame *
213x_window_to_frame (wdesc)
01f1ba30
JB
214 int wdesc;
215{
f676886a
JB
216 Lisp_Object tail, frame;
217 struct frame *f;
01f1ba30 218
bcb2db92
RS
219 for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons;
220 tail = XCONS (tail)->cdr)
01f1ba30 221 {
f676886a 222 frame = XCONS (tail)->car;
bcb2db92 223 if (XGCTYPE (frame) != Lisp_Frame)
01f1ba30 224 continue;
f676886a 225 f = XFRAME (frame);
fe24a618 226 if (FRAME_X_WINDOW (f) == wdesc
f676886a
JB
227 || f->display.x->icon_desc == wdesc)
228 return f;
01f1ba30
JB
229 }
230 return 0;
231}
232
01f1ba30 233\f
f676886a 234/* Connect the frame-parameter names for X frames
01f1ba30
JB
235 to the ways of passing the parameter values to the window system.
236
237 The name of a parameter, as a Lisp symbol,
f676886a
JB
238 has an `x-frame-parameter' property which is an integer in Lisp
239 but can be interpreted as an `enum x_frame_parm' in C. */
01f1ba30 240
f676886a 241enum x_frame_parm
01f1ba30
JB
242{
243 X_PARM_FOREGROUND_COLOR,
244 X_PARM_BACKGROUND_COLOR,
245 X_PARM_MOUSE_COLOR,
246 X_PARM_CURSOR_COLOR,
247 X_PARM_BORDER_COLOR,
248 X_PARM_ICON_TYPE,
249 X_PARM_FONT,
250 X_PARM_BORDER_WIDTH,
251 X_PARM_INTERNAL_BORDER_WIDTH,
252 X_PARM_NAME,
253 X_PARM_AUTORAISE,
254 X_PARM_AUTOLOWER,
a3c87d4e 255 X_PARM_VERT_SCROLL_BAR,
d043f1a4
RS
256 X_PARM_VISIBILITY,
257 X_PARM_MENU_BAR_LINES
01f1ba30
JB
258};
259
260
f676886a 261struct x_frame_parm_table
01f1ba30
JB
262{
263 char *name;
f676886a 264 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
01f1ba30
JB
265};
266
267void x_set_foreground_color ();
268void x_set_background_color ();
269void x_set_mouse_color ();
270void x_set_cursor_color ();
271void x_set_border_color ();
dbc4e1c1 272void x_set_cursor_type ();
01f1ba30
JB
273void x_set_icon_type ();
274void x_set_font ();
275void x_set_border_width ();
276void x_set_internal_border_width ();
f945b920 277void x_explicitly_set_name ();
01f1ba30
JB
278void x_set_autoraise ();
279void x_set_autolower ();
a3c87d4e 280void x_set_vertical_scroll_bars ();
d043f1a4
RS
281void x_set_visibility ();
282void x_set_menu_bar_lines ();
01f1ba30 283
f676886a 284static struct x_frame_parm_table x_frame_parms[] =
01f1ba30
JB
285{
286 "foreground-color", x_set_foreground_color,
287 "background-color", x_set_background_color,
288 "mouse-color", x_set_mouse_color,
289 "cursor-color", x_set_cursor_color,
290 "border-color", x_set_border_color,
dbc4e1c1 291 "cursor-type", x_set_cursor_type,
01f1ba30
JB
292 "icon-type", x_set_icon_type,
293 "font", x_set_font,
294 "border-width", x_set_border_width,
295 "internal-border-width", x_set_internal_border_width,
f945b920 296 "name", x_explicitly_set_name,
baaed68e
JB
297 "auto-raise", x_set_autoraise,
298 "auto-lower", x_set_autolower,
a3c87d4e 299 "vertical-scroll-bars", x_set_vertical_scroll_bars,
d043f1a4
RS
300 "visibility", x_set_visibility,
301 "menu-bar-lines", x_set_menu_bar_lines,
01f1ba30
JB
302};
303
f676886a 304/* Attach the `x-frame-parameter' properties to
01f1ba30
JB
305 the Lisp symbol names of parameters relevant to X. */
306
307init_x_parm_symbols ()
308{
309 int i;
310
d043f1a4 311 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
f676886a 312 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
01f1ba30
JB
313 make_number (i));
314}
315\f
f9942c9e
JB
316/* Change the parameters of FRAME as specified by ALIST.
317 If a parameter is not specially recognized, do nothing;
318 otherwise call the `x_set_...' function for that parameter. */
d043f1a4 319
f9942c9e
JB
320void
321x_set_frame_parameters (f, alist)
322 FRAME_PTR f;
323 Lisp_Object alist;
324{
325 Lisp_Object tail;
326
327 /* If both of these parameters are present, it's more efficient to
328 set them both at once. So we wait until we've looked at the
329 entire list before we set them. */
330 Lisp_Object width, height;
331
332 /* Same here. */
333 Lisp_Object left, top;
f9942c9e 334
f5e70acd
RS
335 /* Record in these vectors all the parms specified. */
336 Lisp_Object *parms;
337 Lisp_Object *values;
338 int i;
339
340 i = 0;
341 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
342 i++;
343
344 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
345 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
f9942c9e 346
f5e70acd
RS
347 /* Extract parm names and values into those vectors. */
348
349 i = 0;
f9942c9e
JB
350 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
351 {
352 Lisp_Object elt, prop, val;
353
354 elt = Fcar (tail);
f5e70acd
RS
355 parms[i] = Fcar (elt);
356 values[i] = Fcdr (elt);
357 i++;
358 }
359
360 XSET (width, Lisp_Int, FRAME_WIDTH (f));
361 XSET (height, Lisp_Int, FRAME_HEIGHT (f));
362 XSET (top, Lisp_Int, f->display.x->top_pos);
363 XSET (left, Lisp_Int, f->display.x->left_pos);
f9942c9e 364
f5e70acd
RS
365 /* Now process them in reverse of specified order. */
366 for (i--; i >= 0; i--)
367 {
368 Lisp_Object prop, val;
369
370 prop = parms[i];
371 val = values[i];
372
373 if (EQ (prop, Qwidth))
f9942c9e 374 width = val;
f5e70acd 375 else if (EQ (prop, Qheight))
f9942c9e 376 height = val;
f5e70acd 377 else if (EQ (prop, Qtop))
f9942c9e 378 top = val;
f5e70acd 379 else if (EQ (prop, Qleft))
f9942c9e
JB
380 left = val;
381 else
382 {
ea96210c
JB
383 register Lisp_Object param_index = Fget (prop, Qx_frame_parameter);
384 register Lisp_Object old_value = get_frame_param (f, prop);
385
f9942c9e 386 store_frame_param (f, prop, val);
ea96210c
JB
387 if (XTYPE (param_index) == Lisp_Int
388 && XINT (param_index) >= 0
389 && (XINT (param_index)
390 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
391 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
f9942c9e
JB
392 }
393 }
394
395 /* Don't call these unless they've changed; the window may not actually
396 exist yet. */
397 {
398 Lisp_Object frame;
399
400 XSET (frame, Lisp_Frame, f);
401 if (XINT (width) != FRAME_WIDTH (f)
402 || XINT (height) != FRAME_HEIGHT (f))
403 Fset_frame_size (frame, width, height);
404 if (XINT (left) != f->display.x->left_pos
405 || XINT (top) != f->display.x->top_pos)
406 Fset_frame_position (frame, left, top);
407 }
408}
01f1ba30 409
f676886a 410/* Insert a description of internally-recorded parameters of frame X
01f1ba30
JB
411 into the parameter alist *ALISTPTR that is to be given to the user.
412 Only parameters that are specific to the X window system
f676886a 413 and whose values are not correctly recorded in the frame's
01f1ba30
JB
414 param_alist need to be considered here. */
415
f676886a
JB
416x_report_frame_params (f, alistptr)
417 struct frame *f;
01f1ba30
JB
418 Lisp_Object *alistptr;
419{
420 char buf[16];
421
f9942c9e
JB
422 store_in_alist (alistptr, Qleft, make_number (f->display.x->left_pos));
423 store_in_alist (alistptr, Qtop, make_number (f->display.x->top_pos));
424 store_in_alist (alistptr, Qborder_width,
f676886a 425 make_number (f->display.x->border_width));
f9942c9e 426 store_in_alist (alistptr, Qinternal_border_width,
f676886a 427 make_number (f->display.x->internal_border_width));
fe24a618 428 sprintf (buf, "%d", FRAME_X_WINDOW (f));
f9942c9e 429 store_in_alist (alistptr, Qwindow_id,
01f1ba30 430 build_string (buf));
d043f1a4
RS
431 store_in_alist (alistptr, Qvisibility,
432 (FRAME_VISIBLE_P (f) ? Qt
433 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
01f1ba30
JB
434}
435\f
436/* Decide if color named COLOR is valid for the display
f676886a 437 associated with the selected frame. */
01f1ba30
JB
438int
439defined_color (color, color_def)
440 char *color;
441 Color *color_def;
442{
443 register int foo;
444 Colormap screen_colormap;
445
446 BLOCK_INPUT;
447#ifdef HAVE_X11
448 screen_colormap
449 = DefaultColormap (x_current_display, XDefaultScreen (x_current_display));
450
451 foo = XParseColor (x_current_display, screen_colormap,
452 color, color_def)
453 && XAllocColor (x_current_display, screen_colormap, color_def);
454#else
455 foo = XParseColor (color, color_def) && XGetHardwareColor (color_def);
456#endif /* not HAVE_X11 */
457 UNBLOCK_INPUT;
458
459 if (foo)
460 return 1;
461 else
462 return 0;
463}
464
465/* Given a string ARG naming a color, compute a pixel value from it
f676886a
JB
466 suitable for screen F.
467 If F is not a color screen, return DEF (default) regardless of what
01f1ba30
JB
468 ARG says. */
469
470int
471x_decode_color (arg, def)
472 Lisp_Object arg;
473 int def;
474{
475 Color cdef;
476
477 CHECK_STRING (arg, 0);
478
479 if (strcmp (XSTRING (arg)->data, "black") == 0)
480 return BLACK_PIX_DEFAULT;
481 else if (strcmp (XSTRING (arg)->data, "white") == 0)
482 return WHITE_PIX_DEFAULT;
483
484#ifdef HAVE_X11
a6605e5c 485 if (x_screen_planes == 1)
01f1ba30
JB
486 return def;
487#else
265a9e55 488 if (DISPLAY_CELLS == 1)
01f1ba30
JB
489 return def;
490#endif
491
492 if (defined_color (XSTRING (arg)->data, &cdef))
493 return cdef.pixel;
494 else
495 Fsignal (Qundefined_color, Fcons (arg, Qnil));
496}
497\f
f676886a 498/* Functions called only from `x_set_frame_param'
01f1ba30
JB
499 to set individual parameters.
500
fe24a618 501 If FRAME_X_WINDOW (f) is 0,
f676886a 502 the frame is being created and its X-window does not exist yet.
01f1ba30
JB
503 In that case, just record the parameter's new value
504 in the standard place; do not attempt to change the window. */
505
506void
f676886a
JB
507x_set_foreground_color (f, arg, oldval)
508 struct frame *f;
01f1ba30
JB
509 Lisp_Object arg, oldval;
510{
f676886a 511 f->display.x->foreground_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
fe24a618 512 if (FRAME_X_WINDOW (f) != 0)
01f1ba30
JB
513 {
514#ifdef HAVE_X11
515 BLOCK_INPUT;
f676886a
JB
516 XSetForeground (x_current_display, f->display.x->normal_gc,
517 f->display.x->foreground_pixel);
518 XSetBackground (x_current_display, f->display.x->reverse_gc,
519 f->display.x->foreground_pixel);
01f1ba30
JB
520 UNBLOCK_INPUT;
521#endif /* HAVE_X11 */
ea96210c 522 recompute_basic_faces (f);
179956b9 523 if (FRAME_VISIBLE_P (f))
f676886a 524 redraw_frame (f);
01f1ba30
JB
525 }
526}
527
528void
f676886a
JB
529x_set_background_color (f, arg, oldval)
530 struct frame *f;
01f1ba30
JB
531 Lisp_Object arg, oldval;
532{
533 Pixmap temp;
534 int mask;
535
f676886a 536 f->display.x->background_pixel = x_decode_color (arg, WHITE_PIX_DEFAULT);
01f1ba30 537
fe24a618 538 if (FRAME_X_WINDOW (f) != 0)
01f1ba30
JB
539 {
540 BLOCK_INPUT;
541#ifdef HAVE_X11
f676886a
JB
542 /* The main frame area. */
543 XSetBackground (x_current_display, f->display.x->normal_gc,
544 f->display.x->background_pixel);
545 XSetForeground (x_current_display, f->display.x->reverse_gc,
546 f->display.x->background_pixel);
fe24a618 547 XSetWindowBackground (x_current_display, FRAME_X_WINDOW (f),
f676886a 548 f->display.x->background_pixel);
01f1ba30 549
01f1ba30 550#else
f676886a 551 temp = XMakeTile (f->display.x->background_pixel);
fe24a618 552 XChangeBackground (FRAME_X_WINDOW (f), temp);
01f1ba30
JB
553 XFreePixmap (temp);
554#endif /* not HAVE_X11 */
555 UNBLOCK_INPUT;
556
ea96210c
JB
557 recompute_basic_faces (f);
558
179956b9 559 if (FRAME_VISIBLE_P (f))
f676886a 560 redraw_frame (f);
01f1ba30
JB
561 }
562}
563
564void
f676886a
JB
565x_set_mouse_color (f, arg, oldval)
566 struct frame *f;
01f1ba30
JB
567 Lisp_Object arg, oldval;
568{
569 Cursor cursor, nontext_cursor, mode_cursor;
570 int mask_color;
571
572 if (!EQ (Qnil, arg))
f676886a
JB
573 f->display.x->mouse_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
574 mask_color = f->display.x->background_pixel;
01f1ba30 575 /* No invisible pointers. */
f676886a
JB
576 if (mask_color == f->display.x->mouse_pixel
577 && mask_color == f->display.x->background_pixel)
578 f->display.x->mouse_pixel = f->display.x->foreground_pixel;
01f1ba30
JB
579
580 BLOCK_INPUT;
581#ifdef HAVE_X11
fe24a618
JB
582
583 /* It's not okay to crash if the user selects a screwey cursor. */
584 x_catch_errors ();
585
01f1ba30
JB
586 if (!EQ (Qnil, Vx_pointer_shape))
587 {
588 CHECK_NUMBER (Vx_pointer_shape, 0);
589 cursor = XCreateFontCursor (x_current_display, XINT (Vx_pointer_shape));
590 }
591 else
592 cursor = XCreateFontCursor (x_current_display, XC_xterm);
a6605e5c 593 x_check_errors ("bad text pointer cursor: %s");
01f1ba30
JB
594
595 if (!EQ (Qnil, Vx_nontext_pointer_shape))
596 {
597 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
598 nontext_cursor = XCreateFontCursor (x_current_display,
599 XINT (Vx_nontext_pointer_shape));
600 }
601 else
602 nontext_cursor = XCreateFontCursor (x_current_display, XC_left_ptr);
a6605e5c 603 x_check_errors ("bad nontext pointer cursor: %s");
01f1ba30
JB
604
605 if (!EQ (Qnil, Vx_mode_pointer_shape))
606 {
607 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
608 mode_cursor = XCreateFontCursor (x_current_display,
609 XINT (Vx_mode_pointer_shape));
610 }
611 else
612 mode_cursor = XCreateFontCursor (x_current_display, XC_xterm);
613
fe24a618
JB
614 /* Check and report errors with the above calls. */
615 x_check_errors ("can't set cursor shape: %s");
616 x_uncatch_errors ();
617
01f1ba30
JB
618 {
619 XColor fore_color, back_color;
620
f676886a 621 fore_color.pixel = f->display.x->mouse_pixel;
01f1ba30
JB
622 back_color.pixel = mask_color;
623 XQueryColor (x_current_display,
624 DefaultColormap (x_current_display,
625 DefaultScreen (x_current_display)),
626 &fore_color);
627 XQueryColor (x_current_display,
628 DefaultColormap (x_current_display,
629 DefaultScreen (x_current_display)),
630 &back_color);
631 XRecolorCursor (x_current_display, cursor,
632 &fore_color, &back_color);
633 XRecolorCursor (x_current_display, nontext_cursor,
634 &fore_color, &back_color);
635 XRecolorCursor (x_current_display, mode_cursor,
636 &fore_color, &back_color);
637 }
638#else /* X10 */
639 cursor = XCreateCursor (16, 16, MouseCursor, MouseMask,
640 0, 0,
f676886a
JB
641 f->display.x->mouse_pixel,
642 f->display.x->background_pixel,
01f1ba30
JB
643 GXcopy);
644#endif /* X10 */
645
fe24a618 646 if (FRAME_X_WINDOW (f) != 0)
01f1ba30 647 {
fe24a618 648 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f), cursor);
01f1ba30
JB
649 }
650
f676886a
JB
651 if (cursor != f->display.x->text_cursor && f->display.x->text_cursor != 0)
652 XFreeCursor (XDISPLAY f->display.x->text_cursor);
653 f->display.x->text_cursor = cursor;
01f1ba30 654#ifdef HAVE_X11
f676886a
JB
655 if (nontext_cursor != f->display.x->nontext_cursor
656 && f->display.x->nontext_cursor != 0)
657 XFreeCursor (XDISPLAY f->display.x->nontext_cursor);
658 f->display.x->nontext_cursor = nontext_cursor;
659
660 if (mode_cursor != f->display.x->modeline_cursor
661 && f->display.x->modeline_cursor != 0)
662 XFreeCursor (XDISPLAY f->display.x->modeline_cursor);
663 f->display.x->modeline_cursor = mode_cursor;
01f1ba30
JB
664#endif /* HAVE_X11 */
665
666 XFlushQueue ();
667 UNBLOCK_INPUT;
668}
669
670void
f676886a
JB
671x_set_cursor_color (f, arg, oldval)
672 struct frame *f;
01f1ba30
JB
673 Lisp_Object arg, oldval;
674{
675 unsigned long fore_pixel;
676
677 if (!EQ (Vx_cursor_fore_pixel, Qnil))
678 fore_pixel = x_decode_color (Vx_cursor_fore_pixel, WHITE_PIX_DEFAULT);
679 else
f676886a
JB
680 fore_pixel = f->display.x->background_pixel;
681 f->display.x->cursor_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
f9942c9e
JB
682
683 /* Make sure that the cursor color differs from the background color. */
f676886a 684 if (f->display.x->cursor_pixel == f->display.x->background_pixel)
01f1ba30 685 {
f676886a
JB
686 f->display.x->cursor_pixel == f->display.x->mouse_pixel;
687 if (f->display.x->cursor_pixel == fore_pixel)
688 fore_pixel = f->display.x->background_pixel;
01f1ba30 689 }
c49cbce2 690 f->display.x->cursor_foreground_pixel = fore_pixel;
01f1ba30 691
fe24a618 692 if (FRAME_X_WINDOW (f) != 0)
01f1ba30
JB
693 {
694#ifdef HAVE_X11
695 BLOCK_INPUT;
f676886a
JB
696 XSetBackground (x_current_display, f->display.x->cursor_gc,
697 f->display.x->cursor_pixel);
698 XSetForeground (x_current_display, f->display.x->cursor_gc,
01f1ba30
JB
699 fore_pixel);
700 UNBLOCK_INPUT;
701#endif /* HAVE_X11 */
702
179956b9 703 if (FRAME_VISIBLE_P (f))
01f1ba30 704 {
f676886a
JB
705 x_display_cursor (f, 0);
706 x_display_cursor (f, 1);
01f1ba30
JB
707 }
708 }
709}
710
f676886a 711/* Set the border-color of frame F to value described by ARG.
01f1ba30
JB
712 ARG can be a string naming a color.
713 The border-color is used for the border that is drawn by the X server.
714 Note that this does not fully take effect if done before
f676886a 715 F has an x-window; it must be redone when the window is created.
01f1ba30
JB
716
717 Note: this is done in two routines because of the way X10 works.
718
719 Note: under X11, this is normally the province of the window manager,
720 and so emacs' border colors may be overridden. */
721
722void
f676886a
JB
723x_set_border_color (f, arg, oldval)
724 struct frame *f;
01f1ba30
JB
725 Lisp_Object arg, oldval;
726{
727 unsigned char *str;
728 int pix;
729
730 CHECK_STRING (arg, 0);
731 str = XSTRING (arg)->data;
732
733#ifndef HAVE_X11
734 if (!strcmp (str, "grey") || !strcmp (str, "Grey")
735 || !strcmp (str, "gray") || !strcmp (str, "Gray"))
736 pix = -1;
737 else
738#endif /* X10 */
739
740 pix = x_decode_color (arg, BLACK_PIX_DEFAULT);
741
f676886a 742 x_set_border_pixel (f, pix);
01f1ba30
JB
743}
744
f676886a 745/* Set the border-color of frame F to pixel value PIX.
01f1ba30 746 Note that this does not fully take effect if done before
f676886a 747 F has an x-window. */
01f1ba30 748
f676886a
JB
749x_set_border_pixel (f, pix)
750 struct frame *f;
01f1ba30
JB
751 int pix;
752{
f676886a 753 f->display.x->border_pixel = pix;
01f1ba30 754
fe24a618 755 if (FRAME_X_WINDOW (f) != 0 && f->display.x->border_width > 0)
01f1ba30
JB
756 {
757 Pixmap temp;
758 int mask;
759
760 BLOCK_INPUT;
761#ifdef HAVE_X11
fe24a618 762 XSetWindowBorder (x_current_display, FRAME_X_WINDOW (f),
01f1ba30 763 pix);
01f1ba30
JB
764#else
765 if (pix < 0)
dbc4e1c1
JB
766 temp = XMakePixmap ((Bitmap) XStoreBitmap (gray_width, gray_height,
767 gray_bits),
01f1ba30
JB
768 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
769 else
770 temp = XMakeTile (pix);
fe24a618 771 XChangeBorder (FRAME_X_WINDOW (f), temp);
01f1ba30
JB
772 XFreePixmap (XDISPLAY temp);
773#endif /* not HAVE_X11 */
774 UNBLOCK_INPUT;
775
179956b9 776 if (FRAME_VISIBLE_P (f))
f676886a 777 redraw_frame (f);
01f1ba30
JB
778 }
779}
780
dbc4e1c1
JB
781void
782x_set_cursor_type (f, arg, oldval)
783 FRAME_PTR f;
784 Lisp_Object arg, oldval;
785{
786 if (EQ (arg, Qbar))
787 FRAME_DESIRED_CURSOR (f) = bar_cursor;
15ab234b
RS
788 else
789#if 0
790 if (EQ (arg, Qbox))
791#endif
792 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
793 /* Error messages commented out because people have trouble fixing
794 .Xdefaults with Emacs, when it has something bad in it. */
795#if 0
dbc4e1c1
JB
796 else
797 error
798 ("the `cursor-type' frame parameter should be either `bar' or `box'");
15ab234b 799#endif
dbc4e1c1
JB
800
801 /* Make sure the cursor gets redrawn. This is overkill, but how
802 often do people change cursor types? */
803 update_mode_lines++;
804}
805
01f1ba30 806void
f676886a
JB
807x_set_icon_type (f, arg, oldval)
808 struct frame *f;
01f1ba30
JB
809 Lisp_Object arg, oldval;
810{
811 Lisp_Object tem;
812 int result;
813
814 if (EQ (oldval, Qnil) == EQ (arg, Qnil))
815 return;
816
817 BLOCK_INPUT;
265a9e55 818 if (NILP (arg))
f676886a 819 result = x_text_icon (f, 0);
01f1ba30 820 else
f111a131 821 result = x_bitmap_icon (f);
01f1ba30
JB
822
823 if (result)
824 {
01f1ba30 825 UNBLOCK_INPUT;
f9942c9e 826 error ("No icon window available.");
01f1ba30
JB
827 }
828
829 /* If the window was unmapped (and its icon was mapped),
830 the new icon is not mapped, so map the window in its stead. */
179956b9 831 if (FRAME_VISIBLE_P (f))
fe24a618 832 XMapWindow (XDISPLAY FRAME_X_WINDOW (f));
01f1ba30
JB
833
834 XFlushQueue ();
835 UNBLOCK_INPUT;
836}
837
ea96210c
JB
838extern Lisp_Object x_new_font ();
839
01f1ba30 840void
f676886a
JB
841x_set_font (f, arg, oldval)
842 struct frame *f;
01f1ba30
JB
843 Lisp_Object arg, oldval;
844{
ea96210c 845 Lisp_Object result;
01f1ba30
JB
846
847 CHECK_STRING (arg, 1);
01f1ba30
JB
848
849 BLOCK_INPUT;
ea96210c 850 result = x_new_font (f, XSTRING (arg)->data);
01f1ba30
JB
851 UNBLOCK_INPUT;
852
ea96210c
JB
853 if (EQ (result, Qnil))
854 error ("Font \"%s\" is not defined", XSTRING (arg)->data);
855 else if (EQ (result, Qt))
c7e1d890 856 error ("the characters of the given font have varying widths");
ea96210c
JB
857 else if (STRINGP (result))
858 {
859 recompute_basic_faces (f);
860 store_frame_param (f, Qfont, result);
861 }
862 else
863 abort ();
01f1ba30
JB
864}
865
866void
f676886a
JB
867x_set_border_width (f, arg, oldval)
868 struct frame *f;
01f1ba30
JB
869 Lisp_Object arg, oldval;
870{
871 CHECK_NUMBER (arg, 0);
872
f676886a 873 if (XINT (arg) == f->display.x->border_width)
01f1ba30
JB
874 return;
875
fe24a618 876 if (FRAME_X_WINDOW (f) != 0)
01f1ba30
JB
877 error ("Cannot change the border width of a window");
878
f676886a 879 f->display.x->border_width = XINT (arg);
01f1ba30
JB
880}
881
882void
f676886a
JB
883x_set_internal_border_width (f, arg, oldval)
884 struct frame *f;
01f1ba30
JB
885 Lisp_Object arg, oldval;
886{
887 int mask;
f676886a 888 int old = f->display.x->internal_border_width;
01f1ba30
JB
889
890 CHECK_NUMBER (arg, 0);
f676886a
JB
891 f->display.x->internal_border_width = XINT (arg);
892 if (f->display.x->internal_border_width < 0)
893 f->display.x->internal_border_width = 0;
01f1ba30 894
f676886a 895 if (f->display.x->internal_border_width == old)
01f1ba30
JB
896 return;
897
fe24a618 898 if (FRAME_X_WINDOW (f) != 0)
01f1ba30
JB
899 {
900 BLOCK_INPUT;
f676886a 901 x_set_window_size (f, f->width, f->height);
01f1ba30 902#if 0
f676886a 903 x_set_resize_hint (f);
01f1ba30
JB
904#endif
905 XFlushQueue ();
906 UNBLOCK_INPUT;
f676886a 907 SET_FRAME_GARBAGED (f);
01f1ba30
JB
908 }
909}
910
d043f1a4
RS
911void
912x_set_visibility (f, value, oldval)
913 struct frame *f;
914 Lisp_Object value, oldval;
915{
916 Lisp_Object frame;
917 XSET (frame, Lisp_Frame, f);
918
919 if (NILP (value))
920 Fmake_frame_invisible (frame);
49795535 921 else if (EQ (value, Qicon))
d043f1a4 922 Ficonify_frame (frame);
49795535
JB
923 else
924 Fmake_frame_visible (frame);
d043f1a4
RS
925}
926
927static void
928x_set_menu_bar_lines_1 (window, n)
929 Lisp_Object window;
930 int n;
931{
47c0f58b 932 struct window *w = XWINDOW (window);
d043f1a4 933
47c0f58b
RS
934 XFASTINT (w->top) += n;
935 XFASTINT (w->height) -= n;
d043f1a4 936
47c0f58b
RS
937 /* Handle just the top child in a vertical split. */
938 if (!NILP (w->vchild))
939 x_set_menu_bar_lines_1 (w->vchild, n);
d043f1a4 940
47c0f58b
RS
941 /* Adjust all children in a horizontal split. */
942 for (window = w->hchild; !NILP (window); window = w->next)
943 {
944 w = XWINDOW (window);
945 x_set_menu_bar_lines_1 (window, n);
d043f1a4
RS
946 }
947}
948
949void
950x_set_menu_bar_lines (f, value, oldval)
951 struct frame *f;
952 Lisp_Object value, oldval;
953{
954 int nlines;
955 int olines = FRAME_MENU_BAR_LINES (f);
956
f64ba6ea
JB
957 /* Right now, menu bars don't work properly in minibuf-only frames;
958 most of the commands try to apply themselves to the minibuffer
959 frame itslef, and get an error because you can't switch buffers
960 in or split the minibuffer window. */
519066d2 961 if (FRAME_MINIBUF_ONLY_P (f))
f64ba6ea
JB
962 return;
963
d043f1a4
RS
964 if (XTYPE (value) == Lisp_Int)
965 nlines = XINT (value);
966 else
967 nlines = 0;
968
969 FRAME_MENU_BAR_LINES (f) = nlines;
970 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
d043f1a4
RS
971}
972
f945b920
JB
973/* Change the name of frame F to ARG. If ARG is nil, set F's name to
974 x_id_name.
975
976 If EXPLICIT is non-zero, that indicates that lisp code is setting the
977 name; if ARG is a string, set F's name to ARG and set
978 F->explicit_name; if ARG is Qnil, then clear F->explicit_name.
979
980 If EXPLICIT is zero, that indicates that Emacs redisplay code is
981 suggesting a new name, which lisp code should override; if
982 F->explicit_name is set, ignore the new name; otherwise, set it. */
983
984void
985x_set_name (f, name, explicit)
986 struct frame *f;
987 Lisp_Object name;
988 int explicit;
989{
990 /* Make sure that requests from lisp code override requests from
991 Emacs redisplay code. */
992 if (explicit)
993 {
994 /* If we're switching from explicit to implicit, we had better
995 update the mode lines and thereby update the title. */
996 if (f->explicit_name && NILP (name))
cf177271 997 update_mode_lines = 1;
f945b920
JB
998
999 f->explicit_name = ! NILP (name);
1000 }
1001 else if (f->explicit_name)
1002 return;
1003
1004 /* If NAME is nil, set the name to the x_id_name. */
1005 if (NILP (name))
1006 name = build_string (x_id_name);
62265f1c 1007 else
f945b920 1008 CHECK_STRING (name, 0);
01f1ba30 1009
f945b920
JB
1010 /* Don't change the name if it's already NAME. */
1011 if (! NILP (Fstring_equal (name, f->name)))
daa37602
JB
1012 return;
1013
fe24a618 1014 if (FRAME_X_WINDOW (f))
01f1ba30 1015 {
01f1ba30 1016 BLOCK_INPUT;
fe24a618
JB
1017
1018#ifdef HAVE_X11R4
1019 {
1020 XTextProperty text;
1021 text.value = XSTRING (name)->data;
1022 text.encoding = XA_STRING;
1023 text.format = 8;
1024 text.nitems = XSTRING (name)->size;
1025 XSetWMName (x_current_display, FRAME_X_WINDOW (f), &text);
1026 XSetWMIconName (x_current_display, FRAME_X_WINDOW (f), &text);
1027 }
1028#else
1029 XSetIconName (XDISPLAY FRAME_X_WINDOW (f),
1030 XSTRING (name)->data);
1031 XStoreName (XDISPLAY FRAME_X_WINDOW (f),
1032 XSTRING (name)->data);
1033#endif
1034
01f1ba30
JB
1035 UNBLOCK_INPUT;
1036 }
daa37602 1037
f945b920
JB
1038 f->name = name;
1039}
1040
1041/* This function should be called when the user's lisp code has
1042 specified a name for the frame; the name will override any set by the
1043 redisplay code. */
1044void
1045x_explicitly_set_name (f, arg, oldval)
1046 FRAME_PTR f;
1047 Lisp_Object arg, oldval;
1048{
1049 x_set_name (f, arg, 1);
1050}
1051
1052/* This function should be called by Emacs redisplay code to set the
1053 name; names set this way will never override names set by the user's
1054 lisp code. */
25250031 1055void
f945b920
JB
1056x_implicitly_set_name (f, arg, oldval)
1057 FRAME_PTR f;
1058 Lisp_Object arg, oldval;
1059{
1060 x_set_name (f, arg, 0);
01f1ba30
JB
1061}
1062
1063void
f676886a
JB
1064x_set_autoraise (f, arg, oldval)
1065 struct frame *f;
01f1ba30
JB
1066 Lisp_Object arg, oldval;
1067{
f676886a 1068 f->auto_raise = !EQ (Qnil, arg);
01f1ba30
JB
1069}
1070
1071void
f676886a
JB
1072x_set_autolower (f, arg, oldval)
1073 struct frame *f;
01f1ba30
JB
1074 Lisp_Object arg, oldval;
1075{
f676886a 1076 f->auto_lower = !EQ (Qnil, arg);
01f1ba30 1077}
179956b9
JB
1078
1079void
a3c87d4e 1080x_set_vertical_scroll_bars (f, arg, oldval)
179956b9
JB
1081 struct frame *f;
1082 Lisp_Object arg, oldval;
1083{
a3c87d4e 1084 if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
179956b9 1085 {
a3c87d4e 1086 FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
179956b9 1087
cf177271
JB
1088 /* We set this parameter before creating the X window for the
1089 frame, so we can get the geometry right from the start.
1090 However, if the window hasn't been created yet, we shouldn't
1091 call x_set_window_size. */
1092 if (FRAME_X_WINDOW (f))
1093 x_set_window_size (f, FRAME_WIDTH (f), FRAME_HEIGHT (f));
179956b9
JB
1094 }
1095}
01f1ba30 1096\f
f676886a 1097/* Subroutines of creating an X frame. */
01f1ba30
JB
1098
1099#ifdef HAVE_X11
1100extern char *x_get_string_resource ();
1101extern XrmDatabase x_load_resources ();
1102
cf177271
JB
1103DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
1104 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1105This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1106class, where INSTANCE is the name under which Emacs was invoked.\n\
01f1ba30 1107\n\
8fabe6f4
RS
1108The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1109class, respectively. You must specify both of them or neither.\n\
1110If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
cf177271
JB
1111and the class is `Emacs.CLASS.SUBCLASS'.")
1112 (attribute, class, component, subclass)
1113 Lisp_Object attribute, class, component, subclass;
01f1ba30
JB
1114{
1115 register char *value;
1116 char *name_key;
1117 char *class_key;
1118
11ae94fe
RS
1119 check_x ();
1120
01f1ba30 1121 CHECK_STRING (attribute, 0);
cf177271
JB
1122 CHECK_STRING (class, 0);
1123
8fabe6f4
RS
1124 if (!NILP (component))
1125 CHECK_STRING (component, 1);
1126 if (!NILP (subclass))
1127 CHECK_STRING (subclass, 2);
1128 if (NILP (component) != NILP (subclass))
1129 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1130
1131 if (NILP (component))
01f1ba30 1132 {
cf177271
JB
1133 /* Allocate space for the components, the dots which separate them,
1134 and the final '\0'. */
ac63d3d6 1135 name_key = (char *) alloca (XSTRING (Vxrdb_name)->size
cf177271
JB
1136 + XSTRING (attribute)->size
1137 + 2);
1138 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1139 + XSTRING (class)->size
1140 + 2);
60fb3ee1 1141
01f1ba30 1142 sprintf (name_key, "%s.%s",
ac63d3d6 1143 XSTRING (Vxrdb_name)->data,
01f1ba30 1144 XSTRING (attribute)->data);
cf177271
JB
1145 sprintf (class_key, "%s.%s",
1146 EMACS_CLASS,
1147 XSTRING (class)->data);
01f1ba30
JB
1148 }
1149 else
1150 {
ac63d3d6 1151 name_key = (char *) alloca (XSTRING (Vxrdb_name)->size
cf177271
JB
1152 + XSTRING (component)->size
1153 + XSTRING (attribute)->size
1154 + 3);
60fb3ee1 1155
cf177271
JB
1156 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1157 + XSTRING (class)->size
1158 + XSTRING (subclass)->size
1159 + 3);
01f1ba30
JB
1160
1161 sprintf (name_key, "%s.%s.%s",
ac63d3d6 1162 XSTRING (Vxrdb_name)->data,
8fabe6f4 1163 XSTRING (component)->data,
01f1ba30 1164 XSTRING (attribute)->data);
ac63d3d6 1165 sprintf (class_key, "%s.%s.%s",
cf177271
JB
1166 EMACS_CLASS,
1167 XSTRING (class)->data,
1168 XSTRING (subclass)->data);
01f1ba30
JB
1169 }
1170
1171 value = x_get_string_resource (xrdb, name_key, class_key);
1172
1173 if (value != (char *) 0)
1174 return build_string (value);
1175 else
1176 return Qnil;
1177}
1178
3402e1a4
RS
1179/* Used when C code wants a resource value. */
1180
1181char *
1182x_get_resource_string (attribute, class)
1183 char *attribute, *class;
1184{
1185 register char *value;
1186 char *name_key;
1187 char *class_key;
1188
1189 /* Allocate space for the components, the dots which separate them,
1190 and the final '\0'. */
1191 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
1192 + strlen (attribute) + 2);
1193 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1194 + strlen (class) + 2);
1195
1196 sprintf (name_key, "%s.%s",
1197 XSTRING (Vinvocation_name)->data,
1198 attribute);
1199 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
1200
1201 return x_get_string_resource (xrdb, name_key, class_key);
1202}
1203
01f1ba30
JB
1204#else /* X10 */
1205
60fb3ee1 1206DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
f9942c9e 1207 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
01f1ba30
JB
1208Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1209The defaults are specified in the file `~/.Xdefaults'.")
60fb3ee1
JB
1210 (arg)
1211 Lisp_Object arg;
01f1ba30
JB
1212{
1213 register unsigned char *value;
1214
1215 CHECK_STRING (arg, 1);
1216
1217 value = (unsigned char *) XGetDefault (XDISPLAY
59653951 1218 XSTRING (Vinvocation_name)->data,
01f1ba30
JB
1219 XSTRING (arg)->data);
1220 if (value == 0)
1221 /* Try reversing last two args, in case this is the buggy version of X. */
1222 value = (unsigned char *) XGetDefault (XDISPLAY
1223 XSTRING (arg)->data,
59653951 1224 XSTRING (Vinvocation_name)->data);
01f1ba30
JB
1225 if (value != 0)
1226 return build_string (value);
1227 else
1228 return (Qnil);
1229}
1230
cf177271
JB
1231#define Fx_get_resource(attribute, class, component, subclass) \
1232 Fx_get_default(attribute)
01f1ba30
JB
1233
1234#endif /* X10 */
1235
60fb3ee1
JB
1236/* Types we might convert a resource string into. */
1237enum resource_types
1238 {
f945b920 1239 number, boolean, string, symbol,
60fb3ee1
JB
1240 };
1241
01f1ba30 1242/* Return the value of parameter PARAM.
60fb3ee1 1243
f676886a 1244 First search ALIST, then Vdefault_frame_alist, then the X defaults
cf177271 1245 database, using ATTRIBUTE as the attribute name and CLASS as its class.
60fb3ee1
JB
1246
1247 Convert the resource to the type specified by desired_type.
1248
f9942c9e
JB
1249 If no default is specified, return Qunbound. If you call
1250 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1251 and don't let it get stored in any lisp-visible variables! */
01f1ba30
JB
1252
1253static Lisp_Object
cf177271 1254x_get_arg (alist, param, attribute, class, type)
3c254570 1255 Lisp_Object alist, param;
60fb3ee1 1256 char *attribute;
cf177271 1257 char *class;
60fb3ee1 1258 enum resource_types type;
01f1ba30
JB
1259{
1260 register Lisp_Object tem;
1261
1262 tem = Fassq (param, alist);
1263 if (EQ (tem, Qnil))
f676886a 1264 tem = Fassq (param, Vdefault_frame_alist);
f9942c9e 1265 if (EQ (tem, Qnil))
01f1ba30 1266 {
60fb3ee1 1267
f9942c9e 1268 if (attribute)
60fb3ee1 1269 {
cf177271
JB
1270 tem = Fx_get_resource (build_string (attribute),
1271 build_string (class),
1272 Qnil, Qnil);
f9942c9e
JB
1273
1274 if (NILP (tem))
1275 return Qunbound;
1276
1277 switch (type)
1278 {
1279 case number:
1280 return make_number (atoi (XSTRING (tem)->data));
1281
1282 case boolean:
1283 tem = Fdowncase (tem);
1284 if (!strcmp (XSTRING (tem)->data, "on")
1285 || !strcmp (XSTRING (tem)->data, "true"))
1286 return Qt;
1287 else
1288 return Qnil;
1289
1290 case string:
1291 return tem;
1292
f945b920 1293 case symbol:
49795535
JB
1294 /* As a special case, we map the values `true' and `on'
1295 to Qt, and `false' and `off' to Qnil. */
1296 {
1297 Lisp_Object lower = Fdowncase (tem);
1298 if (!strcmp (XSTRING (tem)->data, "on")
1299 || !strcmp (XSTRING (tem)->data, "true"))
1300 return Qt;
8bc59570 1301 else if (!strcmp (XSTRING (tem)->data, "off")
49795535
JB
1302 || !strcmp (XSTRING (tem)->data, "false"))
1303 return Qnil;
1304 else
89032215 1305 return Fintern (tem, Qnil);
49795535 1306 }
f945b920 1307
f9942c9e
JB
1308 default:
1309 abort ();
1310 }
60fb3ee1 1311 }
f9942c9e
JB
1312 else
1313 return Qunbound;
01f1ba30
JB
1314 }
1315 return Fcdr (tem);
1316}
1317
f676886a 1318/* Record in frame F the specified or default value according to ALIST
01f1ba30
JB
1319 of the parameter named PARAM (a Lisp symbol).
1320 If no value is specified for PARAM, look for an X default for XPROP
f676886a 1321 on the frame named NAME.
01f1ba30
JB
1322 If that is not found either, use the value DEFLT. */
1323
1324static Lisp_Object
cf177271 1325x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
f676886a 1326 struct frame *f;
01f1ba30 1327 Lisp_Object alist;
f9942c9e 1328 Lisp_Object prop;
01f1ba30
JB
1329 Lisp_Object deflt;
1330 char *xprop;
cf177271 1331 char *xclass;
60fb3ee1 1332 enum resource_types type;
01f1ba30 1333{
01f1ba30
JB
1334 Lisp_Object tem;
1335
cf177271 1336 tem = x_get_arg (alist, prop, xprop, xclass, type);
f9942c9e 1337 if (EQ (tem, Qunbound))
01f1ba30 1338 tem = deflt;
f9942c9e 1339 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
01f1ba30
JB
1340 return tem;
1341}
1342\f
8af1d7ca 1343DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
01f1ba30
JB
1344 "Parse an X-style geometry string STRING.\n\
1345Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1346 (string)
a6605e5c 1347 Lisp_Object string;
01f1ba30
JB
1348{
1349 int geometry, x, y;
1350 unsigned int width, height;
1351 Lisp_Object values[4];
1352
1353 CHECK_STRING (string, 0);
1354
1355 geometry = XParseGeometry ((char *) XSTRING (string)->data,
1356 &x, &y, &width, &height);
1357
1358 switch (geometry & 0xf) /* Mask out {X,Y}Negative */
1359 {
1360 case (XValue | YValue):
1361 /* What's one pixel among friends?
1362 Perhaps fix this some day by returning symbol `extreme-top'... */
1363 if (x == 0 && (geometry & XNegative))
1364 x = -1;
1365 if (y == 0 && (geometry & YNegative))
1366 y = -1;
f9942c9e
JB
1367 values[0] = Fcons (Qleft, make_number (x));
1368 values[1] = Fcons (Qtop, make_number (y));
01f1ba30
JB
1369 return Flist (2, values);
1370 break;
1371
1372 case (WidthValue | HeightValue):
f9942c9e
JB
1373 values[0] = Fcons (Qwidth, make_number (width));
1374 values[1] = Fcons (Qheight, make_number (height));
01f1ba30
JB
1375 return Flist (2, values);
1376 break;
1377
1378 case (XValue | YValue | WidthValue | HeightValue):
1379 if (x == 0 && (geometry & XNegative))
1380 x = -1;
1381 if (y == 0 && (geometry & YNegative))
1382 y = -1;
f9942c9e
JB
1383 values[0] = Fcons (Qwidth, make_number (width));
1384 values[1] = Fcons (Qheight, make_number (height));
1385 values[2] = Fcons (Qleft, make_number (x));
1386 values[3] = Fcons (Qtop, make_number (y));
01f1ba30
JB
1387 return Flist (4, values);
1388 break;
1389
1390 case 0:
1391 return Qnil;
1392
1393 default:
1394 error ("Must specify x and y value, and/or width and height");
1395 }
1396}
1397
1398#ifdef HAVE_X11
1399/* Calculate the desired size and position of this window,
1400 or set rubber-band prompting if none. */
1401
1402#define DEFAULT_ROWS 40
1403#define DEFAULT_COLS 80
1404
f9942c9e 1405static int
f676886a
JB
1406x_figure_window_size (f, parms)
1407 struct frame *f;
01f1ba30
JB
1408 Lisp_Object parms;
1409{
1410 register Lisp_Object tem0, tem1;
1411 int height, width, left, top;
1412 register int geometry;
1413 long window_prompting = 0;
1414
1415 /* Default values if we fall through.
1416 Actually, if that happens we should get
1417 window manager prompting. */
f676886a
JB
1418 f->width = DEFAULT_COLS;
1419 f->height = DEFAULT_ROWS;
bd0b85c3
RS
1420 /* Window managers expect that if program-specified
1421 positions are not (0,0), they're intentional, not defaults. */
1422 f->display.x->top_pos = 0;
1423 f->display.x->left_pos = 0;
01f1ba30 1424
cf177271
JB
1425 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
1426 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
f9942c9e 1427 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
01f1ba30
JB
1428 {
1429 CHECK_NUMBER (tem0, 0);
1430 CHECK_NUMBER (tem1, 0);
f676886a
JB
1431 f->height = XINT (tem0);
1432 f->width = XINT (tem1);
01f1ba30
JB
1433 window_prompting |= USSize;
1434 }
f9942c9e 1435 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
01f1ba30
JB
1436 error ("Must specify *both* height and width");
1437
739f2f53
RS
1438 f->display.x->vertical_scroll_bar_extra
1439 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
1440 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f)
1441 : 0);
179956b9
JB
1442 f->display.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
1443 f->display.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
01f1ba30 1444
cf177271
JB
1445 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
1446 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
f9942c9e 1447 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
01f1ba30
JB
1448 {
1449 CHECK_NUMBER (tem0, 0);
1450 CHECK_NUMBER (tem1, 0);
f676886a
JB
1451 f->display.x->top_pos = XINT (tem0);
1452 f->display.x->left_pos = XINT (tem1);
1453 x_calc_absolute_position (f);
01f1ba30
JB
1454 window_prompting |= USPosition;
1455 }
f9942c9e 1456 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
01f1ba30
JB
1457 error ("Must specify *both* top and left corners");
1458
739f2f53
RS
1459#if 0 /* PPosition and PSize mean "specified explicitly,
1460 by the program rather than by the user". So it is wrong to
1461 set them if nothing was specified. */
01f1ba30
JB
1462 switch (window_prompting)
1463 {
1464 case USSize | USPosition:
1465 return window_prompting;
1466 break;
1467
1468 case USSize: /* Got the size, need the position. */
1469 window_prompting |= PPosition;
1470 return window_prompting;
1471 break;
1472
1473 case USPosition: /* Got the position, need the size. */
1474 window_prompting |= PSize;
1475 return window_prompting;
1476 break;
1477
1478 case 0: /* Got nothing, take both from geometry. */
1479 window_prompting |= PPosition | PSize;
1480 return window_prompting;
1481 break;
1482
1483 default:
1484 /* Somehow a bit got set in window_prompting that we didn't
1485 put there. */
1486 abort ();
1487 }
739f2f53
RS
1488#endif
1489 return window_prompting;
01f1ba30
JB
1490}
1491
1492static void
f676886a
JB
1493x_window (f)
1494 struct frame *f;
01f1ba30
JB
1495{
1496 XSetWindowAttributes attributes;
1497 unsigned long attribute_mask;
1498 XClassHint class_hints;
1499
f676886a
JB
1500 attributes.background_pixel = f->display.x->background_pixel;
1501 attributes.border_pixel = f->display.x->border_pixel;
01f1ba30
JB
1502 attributes.bit_gravity = StaticGravity;
1503 attributes.backing_store = NotUseful;
1504 attributes.save_under = True;
1505 attributes.event_mask = STANDARD_EVENT_SET;
1506 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
1507#if 0
1508 | CWBackingStore | CWSaveUnder
1509#endif
1510 | CWEventMask);
1511
1512 BLOCK_INPUT;
fe24a618 1513 FRAME_X_WINDOW (f)
01f1ba30 1514 = XCreateWindow (x_current_display, ROOT_WINDOW,
f676886a
JB
1515 f->display.x->left_pos,
1516 f->display.x->top_pos,
1517 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
1518 f->display.x->border_width,
01f1ba30
JB
1519 CopyFromParent, /* depth */
1520 InputOutput, /* class */
1521 screen_visual, /* set in Fx_open_connection */
1522 attribute_mask, &attributes);
1523
ebc9936d 1524 class_hints.res_name = (char *) XSTRING (Vxrdb_name)->data;
01f1ba30 1525 class_hints.res_class = EMACS_CLASS;
fe24a618 1526 XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints);
01f1ba30 1527
179956b9
JB
1528 /* This indicates that we use the "Passive Input" input model.
1529 Unless we do this, we don't get the Focus{In,Out} events that we
1530 need to draw the cursor correctly. Accursed bureaucrats.
1531 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1532
1533 f->display.x->wm_hints.input = True;
1534 f->display.x->wm_hints.flags |= InputHint;
1535 XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints);
1536
e373f201
JB
1537 /* x_set_name normally ignores requests to set the name if the
1538 requested name is the same as the current name. This is the one
1539 place where that assumption isn't correct; f->name is set, but
1540 the X server hasn't been told. */
1541 {
1542 Lisp_Object name = f->name;
cf177271 1543 int explicit = f->explicit_name;
e373f201
JB
1544
1545 f->name = Qnil;
cf177271
JB
1546 f->explicit_name = 0;
1547 x_set_name (f, name, explicit);
e373f201
JB
1548 }
1549
fe24a618 1550 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
f676886a 1551 f->display.x->text_cursor);
01f1ba30
JB
1552 UNBLOCK_INPUT;
1553
fe24a618 1554 if (FRAME_X_WINDOW (f) == 0)
01f1ba30
JB
1555 error ("Unable to create window.");
1556}
1557
1558/* Handle the icon stuff for this window. Perhaps later we might
1559 want an x_set_icon_position which can be called interactively as
1560 well. */
1561
1562static void
f676886a
JB
1563x_icon (f, parms)
1564 struct frame *f;
01f1ba30
JB
1565 Lisp_Object parms;
1566{
f9942c9e 1567 Lisp_Object icon_x, icon_y;
01f1ba30
JB
1568
1569 /* Set the position of the icon. Note that twm groups all
1570 icons in an icon window. */
cf177271
JB
1571 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
1572 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
f9942c9e 1573 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
01f1ba30 1574 {
f9942c9e
JB
1575 CHECK_NUMBER (icon_x, 0);
1576 CHECK_NUMBER (icon_y, 0);
01f1ba30 1577 }
f9942c9e 1578 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
01f1ba30 1579 error ("Both left and top icon corners of icon must be specified");
01f1ba30 1580
f9942c9e
JB
1581 BLOCK_INPUT;
1582
fe24a618
JB
1583 if (! EQ (icon_x, Qunbound))
1584 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
f9942c9e 1585
01f1ba30 1586 /* Start up iconic or window? */
49795535
JB
1587 x_wm_set_window_state
1588 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
1589 ? IconicState
1590 : NormalState));
01f1ba30 1591
01f1ba30
JB
1592 UNBLOCK_INPUT;
1593}
1594
1595/* Make the GC's needed for this window, setting the
1596 background, border and mouse colors; also create the
1597 mouse cursor and the gray border tile. */
1598
f945b920
JB
1599static char cursor_bits[] =
1600 {
1601 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1602 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1603 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1604 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1605 };
1606
01f1ba30 1607static void
f676886a
JB
1608x_make_gc (f)
1609 struct frame *f;
01f1ba30
JB
1610{
1611 XGCValues gc_values;
1612 GC temp_gc;
1613 XImage tileimage;
01f1ba30 1614
6afb1d07
JB
1615 BLOCK_INPUT;
1616
f676886a 1617 /* Create the GC's of this frame.
01f1ba30
JB
1618 Note that many default values are used. */
1619
1620 /* Normal video */
f676886a
JB
1621 gc_values.font = f->display.x->font->fid;
1622 gc_values.foreground = f->display.x->foreground_pixel;
1623 gc_values.background = f->display.x->background_pixel;
01f1ba30 1624 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
f676886a 1625 f->display.x->normal_gc = XCreateGC (x_current_display,
fe24a618 1626 FRAME_X_WINDOW (f),
01f1ba30
JB
1627 GCLineWidth | GCFont
1628 | GCForeground | GCBackground,
1629 &gc_values);
1630
1631 /* Reverse video style. */
f676886a
JB
1632 gc_values.foreground = f->display.x->background_pixel;
1633 gc_values.background = f->display.x->foreground_pixel;
1634 f->display.x->reverse_gc = XCreateGC (x_current_display,
fe24a618 1635 FRAME_X_WINDOW (f),
01f1ba30
JB
1636 GCFont | GCForeground | GCBackground
1637 | GCLineWidth,
1638 &gc_values);
1639
1640 /* Cursor has cursor-color background, background-color foreground. */
f676886a
JB
1641 gc_values.foreground = f->display.x->background_pixel;
1642 gc_values.background = f->display.x->cursor_pixel;
01f1ba30
JB
1643 gc_values.fill_style = FillOpaqueStippled;
1644 gc_values.stipple
1645 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1646 cursor_bits, 16, 16);
f676886a 1647 f->display.x->cursor_gc
fe24a618 1648 = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
1649 (GCFont | GCForeground | GCBackground
1650 | GCFillStyle | GCStipple | GCLineWidth),
1651 &gc_values);
1652
1653 /* Create the gray border tile used when the pointer is not in
f676886a
JB
1654 the frame. Since this depends on the frame's pixel values,
1655 this must be done on a per-frame basis. */
d043f1a4
RS
1656 f->display.x->border_tile
1657 = (XCreatePixmapFromBitmapData
1658 (x_current_display, ROOT_WINDOW,
1659 gray_bits, gray_width, gray_height,
1660 f->display.x->foreground_pixel,
1661 f->display.x->background_pixel,
1662 DefaultDepth (x_current_display, XDefaultScreen (x_current_display))));
6afb1d07
JB
1663
1664 UNBLOCK_INPUT;
01f1ba30
JB
1665}
1666#endif /* HAVE_X11 */
1667
f676886a 1668DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
01f1ba30 1669 1, 1, 0,
f676886a
JB
1670 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
1671Return an Emacs frame object representing the X window.\n\
1672ALIST is an alist of frame parameters.\n\
1673If the parameters specify that the frame should not have a minibuffer,\n\
e22d6b02 1674and do not specify a specific minibuffer window to use,\n\
f676886a
JB
1675then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1676be shared by the new frame.")
01f1ba30
JB
1677 (parms)
1678 Lisp_Object parms;
1679{
1680#ifdef HAVE_X11
f676886a
JB
1681 struct frame *f;
1682 Lisp_Object frame, tem;
01f1ba30
JB
1683 Lisp_Object name;
1684 int minibuffer_only = 0;
1685 long window_prompting = 0;
1686 int width, height;
1687
11ae94fe 1688 check_x ();
01f1ba30 1689
cf177271
JB
1690 name = x_get_arg (parms, Qname, "title", "Title", string);
1691 if (XTYPE (name) != Lisp_String
1692 && ! EQ (name, Qunbound)
1693 && ! NILP (name))
f676886a 1694 error ("x-create-frame: name parameter must be a string");
01f1ba30 1695
cf177271 1696 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
f9942c9e 1697 if (EQ (tem, Qnone) || NILP (tem))
f676886a 1698 f = make_frame_without_minibuffer (Qnil);
f9942c9e 1699 else if (EQ (tem, Qonly))
01f1ba30 1700 {
f676886a 1701 f = make_minibuffer_frame ();
01f1ba30
JB
1702 minibuffer_only = 1;
1703 }
f9942c9e 1704 else if (XTYPE (tem) == Lisp_Window)
f676886a 1705 f = make_frame_without_minibuffer (tem);
f9942c9e
JB
1706 else
1707 f = make_frame (1);
01f1ba30 1708
a3c87d4e
JB
1709 /* Note that X Windows does support scroll bars. */
1710 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
179956b9 1711
cf177271
JB
1712 /* Set the name; the functions to which we pass f expect the name to
1713 be set. */
1714 if (EQ (name, Qunbound) || NILP (name))
1715 {
1716 f->name = build_string (x_id_name);
1717 f->explicit_name = 0;
1718 }
1719 else
1720 {
1721 f->name = name;
1722 f->explicit_name = 1;
1723 }
01f1ba30 1724
f676886a
JB
1725 XSET (frame, Lisp_Frame, f);
1726 f->output_method = output_x_window;
1727 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1728 bzero (f->display.x, sizeof (struct x_display));
01f1ba30 1729
f676886a
JB
1730 /* Note that the frame has no physical cursor right now. */
1731 f->phys_cursor_x = -1;
265a9e55 1732
01f1ba30
JB
1733 /* Extract the window parameters from the supplied values
1734 that are needed to determine window geometry. */
ee8f40cc
JB
1735 x_default_parameter (f, parms, Qfont,
1736 build_string
1737 /* If we use an XLFD name for this font, the lisp code
1738 knows how to find variants which are bold, italic,
1739 etcetera. */
1740 ("-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1"),
cf177271
JB
1741 "font", "Font", string);
1742 x_default_parameter (f, parms, Qborder_width, make_number (2),
1743 "borderwidth", "BorderWidth", number);
1744 /* This defaults to 2 in order to match xterm. */
1745 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1746 "internalBorderWidth", "BorderWidth", number);
a3c87d4e
JB
1747 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
1748 "verticalScrollBars", "ScrollBars", boolean);
01f1ba30
JB
1749
1750 /* Also do the stuff which must be set before the window exists. */
cf177271
JB
1751 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
1752 "foreground", "Foreground", string);
1753 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
1754 "background", "Background", string);
1755 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
1756 "pointerColor", "Foreground", string);
1757 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
1758 "cursorColor", "Foreground", string);
1759 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
1760 "borderColor", "BorderColor", string);
01f1ba30 1761
f676886a
JB
1762 f->display.x->parent_desc = ROOT_WINDOW;
1763 window_prompting = x_figure_window_size (f, parms);
01f1ba30 1764
f676886a
JB
1765 x_window (f);
1766 x_icon (f, parms);
1767 x_make_gc (f);
ea96210c 1768 init_frame_faces (f);
01f1ba30 1769
f9942c9e
JB
1770 /* We need to do this after creating the X window, so that the
1771 icon-creation functions can say whose icon they're describing. */
cf177271 1772 x_default_parameter (f, parms, Qicon_type, Qnil,
6998a3b4 1773 "bitmapIcon", "BitmapIcon", symbol);
f9942c9e 1774
cf177271
JB
1775 x_default_parameter (f, parms, Qauto_raise, Qnil,
1776 "autoRaise", "AutoRaiseLower", boolean);
1777 x_default_parameter (f, parms, Qauto_lower, Qnil,
1778 "autoLower", "AutoRaiseLower", boolean);
dbc4e1c1
JB
1779 x_default_parameter (f, parms, Qcursor_type, Qbox,
1780 "cursorType", "CursorType", symbol);
f9942c9e 1781
f676886a 1782 /* Dimensions, especially f->height, must be done via change_frame_size.
01f1ba30 1783 Change will not be effected unless different from the current
f676886a
JB
1784 f->height. */
1785 width = f->width;
1786 height = f->height;
1787 f->height = f->width = 0;
f9942c9e 1788 change_frame_size (f, height, width, 1, 0);
d043f1a4
RS
1789
1790 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0),
1791 "menuBarLines", "MenuBarLines", number);
1792
01f1ba30 1793 BLOCK_INPUT;
f676886a 1794 x_wm_set_size_hint (f, window_prompting);
01f1ba30
JB
1795 UNBLOCK_INPUT;
1796
cf177271 1797 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
f676886a 1798 f->no_split = minibuffer_only || EQ (tem, Qt);
01f1ba30 1799
d043f1a4
RS
1800 /* Make the window appear on the frame and enable display,
1801 unless the caller says not to. */
49795535
JB
1802 {
1803 Lisp_Object visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
1804
1805 if (EQ (visibility, Qunbound))
1806 visibility = Qt;
1807
1808 if (EQ (visibility, Qicon))
1809 x_iconify_frame (f);
1810 else if (! NILP (visibility))
1811 x_make_frame_visible (f);
1812 else
1813 /* Must have been Qnil. */
1814 ;
1815 }
01f1ba30 1816
f676886a 1817 return frame;
01f1ba30 1818#else /* X10 */
f676886a
JB
1819 struct frame *f;
1820 Lisp_Object frame, tem;
01f1ba30
JB
1821 Lisp_Object name;
1822 int pixelwidth, pixelheight;
1823 Cursor cursor;
1824 int height, width;
1825 Window parent;
1826 Pixmap temp;
1827 int minibuffer_only = 0;
1828 Lisp_Object vscroll, hscroll;
1829
1830 if (x_current_display == 0)
1831 error ("X windows are not in use or not initialized");
1832
f9942c9e 1833 name = Fassq (Qname, parms);
01f1ba30 1834
cf177271 1835 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
f9942c9e 1836 if (EQ (tem, Qnone))
f676886a 1837 f = make_frame_without_minibuffer (Qnil);
f9942c9e 1838 else if (EQ (tem, Qonly))
01f1ba30 1839 {
f676886a 1840 f = make_minibuffer_frame ();
01f1ba30
JB
1841 minibuffer_only = 1;
1842 }
f9942c9e 1843 else if (EQ (tem, Qnil) || EQ (tem, Qunbound))
f676886a 1844 f = make_frame (1);
f9942c9e
JB
1845 else
1846 f = make_frame_without_minibuffer (tem);
01f1ba30
JB
1847
1848 parent = ROOT_WINDOW;
1849
f676886a
JB
1850 XSET (frame, Lisp_Frame, f);
1851 f->output_method = output_x_window;
1852 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1853 bzero (f->display.x, sizeof (struct x_display));
01f1ba30
JB
1854
1855 /* Some temprorary default values for height and width. */
1856 width = 80;
1857 height = 40;
f676886a
JB
1858 f->display.x->left_pos = -1;
1859 f->display.x->top_pos = -1;
01f1ba30 1860
f676886a 1861 /* Give the frame a default name (which may be overridden with PARMS). */
01f1ba30
JB
1862
1863 strncpy (iconidentity, ICONTAG, MAXICID);
1864 if (gethostname (&iconidentity[sizeof (ICONTAG) - 1],
1865 (MAXICID - 1) - sizeof (ICONTAG)))
1866 iconidentity[sizeof (ICONTAG) - 2] = '\0';
f676886a 1867 f->name = build_string (iconidentity);
01f1ba30
JB
1868
1869 /* Extract some window parameters from the supplied values.
1870 These are the parameters that affect window geometry. */
1871
cf177271 1872 tem = x_get_arg (parms, Qfont, "BodyFont", 0, string);
f9942c9e 1873 if (EQ (tem, Qunbound))
01f1ba30 1874 tem = build_string ("9x15");
f9942c9e
JB
1875 x_set_font (f, tem, Qnil);
1876 x_default_parameter (f, parms, Qborder_color,
cf177271 1877 build_string ("black"), "Border", 0, string);
f9942c9e 1878 x_default_parameter (f, parms, Qbackground_color,
cf177271 1879 build_string ("white"), "Background", 0, string);
f9942c9e 1880 x_default_parameter (f, parms, Qforeground_color,
cf177271 1881 build_string ("black"), "Foreground", 0, string);
f9942c9e 1882 x_default_parameter (f, parms, Qmouse_color,
cf177271 1883 build_string ("black"), "Mouse", 0, string);
f9942c9e 1884 x_default_parameter (f, parms, Qcursor_color,
cf177271 1885 build_string ("black"), "Cursor", 0, string);
f9942c9e 1886 x_default_parameter (f, parms, Qborder_width,
cf177271 1887 make_number (2), "BorderWidth", 0, number);
f9942c9e 1888 x_default_parameter (f, parms, Qinternal_border_width,
cf177271 1889 make_number (4), "InternalBorderWidth", 0, number);
f9942c9e 1890 x_default_parameter (f, parms, Qauto_raise,
cf177271 1891 Qnil, "AutoRaise", 0, boolean);
01f1ba30 1892
cf177271
JB
1893 hscroll = EQ (x_get_arg (parms, Qhorizontal_scroll_bar, 0, 0, boolean), Qt);
1894 vscroll = EQ (x_get_arg (parms, Qvertical_scroll_bar, 0, 0, boolean), Qt);
01f1ba30 1895
f676886a
JB
1896 if (f->display.x->internal_border_width < 0)
1897 f->display.x->internal_border_width = 0;
01f1ba30 1898
cf177271 1899 tem = x_get_arg (parms, Qwindow_id, 0, 0, number);
f9942c9e 1900 if (!EQ (tem, Qunbound))
01f1ba30
JB
1901 {
1902 WINDOWINFO_TYPE wininfo;
1903 int nchildren;
1904 Window *children, root;
1905
f9942c9e 1906 CHECK_NUMBER (tem, 0);
fe24a618 1907 FRAME_X_WINDOW (f) = (Window) XINT (tem);
01f1ba30
JB
1908
1909 BLOCK_INPUT;
fe24a618
JB
1910 XGetWindowInfo (FRAME_X_WINDOW (f), &wininfo);
1911 XQueryTree (FRAME_X_WINDOW (f), &parent, &nchildren, &children);
9ac0d9e0 1912 xfree (children);
01f1ba30
JB
1913 UNBLOCK_INPUT;
1914
cf177271
JB
1915 height = PIXEL_TO_CHAR_HEIGHT (f, wininfo.height);
1916 width = PIXEL_TO_CHAR_WIDTH (f, wininfo.width);
f676886a
JB
1917 f->display.x->left_pos = wininfo.x;
1918 f->display.x->top_pos = wininfo.y;
179956b9 1919 FRAME_SET_VISIBILITY (f, wininfo.mapped != 0);
f676886a
JB
1920 f->display.x->border_width = wininfo.bdrwidth;
1921 f->display.x->parent_desc = parent;
01f1ba30
JB
1922 }
1923 else
1924 {
cf177271 1925 tem = x_get_arg (parms, Qparent_id, 0, 0, number);
f9942c9e 1926 if (!EQ (tem, Qunbound))
01f1ba30 1927 {
f9942c9e
JB
1928 CHECK_NUMBER (tem, 0);
1929 parent = (Window) XINT (tem);
01f1ba30 1930 }
f676886a 1931 f->display.x->parent_desc = parent;
cf177271 1932 tem = x_get_arg (parms, Qheight, 0, 0, number);
f9942c9e 1933 if (EQ (tem, Qunbound))
01f1ba30 1934 {
cf177271 1935 tem = x_get_arg (parms, Qwidth, 0, 0, number);
f9942c9e 1936 if (EQ (tem, Qunbound))
01f1ba30 1937 {
cf177271 1938 tem = x_get_arg (parms, Qtop, 0, 0, number);
f9942c9e 1939 if (EQ (tem, Qunbound))
cf177271 1940 tem = x_get_arg (parms, Qleft, 0, 0, number);
01f1ba30
JB
1941 }
1942 }
f9942c9e 1943 /* Now TEM is Qunbound if no edge or size was specified.
01f1ba30 1944 In that case, we must do rubber-banding. */
f9942c9e 1945 if (EQ (tem, Qunbound))
01f1ba30 1946 {
cf177271 1947 tem = x_get_arg (parms, Qgeometry, 0, 0, number);
f676886a
JB
1948 x_rubber_band (f,
1949 &f->display.x->left_pos, &f->display.x->top_pos,
01f1ba30
JB
1950 &width, &height,
1951 (XTYPE (tem) == Lisp_String
1952 ? (char *) XSTRING (tem)->data : ""),
f676886a 1953 XSTRING (f->name)->data,
265a9e55 1954 !NILP (hscroll), !NILP (vscroll));
01f1ba30
JB
1955 }
1956 else
1957 {
1958 /* Here if at least one edge or size was specified.
1959 Demand that they all were specified, and use them. */
cf177271 1960 tem = x_get_arg (parms, Qheight, 0, 0, number);
f9942c9e 1961 if (EQ (tem, Qunbound))
01f1ba30
JB
1962 error ("Height not specified");
1963 CHECK_NUMBER (tem, 0);
1964 height = XINT (tem);
1965
cf177271 1966 tem = x_get_arg (parms, Qwidth, 0, 0, number);
f9942c9e 1967 if (EQ (tem, Qunbound))
01f1ba30
JB
1968 error ("Width not specified");
1969 CHECK_NUMBER (tem, 0);
1970 width = XINT (tem);
1971
cf177271 1972 tem = x_get_arg (parms, Qtop, 0, 0, number);
f9942c9e 1973 if (EQ (tem, Qunbound))
01f1ba30
JB
1974 error ("Top position not specified");
1975 CHECK_NUMBER (tem, 0);
f676886a 1976 f->display.x->left_pos = XINT (tem);
01f1ba30 1977
cf177271 1978 tem = x_get_arg (parms, Qleft, 0, 0, number);
f9942c9e 1979 if (EQ (tem, Qunbound))
01f1ba30
JB
1980 error ("Left position not specified");
1981 CHECK_NUMBER (tem, 0);
f676886a 1982 f->display.x->top_pos = XINT (tem);
01f1ba30
JB
1983 }
1984
cf177271
JB
1985 pixelwidth = CHAR_TO_PIXEL_WIDTH (f, width);
1986 pixelheight = CHAR_TO_PIXEL_HEIGHT (f, height);
01f1ba30
JB
1987
1988 BLOCK_INPUT;
fe24a618 1989 FRAME_X_WINDOW (f)
01f1ba30 1990 = XCreateWindow (parent,
f676886a
JB
1991 f->display.x->left_pos, /* Absolute horizontal offset */
1992 f->display.x->top_pos, /* Absolute Vertical offset */
01f1ba30 1993 pixelwidth, pixelheight,
f676886a 1994 f->display.x->border_width,
01f1ba30
JB
1995 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
1996 UNBLOCK_INPUT;
fe24a618 1997 if (FRAME_X_WINDOW (f) == 0)
01f1ba30
JB
1998 error ("Unable to create window.");
1999 }
2000
2001 /* Install the now determined height and width
2002 in the windows and in phys_lines and desired_lines. */
f9942c9e 2003 change_frame_size (f, height, width, 1, 0);
fe24a618 2004 XSelectInput (FRAME_X_WINDOW (f), KeyPressed | ExposeWindow
01f1ba30
JB
2005 | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy
2006 | EnterWindow | LeaveWindow | UnmapWindow );
f676886a 2007 x_set_resize_hint (f);
01f1ba30
JB
2008
2009 /* Tell the server the window's default name. */
fe24a618 2010 XStoreName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (f->name)->data);
1113d9db 2011
01f1ba30
JB
2012 /* Now override the defaults with all the rest of the specified
2013 parms. */
cf177271 2014 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
f676886a 2015 f->no_split = minibuffer_only || EQ (tem, Qt);
01f1ba30 2016
8af1d7ca
JB
2017 /* Do not create an icon window if the caller says not to */
2018 if (!EQ (x_get_arg (parms, Qsuppress_icon, 0, 0, boolean), Qt)
2019 || f->display.x->parent_desc != ROOT_WINDOW)
2020 {
2021 x_text_icon (f, iconidentity);
2022 x_default_parameter (f, parms, Qicon_type, Qnil,
2023 "BitmapIcon", 0, symbol);
2024 }
01f1ba30
JB
2025
2026 /* Tell the X server the previously set values of the
2027 background, border and mouse colors; also create the mouse cursor. */
2028 BLOCK_INPUT;
f676886a 2029 temp = XMakeTile (f->display.x->background_pixel);
fe24a618 2030 XChangeBackground (FRAME_X_WINDOW (f), temp);
01f1ba30
JB
2031 XFreePixmap (temp);
2032 UNBLOCK_INPUT;
f676886a 2033 x_set_border_pixel (f, f->display.x->border_pixel);
01f1ba30 2034
f676886a 2035 x_set_mouse_color (f, Qnil, Qnil);
01f1ba30
JB
2036
2037 /* Now override the defaults with all the rest of the specified parms. */
2038
f676886a 2039 Fmodify_frame_parameters (frame, parms);
01f1ba30 2040
f676886a 2041 /* Make the window appear on the frame and enable display. */
49795535
JB
2042 {
2043 Lisp_Object visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
2044
2045 if (EQ (visibility, Qunbound))
2046 visibility = Qt;
2047
2048 if (! EQ (visibility, Qicon)
2049 && ! NILP (visibility))
2050 x_make_window_visible (f);
2051 }
01f1ba30 2052
cf177271 2053 SET_FRAME_GARBAGED (f);
01f1ba30 2054
f676886a 2055 return frame;
01f1ba30
JB
2056#endif /* X10 */
2057}
2058
f676886a
JB
2059DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
2060 "Set the focus on FRAME.")
2061 (frame)
2062 Lisp_Object frame;
01f1ba30 2063{
f676886a 2064 CHECK_LIVE_FRAME (frame, 0);
01f1ba30 2065
f9942c9e 2066 if (FRAME_X_P (XFRAME (frame)))
01f1ba30
JB
2067 {
2068 BLOCK_INPUT;
f676886a 2069 x_focus_on_frame (XFRAME (frame));
01f1ba30 2070 UNBLOCK_INPUT;
f676886a 2071 return frame;
01f1ba30
JB
2072 }
2073
2074 return Qnil;
2075}
2076
f676886a
JB
2077DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
2078 "If a frame has been focused, release it.")
01f1ba30
JB
2079 ()
2080{
f676886a 2081 if (x_focus_frame)
01f1ba30
JB
2082 {
2083 BLOCK_INPUT;
f676886a 2084 x_unfocus_frame (x_focus_frame);
01f1ba30
JB
2085 UNBLOCK_INPUT;
2086 }
2087
2088 return Qnil;
2089}
2090\f
2091#ifndef HAVE_X11
2092/* Computes an X-window size and position either from geometry GEO
2093 or with the mouse.
2094
f676886a 2095 F is a frame. It specifies an X window which is used to
01f1ba30
JB
2096 determine which display to compute for. Its font, borders
2097 and colors control how the rectangle will be displayed.
2098
2099 X and Y are where to store the positions chosen.
2100 WIDTH and HEIGHT are where to store the sizes chosen.
2101
2102 GEO is the geometry that may specify some of the info.
2103 STR is a prompt to display.
2104 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2105
2106int
f676886a
JB
2107x_rubber_band (f, x, y, width, height, geo, str, hscroll, vscroll)
2108 struct frame *f;
01f1ba30
JB
2109 int *x, *y, *width, *height;
2110 char *geo;
2111 char *str;
2112 int hscroll, vscroll;
2113{
2114 OpaqueFrame frame;
2115 Window tempwindow;
2116 WindowInfo wininfo;
2117 int border_color;
2118 int background_color;
2119 Lisp_Object tem;
2120 int mask;
2121
2122 BLOCK_INPUT;
2123
f676886a
JB
2124 background_color = f->display.x->background_pixel;
2125 border_color = f->display.x->border_pixel;
01f1ba30 2126
f676886a 2127 frame.bdrwidth = f->display.x->border_width;
01f1ba30
JB
2128 frame.border = XMakeTile (border_color);
2129 frame.background = XMakeTile (background_color);
2130 tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5,
f676886a 2131 (2 * f->display.x->internal_border_width
01f1ba30 2132 + (vscroll ? VSCROLL_WIDTH : 0)),
f676886a 2133 (2 * f->display.x->internal_border_width
01f1ba30 2134 + (hscroll ? HSCROLL_HEIGHT : 0)),
f676886a
JB
2135 width, height, f->display.x->font,
2136 FONT_WIDTH (f->display.x->font),
2137 FONT_HEIGHT (f->display.x->font));
01f1ba30
JB
2138 XFreePixmap (frame.border);
2139 XFreePixmap (frame.background);
2140
2141 if (tempwindow != 0)
2142 {
2143 XQueryWindow (tempwindow, &wininfo);
2144 XDestroyWindow (tempwindow);
2145 *x = wininfo.x;
2146 *y = wininfo.y;
2147 }
2148
2149 /* Coordinates we got are relative to the root window.
2150 Convert them to coordinates relative to desired parent window
2151 by scanning from there up to the root. */
f676886a 2152 tempwindow = f->display.x->parent_desc;
01f1ba30
JB
2153 while (tempwindow != ROOT_WINDOW)
2154 {
2155 int nchildren;
2156 Window *children;
2157 XQueryWindow (tempwindow, &wininfo);
2158 *x -= wininfo.x;
2159 *y -= wininfo.y;
2160 XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
9ac0d9e0 2161 xfree (children);
01f1ba30
JB
2162 }
2163
2164 UNBLOCK_INPUT;
2165 return tempwindow != 0;
2166}
2167#endif /* not HAVE_X11 */
2168\f
f0614854
JB
2169DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
2170 "Return a list of the names of available fonts matching PATTERN.\n\
2171If optional arguments FACE and FRAME are specified, return only fonts\n\
2172the same size as FACE on FRAME.\n\
2173\n\
2174PATTERN is a string, perhaps with wildcard characters;\n\
2175 the * character matches any substring, and\n\
2176 the ? character matches any single character.\n\
2177 PATTERN is case-insensitive.\n\
2178FACE is a face name - a symbol.\n\
2179\n\
2180The return value is a list of strings, suitable as arguments to\n\
2181set-face-font.\n\
2182\n\
2183The list does not include fonts Emacs can't use (i.e. proportional\n\
2184fonts), even if they match PATTERN and FACE.")
2185 (pattern, face, frame)
2186 Lisp_Object pattern, face, frame;
2187{
2188 int num_fonts;
2189 char **names;
2190 XFontStruct *info;
2191 XFontStruct *size_ref;
2192 Lisp_Object list;
2193
2194 CHECK_STRING (pattern, 0);
2195 if (!NILP (face))
2196 CHECK_SYMBOL (face, 1);
2197 if (!NILP (frame))
739f2f53 2198 CHECK_LIVE_FRAME (frame, 2);
f0614854
JB
2199
2200 if (NILP (face))
2201 size_ref = 0;
2202 else
2203 {
2204 FRAME_PTR f = NILP (frame) ? selected_frame : XFRAME (frame);
2205 int face_id = face_name_id_number (f, face);
2206
6998a3b4
RS
2207 if (face_id < 0 || face_id >= FRAME_N_FACES (f)
2208 || FRAME_FACES (f) [face_id] == 0)
ea96210c 2209 size_ref = f->display.x->font;
6998a3b4
RS
2210 else
2211 {
2212 size_ref = FRAME_FACES (f) [face_id]->font;
2213 if (size_ref == (XFontStruct *) (~0))
2214 size_ref = f->display.x->font;
2215 }
f0614854
JB
2216 }
2217
2218 BLOCK_INPUT;
2219 names = XListFontsWithInfo (x_current_display,
2220 XSTRING (pattern)->data,
ea96210c 2221 2000, /* maxnames */
f0614854
JB
2222 &num_fonts, /* count_return */
2223 &info); /* info_return */
2224 UNBLOCK_INPUT;
2225
2226 {
2227 Lisp_Object *tail;
2228 int i;
2229
2230 list = Qnil;
2231 tail = &list;
2232 for (i = 0; i < num_fonts; i++)
ea96210c
JB
2233 if (! size_ref
2234 || same_size_fonts (&info[i], size_ref))
f0614854
JB
2235 {
2236 *tail = Fcons (build_string (names[i]), Qnil);
2237 tail = &XCONS (*tail)->cdr;
2238 }
2239
2240 XFreeFontInfo (names, info, num_fonts);
2241 }
2242
2243 return list;
2244}
2245
2246\f
8af1d7ca 2247DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 1, 0,
01f1ba30
JB
2248 "Return t if the current X display supports the color named COLOR.")
2249 (color)
2250 Lisp_Object color;
2251{
2252 Color foo;
2253
11ae94fe 2254 check_x ();
01f1ba30
JB
2255 CHECK_STRING (color, 0);
2256
2257 if (defined_color (XSTRING (color)->data, &foo))
2258 return Qt;
2259 else
2260 return Qnil;
2261}
2262
bcc426b4
RS
2263DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 0, 0,
2264 "Return t if the X screen currently in use supports color.")
01f1ba30
JB
2265 ()
2266{
11ae94fe
RS
2267 check_x ();
2268
a6605e5c 2269 if (x_screen_planes <= 2)
01f1ba30
JB
2270 return Qnil;
2271
2272 switch (screen_visual->class)
2273 {
2274 case StaticColor:
2275 case PseudoColor:
2276 case TrueColor:
2277 case DirectColor:
2278 return Qt;
2279
2280 default:
2281 return Qnil;
2282 }
2283}
2284
41beb8fc
RS
2285DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2286 0, 1, 0,
2287 "Returns the width in pixels of the display FRAME is on.")
2288 (frame)
2289 Lisp_Object frame;
2290{
2291 Display *dpy = x_current_display;
11ae94fe 2292 check_x ();
41beb8fc
RS
2293 return make_number (DisplayWidth (dpy, DefaultScreen (dpy)));
2294}
2295
2296DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2297 Sx_display_pixel_height, 0, 1, 0,
2298 "Returns the height in pixels of the display FRAME is on.")
2299 (frame)
2300 Lisp_Object frame;
2301{
2302 Display *dpy = x_current_display;
11ae94fe 2303 check_x ();
41beb8fc
RS
2304 return make_number (DisplayHeight (dpy, DefaultScreen (dpy)));
2305}
2306
2307DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2308 0, 1, 0,
2309 "Returns the number of bitplanes of the display FRAME is on.")
2310 (frame)
2311 Lisp_Object frame;
2312{
2313 Display *dpy = x_current_display;
11ae94fe 2314 check_x ();
41beb8fc
RS
2315 return make_number (DisplayPlanes (dpy, DefaultScreen (dpy)));
2316}
2317
2318DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2319 0, 1, 0,
2320 "Returns the number of color cells of the display FRAME is on.")
2321 (frame)
2322 Lisp_Object frame;
2323{
2324 Display *dpy = x_current_display;
11ae94fe 2325 check_x ();
41beb8fc
RS
2326 return make_number (DisplayCells (dpy, DefaultScreen (dpy)));
2327}
2328
2329DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
2330 "Returns the vendor ID string of the X server FRAME is on.")
2331 (frame)
2332 Lisp_Object frame;
2333{
2334 Display *dpy = x_current_display;
2335 char *vendor;
11ae94fe 2336 check_x ();
41beb8fc
RS
2337 vendor = ServerVendor (dpy);
2338 if (! vendor) vendor = "";
2339 return build_string (vendor);
2340}
2341
2342DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
2343 "Returns the version numbers of the X server in use.\n\
2344The value is a list of three integers: the major and minor\n\
2345version numbers of the X Protocol in use, and the vendor-specific release\n\
2346number. See also the variable `x-server-vendor'.")
2347 (frame)
2348 Lisp_Object frame;
2349{
2350 Display *dpy = x_current_display;
11ae94fe
RS
2351
2352 check_x ();
41beb8fc
RS
2353 return Fcons (make_number (ProtocolVersion (dpy)),
2354 Fcons (make_number (ProtocolRevision (dpy)),
2355 Fcons (make_number (VendorRelease (dpy)), Qnil)));
2356}
2357
2358DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
2359 "Returns the number of screens on the X server FRAME is on.")
2360 (frame)
2361 Lisp_Object frame;
2362{
11ae94fe 2363 check_x ();
41beb8fc
RS
2364 return make_number (ScreenCount (x_current_display));
2365}
2366
2367DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
2368 "Returns the height in millimeters of the X screen FRAME is on.")
2369 (frame)
2370 Lisp_Object frame;
2371{
11ae94fe 2372 check_x ();
41beb8fc
RS
2373 return make_number (HeightMMOfScreen (x_screen));
2374}
2375
2376DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
2377 "Returns the width in millimeters of the X screen FRAME is on.")
2378 (frame)
2379 Lisp_Object frame;
2380{
11ae94fe 2381 check_x ();
41beb8fc
RS
2382 return make_number (WidthMMOfScreen (x_screen));
2383}
2384
2385DEFUN ("x-display-backing-store", Fx_display_backing_store,
2386 Sx_display_backing_store, 0, 1, 0,
2387 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2388The value may be `always', `when-mapped', or `not-useful'.")
2389 (frame)
2390 Lisp_Object frame;
2391{
11ae94fe
RS
2392 check_x ();
2393
41beb8fc
RS
2394 switch (DoesBackingStore (x_screen))
2395 {
2396 case Always:
2397 return intern ("always");
2398
2399 case WhenMapped:
2400 return intern ("when-mapped");
2401
2402 case NotUseful:
2403 return intern ("not-useful");
2404
2405 default:
2406 error ("Strange value for BackingStore parameter of screen");
2407 }
2408}
2409
2410DEFUN ("x-display-visual-class", Fx_display_visual_class,
2411 Sx_display_visual_class, 0, 1, 0,
2412 "Returns the visual class of the display `screen' is on.\n\
2413The value is one of the symbols `static-gray', `gray-scale',\n\
2414`static-color', `pseudo-color', `true-color', or `direct-color'.")
2415 (screen)
2416 Lisp_Object screen;
2417{
11ae94fe
RS
2418 check_x ();
2419
41beb8fc
RS
2420 switch (screen_visual->class)
2421 {
2422 case StaticGray: return (intern ("static-gray"));
2423 case GrayScale: return (intern ("gray-scale"));
2424 case StaticColor: return (intern ("static-color"));
2425 case PseudoColor: return (intern ("pseudo-color"));
2426 case TrueColor: return (intern ("true-color"));
2427 case DirectColor: return (intern ("direct-color"));
2428 default:
2429 error ("Display has an unknown visual class");
2430 }
2431}
2432
2433DEFUN ("x-display-save-under", Fx_display_save_under,
2434 Sx_display_save_under, 0, 1, 0,
2435 "Returns t if the X screen FRAME is on supports the save-under feature.")
2436 (frame)
2437 Lisp_Object frame;
2438{
11ae94fe
RS
2439 check_x ();
2440
41beb8fc
RS
2441 if (DoesSaveUnders (x_screen) == True)
2442 return Qt;
2443 else
2444 return Qnil;
2445}
2446\f
55caf99c
RS
2447x_pixel_width (f)
2448 register struct frame *f;
01f1ba30 2449{
55caf99c 2450 return PIXEL_WIDTH (f);
01f1ba30
JB
2451}
2452
55caf99c
RS
2453x_pixel_height (f)
2454 register struct frame *f;
01f1ba30 2455{
55caf99c
RS
2456 return PIXEL_HEIGHT (f);
2457}
2458
2459x_char_width (f)
2460 register struct frame *f;
2461{
2462 return FONT_WIDTH (f->display.x->font);
2463}
2464
2465x_char_height (f)
2466 register struct frame *f;
2467{
2468 return FONT_HEIGHT (f->display.x->font);
01f1ba30
JB
2469}
2470\f
85ffea93
RS
2471#if 0 /* These no longer seem like the right way to do things. */
2472
f676886a 2473/* Draw a rectangle on the frame with left top corner including
01f1ba30
JB
2474 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2475 CHARS by LINES wide and long and is the color of the cursor. */
2476
2477void
f676886a
JB
2478x_rectangle (f, gc, left_char, top_char, chars, lines)
2479 register struct frame *f;
01f1ba30
JB
2480 GC gc;
2481 register int top_char, left_char, chars, lines;
2482{
2483 int width;
2484 int height;
f676886a
JB
2485 int left = (left_char * FONT_WIDTH (f->display.x->font)
2486 + f->display.x->internal_border_width);
2487 int top = (top_char * FONT_HEIGHT (f->display.x->font)
2488 + f->display.x->internal_border_width);
01f1ba30
JB
2489
2490 if (chars < 0)
f676886a 2491 width = FONT_WIDTH (f->display.x->font) / 2;
01f1ba30 2492 else
f676886a 2493 width = FONT_WIDTH (f->display.x->font) * chars;
01f1ba30 2494 if (lines < 0)
f676886a 2495 height = FONT_HEIGHT (f->display.x->font) / 2;
01f1ba30 2496 else
f676886a 2497 height = FONT_HEIGHT (f->display.x->font) * lines;
01f1ba30 2498
fe24a618 2499 XDrawRectangle (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
2500 gc, left, top, width, height);
2501}
2502
2503DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
f676886a 2504 "Draw a rectangle on FRAME between coordinates specified by\n\
01f1ba30 2505numbers X0, Y0, X1, Y1 in the cursor pixel.")
f676886a
JB
2506 (frame, X0, Y0, X1, Y1)
2507 register Lisp_Object frame, X0, X1, Y0, Y1;
01f1ba30
JB
2508{
2509 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2510
f676886a 2511 CHECK_LIVE_FRAME (frame, 0);
01f1ba30
JB
2512 CHECK_NUMBER (X0, 0);
2513 CHECK_NUMBER (Y0, 1);
2514 CHECK_NUMBER (X1, 2);
2515 CHECK_NUMBER (Y1, 3);
2516
2517 x0 = XINT (X0);
2518 x1 = XINT (X1);
2519 y0 = XINT (Y0);
2520 y1 = XINT (Y1);
2521
2522 if (y1 > y0)
2523 {
2524 top = y0;
2525 n_lines = y1 - y0 + 1;
2526 }
2527 else
2528 {
2529 top = y1;
2530 n_lines = y0 - y1 + 1;
2531 }
2532
2533 if (x1 > x0)
2534 {
2535 left = x0;
2536 n_chars = x1 - x0 + 1;
2537 }
2538 else
2539 {
2540 left = x1;
2541 n_chars = x0 - x1 + 1;
2542 }
2543
2544 BLOCK_INPUT;
f676886a 2545 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->cursor_gc,
01f1ba30
JB
2546 left, top, n_chars, n_lines);
2547 UNBLOCK_INPUT;
2548
2549 return Qt;
2550}
2551
2552DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
f676886a 2553 "Draw a rectangle drawn on FRAME between coordinates\n\
01f1ba30 2554X0, Y0, X1, Y1 in the regular background-pixel.")
f676886a
JB
2555 (frame, X0, Y0, X1, Y1)
2556 register Lisp_Object frame, X0, Y0, X1, Y1;
01f1ba30
JB
2557{
2558 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2559
f676886a 2560 CHECK_FRAME (frame, 0);
01f1ba30
JB
2561 CHECK_NUMBER (X0, 0);
2562 CHECK_NUMBER (Y0, 1);
2563 CHECK_NUMBER (X1, 2);
2564 CHECK_NUMBER (Y1, 3);
2565
2566 x0 = XINT (X0);
2567 x1 = XINT (X1);
2568 y0 = XINT (Y0);
2569 y1 = XINT (Y1);
2570
2571 if (y1 > y0)
2572 {
2573 top = y0;
2574 n_lines = y1 - y0 + 1;
2575 }
2576 else
2577 {
2578 top = y1;
2579 n_lines = y0 - y1 + 1;
2580 }
2581
2582 if (x1 > x0)
2583 {
2584 left = x0;
2585 n_chars = x1 - x0 + 1;
2586 }
2587 else
2588 {
2589 left = x1;
2590 n_chars = x0 - x1 + 1;
2591 }
2592
2593 BLOCK_INPUT;
f676886a 2594 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->reverse_gc,
01f1ba30
JB
2595 left, top, n_chars, n_lines);
2596 UNBLOCK_INPUT;
2597
2598 return Qt;
2599}
2600
2601/* Draw lines around the text region beginning at the character position
2602 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
2603 pixel and line characteristics. */
2604
f676886a 2605#define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
01f1ba30
JB
2606
2607static void
f676886a
JB
2608outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
2609 register struct frame *f;
01f1ba30
JB
2610 GC gc;
2611 int top_x, top_y, bottom_x, bottom_y;
2612{
f676886a
JB
2613 register int ibw = f->display.x->internal_border_width;
2614 register int font_w = FONT_WIDTH (f->display.x->font);
2615 register int font_h = FONT_HEIGHT (f->display.x->font);
01f1ba30
JB
2616 int y = top_y;
2617 int x = line_len (y);
2618 XPoint *pixel_points = (XPoint *)
2619 alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
2620 register XPoint *this_point = pixel_points;
2621
2622 /* Do the horizontal top line/lines */
2623 if (top_x == 0)
2624 {
2625 this_point->x = ibw;
2626 this_point->y = ibw + (font_h * top_y);
2627 this_point++;
2628 if (x == 0)
2629 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
2630 else
2631 this_point->x = ibw + (font_w * x);
2632 this_point->y = (this_point - 1)->y;
2633 }
2634 else
2635 {
2636 this_point->x = ibw;
2637 this_point->y = ibw + (font_h * (top_y + 1));
2638 this_point++;
2639 this_point->x = ibw + (font_w * top_x);
2640 this_point->y = (this_point - 1)->y;
2641 this_point++;
2642 this_point->x = (this_point - 1)->x;
2643 this_point->y = ibw + (font_h * top_y);
2644 this_point++;
2645 this_point->x = ibw + (font_w * x);
2646 this_point->y = (this_point - 1)->y;
2647 }
2648
2649 /* Now do the right side. */
2650 while (y < bottom_y)
2651 { /* Right vertical edge */
2652 this_point++;
2653 this_point->x = (this_point - 1)->x;
2654 this_point->y = ibw + (font_h * (y + 1));
2655 this_point++;
2656
2657 y++; /* Horizontal connection to next line */
2658 x = line_len (y);
2659 if (x == 0)
2660 this_point->x = ibw + (font_w / 2);
2661 else
2662 this_point->x = ibw + (font_w * x);
2663
2664 this_point->y = (this_point - 1)->y;
2665 }
2666
2667 /* Now do the bottom and connect to the top left point. */
2668 this_point->x = ibw + (font_w * (bottom_x + 1));
2669
2670 this_point++;
2671 this_point->x = (this_point - 1)->x;
2672 this_point->y = ibw + (font_h * (bottom_y + 1));
2673 this_point++;
2674 this_point->x = ibw;
2675 this_point->y = (this_point - 1)->y;
2676 this_point++;
2677 this_point->x = pixel_points->x;
2678 this_point->y = pixel_points->y;
2679
fe24a618 2680 XDrawLines (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
2681 gc, pixel_points,
2682 (this_point - pixel_points + 1), CoordModeOrigin);
2683}
2684
2685DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
2686 "Highlight the region between point and the character under the mouse\n\
f676886a 2687selected frame.")
01f1ba30
JB
2688 (event)
2689 register Lisp_Object event;
2690{
2691 register int x0, y0, x1, y1;
f676886a 2692 register struct frame *f = selected_frame;
01f1ba30
JB
2693 register int p1, p2;
2694
2695 CHECK_CONS (event, 0);
2696
2697 BLOCK_INPUT;
2698 x0 = XINT (Fcar (Fcar (event)));
2699 y0 = XINT (Fcar (Fcdr (Fcar (event))));
2700
2701 /* If the mouse is past the end of the line, don't that area. */
2702 /* ReWrite this... */
2703
f676886a
JB
2704 x1 = f->cursor_x;
2705 y1 = f->cursor_y;
01f1ba30
JB
2706
2707 if (y1 > y0) /* point below mouse */
f676886a 2708 outline_region (f, f->display.x->cursor_gc,
01f1ba30
JB
2709 x0, y0, x1, y1);
2710 else if (y1 < y0) /* point above mouse */
f676886a 2711 outline_region (f, f->display.x->cursor_gc,
01f1ba30
JB
2712 x1, y1, x0, y0);
2713 else /* same line: draw horizontal rectangle */
2714 {
2715 if (x1 > x0)
f676886a 2716 x_rectangle (f, f->display.x->cursor_gc,
01f1ba30
JB
2717 x0, y0, (x1 - x0 + 1), 1);
2718 else if (x1 < x0)
f676886a 2719 x_rectangle (f, f->display.x->cursor_gc,
01f1ba30
JB
2720 x1, y1, (x0 - x1 + 1), 1);
2721 }
2722
2723 XFlush (x_current_display);
2724 UNBLOCK_INPUT;
2725
2726 return Qnil;
2727}
2728
2729DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
2730 "Erase any highlighting of the region between point and the character\n\
f676886a 2731at X, Y on the selected frame.")
01f1ba30
JB
2732 (event)
2733 register Lisp_Object event;
2734{
2735 register int x0, y0, x1, y1;
f676886a 2736 register struct frame *f = selected_frame;
01f1ba30
JB
2737
2738 BLOCK_INPUT;
2739 x0 = XINT (Fcar (Fcar (event)));
2740 y0 = XINT (Fcar (Fcdr (Fcar (event))));
f676886a
JB
2741 x1 = f->cursor_x;
2742 y1 = f->cursor_y;
01f1ba30
JB
2743
2744 if (y1 > y0) /* point below mouse */
f676886a 2745 outline_region (f, f->display.x->reverse_gc,
01f1ba30
JB
2746 x0, y0, x1, y1);
2747 else if (y1 < y0) /* point above mouse */
f676886a 2748 outline_region (f, f->display.x->reverse_gc,
01f1ba30
JB
2749 x1, y1, x0, y0);
2750 else /* same line: draw horizontal rectangle */
2751 {
2752 if (x1 > x0)
f676886a 2753 x_rectangle (f, f->display.x->reverse_gc,
01f1ba30
JB
2754 x0, y0, (x1 - x0 + 1), 1);
2755 else if (x1 < x0)
f676886a 2756 x_rectangle (f, f->display.x->reverse_gc,
01f1ba30
JB
2757 x1, y1, (x0 - x1 + 1), 1);
2758 }
2759 UNBLOCK_INPUT;
2760
2761 return Qnil;
2762}
2763
01f1ba30
JB
2764#if 0
2765int contour_begin_x, contour_begin_y;
2766int contour_end_x, contour_end_y;
2767int contour_npoints;
2768
2769/* Clip the top part of the contour lines down (and including) line Y_POS.
2770 If X_POS is in the middle (rather than at the end) of the line, drop
2771 down a line at that character. */
2772
2773static void
2774clip_contour_top (y_pos, x_pos)
2775{
2776 register XPoint *begin = contour_lines[y_pos].top_left;
2777 register XPoint *end;
2778 register int npoints;
f676886a 2779 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
01f1ba30
JB
2780
2781 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
2782 {
2783 end = contour_lines[y_pos].top_right;
2784 npoints = (end - begin + 1);
2785 XDrawLines (x_current_display, contour_window,
2786 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2787
2788 bcopy (end, begin + 1, contour_last_point - end + 1);
2789 contour_last_point -= (npoints - 2);
2790 XDrawLines (x_current_display, contour_window,
2791 contour_erase_gc, begin, 2, CoordModeOrigin);
2792 XFlush (x_current_display);
2793
2794 /* Now, update contour_lines structure. */
2795 }
2796 /* ______. */
2797 else /* |________*/
2798 {
2799 register XPoint *p = begin + 1;
2800 end = contour_lines[y_pos].bottom_right;
2801 npoints = (end - begin + 1);
2802 XDrawLines (x_current_display, contour_window,
2803 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2804
2805 p->y = begin->y;
2806 p->x = ibw + (font_w * (x_pos + 1));
2807 p++;
2808 p->y = begin->y + font_h;
2809 p->x = (p - 1)->x;
2810 bcopy (end, begin + 3, contour_last_point - end + 1);
2811 contour_last_point -= (npoints - 5);
2812 XDrawLines (x_current_display, contour_window,
2813 contour_erase_gc, begin, 4, CoordModeOrigin);
2814 XFlush (x_current_display);
2815
2816 /* Now, update contour_lines structure. */
2817 }
2818}
2819
2820/* Erase the top horzontal lines of the contour, and then extend
2821 the contour upwards. */
2822
2823static void
2824extend_contour_top (line)
2825{
2826}
2827
2828static void
2829clip_contour_bottom (x_pos, y_pos)
2830 int x_pos, y_pos;
2831{
2832}
2833
2834static void
2835extend_contour_bottom (x_pos, y_pos)
2836{
2837}
2838
2839DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
2840 "")
2841 (event)
2842 Lisp_Object event;
2843{
f676886a
JB
2844 register struct frame *f = selected_frame;
2845 register int point_x = f->cursor_x;
2846 register int point_y = f->cursor_y;
01f1ba30
JB
2847 register int mouse_below_point;
2848 register Lisp_Object obj;
2849 register int x_contour_x, x_contour_y;
2850
2851 x_contour_x = x_mouse_x;
2852 x_contour_y = x_mouse_y;
2853 if (x_contour_y > point_y || (x_contour_y == point_y
2854 && x_contour_x > point_x))
2855 {
2856 mouse_below_point = 1;
f676886a 2857 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
01f1ba30
JB
2858 x_contour_x, x_contour_y);
2859 }
2860 else
2861 {
2862 mouse_below_point = 0;
f676886a 2863 outline_region (f, f->display.x->cursor_gc, x_contour_x, x_contour_y,
01f1ba30
JB
2864 point_x, point_y);
2865 }
2866
2867 while (1)
2868 {
95be70ed 2869 obj = read_char (-1, 0, 0, Qnil, 0);
01f1ba30
JB
2870 if (XTYPE (obj) != Lisp_Cons)
2871 break;
2872
2873 if (mouse_below_point)
2874 {
2875 if (x_mouse_y <= point_y) /* Flipped. */
2876 {
2877 mouse_below_point = 0;
2878
f676886a 2879 outline_region (f, f->display.x->reverse_gc, point_x, point_y,
01f1ba30 2880 x_contour_x, x_contour_y);
f676886a 2881 outline_region (f, f->display.x->cursor_gc, x_mouse_x, x_mouse_y,
01f1ba30
JB
2882 point_x, point_y);
2883 }
2884 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
2885 {
2886 clip_contour_bottom (x_mouse_y);
2887 }
2888 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
2889 {
2890 extend_bottom_contour (x_mouse_y);
2891 }
2892
2893 x_contour_x = x_mouse_x;
2894 x_contour_y = x_mouse_y;
2895 }
2896 else /* mouse above or same line as point */
2897 {
2898 if (x_mouse_y >= point_y) /* Flipped. */
2899 {
2900 mouse_below_point = 1;
2901
f676886a 2902 outline_region (f, f->display.x->reverse_gc,
01f1ba30 2903 x_contour_x, x_contour_y, point_x, point_y);
f676886a 2904 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
01f1ba30
JB
2905 x_mouse_x, x_mouse_y);
2906 }
2907 else if (x_mouse_y > x_contour_y) /* Top clipped. */
2908 {
2909 clip_contour_top (x_mouse_y);
2910 }
2911 else if (x_mouse_y < x_contour_y) /* Top extended. */
2912 {
2913 extend_contour_top (x_mouse_y);
2914 }
2915 }
2916 }
2917
b4f5687c 2918 unread_command_event = obj;
01f1ba30
JB
2919 if (mouse_below_point)
2920 {
2921 contour_begin_x = point_x;
2922 contour_begin_y = point_y;
2923 contour_end_x = x_contour_x;
2924 contour_end_y = x_contour_y;
2925 }
2926 else
2927 {
2928 contour_begin_x = x_contour_x;
2929 contour_begin_y = x_contour_y;
2930 contour_end_x = point_x;
2931 contour_end_y = point_y;
2932 }
2933}
2934#endif
2935
2936DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
2937 "")
2938 (event)
2939 Lisp_Object event;
2940{
2941 register Lisp_Object obj;
f676886a 2942 struct frame *f = selected_frame;
01f1ba30 2943 register struct window *w = XWINDOW (selected_window);
f676886a
JB
2944 register GC line_gc = f->display.x->cursor_gc;
2945 register GC erase_gc = f->display.x->reverse_gc;
01f1ba30
JB
2946#if 0
2947 char dash_list[] = {6, 4, 6, 4};
2948 int dashes = 4;
2949 XGCValues gc_values;
2950#endif
2951 register int previous_y;
f676886a
JB
2952 register int line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
2953 + f->display.x->internal_border_width;
2954 register int left = f->display.x->internal_border_width
01f1ba30 2955 + (w->left
f676886a 2956 * FONT_WIDTH (f->display.x->font));
01f1ba30 2957 register int right = left + (w->width
f676886a
JB
2958 * FONT_WIDTH (f->display.x->font))
2959 - f->display.x->internal_border_width;
01f1ba30
JB
2960
2961#if 0
2962 BLOCK_INPUT;
f676886a
JB
2963 gc_values.foreground = f->display.x->cursor_pixel;
2964 gc_values.background = f->display.x->background_pixel;
01f1ba30
JB
2965 gc_values.line_width = 1;
2966 gc_values.line_style = LineOnOffDash;
2967 gc_values.cap_style = CapRound;
2968 gc_values.join_style = JoinRound;
2969
fe24a618 2970 line_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
2971 GCLineStyle | GCJoinStyle | GCCapStyle
2972 | GCLineWidth | GCForeground | GCBackground,
2973 &gc_values);
2974 XSetDashes (x_current_display, line_gc, 0, dash_list, dashes);
f676886a
JB
2975 gc_values.foreground = f->display.x->background_pixel;
2976 gc_values.background = f->display.x->foreground_pixel;
fe24a618 2977 erase_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
2978 GCLineStyle | GCJoinStyle | GCCapStyle
2979 | GCLineWidth | GCForeground | GCBackground,
2980 &gc_values);
2981 XSetDashes (x_current_display, erase_gc, 0, dash_list, dashes);
2982#endif
2983
2984 while (1)
2985 {
2986 BLOCK_INPUT;
2987 if (x_mouse_y >= XINT (w->top)
2988 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
2989 {
2990 previous_y = x_mouse_y;
f676886a
JB
2991 line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
2992 + f->display.x->internal_border_width;
fe24a618 2993 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
2994 line_gc, left, line, right, line);
2995 }
2996 XFlushQueue ();
2997 UNBLOCK_INPUT;
2998
2999 do
3000 {
95be70ed 3001 obj = read_char (-1, 0, 0, Qnil, 0);
01f1ba30
JB
3002 if ((XTYPE (obj) != Lisp_Cons)
3003 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
f9942c9e 3004 Qvertical_scroll_bar))
01f1ba30
JB
3005 || x_mouse_grabbed)
3006 {
3007 BLOCK_INPUT;
fe24a618 3008 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
3009 erase_gc, left, line, right, line);
3010 UNBLOCK_INPUT;
b4f5687c 3011 unread_command_event = obj;
01f1ba30
JB
3012#if 0
3013 XFreeGC (x_current_display, line_gc);
3014 XFreeGC (x_current_display, erase_gc);
3015#endif
3016 return Qnil;
3017 }
3018 }
3019 while (x_mouse_y == previous_y);
3020
3021 BLOCK_INPUT;
fe24a618 3022 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
3023 erase_gc, left, line, right, line);
3024 UNBLOCK_INPUT;
3025 }
3026}
06ef7355 3027#endif
01f1ba30 3028\f
01f1ba30
JB
3029/* Offset in buffer of character under the pointer, or 0. */
3030int mouse_buffer_offset;
3031
3032#if 0
3033/* These keep track of the rectangle following the pointer. */
3034int mouse_track_top, mouse_track_left, mouse_track_width;
3035
3036DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
3037 "Track the pointer.")
3038 ()
3039{
3040 static Cursor current_pointer_shape;
f676886a 3041 FRAME_PTR f = x_mouse_frame;
01f1ba30
JB
3042
3043 BLOCK_INPUT;
f676886a
JB
3044 if (EQ (Vmouse_frame_part, Qtext_part)
3045 && (current_pointer_shape != f->display.x->nontext_cursor))
01f1ba30
JB
3046 {
3047 unsigned char c;
3048 struct buffer *buf;
3049
f676886a 3050 current_pointer_shape = f->display.x->nontext_cursor;
01f1ba30 3051 XDefineCursor (x_current_display,
fe24a618 3052 FRAME_X_WINDOW (f),
01f1ba30
JB
3053 current_pointer_shape);
3054
3055 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
3056 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
3057 }
f676886a
JB
3058 else if (EQ (Vmouse_frame_part, Qmodeline_part)
3059 && (current_pointer_shape != f->display.x->modeline_cursor))
01f1ba30 3060 {
f676886a 3061 current_pointer_shape = f->display.x->modeline_cursor;
01f1ba30 3062 XDefineCursor (x_current_display,
fe24a618 3063 FRAME_X_WINDOW (f),
01f1ba30
JB
3064 current_pointer_shape);
3065 }
3066
3067 XFlushQueue ();
3068 UNBLOCK_INPUT;
3069}
3070#endif
3071
3072#if 0
3073DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
3074 "Draw rectangle around character under mouse pointer, if there is one.")
3075 (event)
3076 Lisp_Object event;
3077{
3078 struct window *w = XWINDOW (Vmouse_window);
f676886a 3079 struct frame *f = XFRAME (WINDOW_FRAME (w));
01f1ba30
JB
3080 struct buffer *b = XBUFFER (w->buffer);
3081 Lisp_Object obj;
3082
3083 if (! EQ (Vmouse_window, selected_window))
3084 return Qnil;
3085
3086 if (EQ (event, Qnil))
3087 {
3088 int x, y;
3089
f676886a 3090 x_read_mouse_position (selected_frame, &x, &y);
01f1ba30
JB
3091 }
3092
3093 BLOCK_INPUT;
3094 mouse_track_width = 0;
3095 mouse_track_left = mouse_track_top = -1;
3096
3097 do
3098 {
3099 if ((x_mouse_x != mouse_track_left
3100 && (x_mouse_x < mouse_track_left
3101 || x_mouse_x > (mouse_track_left + mouse_track_width)))
3102 || x_mouse_y != mouse_track_top)
3103 {
3104 int hp = 0; /* Horizontal position */
f676886a
JB
3105 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
3106 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
01f1ba30 3107 int tab_width = XINT (b->tab_width);
265a9e55 3108 int ctl_arrow_p = !NILP (b->ctl_arrow);
01f1ba30
JB
3109 unsigned char c;
3110 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
3111 int in_mode_line = 0;
3112
f676886a 3113 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
01f1ba30
JB
3114 break;
3115
3116 /* Erase previous rectangle. */
3117 if (mouse_track_width)
3118 {
f676886a 3119 x_rectangle (f, f->display.x->reverse_gc,
01f1ba30
JB
3120 mouse_track_left, mouse_track_top,
3121 mouse_track_width, 1);
3122
f676886a
JB
3123 if ((mouse_track_left == f->phys_cursor_x
3124 || mouse_track_left == f->phys_cursor_x - 1)
3125 && mouse_track_top == f->phys_cursor_y)
01f1ba30 3126 {
f676886a 3127 x_display_cursor (f, 1);
01f1ba30
JB
3128 }
3129 }
3130
3131 mouse_track_left = x_mouse_x;
3132 mouse_track_top = x_mouse_y;
3133 mouse_track_width = 0;
3134
3135 if (mouse_track_left > len) /* Past the end of line. */
3136 goto draw_or_not;
3137
3138 if (mouse_track_top == mode_line_vpos)
3139 {
3140 in_mode_line = 1;
3141 goto draw_or_not;
3142 }
3143
3144 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
3145 do
3146 {
3147 c = FETCH_CHAR (p);
f676886a 3148 if (len == f->width && hp == len - 1 && c != '\n')
01f1ba30
JB
3149 goto draw_or_not;
3150
3151 switch (c)
3152 {
3153 case '\t':
3154 mouse_track_width = tab_width - (hp % tab_width);
3155 p++;
3156 hp += mouse_track_width;
3157 if (hp > x_mouse_x)
3158 {
3159 mouse_track_left = hp - mouse_track_width;
3160 goto draw_or_not;
3161 }
3162 continue;
3163
3164 case '\n':
3165 mouse_track_width = -1;
3166 goto draw_or_not;
3167
3168 default:
3169 if (ctl_arrow_p && (c < 040 || c == 0177))
3170 {
3171 if (p > ZV)
3172 goto draw_or_not;
3173
3174 mouse_track_width = 2;
3175 p++;
3176 hp +=2;
3177 if (hp > x_mouse_x)
3178 {
3179 mouse_track_left = hp - mouse_track_width;
3180 goto draw_or_not;
3181 }
3182 }
3183 else
3184 {
3185 mouse_track_width = 1;
3186 p++;
3187 hp++;
3188 }
3189 continue;
3190 }
3191 }
3192 while (hp <= x_mouse_x);
3193
3194 draw_or_not:
3195 if (mouse_track_width) /* Over text; use text pointer shape. */
3196 {
3197 XDefineCursor (x_current_display,
fe24a618 3198 FRAME_X_WINDOW (f),
f676886a
JB
3199 f->display.x->text_cursor);
3200 x_rectangle (f, f->display.x->cursor_gc,
01f1ba30
JB
3201 mouse_track_left, mouse_track_top,
3202 mouse_track_width, 1);
3203 }
3204 else if (in_mode_line)
3205 XDefineCursor (x_current_display,
fe24a618 3206 FRAME_X_WINDOW (f),
f676886a 3207 f->display.x->modeline_cursor);
01f1ba30
JB
3208 else
3209 XDefineCursor (x_current_display,
fe24a618 3210 FRAME_X_WINDOW (f),
f676886a 3211 f->display.x->nontext_cursor);
01f1ba30
JB
3212 }
3213
3214 XFlush (x_current_display);
3215 UNBLOCK_INPUT;
3216
95be70ed 3217 obj = read_char (-1, 0, 0, Qnil, 0);
01f1ba30
JB
3218 BLOCK_INPUT;
3219 }
3220 while (XTYPE (obj) == Lisp_Cons /* Mouse event */
a3c87d4e 3221 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
01f1ba30
JB
3222 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
3223 && EQ (Vmouse_window, selected_window) /* In this window */
f676886a 3224 && x_mouse_frame);
01f1ba30 3225
b4f5687c 3226 unread_command_event = obj;
01f1ba30
JB
3227
3228 if (mouse_track_width)
3229 {
f676886a 3230 x_rectangle (f, f->display.x->reverse_gc,
01f1ba30
JB
3231 mouse_track_left, mouse_track_top,
3232 mouse_track_width, 1);
3233 mouse_track_width = 0;
f676886a
JB
3234 if ((mouse_track_left == f->phys_cursor_x
3235 || mouse_track_left - 1 == f->phys_cursor_x)
3236 && mouse_track_top == f->phys_cursor_y)
01f1ba30 3237 {
f676886a 3238 x_display_cursor (f, 1);
01f1ba30
JB
3239 }
3240 }
3241 XDefineCursor (x_current_display,
fe24a618 3242 FRAME_X_WINDOW (f),
f676886a 3243 f->display.x->nontext_cursor);
01f1ba30
JB
3244 XFlush (x_current_display);
3245 UNBLOCK_INPUT;
3246
3247 return Qnil;
3248}
3249#endif
3250\f
3251#if 0
3252#include "glyphs.h"
3253
3254/* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
f676886a 3255 on the frame F at position X, Y. */
01f1ba30 3256
f676886a
JB
3257x_draw_pixmap (f, x, y, image_data, width, height)
3258 struct frame *f;
01f1ba30
JB
3259 int x, y, width, height;
3260 char *image_data;
3261{
3262 Pixmap image;
3263
3264 image = XCreateBitmapFromData (x_current_display,
fe24a618 3265 FRAME_X_WINDOW (f), image_data,
01f1ba30 3266 width, height);
fe24a618 3267 XCopyPlane (x_current_display, image, FRAME_X_WINDOW (f),
f676886a 3268 f->display.x->normal_gc, 0, 0, width, height, x, y);
01f1ba30
JB
3269}
3270#endif
3271\f
01f1ba30
JB
3272#ifndef HAVE_X11
3273DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
3274 1, 1, "sStore text in cut buffer: ",
3275 "Store contents of STRING into the cut buffer of the X window system.")
3276 (string)
3277 register Lisp_Object string;
3278{
3279 int mask;
3280
3281 CHECK_STRING (string, 1);
f9942c9e 3282 if (! FRAME_X_P (selected_frame))
f676886a 3283 error ("Selected frame does not understand X protocol.");
01f1ba30
JB
3284
3285 BLOCK_INPUT;
3286 XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size);
3287 UNBLOCK_INPUT;
3288
3289 return Qnil;
3290}
3291
3292DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
3293 "Return contents of cut buffer of the X window system, as a string.")
3294 ()
3295{
3296 int len;
3297 register Lisp_Object string;
3298 int mask;
3299 register char *d;
3300
3301 BLOCK_INPUT;
3302 d = XFetchBytes (&len);
3303 string = make_string (d, len);
3304 XFree (d);
3305 UNBLOCK_INPUT;
3306 return string;
3307}
3308#endif /* X10 */
3309\f
3310#ifdef HAVE_X11
3311DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3312"Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3313KEYSYM is a string which conforms to the X keysym definitions found\n\
3314in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3315list of strings specifying modifier keys such as Control_L, which must\n\
3316also be depressed for NEWSTRING to appear.")
3317 (x_keysym, modifiers, newstring)
3318 register Lisp_Object x_keysym;
3319 register Lisp_Object modifiers;
3320 register Lisp_Object newstring;
3321{
3322 char *rawstring;
c047688c
JA
3323 register KeySym keysym;
3324 KeySym modifier_list[16];
01f1ba30 3325
11ae94fe 3326 check_x ();
01f1ba30
JB
3327 CHECK_STRING (x_keysym, 1);
3328 CHECK_STRING (newstring, 3);
3329
3330 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
3331 if (keysym == NoSymbol)
3332 error ("Keysym does not exist");
3333
265a9e55 3334 if (NILP (modifiers))
01f1ba30
JB
3335 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
3336 XSTRING (newstring)->data, XSTRING (newstring)->size);
3337 else
3338 {
3339 register Lisp_Object rest, mod;
3340 register int i = 0;
3341
265a9e55 3342 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
01f1ba30
JB
3343 {
3344 if (i == 16)
3345 error ("Can't have more than 16 modifiers");
3346
3347 mod = Fcar (rest);
3348 CHECK_STRING (mod, 3);
3349 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
3350 if (modifier_list[i] == NoSymbol
3351 || !IsModifierKey (modifier_list[i]))
3352 error ("Element is not a modifier keysym");
3353 i++;
3354 }
3355
3356 XRebindKeysym (x_current_display, keysym, modifier_list, i,
3357 XSTRING (newstring)->data, XSTRING (newstring)->size);
3358 }
3359
3360 return Qnil;
3361}
3362
3363DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3364 "Rebind KEYCODE to list of strings STRINGS.\n\
3365STRINGS should be a list of 16 elements, one for each shift combination.\n\
3366nil as element means don't change.\n\
3367See the documentation of `x-rebind-key' for more information.")
3368 (keycode, strings)
3369 register Lisp_Object keycode;
3370 register Lisp_Object strings;
3371{
3372 register Lisp_Object item;
3373 register unsigned char *rawstring;
3374 KeySym rawkey, modifier[1];
3375 int strsize;
3376 register unsigned i;
3377
11ae94fe 3378 check_x ();
01f1ba30
JB
3379 CHECK_NUMBER (keycode, 1);
3380 CHECK_CONS (strings, 2);
3381 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3382 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3383 {
3384 item = Fcar (strings);
265a9e55 3385 if (!NILP (item))
01f1ba30
JB
3386 {
3387 CHECK_STRING (item, 2);
3388 strsize = XSTRING (item)->size;
3389 rawstring = (unsigned char *) xmalloc (strsize);
3390 bcopy (XSTRING (item)->data, rawstring, strsize);
3391 modifier[1] = 1 << i;
3392 XRebindKeysym (x_current_display, rawkey, modifier, 1,
3393 rawstring, strsize);
3394 }
3395 }
3396 return Qnil;
3397}
9d04a87a 3398#endif /* HAVE_X11 */
01f1ba30
JB
3399\f
3400#ifdef HAVE_X11
3401Visual *
3402select_visual (screen, depth)
3403 Screen *screen;
3404 unsigned int *depth;
3405{
3406 Visual *v;
3407 XVisualInfo *vinfo, vinfo_template;
3408 int n_visuals;
3409
3410 v = DefaultVisualOfScreen (screen);
fe24a618
JB
3411
3412#ifdef HAVE_X11R4
3413 vinfo_template.visualid = XVisualIDFromVisual (v);
3414#else
6afb1d07 3415 vinfo_template.visualid = v->visualid;
fe24a618
JB
3416#endif
3417
f0614854
JB
3418 vinfo_template.screen = XScreenNumberOfScreen (screen);
3419
3420 vinfo = XGetVisualInfo (x_current_display,
3421 VisualIDMask | VisualScreenMask, &vinfo_template,
01f1ba30
JB
3422 &n_visuals);
3423 if (n_visuals != 1)
3424 fatal ("Can't get proper X visual info");
3425
3426 if ((1 << vinfo->depth) == vinfo->colormap_size)
3427 *depth = vinfo->depth;
3428 else
3429 {
3430 int i = 0;
3431 int n = vinfo->colormap_size - 1;
3432 while (n)
3433 {
3434 n = n >> 1;
3435 i++;
3436 }
3437 *depth = i;
3438 }
3439
3440 XFree ((char *) vinfo);
3441 return v;
3442}
3443#endif /* HAVE_X11 */
3444
3445DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
3446 1, 2, 0, "Open a connection to an X server.\n\
3447DISPLAY is the name of the display to connect to. Optional second\n\
3448arg XRM_STRING is a string of resources in xrdb format.")
3449 (display, xrm_string)
3450 Lisp_Object display, xrm_string;
3451{
3452 unsigned int n_planes;
01f1ba30
JB
3453 unsigned char *xrm_option;
3454
3455 CHECK_STRING (display, 0);
3456 if (x_current_display != 0)
3457 error ("X server connection is already initialized");
3458
3459 /* This is what opens the connection and sets x_current_display.
3460 This also initializes many symbols, such as those used for input. */
3461 x_term_init (XSTRING (display)->data);
3462
01f1ba30
JB
3463#ifdef HAVE_X11
3464 XFASTINT (Vwindow_system_version) = 11;
3465
3466 if (!EQ (xrm_string, Qnil))
3467 {
3468 CHECK_STRING (xrm_string, 1);
6c703f4a 3469 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
01f1ba30
JB
3470 }
3471 else
3472 xrm_option = (unsigned char *) 0;
3473 xrdb = x_load_resources (x_current_display, xrm_option, EMACS_CLASS);
c58a1a0c 3474#if defined (HAVE_X11R5) && ! defined (NO_XRM_SET_DATBASE)
eb5d618c
JB
3475 XrmSetDatabase (x_current_display, xrdb);
3476#else
01f1ba30 3477 x_current_display->db = xrdb;
eb5d618c 3478#endif
01f1ba30 3479
ac63d3d6
JB
3480 /* Make a version of Vinvocation_name suitable for use in xrdb
3481 queries - i.e. containing no dots or asterisks. */
3482 Vxrdb_name = Fcopy_sequence (Vinvocation_name);
3483 {
3484 int i;
3485 int len = XSTRING (Vxrdb_name)->size;
3486 char *data = XSTRING (Vxrdb_name)->data;
3487
3488 for (i = 0; i < len; i++)
3489 if (data[i] == '.' || data[i] == '*')
3490 data[i] = '-';
3491 }
3492
01f1ba30
JB
3493 x_screen = DefaultScreenOfDisplay (x_current_display);
3494
01f1ba30 3495 screen_visual = select_visual (x_screen, &n_planes);
a6605e5c 3496 x_screen_planes = n_planes;
41beb8fc
RS
3497 x_screen_height = HeightOfScreen (x_screen);
3498 x_screen_width = WidthOfScreen (x_screen);
01f1ba30
JB
3499
3500 /* X Atoms used by emacs. */
99e72068 3501 Xatoms_of_xselect ();
01f1ba30 3502 BLOCK_INPUT;
3c254570
JA
3503 Xatom_wm_protocols = XInternAtom (x_current_display, "WM_PROTOCOLS",
3504 False);
3505 Xatom_wm_take_focus = XInternAtom (x_current_display, "WM_TAKE_FOCUS",
3506 False);
3507 Xatom_wm_save_yourself = XInternAtom (x_current_display, "WM_SAVE_YOURSELF",
3508 False);
3509 Xatom_wm_delete_window = XInternAtom (x_current_display, "WM_DELETE_WINDOW",
3510 False);
3511 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
3512 False);
3513 Xatom_wm_configure_denied = XInternAtom (x_current_display,
3514 "WM_CONFIGURE_DENIED", False);
3515 Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED",
3516 False);
01f1ba30
JB
3517 UNBLOCK_INPUT;
3518#else /* not HAVE_X11 */
3519 XFASTINT (Vwindow_system_version) = 10;
3520#endif /* not HAVE_X11 */
3521 return Qnil;
3522}
3523
3524DEFUN ("x-close-current-connection", Fx_close_current_connection,
3525 Sx_close_current_connection,
3526 0, 0, 0, "Close the connection to the current X server.")
3527 ()
3528{
3529#ifdef HAVE_X11
3530 /* This is ONLY used when killing emacs; For switching displays
3531 we'll have to take care of setting CloseDownMode elsewhere. */
3532
3533 if (x_current_display)
3534 {
3535 BLOCK_INPUT;
3536 XSetCloseDownMode (x_current_display, DestroyAll);
3537 XCloseDisplay (x_current_display);
739f2f53 3538 x_current_display = 0;
01f1ba30
JB
3539 }
3540 else
3541 fatal ("No current X display connection to close\n");
3542#endif
3543 return Qnil;
3544}
3545
3546DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize,
3547 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
3548If ON is nil, allow buffering of requests.\n\
3549Turning on synchronization prohibits the Xlib routines from buffering\n\
3550requests and seriously degrades performance, but makes debugging much\n\
3551easier.")
3552 (on)
3553 Lisp_Object on;
3554{
11ae94fe
RS
3555 check_x ();
3556
01f1ba30
JB
3557 XSynchronize (x_current_display, !EQ (on, Qnil));
3558
3559 return Qnil;
3560}
3561
3562\f
3563syms_of_xfns ()
3564{
01f1ba30
JB
3565 /* This is zero if not using X windows. */
3566 x_current_display = 0;
3567
f9942c9e
JB
3568 /* The section below is built by the lisp expression at the top of the file,
3569 just above where these variables are declared. */
3570 /*&&& init symbols here &&&*/
3571 Qauto_raise = intern ("auto-raise");
3572 staticpro (&Qauto_raise);
3573 Qauto_lower = intern ("auto-lower");
3574 staticpro (&Qauto_lower);
3575 Qbackground_color = intern ("background-color");
3576 staticpro (&Qbackground_color);
dbc4e1c1
JB
3577 Qbar = intern ("bar");
3578 staticpro (&Qbar);
f9942c9e
JB
3579 Qborder_color = intern ("border-color");
3580 staticpro (&Qborder_color);
3581 Qborder_width = intern ("border-width");
3582 staticpro (&Qborder_width);
dbc4e1c1
JB
3583 Qbox = intern ("box");
3584 staticpro (&Qbox);
f9942c9e
JB
3585 Qcursor_color = intern ("cursor-color");
3586 staticpro (&Qcursor_color);
dbc4e1c1
JB
3587 Qcursor_type = intern ("cursor-type");
3588 staticpro (&Qcursor_type);
f9942c9e
JB
3589 Qfont = intern ("font");
3590 staticpro (&Qfont);
3591 Qforeground_color = intern ("foreground-color");
3592 staticpro (&Qforeground_color);
3593 Qgeometry = intern ("geometry");
3594 staticpro (&Qgeometry);
49795535
JB
3595 Qicon = intern ("icon");
3596 staticpro (&Qicon);
f9942c9e
JB
3597 Qicon_left = intern ("icon-left");
3598 staticpro (&Qicon_left);
3599 Qicon_top = intern ("icon-top");
3600 staticpro (&Qicon_top);
3601 Qicon_type = intern ("icon-type");
3602 staticpro (&Qicon_type);
f9942c9e
JB
3603 Qinternal_border_width = intern ("internal-border-width");
3604 staticpro (&Qinternal_border_width);
3605 Qleft = intern ("left");
3606 staticpro (&Qleft);
3607 Qmouse_color = intern ("mouse-color");
3608 staticpro (&Qmouse_color);
baaed68e
JB
3609 Qnone = intern ("none");
3610 staticpro (&Qnone);
f9942c9e
JB
3611 Qparent_id = intern ("parent-id");
3612 staticpro (&Qparent_id);
8af1d7ca
JB
3613 Qsuppress_icon = intern ("suppress-icon");
3614 staticpro (&Qsuppress_icon);
f9942c9e
JB
3615 Qtop = intern ("top");
3616 staticpro (&Qtop);
01f1ba30 3617 Qundefined_color = intern ("undefined-color");
f9942c9e 3618 staticpro (&Qundefined_color);
a3c87d4e
JB
3619 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
3620 staticpro (&Qvertical_scroll_bars);
49795535
JB
3621 Qvisibility = intern ("visibility");
3622 staticpro (&Qvisibility);
f9942c9e
JB
3623 Qwindow_id = intern ("window-id");
3624 staticpro (&Qwindow_id);
3625 Qx_frame_parameter = intern ("x-frame-parameter");
3626 staticpro (&Qx_frame_parameter);
3627 /* This is the end of symbol initialization. */
3628
01f1ba30
JB
3629 Fput (Qundefined_color, Qerror_conditions,
3630 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
3631 Fput (Qundefined_color, Qerror_message,
3632 build_string ("Undefined color"));
3633
f9942c9e
JB
3634 init_x_parm_symbols ();
3635
01f1ba30
JB
3636 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
3637 "The buffer offset of the character under the pointer.");
a6605e5c 3638 mouse_buffer_offset = 0;
01f1ba30 3639
01f1ba30 3640 DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape,
af01ef26
RS
3641 "The shape of the pointer when over text.\n\
3642Changing the value does not affect existing frames\n\
3643unless you set the mouse color.");
01f1ba30
JB
3644 Vx_pointer_shape = Qnil;
3645
ac63d3d6
JB
3646 staticpro (&Vxrdb_name);
3647
af01ef26 3648#if 0
01f1ba30
JB
3649 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
3650 "The shape of the pointer when not over text.");
af01ef26 3651#endif
01f1ba30
JB
3652 Vx_nontext_pointer_shape = Qnil;
3653
af01ef26 3654#if 0
01f1ba30 3655 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
06ef7355 3656 "The shape of the pointer when over the mode line.");
af01ef26 3657#endif
01f1ba30
JB
3658 Vx_mode_pointer_shape = Qnil;
3659
01f1ba30
JB
3660 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
3661 "A string indicating the foreground color of the cursor box.");
3662 Vx_cursor_fore_pixel = Qnil;
3663
3664 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed,
3665 "Non-nil if a mouse button is currently depressed.");
3666 Vmouse_depressed = Qnil;
3667
01f1ba30
JB
3668 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
3669 "t if no X window manager is in use.");
3670
3671#ifdef HAVE_X11
3672 defsubr (&Sx_get_resource);
85ffea93 3673#if 0
01f1ba30
JB
3674 defsubr (&Sx_draw_rectangle);
3675 defsubr (&Sx_erase_rectangle);
3676 defsubr (&Sx_contour_region);
3677 defsubr (&Sx_uncontour_region);
85ffea93 3678#endif
bcc426b4 3679 defsubr (&Sx_display_color_p);
f0614854 3680 defsubr (&Sx_list_fonts);
8af1d7ca 3681 defsubr (&Sx_color_defined_p);
41beb8fc
RS
3682 defsubr (&Sx_server_vendor);
3683 defsubr (&Sx_server_version);
3684 defsubr (&Sx_display_pixel_width);
3685 defsubr (&Sx_display_pixel_height);
3686 defsubr (&Sx_display_mm_width);
3687 defsubr (&Sx_display_mm_height);
3688 defsubr (&Sx_display_screens);
3689 defsubr (&Sx_display_planes);
3690 defsubr (&Sx_display_color_cells);
3691 defsubr (&Sx_display_visual_class);
3692 defsubr (&Sx_display_backing_store);
3693 defsubr (&Sx_display_save_under);
9d04a87a
RS
3694 defsubr (&Sx_rebind_key);
3695 defsubr (&Sx_rebind_keys);
01f1ba30
JB
3696#if 0
3697 defsubr (&Sx_track_pointer);
01f1ba30
JB
3698 defsubr (&Sx_grab_pointer);
3699 defsubr (&Sx_ungrab_pointer);
809ca691 3700#endif
01f1ba30
JB
3701#else
3702 defsubr (&Sx_get_default);
3703 defsubr (&Sx_store_cut_buffer);
3704 defsubr (&Sx_get_cut_buffer);
01f1ba30 3705#endif
8af1d7ca 3706 defsubr (&Sx_parse_geometry);
f676886a
JB
3707 defsubr (&Sx_create_frame);
3708 defsubr (&Sfocus_frame);
3709 defsubr (&Sunfocus_frame);
06ef7355 3710#if 0
01f1ba30 3711 defsubr (&Sx_horizontal_line);
06ef7355 3712#endif
01f1ba30
JB
3713 defsubr (&Sx_open_connection);
3714 defsubr (&Sx_close_current_connection);
3715 defsubr (&Sx_synchronize);
01f1ba30
JB
3716}
3717
3718#endif /* HAVE_X_WINDOWS */