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